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 App.Type.Form.Delegation (Form, Field(..), update, mkEmptyDelegationForm)
|
||||||
import GenericParser.DomainParser.Common (DomainError) as DomainParser
|
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 }
|
|
||||||
|
|
||||||
-- | Possible errors regarding the form (domain parsing errors).
|
|
||||||
data Error
|
|
||||||
= VENameServer1 (G.Error DomainParser.DomainError)
|
|
||||||
| VENameServer2 (G.Error DomainParser.DomainError)
|
|
||||||
|
|
|
||||||
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
|
module App.Type.ResourceRecord
|
||||||
|
( module App.Type.Error.ResourceRecord
|
||||||
import Prelude (class Show, ($), (-), (<>))
|
, module App.Type.Form.ResourceRecord
|
||||||
-- import Data.String (toLower)
|
, module App.Type.ResourceRecord.AcceptedRRTypes
|
||||||
import Data.Generic.Rep (class Generic)
|
, module App.Type.ResourceRecord.ResourceRecord
|
||||||
import App.Type.GenericSerialization (generic_serialization)
|
) where
|
||||||
import Data.Show.Generic (genericShow)
|
|
||||||
|
import App.Type.Error.ResourceRecord
|
||||||
import Data.Array as A
|
import App.Type.Form.ResourceRecord (Field(..), Form, RRUpdateValue(..), TMP, mkEmptyRRForm, update_form)
|
||||||
import Data.Maybe (Maybe(..), fromMaybe, maybe)
|
import App.Type.ResourceRecord.AcceptedRRTypes (AcceptedRRTypes(..))
|
||||||
import Data.Either (Either(..))
|
|
||||||
|
import App.Type.ResourceRecord.ResourceRecord (RRId, ResourceRecord, SRVProtocol(..)
|
||||||
import GenericParser.Parser as G
|
, codec, codecSRVProtocol, default_caa
|
||||||
import GenericParser.IPAddress as IPAddress
|
, default_qualifier_str, default_rr
|
||||||
import GenericParser.DomainParser.Common (DomainError) as DomainParser
|
, emptyRR, srv_protocols, srv_protocols_txt, str_to_srv_protocol)
|
||||||
|
|
||||||
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
|
|
||||||
|
|
|
||||||
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