halogen-websocket-ipc-playzone/src/App/RR.purs

module App.RR where

type InputParameter
  = { valid :: Boolean
    , value :: String
    }

type RecordType   = String
type RecordValue  = String
type RecordDomain = String

-- These should be integers, but I use these values in user inputs.
type TTL      = String
type Weight   = String
type Priority = String
type Port     = String
type Protocol = String

type RRId = Int

type Modified = Boolean
type Valid    = Boolean

type RecordBase l
  = { t        :: RecordType
    , id       :: RRId
    , modified :: Boolean
    , valid    :: Boolean
    , ttl      :: TTL
    , domain   :: RecordDomain
    , value    :: RecordValue | l
    }

-- CNAME A AAAA NS TXT
type SimpleRR l = RecordBase (|l)

type MXRR  l = RecordBase ( priority :: Priority | l)
type SRVRR l = RecordBase ( priority :: Priority
                          , protocol :: Protocol
                          , weight   :: Weight
                          , port     :: Port
                          | l)

type SOARR l
  = RecordBase ( mname   :: String
               , rname   :: String
               , serial  :: String -- Int
               , refresh :: String -- Int
               , retry   :: String -- Int
               , expire  :: String -- Int
               , minttl  :: String -- Int
               | l)

--data Status
--  = Synchronized
--  | UnSynchronized
--
--type Reason = String
--data Validity
--  = Valid
--  | Invalid (Maybe Reason)
--
---- TODO: add smart constructors.
--data Domain       = Domain String
--data RRAValue     = RRAValue String
--data RRAAAAValue  = RRAAAAValue String
--data RRCNAMEValue = RRCNAMEValue String
--data RRNSValue    = RRNSValue String
--data RRTXTValue   = RRTXTValue String
--data RRMXValue    = RRMXValue String
--data RRSRVValue   = RRSRVValue String
--data Priority     = Priority String
--data Weight       = Weight String
--data Port         = Port String
--
--data RR
--  = A      RRId Status Validity TTL Domain RRAValue
--  | AAAA   RRId Status Validity TTL Domain RRAAAAValue
--  | CNAME  RRId Status Validity TTL Domain RRCNAMEValue
--  | NS     RRId Status Validity TTL Domain RRNSValue
--  | TXT    RRId Status Validity TTL Domain RRTXTValue
--  | MX     RRId Status Validity TTL Domain RRMXValue  Priority
--  | SRV    RRId Status Validity TTL Domain RRSRVValue Priority Weight Port

mkNS    :: RRId -> Modified -> Valid
  -> TTL -> RecordDomain -> RecordValue -> RecordBase ()
mkNS    i c ok t d v
  = { id: i, t: "NS", modified: c, valid: ok
    , ttl: t, domain: d, value: v }
mkA     :: RRId -> Modified -> Valid
  -> TTL -> RecordDomain -> RecordValue -> RecordBase ()
mkA     i c ok t d v
  = { id: i, t: "A", modified: c, valid: ok
    , ttl: t, domain: d, value: v }
mkAAAA  :: RRId -> Modified -> Valid
  -> TTL -> RecordDomain -> RecordValue -> RecordBase ()
mkAAAA  i c ok t d v
  = { id: i, t: "AAAA", modified: c, valid: ok
    , ttl: t, domain: d, value: v }
mkCNAME :: RRId -> Modified -> Valid
  -> TTL -> RecordDomain -> RecordValue -> RecordBase ()
mkCNAME i c ok t d v
  = { id: i, t: "CNAME", modified: c, valid: ok
    , ttl: t, domain: d, value: v }
mkTXT   :: RRId -> Modified -> Valid
  -> TTL -> RecordDomain -> RecordValue -> RecordBase ()
mkTXT   i c ok t d v
  = { id: i, t: "TXT", modified: c, valid: ok
    , ttl: t, domain: d, value: v }

mkMX    :: RRId -> Modified -> Valid
  -> TTL -> RecordDomain -> RecordValue -> Priority -> MXRR ()
mkMX  i c ok t d v p
  = { id: i, t: "MX", modified: c, valid: ok
    , ttl: t, priority: p, domain: d, value: v }

mkSRV   :: RRId -> Modified -> Valid
  -> Priority -> Protocol -> Weight -> Port
  -> TTL -> RecordDomain -> RecordValue -> SRVRR ()
mkSRV  i c ok p prot w prt t d v
  = { id: i, t: "SRV", modified: c
    , valid: ok, priority: p, protocol: prot, weight: w, port: prt
    , ttl: t, domain: d, value: v
    }

defaultResourceA :: SimpleRR ()
defaultResourceA = mkA 0 false true "200"  "www"   "192.168.10.2"

defaultResourceMX :: MXRR ()
defaultResourceMX = mkMX 0 false true "500" "mail" "www" "200"

defaultResourceSRV :: SRVRR ()
-- RRId  Modified  Valid  Priority  Protocol Weight  Port  TTL  Domain  Value
defaultResourceSRV = mkSRV 0 false true "10" "_tcp" "100" "80" "200" "_sip._tcp.example.com." "sip.example.com."