WIP: SPF
This commit is contained in:
parent
b8b766007c
commit
10f9f7ebb5
@ -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
|
||||
}
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user