Refactoring: split forms, validation errors, generic data types.
This commit is contained in:
parent
a3bdecb1fd
commit
4b59d52684
8 changed files with 575 additions and 522 deletions
|
|
@ -1,45 +1,7 @@
|
|||
module App.Type.Delegation where
|
||||
module App.Type.Delegation
|
||||
( module App.Type.Form.Delegation
|
||||
, module App.Type.Error.Delegation
|
||||
) where
|
||||
|
||||
import GenericParser.Parser as G
|
||||
import GenericParser.DomainParser.Common (DomainError) as DomainParser
|
||||
|
||||
-- | The required data needed to properly delegate a domain: two name servers.
|
||||
-- | The type also includes potential errors found while validating the data.
|
||||
type Form
|
||||
= { nameserver1 :: String
|
||||
, nameserver2 :: String
|
||||
, errors :: Array Error
|
||||
}
|
||||
|
||||
-- | Empty delegation form, with default inputs.
|
||||
mkEmptyDelegationForm :: Form
|
||||
mkEmptyDelegationForm
|
||||
= { nameserver1: "ns0.example.com"
|
||||
, nameserver2: "ns1.example.com"
|
||||
, errors: []
|
||||
}
|
||||
|
||||
-- | What are the **fields** of our delegation form?
|
||||
-- | This *Field* data type provides a way to update the form with `update`.
|
||||
data Field
|
||||
= NameServer1 String
|
||||
| NameServer2 String
|
||||
|
||||
-- | Utility function to update a field of the form, based on the previous `Form` and `Field` types.
|
||||
-- |
|
||||
-- | RATIONALE: this utility function enables a generic way of handling field updates.
|
||||
-- | In Halogen, a single *Action* is required to update all fields:
|
||||
-- |```
|
||||
-- | UpdateDelegationForm field -> do
|
||||
-- | state <- H.get
|
||||
-- | H.modify_ _ { delegation_form = Delegation.update state.delegation_form field }
|
||||
-- |```
|
||||
update :: Form -> Field -> Form
|
||||
update form updated_field = case updated_field of
|
||||
NameServer1 val -> form { nameserver1 = val }
|
||||
NameServer2 val -> form { nameserver2 = val }
|
||||
|
||||
-- | Possible errors regarding the form (domain parsing errors).
|
||||
data Error
|
||||
= VENameServer1 (G.Error DomainParser.DomainError)
|
||||
| VENameServer2 (G.Error DomainParser.DomainError)
|
||||
import App.Type.Form.Delegation (Form, Field(..), update, mkEmptyDelegationForm)
|
||||
import App.Type.Error.Delegation (Error(..))
|
||||
|
|
|
|||
10
src/App/Type/Error/Delegation.purs
Normal file
10
src/App/Type/Error/Delegation.purs
Normal file
|
|
@ -0,0 +1,10 @@
|
|||
-- | Possible errors while verifying the Delegation form.
|
||||
module App.Type.Error.Delegation where
|
||||
|
||||
import GenericParser.Parser as G
|
||||
import GenericParser.DomainParser.Common (DomainError) as DomainParser
|
||||
|
||||
-- | Possible errors regarding the form (domain parsing errors).
|
||||
data Error
|
||||
= VENameServer1 (G.Error DomainParser.DomainError)
|
||||
| VENameServer2 (G.Error DomainParser.DomainError)
|
||||
56
src/App/Type/Error/ResourceRecord.purs
Normal file
56
src/App/Type/Error/ResourceRecord.purs
Normal file
|
|
@ -0,0 +1,56 @@
|
|||
module App.Type.Error.ResourceRecord where
|
||||
|
||||
import Prelude (class Show, ($), (-), (<>))
|
||||
|
||||
import GenericParser.Parser as G
|
||||
import GenericParser.IPAddress as IPAddress
|
||||
import GenericParser.DomainParser.Common (DomainError) as DomainParser
|
||||
|
||||
-- | Errors that might be catched in for the form upon validation (`App.Validation.DNS`).
|
||||
-- |
|
||||
-- | **History:**
|
||||
-- | The module once used dedicated types for each type of RR.
|
||||
-- | That comes with several advantages.
|
||||
-- | First, type verification was a thing, and function were dedicated to a certain type of record.
|
||||
-- | Second, these dedicated types used strings for their fields,
|
||||
-- | which simplifies the typing when dealing with forms.
|
||||
-- | Finally, the validation was a way to convert dedicated types (used in forms)
|
||||
-- | to the general type (used for network serialization).
|
||||
-- | This ensures each resource record is verified before being sent to `dnsmanagerd`.
|
||||
-- |
|
||||
-- | The problem is that, with dedicated types, you are then required to have dedicated functions.
|
||||
-- | Conversion functions are also required.
|
||||
-- |
|
||||
-- | Maybe the code will change again in the future, but for now it will be enough.
|
||||
|
||||
data Error
|
||||
= UNKNOWN
|
||||
| VEIPv4 (G.Error IPAddress.IPv4Error)
|
||||
| VEIPv6 (G.Error IPAddress.IPv6Error)
|
||||
| VEName (G.Error DomainParser.DomainError)
|
||||
| VETTL Int Int Int
|
||||
| VETXT (G.Error TXTError)
|
||||
| VECNAME (G.Error DomainParser.DomainError)
|
||||
| VENS (G.Error DomainParser.DomainError)
|
||||
| VEMX (G.Error DomainParser.DomainError)
|
||||
| VEPriority Int Int Int
|
||||
| VESRV (G.Error DomainParser.DomainError)
|
||||
| VEPort Int Int Int
|
||||
| VEWeight Int Int Int
|
||||
| VEDMARCpct Int Int Int
|
||||
| VEDMARCri Int Int Int
|
||||
|
||||
| VECAAflag Int Int Int -- CAA flag should be between 0 and 255 (1 byte).
|
||||
|
||||
-- SPF
|
||||
| VESPFMechanismName (G.Error DomainParser.DomainError)
|
||||
| VESPFMechanismIPv4 (G.Error IPAddress.IPv4Error)
|
||||
| VESPFMechanismIPv6 (G.Error IPAddress.IPv6Error)
|
||||
|
||||
| VESPFModifierName (G.Error DomainParser.DomainError)
|
||||
|
||||
| DKIMInvalidKeySize Int Int
|
||||
|
||||
data TXTError
|
||||
= TXTInvalidCharacter
|
||||
| TXTTooLong Int Int -- max current
|
||||
39
src/App/Type/Form/Delegation.purs
Normal file
39
src/App/Type/Form/Delegation.purs
Normal file
|
|
@ -0,0 +1,39 @@
|
|||
module App.Type.Form.Delegation where
|
||||
|
||||
import App.Type.Error.Delegation (Error)
|
||||
|
||||
-- | The required data needed to properly delegate a domain: two name servers.
|
||||
-- | The type also includes potential errors found while validating the data.
|
||||
type Form
|
||||
= { nameserver1 :: String
|
||||
, nameserver2 :: String
|
||||
, errors :: Array Error
|
||||
}
|
||||
|
||||
-- | Empty delegation form, with default inputs.
|
||||
mkEmptyDelegationForm :: Form
|
||||
mkEmptyDelegationForm
|
||||
= { nameserver1: "ns0.example.com"
|
||||
, nameserver2: "ns1.example.com"
|
||||
, errors: []
|
||||
}
|
||||
|
||||
-- | What are the **fields** of our delegation form?
|
||||
-- | This *Field* data type provides a way to update the form with `update`.
|
||||
data Field
|
||||
= NameServer1 String
|
||||
| NameServer2 String
|
||||
|
||||
-- | Utility function to update a field of the form, based on the previous `Form` and `Field` types.
|
||||
-- |
|
||||
-- | RATIONALE: this utility function enables a generic way of handling field updates.
|
||||
-- | In Halogen, a single *Action* is required to update all fields:
|
||||
-- |```
|
||||
-- | UpdateDelegationForm field -> do
|
||||
-- | state <- H.get
|
||||
-- | H.modify_ _ { delegation_form = Delegation.update state.delegation_form field }
|
||||
-- |```
|
||||
update :: Form -> Field -> Form
|
||||
update form updated_field = case updated_field of
|
||||
NameServer1 val -> form { nameserver1 = val }
|
||||
NameServer2 val -> form { nameserver2 = val }
|
||||
240
src/App/Type/Form/ResourceRecord.purs
Normal file
240
src/App/Type/Form/ResourceRecord.purs
Normal file
|
|
@ -0,0 +1,240 @@
|
|||
module App.Type.Form.ResourceRecord where
|
||||
|
||||
import Prelude (($), (-), (<>))
|
||||
|
||||
import Data.Maybe (Maybe(..), fromMaybe, maybe)
|
||||
import Data.Array as A
|
||||
import Data.Int (fromString)
|
||||
import Data.Either (Either(..))
|
||||
|
||||
import Utils (id, attach_id, remove_id)
|
||||
|
||||
import App.Validation.Email as Email
|
||||
|
||||
import App.Type.ResourceRecord.AcceptedRRTypes (AcceptedRRTypes(..))
|
||||
|
||||
import App.Type.ResourceRecord.ResourceRecord (ResourceRecord, default_caa, default_rr, srv_protocols)
|
||||
import App.Type.ResourceRecord.CAA as CAA
|
||||
import App.Type.ResourceRecord.DKIM as DKIM
|
||||
import App.Type.ResourceRecord.DMARC as DMARC
|
||||
import App.Type.ResourceRecord.SPF as SPF
|
||||
|
||||
import App.Type.Error.ResourceRecord (Error)
|
||||
|
||||
-- | `Form` is the necessary state to modify a resource record.
|
||||
-- | It contains the currently manipulated record, detected errors, along with some temporary values.
|
||||
-- | FIXME: this form is messy AF and should be replaced.
|
||||
type Form =
|
||||
{ _rr :: ResourceRecord
|
||||
, _errors :: Array Error
|
||||
, _dmarc_mail_errors :: Array Email.Error
|
||||
, _zonefile :: Maybe String
|
||||
, tmp :: TMP
|
||||
}
|
||||
|
||||
data Field
|
||||
= Domain String
|
||||
| TTL String
|
||||
| Target String
|
||||
| Priority String
|
||||
| Weight String
|
||||
| Port String
|
||||
| SPF_v String
|
||||
| SPF_mechanisms (Array SPF.Mechanism)
|
||||
| SPF_modifiers (Array SPF.Modifier)
|
||||
| SPF_q SPF.Qualifier
|
||||
|
||||
| CAA_flag String
|
||||
| CAA_value String
|
||||
|
||||
-- | TMP: temporary stored values regarding specific records such as SPF,
|
||||
-- | DKIM and DMARC.
|
||||
type TMP =
|
||||
{
|
||||
-- SPF details.
|
||||
spf :: { mechanism_q :: String
|
||||
, mechanism_t :: String
|
||||
, mechanism_v :: String
|
||||
, modifier_t :: String
|
||||
, modifier_v :: String
|
||||
}
|
||||
|
||||
-- DMARC details.
|
||||
, dmarc_mail :: String
|
||||
, dmarc_mail_limit :: Maybe Int
|
||||
, dmarc :: DMARC.DMARC
|
||||
|
||||
-- DKIM details.
|
||||
, dkim :: DKIM.DKIM
|
||||
}
|
||||
|
||||
mkEmptyRRForm :: Form
|
||||
mkEmptyRRForm =
|
||||
{
|
||||
-- This is the state for the new RR modal.
|
||||
_rr: default_rr A ""
|
||||
-- List of errors within the form in new RR modal.
|
||||
, _errors: []
|
||||
, _dmarc_mail_errors: []
|
||||
, _zonefile: Nothing
|
||||
, tmp: { spf: { mechanism_q: "pass"
|
||||
, mechanism_t: "a"
|
||||
, mechanism_v: ""
|
||||
, modifier_t: "redirect"
|
||||
, modifier_v: ""
|
||||
}
|
||||
, dkim: DKIM.emptyDKIMRR
|
||||
, dmarc: DMARC.emptyDMARCRR
|
||||
, dmarc_mail: ""
|
||||
, dmarc_mail_limit: Nothing
|
||||
}
|
||||
}
|
||||
|
||||
data RRUpdateValue
|
||||
= CAA_tag Int
|
||||
| SRV_Protocol Int
|
||||
| SPF_Mechanism_q Int
|
||||
| SPF_Mechanism_t Int
|
||||
| SPF_Mechanism_v String
|
||||
| SPF_Modifier_t Int
|
||||
| SPF_Modifier_v String
|
||||
| SPF_Qualifier Int
|
||||
|
||||
-- | Remove a SPF mechanism of the currently modified (SPF) entry (see `_currentRR`).
|
||||
| SPF_remove_mechanism Int
|
||||
-- | Remove a SPF modifier of the currently modified (SPF) entry (see `_currentRR`).
|
||||
| SPF_remove_modifier Int
|
||||
|
||||
-- | Add a SPF mechanism to the currently modified (SPF) entry (see `_currentRR`).
|
||||
| SPF_Mechanism_Add
|
||||
-- | Add a SPF modifier to the currently modified (SPF) entry (see `_currentRR`).
|
||||
| SPF_Modifier_Add
|
||||
|
||||
-- | Change the temporary mail address for DMARC.
|
||||
| DMARC_mail String
|
||||
|
||||
-- | Change the temporary report size limit for DMARC.
|
||||
| DMARC_mail_limit String
|
||||
|
||||
-- | Change the requested report interval.
|
||||
| DMARC_ri String
|
||||
|
||||
-- | Add a new mail address to the DMARC rua list.
|
||||
| DMARC_rua_Add
|
||||
|
||||
-- | Add a new mail address to the DMARC ruf list.
|
||||
| DMARC_ruf_Add
|
||||
|
||||
-- | Remove a mail address of the DMARC rua list.
|
||||
| DMARC_remove_rua Int
|
||||
|
||||
-- | Remove a mail address of the DMARC ruf list.
|
||||
| DMARC_remove_ruf Int
|
||||
|
||||
| DMARC_policy Int
|
||||
| DMARC_sp_policy Int
|
||||
| DMARC_adkim Int
|
||||
| DMARC_aspf Int
|
||||
| DMARC_pct String
|
||||
| DMARC_fo Int
|
||||
|
||||
| DKIM_hash_algo Int
|
||||
| DKIM_sign_algo Int
|
||||
| DKIM_pubkey String
|
||||
| DKIM_note String
|
||||
|
||||
update_form :: Form -> RRUpdateValue -> Form
|
||||
update_form form new_field_value =
|
||||
case new_field_value of
|
||||
CAA_tag v ->
|
||||
let new_tag = fromMaybe CAA.Issue $ CAA.tags A.!! v
|
||||
new_value = case new_tag of
|
||||
CAA.Issue -> "letsencrypt.org"
|
||||
CAA.ContactEmail -> "contact@example.com"
|
||||
CAA.ContactPhone -> "0203040506"
|
||||
_ -> ""
|
||||
new_caa = (fromMaybe default_caa form._rr.caa) { tag = new_tag, value = new_value }
|
||||
in form { _rr { caa = Just new_caa } }
|
||||
|
||||
SRV_Protocol v -> form { _rr { protocol = srv_protocols A.!! v } }
|
||||
SPF_Mechanism_q v -> form { tmp { spf { mechanism_q = maybe "pass" id $ SPF.qualifier_types A.!! v }}}
|
||||
SPF_Mechanism_t v -> form { tmp { spf { mechanism_t = maybe "a" id $ SPF.mechanism_types A.!! v }}}
|
||||
SPF_Mechanism_v v -> form { tmp { spf { mechanism_v = v }}}
|
||||
SPF_Modifier_t v -> form { tmp { spf { modifier_t = maybe "redirect" id $ SPF.modifier_types A.!! v }}}
|
||||
SPF_Modifier_v v -> form { tmp { spf { modifier_v = v }}}
|
||||
SPF_Qualifier v -> form { _rr { q = SPF.qualifiers A.!! v }}
|
||||
SPF_remove_mechanism i ->
|
||||
form { _rr { mechanisms = case form._rr.mechanisms of
|
||||
Just ms -> Just (remove_id i $ attach_id 0 ms)
|
||||
Nothing -> Nothing
|
||||
} }
|
||||
SPF_remove_modifier i ->
|
||||
form { _rr { modifiers = case form._rr.modifiers of
|
||||
Just ms -> Just (remove_id i $ attach_id 0 ms)
|
||||
Nothing -> Nothing
|
||||
} }
|
||||
|
||||
SPF_Mechanism_Add ->
|
||||
let m = form._rr.mechanisms
|
||||
m_q = form.tmp.spf.mechanism_q
|
||||
m_t = form.tmp.spf.mechanism_t
|
||||
m_v = form.tmp.spf.mechanism_v
|
||||
new_list_of_mechanisms = maybe [] id m <> maybe [] (\x -> [x]) (SPF.to_mechanism m_q m_t m_v)
|
||||
new_value = case new_list_of_mechanisms of
|
||||
[] -> Nothing
|
||||
v -> Just v
|
||||
in form { _rr { mechanisms = new_value }}
|
||||
|
||||
SPF_Modifier_Add ->
|
||||
let m = form._rr.modifiers
|
||||
m_t = form.tmp.spf.modifier_t
|
||||
m_v = form.tmp.spf.modifier_v
|
||||
new_list_of_modifiers = maybe [] id m <> maybe [] (\x -> [x]) (SPF.to_modifier m_t m_v)
|
||||
new_value = case new_list_of_modifiers of
|
||||
[] -> Nothing
|
||||
v -> Just v
|
||||
in form { _rr { modifiers = new_value }}
|
||||
|
||||
DMARC_mail v -> form { tmp { dmarc_mail = v } }
|
||||
DMARC_mail_limit v -> form { tmp { dmarc_mail_limit = Just $ fromMaybe 0 $ fromString v } }
|
||||
DMARC_ri v -> form { tmp { dmarc { ri = fromString v } } }
|
||||
DMARC_rua_Add ->
|
||||
case Email.email form.tmp.dmarc_mail of
|
||||
Left errors -> form { _dmarc_mail_errors = errors }
|
||||
Right _ ->
|
||||
let current_ruas = fromMaybe [] form.tmp.dmarc.rua
|
||||
new_list = current_ruas <> [ {mail: form.tmp.dmarc_mail, limit: form.tmp.dmarc_mail_limit} ]
|
||||
in form { tmp { dmarc { rua = Just new_list }}}
|
||||
|
||||
DMARC_ruf_Add ->
|
||||
case Email.email form.tmp.dmarc_mail of
|
||||
Left errors -> form { _dmarc_mail_errors = errors }
|
||||
Right _ ->
|
||||
let current_rufs = fromMaybe [] form.tmp.dmarc.ruf
|
||||
new_list = current_rufs <> [ {mail: form.tmp.dmarc_mail, limit: form.tmp.dmarc_mail_limit} ]
|
||||
in form { tmp { dmarc { ruf = Just new_list }}}
|
||||
|
||||
DMARC_remove_rua i ->
|
||||
let current_ruas = fromMaybe [] form.tmp.dmarc.rua
|
||||
new_value = case (remove_id i $ attach_id 0 current_ruas) of
|
||||
[] -> Nothing
|
||||
v -> Just v
|
||||
in form { tmp { dmarc { rua = new_value } } }
|
||||
|
||||
DMARC_remove_ruf i ->
|
||||
let current_rufs = fromMaybe [] form.tmp.dmarc.ruf
|
||||
new_value = case (remove_id i $ attach_id 0 current_rufs) of
|
||||
[] -> Nothing
|
||||
v -> Just v
|
||||
in form { tmp { dmarc { ruf = new_value } } }
|
||||
|
||||
DMARC_policy v -> form { tmp { dmarc { p = fromMaybe DMARC.None $ DMARC.policies A.!! v } } }
|
||||
DMARC_sp_policy v -> form { tmp { dmarc { sp = DMARC.policies A.!! (v - 1) } } }
|
||||
DMARC_adkim v -> form { tmp { dmarc { adkim = DMARC.consistency_policies A.!! (v - 1) } } }
|
||||
DMARC_aspf v -> form { tmp { dmarc { aspf = DMARC.consistency_policies A.!! (v - 1) } } }
|
||||
DMARC_pct v -> form { tmp { dmarc { pct = Just $ fromMaybe 100 (fromString v) } } }
|
||||
DMARC_fo v -> form { tmp { dmarc { fo = DMARC.report_occasions A.!! (v - 1) } } }
|
||||
DKIM_hash_algo v -> form { tmp { dkim { h = DKIM.hash_algos A.!! v } } }
|
||||
DKIM_sign_algo v -> form { tmp { dkim { k = DKIM.sign_algos A.!! v } } }
|
||||
DKIM_pubkey v -> form { tmp { dkim { p = v } } }
|
||||
DKIM_note v -> form { tmp { dkim { n = Just v } } }
|
||||
|
|
@ -1,478 +1,15 @@
|
|||
module App.Type.ResourceRecord where
|
||||
|
||||
import Prelude (class Show, ($), (-), (<>))
|
||||
-- import Data.String (toLower)
|
||||
import Data.Generic.Rep (class Generic)
|
||||
import App.Type.GenericSerialization (generic_serialization)
|
||||
import Data.Show.Generic (genericShow)
|
||||
|
||||
import Data.Array as A
|
||||
import Data.Maybe (Maybe(..), fromMaybe, maybe)
|
||||
import Data.Either (Either(..))
|
||||
|
||||
import GenericParser.Parser as G
|
||||
import GenericParser.IPAddress as IPAddress
|
||||
import GenericParser.DomainParser.Common (DomainError) as DomainParser
|
||||
|
||||
import Utils (id, attach_id, remove_id)
|
||||
|
||||
import App.Validation.Email as Email
|
||||
|
||||
import Data.Codec.Argonaut (JsonCodec)
|
||||
import Data.Codec.Argonaut as CA
|
||||
import Data.Codec.Argonaut.Record as CAR
|
||||
import Data.Int (fromString)
|
||||
|
||||
import App.Type.ResourceRecord.DKIM as DKIM
|
||||
import App.Type.ResourceRecord.DMARC as DMARC
|
||||
import App.Type.ResourceRecord.SPF as SPF
|
||||
import App.Type.ResourceRecord.CAA as CAA
|
||||
|
||||
type RRId = Int
|
||||
|
||||
type ResourceRecord
|
||||
= { rrtype :: String
|
||||
, rrid :: RRId
|
||||
, name :: String
|
||||
, ttl :: Int
|
||||
, target :: String
|
||||
, readonly :: Boolean
|
||||
|
||||
-- MX (and SRV) specific entry.
|
||||
, priority :: Maybe Int
|
||||
|
||||
-- SRV specific entries.
|
||||
, port :: Maybe Int
|
||||
, protocol :: Maybe SRVProtocol
|
||||
, 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
|
||||
|
||||
, token :: Maybe String
|
||||
|
||||
-- SPF specific entries.
|
||||
, v :: Maybe String -- Default: spf1
|
||||
, mechanisms :: Maybe (Array SPF.Mechanism)
|
||||
, modifiers :: Maybe (Array SPF.Modifier)
|
||||
, q :: Maybe SPF.Qualifier -- Qualifier for default mechanism (`all`).
|
||||
|
||||
, dkim :: Maybe DKIM.DKIM
|
||||
, dmarc :: Maybe DMARC.DMARC
|
||||
, caa :: Maybe CAA.CAA
|
||||
}
|
||||
|
||||
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 codecSRVProtocol
|
||||
, 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
|
||||
|
||||
, token: CAR.optional CA.string
|
||||
|
||||
-- SPF specific entries.
|
||||
, v: CAR.optional CA.string
|
||||
, mechanisms: CAR.optional (CA.array SPF.codecMechanism)
|
||||
, modifiers: CAR.optional (CA.array SPF.codecModifier)
|
||||
, q: CAR.optional SPF.codecQualifier
|
||||
|
||||
, dkim: CAR.optional DKIM.codec
|
||||
, dmarc: CAR.optional DMARC.codec
|
||||
, caa: CAR.optional CAA.codec
|
||||
})
|
||||
|
||||
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
|
||||
|
||||
, token: Nothing
|
||||
|
||||
-- SPF specific entries.
|
||||
, v: Nothing
|
||||
, mechanisms: Nothing
|
||||
, modifiers: Nothing
|
||||
, q: Nothing
|
||||
|
||||
, dkim: Nothing
|
||||
, dmarc: Nothing
|
||||
, caa: Nothing
|
||||
}
|
||||
|
||||
data SRVProtocol = TCP | UDP
|
||||
srv_protocols :: Array SRVProtocol
|
||||
srv_protocols = [TCP, UDP]
|
||||
srv_protocols_txt :: Array String
|
||||
srv_protocols_txt = ["tcp", "udp"]
|
||||
|
||||
derive instance genericSRVProtocol :: Generic SRVProtocol _
|
||||
instance showSRVProtocol :: Show SRVProtocol where
|
||||
show = genericShow
|
||||
|
||||
-- | Codec for just encoding a single value of type `Qualifier`.
|
||||
codecSRVProtocol :: CA.JsonCodec SRVProtocol
|
||||
codecSRVProtocol = CA.prismaticCodec "SRVProtocol" str_to_srv_protocol generic_serialization CA.string
|
||||
|
||||
str_to_srv_protocol :: String -> Maybe SRVProtocol
|
||||
str_to_srv_protocol = case _ of
|
||||
"tcp" -> Just TCP
|
||||
"udp" -> Just UDP
|
||||
_ -> Nothing
|
||||
|
||||
data Field
|
||||
= Domain String
|
||||
| TTL String
|
||||
| Target String
|
||||
| Priority String
|
||||
| Weight String
|
||||
| Port String
|
||||
| SPF_v String
|
||||
| SPF_mechanisms (Array SPF.Mechanism)
|
||||
| SPF_modifiers (Array SPF.Modifier)
|
||||
| SPF_q SPF.Qualifier
|
||||
|
||||
| CAA_flag String
|
||||
| CAA_value String
|
||||
|
||||
-- | TMP: temporary stored values regarding specific records such as SPF,
|
||||
-- | DKIM and DMARC.
|
||||
type TMP =
|
||||
{
|
||||
-- SPF details.
|
||||
spf :: { mechanism_q :: String
|
||||
, mechanism_t :: String
|
||||
, mechanism_v :: String
|
||||
, modifier_t :: String
|
||||
, modifier_v :: String
|
||||
}
|
||||
|
||||
-- DMARC details.
|
||||
, dmarc_mail :: String
|
||||
, dmarc_mail_limit :: Maybe Int
|
||||
, dmarc :: DMARC.DMARC
|
||||
|
||||
-- DKIM details.
|
||||
, dkim :: DKIM.DKIM
|
||||
}
|
||||
|
||||
-- | `Form` is the necessary state to modify a resource record.
|
||||
-- | It contains the currently manipulated record, detected errors, along with some temporary values.
|
||||
-- | FIXME: this form is messy AF and should be replaced.
|
||||
type Form =
|
||||
{ _rr :: ResourceRecord
|
||||
, _errors :: Array Error
|
||||
, _dmarc_mail_errors :: Array Email.Error
|
||||
, _zonefile :: Maybe String
|
||||
, tmp :: TMP
|
||||
}
|
||||
|
||||
default_qualifier_str = "hard_fail" :: String
|
||||
default_caa = { flag: 0, tag: CAA.Issue, value: "letsencrypt.org" } :: CAA.CAA
|
||||
|
||||
default_rr :: AcceptedRRTypes -> String -> ResourceRecord
|
||||
default_rr t domain =
|
||||
case t of
|
||||
A -> emptyRR { rrtype = "A", name = "server1", target = "192.0.2.1" }
|
||||
AAAA -> emptyRR { rrtype = "AAAA", name = "server1", target = "2001:db8::1" }
|
||||
TXT -> emptyRR { rrtype = "TXT", name = "txt", target = "some text" }
|
||||
CNAME -> emptyRR { rrtype = "CNAME", name = "www", target = "server1" }
|
||||
NS -> emptyRR { rrtype = "NS", name = (domain <> "."), target = "ns0.example.com." }
|
||||
MX -> emptyRR { rrtype = "MX", name = "mail", target = "server1", priority = Just 10 }
|
||||
CAA -> emptyRR { rrtype = "CAA", name = "", target = "", caa = Just default_caa }
|
||||
SRV -> emptyRR { rrtype = "SRV", name = "voip", target = "server1"
|
||||
, port = Just 5061, weight = Just 100, priority = Just 10, protocol = Just TCP }
|
||||
SPF -> emptyRR { rrtype = "SPF", name = "", target = ""
|
||||
, mechanisms = Just default_mechanisms, q = Just SPF.HardFail }
|
||||
DKIM -> emptyRR { rrtype = "DKIM", name = "default._domainkey", target = "" }
|
||||
DMARC -> emptyRR { rrtype = "DMARC", name = "_dmarc", target = "" }
|
||||
where
|
||||
default_mechanisms = maybe [] (\x -> [x]) $ SPF.to_mechanism "pass" "mx" ""
|
||||
|
||||
mkEmptyRRForm :: Form
|
||||
mkEmptyRRForm =
|
||||
{
|
||||
-- This is the state for the new RR modal.
|
||||
_rr: default_rr A ""
|
||||
-- List of errors within the form in new RR modal.
|
||||
, _errors: []
|
||||
, _dmarc_mail_errors: []
|
||||
, _zonefile: Nothing
|
||||
, tmp: { spf: { mechanism_q: "pass"
|
||||
, mechanism_t: "a"
|
||||
, mechanism_v: ""
|
||||
, modifier_t: "redirect"
|
||||
, modifier_v: ""
|
||||
}
|
||||
, dkim: DKIM.emptyDKIMRR
|
||||
, dmarc: DMARC.emptyDMARCRR
|
||||
, dmarc_mail: ""
|
||||
, dmarc_mail_limit: Nothing
|
||||
}
|
||||
}
|
||||
|
||||
data RRUpdateValue
|
||||
= CAA_tag Int
|
||||
| SRV_Protocol Int
|
||||
| SPF_Mechanism_q Int
|
||||
| SPF_Mechanism_t Int
|
||||
| SPF_Mechanism_v String
|
||||
| SPF_Modifier_t Int
|
||||
| SPF_Modifier_v String
|
||||
| SPF_Qualifier Int
|
||||
|
||||
-- | Remove a SPF mechanism of the currently modified (SPF) entry (see `_currentRR`).
|
||||
| SPF_remove_mechanism Int
|
||||
-- | Remove a SPF modifier of the currently modified (SPF) entry (see `_currentRR`).
|
||||
| SPF_remove_modifier Int
|
||||
|
||||
-- | Add a SPF mechanism to the currently modified (SPF) entry (see `_currentRR`).
|
||||
| SPF_Mechanism_Add
|
||||
-- | Add a SPF modifier to the currently modified (SPF) entry (see `_currentRR`).
|
||||
| SPF_Modifier_Add
|
||||
|
||||
-- | Change the temporary mail address for DMARC.
|
||||
| DMARC_mail String
|
||||
|
||||
-- | Change the temporary report size limit for DMARC.
|
||||
| DMARC_mail_limit String
|
||||
|
||||
-- | Change the requested report interval.
|
||||
| DMARC_ri String
|
||||
|
||||
-- | Add a new mail address to the DMARC rua list.
|
||||
| DMARC_rua_Add
|
||||
|
||||
-- | Add a new mail address to the DMARC ruf list.
|
||||
| DMARC_ruf_Add
|
||||
|
||||
-- | Remove a mail address of the DMARC rua list.
|
||||
| DMARC_remove_rua Int
|
||||
|
||||
-- | Remove a mail address of the DMARC ruf list.
|
||||
| DMARC_remove_ruf Int
|
||||
|
||||
| DMARC_policy Int
|
||||
| DMARC_sp_policy Int
|
||||
| DMARC_adkim Int
|
||||
| DMARC_aspf Int
|
||||
| DMARC_pct String
|
||||
| DMARC_fo Int
|
||||
|
||||
| DKIM_hash_algo Int
|
||||
| DKIM_sign_algo Int
|
||||
| DKIM_pubkey String
|
||||
| DKIM_note String
|
||||
|
||||
update_form :: Form -> RRUpdateValue -> Form
|
||||
update_form form new_field_value =
|
||||
case new_field_value of
|
||||
CAA_tag v ->
|
||||
let new_tag = fromMaybe CAA.Issue $ CAA.tags A.!! v
|
||||
new_value = case new_tag of
|
||||
CAA.Issue -> "letsencrypt.org"
|
||||
CAA.ContactEmail -> "contact@example.com"
|
||||
CAA.ContactPhone -> "0203040506"
|
||||
_ -> ""
|
||||
new_caa = (fromMaybe default_caa form._rr.caa) { tag = new_tag, value = new_value }
|
||||
in form { _rr { caa = Just new_caa } }
|
||||
|
||||
SRV_Protocol v -> form { _rr { protocol = srv_protocols A.!! v } }
|
||||
SPF_Mechanism_q v -> form { tmp { spf { mechanism_q = maybe "pass" id $ SPF.qualifier_types A.!! v }}}
|
||||
SPF_Mechanism_t v -> form { tmp { spf { mechanism_t = maybe "a" id $ SPF.mechanism_types A.!! v }}}
|
||||
SPF_Mechanism_v v -> form { tmp { spf { mechanism_v = v }}}
|
||||
SPF_Modifier_t v -> form { tmp { spf { modifier_t = maybe "redirect" id $ SPF.modifier_types A.!! v }}}
|
||||
SPF_Modifier_v v -> form { tmp { spf { modifier_v = v }}}
|
||||
SPF_Qualifier v -> form { _rr { q = SPF.qualifiers A.!! v }}
|
||||
SPF_remove_mechanism i ->
|
||||
form { _rr { mechanisms = case form._rr.mechanisms of
|
||||
Just ms -> Just (remove_id i $ attach_id 0 ms)
|
||||
Nothing -> Nothing
|
||||
} }
|
||||
SPF_remove_modifier i ->
|
||||
form { _rr { modifiers = case form._rr.modifiers of
|
||||
Just ms -> Just (remove_id i $ attach_id 0 ms)
|
||||
Nothing -> Nothing
|
||||
} }
|
||||
|
||||
SPF_Mechanism_Add ->
|
||||
let m = form._rr.mechanisms
|
||||
m_q = form.tmp.spf.mechanism_q
|
||||
m_t = form.tmp.spf.mechanism_t
|
||||
m_v = form.tmp.spf.mechanism_v
|
||||
new_list_of_mechanisms = maybe [] id m <> maybe [] (\x -> [x]) (SPF.to_mechanism m_q m_t m_v)
|
||||
new_value = case new_list_of_mechanisms of
|
||||
[] -> Nothing
|
||||
v -> Just v
|
||||
in form { _rr { mechanisms = new_value }}
|
||||
|
||||
SPF_Modifier_Add ->
|
||||
let m = form._rr.modifiers
|
||||
m_t = form.tmp.spf.modifier_t
|
||||
m_v = form.tmp.spf.modifier_v
|
||||
new_list_of_modifiers = maybe [] id m <> maybe [] (\x -> [x]) (SPF.to_modifier m_t m_v)
|
||||
new_value = case new_list_of_modifiers of
|
||||
[] -> Nothing
|
||||
v -> Just v
|
||||
in form { _rr { modifiers = new_value }}
|
||||
|
||||
DMARC_mail v -> form { tmp { dmarc_mail = v } }
|
||||
DMARC_mail_limit v -> form { tmp { dmarc_mail_limit = Just $ fromMaybe 0 $ fromString v } }
|
||||
DMARC_ri v -> form { tmp { dmarc { ri = fromString v } } }
|
||||
DMARC_rua_Add ->
|
||||
case Email.email form.tmp.dmarc_mail of
|
||||
Left errors -> form { _dmarc_mail_errors = errors }
|
||||
Right _ ->
|
||||
let current_ruas = fromMaybe [] form.tmp.dmarc.rua
|
||||
new_list = current_ruas <> [ {mail: form.tmp.dmarc_mail, limit: form.tmp.dmarc_mail_limit} ]
|
||||
in form { tmp { dmarc { rua = Just new_list }}}
|
||||
|
||||
DMARC_ruf_Add ->
|
||||
case Email.email form.tmp.dmarc_mail of
|
||||
Left errors -> form { _dmarc_mail_errors = errors }
|
||||
Right _ ->
|
||||
let current_rufs = fromMaybe [] form.tmp.dmarc.ruf
|
||||
new_list = current_rufs <> [ {mail: form.tmp.dmarc_mail, limit: form.tmp.dmarc_mail_limit} ]
|
||||
in form { tmp { dmarc { ruf = Just new_list }}}
|
||||
|
||||
DMARC_remove_rua i ->
|
||||
let current_ruas = fromMaybe [] form.tmp.dmarc.rua
|
||||
new_value = case (remove_id i $ attach_id 0 current_ruas) of
|
||||
[] -> Nothing
|
||||
v -> Just v
|
||||
in form { tmp { dmarc { rua = new_value } } }
|
||||
|
||||
DMARC_remove_ruf i ->
|
||||
let current_rufs = fromMaybe [] form.tmp.dmarc.ruf
|
||||
new_value = case (remove_id i $ attach_id 0 current_rufs) of
|
||||
[] -> Nothing
|
||||
v -> Just v
|
||||
in form { tmp { dmarc { ruf = new_value } } }
|
||||
|
||||
DMARC_policy v -> form { tmp { dmarc { p = fromMaybe DMARC.None $ DMARC.policies A.!! v } } }
|
||||
DMARC_sp_policy v -> form { tmp { dmarc { sp = DMARC.policies A.!! (v - 1) } } }
|
||||
DMARC_adkim v -> form { tmp { dmarc { adkim = DMARC.consistency_policies A.!! (v - 1) } } }
|
||||
DMARC_aspf v -> form { tmp { dmarc { aspf = DMARC.consistency_policies A.!! (v - 1) } } }
|
||||
DMARC_pct v -> form { tmp { dmarc { pct = Just $ fromMaybe 100 (fromString v) } } }
|
||||
DMARC_fo v -> form { tmp { dmarc { fo = DMARC.report_occasions A.!! (v - 1) } } }
|
||||
DKIM_hash_algo v -> form { tmp { dkim { h = DKIM.hash_algos A.!! v } } }
|
||||
DKIM_sign_algo v -> form { tmp { dkim { k = DKIM.sign_algos A.!! v } } }
|
||||
DKIM_pubkey v -> form { tmp { dkim { p = v } } }
|
||||
DKIM_note v -> form { tmp { dkim { n = Just v } } }
|
||||
|
||||
-- | Errors that might be catched in for the form upon validation (`App.Validation.DNS`).
|
||||
-- |
|
||||
-- | **History:**
|
||||
-- | The module once used dedicated types for each type of RR.
|
||||
-- | That comes with several advantages.
|
||||
-- | First, type verification was a thing, and function were dedicated to a certain type of record.
|
||||
-- | Second, these dedicated types used strings for their fields,
|
||||
-- | which simplifies the typing when dealing with forms.
|
||||
-- | Finally, the validation was a way to convert dedicated types (used in forms)
|
||||
-- | to the general type (used for network serialization).
|
||||
-- | This ensures each resource record is verified before being sent to `dnsmanagerd`.
|
||||
-- |
|
||||
-- | The problem is that, with dedicated types, you are then required to have dedicated functions.
|
||||
-- | Conversion functions are also required.
|
||||
-- |
|
||||
-- | Maybe the code will change again in the future, but for now it will be enough.
|
||||
|
||||
data Error
|
||||
= UNKNOWN
|
||||
| VEIPv4 (G.Error IPAddress.IPv4Error)
|
||||
| VEIPv6 (G.Error IPAddress.IPv6Error)
|
||||
| VEName (G.Error DomainParser.DomainError)
|
||||
| VETTL Int Int Int
|
||||
| VETXT (G.Error TXTError)
|
||||
| VECNAME (G.Error DomainParser.DomainError)
|
||||
| VENS (G.Error DomainParser.DomainError)
|
||||
| VEMX (G.Error DomainParser.DomainError)
|
||||
| VEPriority Int Int Int
|
||||
| VESRV (G.Error DomainParser.DomainError)
|
||||
| VEPort Int Int Int
|
||||
| VEWeight Int Int Int
|
||||
| VEDMARCpct Int Int Int
|
||||
| VEDMARCri Int Int Int
|
||||
|
||||
| VECAAflag Int Int Int -- CAA flag should be between 0 and 255 (1 byte).
|
||||
|
||||
-- SPF
|
||||
| VESPFMechanismName (G.Error DomainParser.DomainError)
|
||||
| VESPFMechanismIPv4 (G.Error IPAddress.IPv4Error)
|
||||
| VESPFMechanismIPv6 (G.Error IPAddress.IPv6Error)
|
||||
|
||||
| VESPFModifierName (G.Error DomainParser.DomainError)
|
||||
|
||||
| DKIMInvalidKeySize Int Int
|
||||
|
||||
-- | The application accepts to add a few new entry types in a DNS zone.
|
||||
-- | Each resource record has a specific form, with dedicated inputs and
|
||||
-- | dedicated validation.
|
||||
data AcceptedRRTypes
|
||||
= A
|
||||
| AAAA
|
||||
| TXT
|
||||
| CNAME
|
||||
| NS
|
||||
| MX
|
||||
| CAA
|
||||
| SRV
|
||||
| SPF
|
||||
| DKIM
|
||||
| DMARC
|
||||
|
||||
derive instance genericAcceptedRRTypes :: Generic AcceptedRRTypes _
|
||||
|
||||
instance showAcceptedRRTypes :: Show AcceptedRRTypes where
|
||||
show = genericShow
|
||||
|
||||
data TXTError
|
||||
= TXTInvalidCharacter
|
||||
| TXTTooLong Int Int -- max current
|
||||
module App.Type.ResourceRecord
|
||||
( module App.Type.Error.ResourceRecord
|
||||
, module App.Type.Form.ResourceRecord
|
||||
, module App.Type.ResourceRecord.AcceptedRRTypes
|
||||
, module App.Type.ResourceRecord.ResourceRecord
|
||||
) where
|
||||
|
||||
import App.Type.Error.ResourceRecord
|
||||
import App.Type.Form.ResourceRecord (Field(..), Form, RRUpdateValue(..), TMP, mkEmptyRRForm, update_form)
|
||||
import App.Type.ResourceRecord.AcceptedRRTypes (AcceptedRRTypes(..))
|
||||
|
||||
import App.Type.ResourceRecord.ResourceRecord (RRId, ResourceRecord, SRVProtocol(..)
|
||||
, codec, codecSRVProtocol, default_caa
|
||||
, default_qualifier_str, default_rr
|
||||
, emptyRR, srv_protocols, srv_protocols_txt, str_to_srv_protocol)
|
||||
|
|
|
|||
27
src/App/Type/ResourceRecord/AcceptedRRTypes.purs
Normal file
27
src/App/Type/ResourceRecord/AcceptedRRTypes.purs
Normal file
|
|
@ -0,0 +1,27 @@
|
|||
module App.Type.ResourceRecord.AcceptedRRTypes where
|
||||
|
||||
import Prelude (class Show, ($), (-), (<>))
|
||||
|
||||
import Data.Generic.Rep (class Generic)
|
||||
import Data.Show.Generic (genericShow)
|
||||
|
||||
-- | The application accepts to add a few new entry types in a DNS zone.
|
||||
-- | Each resource record has a specific form, with dedicated inputs and
|
||||
-- | dedicated validation.
|
||||
data AcceptedRRTypes
|
||||
= A
|
||||
| AAAA
|
||||
| TXT
|
||||
| CNAME
|
||||
| NS
|
||||
| MX
|
||||
| CAA
|
||||
| SRV
|
||||
| SPF
|
||||
| DKIM
|
||||
| DMARC
|
||||
|
||||
derive instance genericAcceptedRRTypes :: Generic AcceptedRRTypes _
|
||||
|
||||
instance showAcceptedRRTypes :: Show AcceptedRRTypes where
|
||||
show = genericShow
|
||||
182
src/App/Type/ResourceRecord/ResourceRecord.purs
Normal file
182
src/App/Type/ResourceRecord/ResourceRecord.purs
Normal file
|
|
@ -0,0 +1,182 @@
|
|||
module App.Type.ResourceRecord.ResourceRecord where
|
||||
|
||||
import Prelude (class Show, ($), (<>))
|
||||
|
||||
-- import Data.String (toLower)
|
||||
import Data.Generic.Rep (class Generic)
|
||||
import App.Type.GenericSerialization (generic_serialization)
|
||||
import Data.Show.Generic (genericShow)
|
||||
|
||||
import Data.Maybe (Maybe(..), maybe)
|
||||
|
||||
import Data.Codec.Argonaut (JsonCodec)
|
||||
import Data.Codec.Argonaut as CA
|
||||
import Data.Codec.Argonaut.Record as CAR
|
||||
|
||||
import App.Type.ResourceRecord.AcceptedRRTypes (AcceptedRRTypes(..))
|
||||
|
||||
import App.Type.ResourceRecord.CAA as CAA
|
||||
import App.Type.ResourceRecord.DKIM as DKIM
|
||||
import App.Type.ResourceRecord.DMARC as DMARC
|
||||
import App.Type.ResourceRecord.SPF as SPF
|
||||
|
||||
type RRId = Int
|
||||
|
||||
type ResourceRecord
|
||||
= { rrtype :: String
|
||||
, rrid :: RRId
|
||||
, name :: String
|
||||
, ttl :: Int
|
||||
, target :: String
|
||||
, readonly :: Boolean
|
||||
|
||||
-- MX (and SRV) specific entry.
|
||||
, priority :: Maybe Int
|
||||
|
||||
-- SRV specific entries.
|
||||
, port :: Maybe Int
|
||||
, protocol :: Maybe SRVProtocol
|
||||
, 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
|
||||
|
||||
, token :: Maybe String
|
||||
|
||||
-- SPF specific entries.
|
||||
, v :: Maybe String -- Default: spf1
|
||||
, mechanisms :: Maybe (Array SPF.Mechanism)
|
||||
, modifiers :: Maybe (Array SPF.Modifier)
|
||||
, q :: Maybe SPF.Qualifier -- Qualifier for default mechanism (`all`).
|
||||
|
||||
, dkim :: Maybe DKIM.DKIM
|
||||
, dmarc :: Maybe DMARC.DMARC
|
||||
, caa :: Maybe CAA.CAA
|
||||
}
|
||||
|
||||
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 codecSRVProtocol
|
||||
, 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
|
||||
|
||||
, token: CAR.optional CA.string
|
||||
|
||||
-- SPF specific entries.
|
||||
, v: CAR.optional CA.string
|
||||
, mechanisms: CAR.optional (CA.array SPF.codecMechanism)
|
||||
, modifiers: CAR.optional (CA.array SPF.codecModifier)
|
||||
, q: CAR.optional SPF.codecQualifier
|
||||
|
||||
, dkim: CAR.optional DKIM.codec
|
||||
, dmarc: CAR.optional DMARC.codec
|
||||
, caa: CAR.optional CAA.codec
|
||||
})
|
||||
|
||||
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
|
||||
|
||||
, token: Nothing
|
||||
|
||||
-- SPF specific entries.
|
||||
, v: Nothing
|
||||
, mechanisms: Nothing
|
||||
, modifiers: Nothing
|
||||
, q: Nothing
|
||||
|
||||
, dkim: Nothing
|
||||
, dmarc: Nothing
|
||||
, caa: Nothing
|
||||
}
|
||||
|
||||
data SRVProtocol = TCP | UDP
|
||||
srv_protocols :: Array SRVProtocol
|
||||
srv_protocols = [TCP, UDP]
|
||||
srv_protocols_txt :: Array String
|
||||
srv_protocols_txt = ["tcp", "udp"]
|
||||
|
||||
derive instance genericSRVProtocol :: Generic SRVProtocol _
|
||||
instance showSRVProtocol :: Show SRVProtocol where
|
||||
show = genericShow
|
||||
|
||||
-- | Codec for just encoding a single value of type `Qualifier`.
|
||||
codecSRVProtocol :: CA.JsonCodec SRVProtocol
|
||||
codecSRVProtocol = CA.prismaticCodec "SRVProtocol" str_to_srv_protocol generic_serialization CA.string
|
||||
|
||||
str_to_srv_protocol :: String -> Maybe SRVProtocol
|
||||
str_to_srv_protocol = case _ of
|
||||
"tcp" -> Just TCP
|
||||
"udp" -> Just UDP
|
||||
_ -> Nothing
|
||||
|
||||
default_qualifier_str = "hard_fail" :: String
|
||||
default_caa = { flag: 0, tag: CAA.Issue, value: "letsencrypt.org" } :: CAA.CAA
|
||||
|
||||
default_rr :: AcceptedRRTypes -> String -> ResourceRecord
|
||||
default_rr t domain =
|
||||
case t of
|
||||
A -> emptyRR { rrtype = "A", name = "server1", target = "192.0.2.1" }
|
||||
AAAA -> emptyRR { rrtype = "AAAA", name = "server1", target = "2001:db8::1" }
|
||||
TXT -> emptyRR { rrtype = "TXT", name = "txt", target = "some text" }
|
||||
CNAME -> emptyRR { rrtype = "CNAME", name = "www", target = "server1" }
|
||||
NS -> emptyRR { rrtype = "NS", name = (domain <> "."), target = "ns0.example.com." }
|
||||
MX -> emptyRR { rrtype = "MX", name = "mail", target = "server1", priority = Just 10 }
|
||||
CAA -> emptyRR { rrtype = "CAA", name = "", target = "", caa = Just default_caa }
|
||||
SRV -> emptyRR { rrtype = "SRV", name = "voip", target = "server1"
|
||||
, port = Just 5061, weight = Just 100, priority = Just 10, protocol = Just TCP }
|
||||
SPF -> emptyRR { rrtype = "SPF", name = "", target = ""
|
||||
, mechanisms = Just default_mechanisms, q = Just SPF.HardFail }
|
||||
DKIM -> emptyRR { rrtype = "DKIM", name = "default._domainkey", target = "" }
|
||||
DMARC -> emptyRR { rrtype = "DMARC", name = "_dmarc", target = "" }
|
||||
where
|
||||
default_mechanisms = maybe [] (\x -> [x]) $ SPF.to_mechanism "pass" "mx" ""
|
||||
Loading…
Add table
Reference in a new issue