diff --git a/src/App/ResourceRecord.purs b/src/App/ResourceRecord.purs index 96d3c2c..4d9f44b 100644 --- a/src/App/ResourceRecord.purs +++ b/src/App/ResourceRecord.purs @@ -1,6 +1,6 @@ module App.ResourceRecord where -import Data.Maybe (Maybe) +import Data.Maybe (Maybe(..)) import Data.Codec.Argonaut (JsonCodec) import Data.Codec.Argonaut as CA @@ -30,6 +30,15 @@ type ResourceRecord , retry :: Maybe Int , expire :: Maybe Int , minttl :: Maybe Int + + -- SPF specific entries. + , v :: Maybe String -- Default: spf1 + , mechanisms :: Maybe (Array Mechanism) + , modifiers :: Maybe (Array Modifier) + , q :: Maybe Int -- Qualifier for default mechanism (`all`). + + -- TODO: DKIM specific entries. + -- TODO: DMARC specific entries. } codec :: JsonCodec ResourceRecord @@ -58,4 +67,65 @@ codec = CA.object "ResourceRecord" , retry: CAR.optional CA.int , expire: CAR.optional CA.int , minttl: CAR.optional CA.int + + -- SPF specific entries. + , v: CAR.optional CA.string + , mechanisms: CAR.optional (CA.array codecMechanism) + , modifiers: CAR.optional (CA.array codecModifier) + , q: CAR.optional CA.int }) + +type Mechanism + = { q :: Maybe Int -- Qualifier (0 = Pass, 1 = Neutral, 2 = soft fail, 3 = hard fail) + , t :: Int -- Type of mechanism (0 = A, 1 = IP4, 2 = IP6, 3 = MX, 4 = PTR, 5 = EXISTS, 6 = INCLUDE) + , v :: String -- Value (IP addresses or ranges, or domains). + } + +codecMechanism :: JsonCodec Mechanism +codecMechanism = CA.object "Mechanism" + (CAR.record + { q: CAR.optional CA.int + , t: CA.int + , v: CA.string + }) + +type Modifier + = { t :: Int -- Type of modifier (0 = EXP, 1 = REDIRECT) + , v :: String -- Value (domain). + } + +codecModifier :: JsonCodec Modifier +codecModifier = CA.object "Modifier" (CAR.record { t: CA.int, v: CA.string }) + +emptyRR :: ResourceRecord +emptyRR + = { rrid: 0 + , readonly: false + , rrtype: "" + , name: "" + , ttl: 1800 + , target: "" + + -- MX + SRV + , priority: Nothing + + -- SRV + , port: Nothing + , protocol: Nothing + , weight: Nothing + + -- SOA + , mname: Nothing + , rname: Nothing + , serial: Nothing + , refresh: Nothing + , retry: Nothing + , expire: Nothing + , minttl: Nothing + + -- SPF specific entries. + , v: Nothing + , mechanisms: Nothing + , modifiers: Nothing + , q: Nothing + } diff --git a/src/App/Validation/DNS.purs b/src/App/Validation/DNS.purs index 39cfaa2..dbfc1cb 100644 --- a/src/App/Validation/DNS.purs +++ b/src/App/Validation/DNS.purs @@ -9,7 +9,7 @@ import Data.Maybe (Maybe(..), maybe) import Data.String.CodeUnits as CU import Data.Validation.Semigroup (V, invalid, toEither) -import App.ResourceRecord (ResourceRecord) +import App.ResourceRecord (ResourceRecord, emptyRR) import GenericParser.SomeParsers as SomeParsers import GenericParser.Parser as G import GenericParser.DomainParser.Common (DomainError) as DomainParser @@ -84,64 +84,6 @@ type RRRetry = Maybe Int type RRExpire = Maybe Int type RRMinttl = Maybe Int - -toRR :: Int -> Boolean -> String -> String -> Int -> String - -> RRPriority - -> RRPort - -> RRProtocol - -> RRWeight - -> RRMname - -> RRRname - -> RRSerial - -> RRRefresh - -> RRRetry - -> RRExpire - -> RRMinttl - -> ResourceRecord -toRR rrid readonly rrtype rrname ttl target - priority port protocol weight mname rname serial refresh retry expire minttl - = { rrid: rrid - , readonly: readonly - , rrtype: rrtype - , name: rrname - , ttl: ttl - , target: target - - -- MX + SRV - , priority: priority - - -- SRV - , port: port - , protocol: protocol - , weight: weight - - -- SOA - , mname: mname - , rname: rname - , serial: serial - , refresh: refresh - , retry: retry - , expire: expire - , minttl: minttl - } - -toRR_basic :: Int -> Boolean -> String -> String -> Int -> String -> ResourceRecord -toRR_basic rrid readonly rrtype rrname ttl target - = toRR rrid readonly rrtype rrname ttl target - Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing - --- last + priority -toRR_mx :: Int -> Boolean -> String -> String -> Int -> String -> Int -> ResourceRecord -toRR_mx rrid readonly rrtype rrname ttl target priority - = toRR rrid readonly rrtype rrname ttl target (Just priority) - Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing - --- last + port + protocol + weight -toRR_srv :: Int -> Boolean -> String -> String -> Int -> String -> Int -> Int -> String -> Int -> ResourceRecord -toRR_srv rrid readonly rrtype rrname ttl target priority port protocol weight - = toRR rrid readonly rrtype rrname ttl target (Just priority) (Just port) (Just protocol) (Just weight) - Nothing Nothing Nothing Nothing Nothing Nothing Nothing - data TXTError = TXTInvalidCharacter | TXTTooLong Int Int -- max current @@ -171,7 +113,7 @@ validationA form = ado name <- parse DomainParser.sub_eof form.name VEName ttl <- is_between min_ttl max_ttl form.ttl VETTL target <- parse IPAddress.ipv4 form.target VEIPv4 - in toRR_basic form.rrid form.readonly "A" name ttl target + in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "A", name = name, ttl = ttl, target = target } validationAAAA :: ResourceRecord -> V (Array Error) ResourceRecord validationAAAA form = ado @@ -179,28 +121,28 @@ validationAAAA form = ado ttl <- is_between min_ttl max_ttl form.ttl VETTL -- use read_input to get unaltered input (the IPv6 parser expands the input) target <- parse (G.read_input IPAddress.ipv6) form.target VEIPv6 - in toRR_basic form.rrid form.readonly "AAAA" name ttl target + in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "AAAA", name = name, ttl = ttl, target = target } validationTXT :: ResourceRecord -> V (Array Error) ResourceRecord validationTXT form = ado name <- parse DomainParser.sub_eof form.name VEName ttl <- is_between min_ttl max_ttl form.ttl VETTL target <- parse txt_parser form.target VETXT - in toRR_basic form.rrid form.readonly "TXT" name ttl target + in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "TXT", name = name, ttl = ttl, target = target } validationCNAME :: ResourceRecord -> V (Array Error) ResourceRecord validationCNAME form = ado name <- parse DomainParser.sub_eof form.name VEName ttl <- is_between min_ttl max_ttl form.ttl VETTL target <- parse DomainParser.sub_eof form.target VECNAME - in toRR_basic form.rrid form.readonly "CNAME" name ttl target + in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "CNAME", name = name, ttl = ttl, target = target } validationNS :: ResourceRecord -> V (Array Error) ResourceRecord validationNS form = ado name <- parse DomainParser.sub_eof form.name VEName ttl <- is_between min_ttl max_ttl form.ttl VETTL target <- parse DomainParser.sub_eof form.target VENS - in toRR_basic form.rrid form.readonly "NS" name ttl target + in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "NS", name = name, ttl = ttl, target = target } data ProtocolError = InvalidProtocol @@ -220,7 +162,8 @@ validationMX form = ado ttl <- is_between min_ttl max_ttl form.ttl VETTL target <- parse DomainParser.sub_eof form.target VEMX priority <- is_between min_priority max_priority (maybe 0 id form.priority) VEPriority - in toRR_mx form.rrid form.readonly "MX" name ttl target priority + in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "MX" + , name = name, ttl = ttl, target = target, priority = Just priority } validationSRV :: ResourceRecord -> V (Array Error) ResourceRecord validationSRV form = ado @@ -231,7 +174,9 @@ validationSRV form = ado protocol <- parse protocol_parser (maybe "" id form.protocol) VEProtocol port <- is_between min_port max_port (maybe 0 id form.port) VEPort weight <- is_between min_weight max_weight (maybe 0 id form.weight) VEWeight - in toRR_srv form.rrid form.readonly "SRV" name ttl target priority port protocol weight + in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "SRV" + , name = name, ttl = ttl, target = target + , priority = Just priority, port = Just port, protocol = Just protocol, weight = Just weight } validation :: ResourceRecord -> Either (Array Error) ResourceRecord validation entry = case entry.rrtype of diff --git a/src/App/ZoneInterface.purs b/src/App/ZoneInterface.purs index a09be19..0e88b7e 100644 --- a/src/App/ZoneInterface.purs +++ b/src/App/ZoneInterface.purs @@ -38,7 +38,7 @@ import Bulma as Bulma import CSSClasses as C import App.AcceptedRRTypes (AcceptedRRTypes(..)) -import App.ResourceRecord (ResourceRecord) +import App.ResourceRecord (ResourceRecord, emptyRR) import App.DisplayErrors (error_to_paragraph) @@ -199,32 +199,11 @@ component = default_domain :: String default_domain = "netlib.re" +default_rr_A :: ResourceRecord +default_rr_A = emptyRR { rrtype = "A", name = "www", target = "10.0.0.1" } + default_empty_rr :: ResourceRecord -default_empty_rr - = { rrtype: "A" - , rrid: 0 - , name: "www" - , ttl: 1800 - , target: "10.0.0.1" - , readonly: false - - -- MX (and SRV) specific entry. - , priority: Nothing - - -- SRV specific entries. - , port: Nothing - , protocol: Nothing - , weight: Nothing - - -- SOA specific entries. - , mname: Nothing - , rname: Nothing - , serial: Nothing - , refresh: Nothing - , retry: Nothing - , expire: Nothing - , minttl: Nothing - } +default_empty_rr = default_rr_A initialState :: Input -> State initialState domain = @@ -411,140 +390,21 @@ handleAction = case _ of CreateNewRRModal t -> do state <- H.get H.modify_ _ { rr_modal = NewRRModal t } - let defaultA = { rrtype: "A" - , rrid: 0 - , ttl: 600 - , readonly: false - , name: "www" - , target: "192.0.2.1" - , port: Nothing - , weight: Nothing - , priority: Nothing - , protocol: Nothing - , mname: Nothing - , rname: Nothing - , serial: Nothing - , refresh: Nothing - , retry: Nothing - , expire: Nothing - , minttl: Nothing - } - defaultAAAA = { rrtype: "AAAA" - , rrid: 0 - , ttl: 600 - , readonly: false - , name: "www" - , target: "2001:db8::1" - , port: Nothing - , weight: Nothing - , priority: Nothing - , protocol: Nothing - , mname: Nothing - , rname: Nothing - , serial: Nothing - , refresh: Nothing - , retry: Nothing - , expire: Nothing - , minttl: Nothing - } - defaultTXT = { rrtype: "TXT" - , rrid: 0 - , ttl: 600 - , readonly: false - , name: "txt" - , target: "some text" - , port: Nothing - , weight: Nothing - , priority: Nothing - , protocol: Nothing - , mname: Nothing - , rname: Nothing - , serial: Nothing - , refresh: Nothing - , retry: Nothing - , expire: Nothing - , minttl: Nothing - } - defaultCNAME = { rrtype: "CNAME" - , rrid: 0 - , ttl: 600 - , readonly: false - , name: "blog" - , target: "www" - , port: Nothing - , weight: Nothing - , priority: Nothing - , protocol: Nothing - , mname: Nothing - , rname: Nothing - , serial: Nothing - , refresh: Nothing - , retry: Nothing - , expire: Nothing - , minttl: Nothing - } - defaultNS = { rrtype: "NS" - , rrid: 0 - , ttl: 600 - , readonly: false - , name: (state._domain <> ".") - , target: "ns0.example.com." - , port: Nothing - , weight: Nothing - , priority: Nothing - , protocol: Nothing - , mname: Nothing - , rname: Nothing - , serial: Nothing - , refresh: Nothing - , retry: Nothing - , expire: Nothing - , minttl: Nothing - } - defaultMX = { rrtype: "MX" - , rrid: 0 - , ttl: 600 - , readonly: false - , name: "mail" - , target: "www" - , port: Nothing - , weight: Nothing - , priority: Just 10 - , protocol: Nothing - , mname: Nothing - , rname: Nothing - , serial: Nothing - , refresh: Nothing - , retry: Nothing - , expire: Nothing - , minttl: Nothing - } - defaultSRV = { rrtype: "SRV" - , rrid: 0 - , ttl: 600 - , readonly: false - , name: "_sip._tcp" - , target: "www" - , port: Just 5061 - , weight: Just 100 - , priority: Just 10 - , protocol: Just "tcp" - , mname: Nothing - , rname: Nothing - , serial: Nothing - , refresh: Nothing - , retry: Nothing - , expire: Nothing - , minttl: Nothing - } + let default_rr_AAAA = emptyRR { rrtype = "AAAA", name = "www", target = "2001:db8::1" } + default_rr_TXT = emptyRR { rrtype = "TXT", name = "txt", target = "some text" } + default_rr_CNAME = emptyRR { rrtype = "CNAME", name = "blog", target = "www" } + default_rr_NS = emptyRR { rrtype = "NS", name = (state._domain <> "."), target = "ns0.example.com." } + default_rr_MX = emptyRR { rrtype = "MX", name = "mail", target = "www", priority = Just 10 } + default_rr_SRV = emptyRR { rrtype = "SRV", name = "_sip._tcp", target = "www" + , port = Just 5061, weight = Just 100, priority = Just 10, protocol = Just "tcp" } case t of - A -> H.modify_ _ { _currentRR = defaultA } - AAAA -> H.modify_ _ { _currentRR = defaultAAAA } - TXT -> H.modify_ _ { _currentRR = defaultTXT } - CNAME -> H.modify_ _ { _currentRR = defaultCNAME } - NS -> H.modify_ _ { _currentRR = defaultNS } - MX -> H.modify_ _ { _currentRR = defaultMX } - SRV -> H.modify_ _ { _currentRR = defaultSRV } + A -> H.modify_ _ { _currentRR = default_rr_A } + AAAA -> H.modify_ _ { _currentRR = default_rr_AAAA } + TXT -> H.modify_ _ { _currentRR = default_rr_TXT } + CNAME -> H.modify_ _ { _currentRR = default_rr_CNAME } + NS -> H.modify_ _ { _currentRR = default_rr_NS } + MX -> H.modify_ _ { _currentRR = default_rr_MX } + SRV -> H.modify_ _ { _currentRR = default_rr_SRV } -- | Initialize the ZoneInterface component: ask for the domain zone to `dnsmanagerd`. Initialize -> do