276 lines
8.6 KiB
Plaintext
276 lines
8.6 KiB
Plaintext
module App.ResourceRecord where
|
|
|
|
import Prelude ((<>), map, bind, pure)
|
|
|
|
import Data.Maybe (Maybe(..), maybe)
|
|
|
|
import Data.Codec.Argonaut (JsonCodec)
|
|
import Data.Codec.Argonaut as CA
|
|
import Data.Codec.Argonaut.Record as CAR
|
|
|
|
type PubKey = String
|
|
type CryptoHash = String
|
|
type Signature = String
|
|
type Algorithm = String
|
|
type Selector = String
|
|
type Time = Int
|
|
|
|
type ResourceRecord
|
|
= { rrtype :: String
|
|
, rrid :: Int
|
|
, name :: String
|
|
, ttl :: Int
|
|
, target :: String
|
|
, readonly :: Boolean
|
|
|
|
-- MX (and SRV) specific entry.
|
|
, priority :: Maybe Int
|
|
|
|
-- SRV specific entries.
|
|
, port :: Maybe Int
|
|
, protocol :: Maybe String
|
|
, weight :: Maybe Int
|
|
|
|
-- SOA specific entries.
|
|
, mname :: Maybe String
|
|
, rname :: Maybe String
|
|
, serial :: Maybe Int
|
|
, refresh :: Maybe Int
|
|
, 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 Qualifier -- Qualifier for default mechanism (`all`).
|
|
|
|
-- DKIM is so complex, it deserves its own type.
|
|
--, dkim :: Maybe DKIM
|
|
|
|
-- TODO: DMARC specific entries.
|
|
}
|
|
|
|
-- DKIM specific entries.
|
|
type DKIM
|
|
= { v :: Maybe Int -- Default: 1
|
|
, a :: Maybe Algorithm -- TODO: (required), signing algorithm (example: `rsa-sha256`)
|
|
, d :: Maybe String -- TODO: (required), Signing Domain Identifier (SDID) (example: `netlib.re`)
|
|
, s :: Maybe Selector -- TODO: (required), selector (name of the DNS TXT entry for DKIM, such as `baguette` for `_baguette._dkim.netlib.re`)
|
|
, c :: Maybe Algorithm -- TODO: (optional), canonicalization algorithm(s) for header and body (ex: "relaxed/simple")
|
|
, q :: Maybe String -- TODO: (optional), default query method (example: `dns/txt`)
|
|
, i :: Maybe String -- TODO: (optional), Agent or User Identifier (AUID) (in practice, an email address)
|
|
, t :: Maybe Time -- TODO: (recommended), signature timestamp (time = number, such as `1117574938`)
|
|
, x :: Maybe Time -- TODO: (recommended), expire time (time = number, such as `1117574938`)
|
|
, l :: Maybe Int -- TODO: (optional), body length (such as `200`)
|
|
, h :: Maybe String -- TODO: (required), header fields - list of those that have been signed
|
|
, z :: Maybe String -- TODO: (optional), header fields - copy of selected header fields and values
|
|
, bh :: Maybe CryptoHash -- TODO: (required), body hash
|
|
, b :: Maybe Signature -- TODO: (required), signature of headers and body
|
|
}
|
|
-- h=from:to:subject:date:keywords:keywords;
|
|
-- z=From:foo@eng.example.net|To:joe@example.com|
|
|
-- Subject:demo=20run|Date:July=205,=202005=203:44:08=20PM=20-0700;
|
|
-- bh=MTIzNDU2Nzg5MDEyMzQ1Njc4OTAxMjM0NTY3ODkwMTI=;
|
|
-- b=dzdVyOfAKCdLXdJOc9G2q8LoXSlEniSbav+yuU4zGeeruD00lszZVoG4ZHRNiYzR
|
|
|
|
codec :: JsonCodec ResourceRecord
|
|
codec = CA.object "ResourceRecord"
|
|
(CAR.record
|
|
{ rrtype: CA.string
|
|
, rrid: CA.int
|
|
, name: CA.string
|
|
, ttl: CA.int
|
|
, target: CA.string
|
|
, readonly: CA.boolean
|
|
|
|
-- MX (and SRV) specific entry.
|
|
, priority: CAR.optional CA.int
|
|
|
|
-- SRV specific entries.
|
|
, port: CAR.optional CA.int
|
|
, protocol: CAR.optional CA.string
|
|
, weight: CAR.optional CA.int
|
|
|
|
-- SOA specific entries.
|
|
, mname: CAR.optional CA.string
|
|
, rname: CAR.optional CA.string
|
|
, serial: CAR.optional CA.int
|
|
, refresh: CAR.optional CA.int
|
|
, 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 codecQualifier
|
|
--, dkim: CAR.optional codecDKIM
|
|
})
|
|
|
|
type Mechanism
|
|
= { q :: Maybe Qualifier
|
|
, t :: MechanismType
|
|
, v :: String -- Value (IP addresses or ranges, or domains).
|
|
}
|
|
|
|
codecMechanism :: JsonCodec Mechanism
|
|
codecMechanism = CA.object "Mechanism"
|
|
(CAR.record
|
|
{ q: CAR.optional codecQualifier
|
|
, t: codecMechanismType
|
|
, v: CA.string
|
|
})
|
|
|
|
-- TODO: this is debug code, before actual validation.
|
|
to_mechanism :: String -> String -> String -> Maybe Mechanism
|
|
to_mechanism q t v = do
|
|
mechanism_type <- str_to_mechanism_type t
|
|
pure { q: str_to_qualifier q, t: mechanism_type, v }
|
|
to_modifier :: String -> String -> Maybe Modifier
|
|
to_modifier t v = do
|
|
modifier_type <- str_to_modifier_type t
|
|
pure { t: modifier_type, v }
|
|
|
|
-- | `show_modifier` acts like `show_mechanism` regarding the value (meaning: it can be discarded).
|
|
-- | But this probably shouldn't since both values of modifiers actually NEED a value.
|
|
show_modifier :: Modifier -> String
|
|
show_modifier m =
|
|
let mtype = show_modifier_type m.t
|
|
value = case m.v of
|
|
"" -> ""
|
|
_ -> "=" <> m.v
|
|
in mtype <> value
|
|
|
|
show_mechanism :: Mechanism -> String
|
|
show_mechanism m =
|
|
let qualifier = case maybe "" show_qualifier_char m.q of
|
|
"+" -> ""
|
|
v -> v
|
|
mtype = show_mechanism_type m.t
|
|
value = case m.v of
|
|
"" -> ""
|
|
_ -> "=" <> m.v
|
|
in qualifier <> mtype <> value
|
|
|
|
show_qualifier_char :: Qualifier -> String
|
|
show_qualifier_char = case _ of
|
|
Pass -> "+"
|
|
Neutral -> "?"
|
|
SoftFail -> "~"
|
|
HardFail -> "-"
|
|
|
|
data MechanismType = A | IP4 | IP6 | MX | PTR | EXISTS | INCLUDE
|
|
mechanism_types :: Array String
|
|
mechanism_types = map show_mechanism_type [ A, IP4, IP6, MX, PTR, EXISTS, INCLUDE ]
|
|
|
|
-- | Codec for just encoding a single value of type `MechanismType`.
|
|
codecMechanismType :: CA.JsonCodec MechanismType
|
|
codecMechanismType = CA.prismaticCodec "MechanismType" str_to_mechanism_type show_mechanism_type CA.string
|
|
|
|
str_to_mechanism_type :: String -> Maybe MechanismType
|
|
str_to_mechanism_type = case _ of
|
|
"a" -> Just A
|
|
"ip4" -> Just IP4
|
|
"ip6" -> Just IP6
|
|
"mx" -> Just MX
|
|
"ptr" -> Just PTR
|
|
"exists" -> Just EXISTS
|
|
"include" -> Just INCLUDE
|
|
_ -> Nothing
|
|
|
|
show_mechanism_type :: MechanismType -> String
|
|
show_mechanism_type = case _ of
|
|
A -> "a"
|
|
IP4 -> "ip4"
|
|
IP6 -> "ip6"
|
|
MX -> "mx"
|
|
PTR -> "ptr"
|
|
EXISTS -> "exists"
|
|
INCLUDE -> "include"
|
|
|
|
data ModifierType = EXP | REDIRECT
|
|
modifier_types :: Array String
|
|
modifier_types = ["exp", "redirect"]
|
|
|
|
show_modifier_type :: ModifierType -> String
|
|
show_modifier_type = case _ of
|
|
EXP -> "exp"
|
|
REDIRECT -> "redirect"
|
|
|
|
-- | Codec for just encoding a single value of type `ModifierType`.
|
|
codecModifierType :: CA.JsonCodec ModifierType
|
|
codecModifierType = CA.prismaticCodec "ModifierType" str_to_modifier_type show_modifier_type CA.string
|
|
|
|
str_to_modifier_type :: String -> Maybe ModifierType
|
|
str_to_modifier_type = case _ of
|
|
"exp" -> Just EXP
|
|
"redirect" -> Just REDIRECT
|
|
_ -> Nothing
|
|
|
|
type Modifier = { t :: ModifierType, v :: String {- Value (domain). -} }
|
|
codecModifier :: JsonCodec Modifier
|
|
codecModifier = CA.object "Modifier" (CAR.record { t: codecModifierType, 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
|
|
|
|
--, dkim: Nothing
|
|
}
|
|
|
|
data Qualifier = Pass | Neutral | SoftFail | HardFail
|
|
all_qualifiers :: Array Qualifier
|
|
all_qualifiers = [Pass, Neutral, SoftFail, HardFail]
|
|
qualifier_types :: Array String
|
|
qualifier_types = ["pass", "neutral", "soft_fail", "hard_fail"]
|
|
|
|
-- | Codec for just encoding a single value of type `Qualifier`.
|
|
codecQualifier :: CA.JsonCodec Qualifier
|
|
codecQualifier = CA.prismaticCodec "Qualifier" str_to_qualifier show_qualifier CA.string
|
|
|
|
str_to_qualifier :: String -> Maybe Qualifier
|
|
str_to_qualifier = case _ of
|
|
"pass" -> Just Pass -- +
|
|
"neutral" -> Just Neutral -- ?
|
|
"soft_fail" -> Just SoftFail -- ~
|
|
"hard_fail" -> Just HardFail -- -
|
|
_ -> Nothing
|
|
|
|
show_qualifier :: Qualifier -> String
|
|
show_qualifier = case _ of
|
|
Pass -> "pass"
|
|
Neutral -> "neutral"
|
|
SoftFail -> "soft_fail"
|
|
HardFail -> "hard_fail"
|