Baguette/dnsmanager-webclient
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Refactoring: WIP.

Browse source
This commit is contained in:
Philippe Pittoli 2025-07-22 18:49:40 +02:00
parent 88dd3addc5
commit f219115f73
8 changed files with 401 additions and 405 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

70
src/App/Page/Zone.purs
View file

@ -41,11 +41,10 @@ import CSSClasses as C
import App.Text.Explanations as Explanations
import App.Type.RRId (RRId)
import App.Type.Field as Field
import App.Type.Delegation (mkEmptyDelegationForm, update_delegation_field, Form, Field) as Delegation
import App.Type.ResourceRecord as RR
import App.Type.Delegation (mkEmptyDelegationForm, update, Form, Field) as Delegation
import App.Type.RRModal (RRModal(..))
import App.Type.AcceptedRRTypes (AcceptedRRTypes(..))
import App.Type.ResourceRecord (ResourceRecord)
import App.Type.DKIM as DKIM
import App.Type.DMARC as DMARC
@ -54,8 +53,6 @@ import App.Message.DNSManagerDaemon as DNSManager
import App.Validation.DNS as Validation
import App.Validation.Delegation as ValidationDelegation
import App.Type.RRForm (RRForm, RRUpdateValue(..), default_caa, default_rr, mkEmptyRRForm, update_form)
-- | `App.Page.Zone` can send messages through websocket interface
-- | connected to dnsmanagerd. See `App.WS`.
-- |
@ -69,9 +66,9 @@ data Output
| AskZoneFile String
| AskNewToken String Int
| AskDeleteRR String Int
| AskSaveRR String ResourceRecord
| AskSaveRR String RR.ResourceRecord
| AskSaveDelegation String String String
| AskAddRR String ResourceRecord
| AskAddRR String RR.ResourceRecord
| AskGetZone String
-- | `App.Page.Zone` can receive messages from `dnsmanagerd`.
@ -90,13 +87,13 @@ type Input = String
-- | 2. `UpdateCurrentRR Field`: modify the fields of the future new RR.
-- | 3. `ValidateRR AcceptedRRTypes`: validate the new RR stored in `_currentRR`.
-- | In case it works, automatically call `AddRR` then `CancelModal`.
-- | 4. `AddRR AcceptedRRTypes ResourceRecord`: send a message to `dnsmanagerd`.
-- | 4. `AddRR AcceptedRRTypes RR.ResourceRecord`: send a message to `dnsmanagerd`.
-- |
-- | Steps to update an entry:
-- | 1. `CreateUpdateRRModal RRId`: create a modal from the values of the RR in `_resources` to update.
-- | 2. `UpdateCurrentRR Field`: modify the currently displayed RR.
-- | 3. `ValidateLocal RRId AcceptedRRTypes`: validate the RR.
-- | 4. `SaveRR ResourceRecord`: save the _validated_ RR by sending a message to `dnsmanagerd`.
-- | 4. `SaveRR RR.ResourceRecord`: save the _validated_ RR by sending a message to `dnsmanagerd`.
data Action
-- | Initiate the component. This means asking the content of the zone to `dnsmanagerd`.
@ -124,7 +121,7 @@ data Action
| ReturnToDomainList
-- | Update new entry form (in the `rr_modal` modal).
| UpdateCurrentRR Field.Field
| UpdateCurrentRR RR.Field
-- | Update a delegation form field (new nameservers for the domain).
| UpdateDelegationForm Delegation.Field
@ -143,13 +140,13 @@ data Action
| ValidateLocal
-- | Add a new resource record to the zone.
| AddRR AcceptedRRTypes ResourceRecord
| AddRR AcceptedRRTypes RR.ResourceRecord
-- | Reset the different temporary values, such as SPF mechanisms or DMARC mail entry.
| ResetTemporaryValues
-- | Save the changes done in an already existing resource record.
| SaveRR ResourceRecord
| SaveRR RR.ResourceRecord
-- | Send a message to remove a resource record.
-- | Automatically closes the modal.
@ -159,7 +156,7 @@ data Action
| AskGeneratedZoneFile
-- | Modification of any attribute of the current RR.
| RRUpdate RRUpdateValue
| RRUpdate RR.RRUpdateValue
-- | Ask a (new) token for a resource record.
| NewToken RRId
@ -180,11 +177,11 @@ type State =
, rr_modal :: RRModal
-- | All resource records.
, _resources :: Array ResourceRecord
, _resources :: Array RR.ResourceRecord
--, _local_errors :: Hash.HashMap RRId (Array Validation.Error)
-- Unique RR form.
, _rr_form :: RRForm
, _rr_form :: RR.Form
-- DelegationForm
, _delegation_form :: Delegation.Form
@ -220,7 +217,7 @@ initialState domain =
, _resources: []
--, _local_errors: Hash.empty
, _rr_form: mkEmptyRRForm
, _rr_form: RR.mkEmptyRRForm
, _delegation_form: Delegation.mkEmptyDelegationForm
@ -331,7 +328,7 @@ handleAction = case _ of
-- | Each time a "new RR" button is clicked, the form resets.
CreateNewRRModal t -> do
state <- H.get
H.modify_ _ { rr_modal = NewRRModal t, _rr_form { _rr = default_rr t state._domain } }
H.modify_ _ { rr_modal = NewRRModal t, _rr_form { _rr = RR.default_rr t state._domain } }
-- | Delegation modal presents a simple form with two entries (chosen nameservers).
CreateDelegationModal -> do
@ -400,8 +397,7 @@ handleAction = case _ of
-- | Update the delegation form.
UpdateDelegationForm field -> do
state <- H.get
let newDelegationForm = Delegation.update_delegation_field state._delegation_form field
H.modify_ _ { _delegation_form = newDelegationForm }
H.modify_ _ { _delegation_form = Delegation.update state._delegation_form field }
-- | Validate any local RR with the new `_resources` and `_local_errors`.
ValidateLocal -> do
@ -487,7 +483,7 @@ handleAction = case _ of
RRUpdate value_to_update -> do
state <- H.get
H.modify_ _ { _rr_form = update_form state._rr_form value_to_update }
H.modify_ _ { _rr_form = RR.update_form state._rr_form value_to_update }
case value_to_update of
SPF_Mechanism_Add -> handleAction $ ResetTemporaryValues
SPF_Modifier_Add -> handleAction $ ResetTemporaryValues
@ -531,7 +527,7 @@ handleQuery = case _ of
pure (Just a)
where
-- replace_entry :: ResourceRecord
-- replace_entry :: RR.ResourceRecord
replace_entry new_rr = do
state <- H.get
H.modify_ _ { _resources = A.filter (\rr -> rr.rrid /= new_rr.rrid) state._resources }
@ -548,7 +544,7 @@ handleQuery = case _ of
H.put $ add_RR state new_rr
add_entries $ fromMaybe [] tail
add_RR :: State -> ResourceRecord -> State
add_RR :: State -> RR.ResourceRecord -> State
add_RR state new_rr = state { _resources = (state._resources <> [ new_rr ]) }
render_new_records :: forall (w :: Type). State -> HH.HTML w Action
@ -605,23 +601,23 @@ loopE f a = case (A.head a) of
Nothing -> pure unit
Just xs -> loopE f xs
update_field :: ResourceRecord -> Field.Field -> ResourceRecord
update_field :: RR.ResourceRecord -> RR.Field -> RR.ResourceRecord
update_field rr updated_field = case updated_field of
Field.Domain val -> rr { name = toLower val }
Field.Target val -> rr { target = val }
Field.TTL val -> rr { ttl = fromMaybe 0 (fromString val) }
Field.Priority val -> rr { priority = fromString val }
Field.Weight val -> rr { weight = fromString val }
Field.Port val -> rr { port = fromString val }
Field.SPF_v val -> rr { v = Just val }
Field.SPF_mechanisms val -> rr { mechanisms = Just val }
Field.SPF_modifiers val -> rr { modifiers = Just val }
Field.SPF_q val -> rr { q = Just val }
RR.Domain val -> rr { name = toLower val }
RR.Target val -> rr { target = val }
RR.TTL val -> rr { ttl = fromMaybe 0 (fromString val) }
RR.Priority val -> rr { priority = fromString val }
RR.Weight val -> rr { weight = fromString val }
RR.Port val -> rr { port = fromString val }
RR.SPF_v val -> rr { v = Just val }
RR.SPF_mechanisms val -> rr { mechanisms = Just val }
RR.SPF_modifiers val -> rr { modifiers = Just val }
RR.SPF_q val -> rr { q = Just val }
Field.CAA_flag val ->
let new_caa = (fromMaybe default_caa rr.caa) { flag = fromMaybe 0 $ fromString val }
RR.CAA_flag val ->
let new_caa = (fromMaybe RR.default_caa rr.caa) { flag = fromMaybe 0 $ fromString val }
in rr { caa = Just new_caa }
Field.CAA_value val ->
let new_caa = (fromMaybe default_caa rr.caa) { value = val }
RR.CAA_value val ->
let new_caa = (fromMaybe RR.default_caa rr.caa) { value = val }
in rr { caa = Just new_caa }

64
src/App/Templates/Modal.purs
View file

@ -20,14 +20,10 @@ import Halogen.HTML.Properties as HP
import App.Type.RRId (RRId)
import App.Type.DMARC as DMARC
import App.Type.DKIM as DKIM
import App.Type.Field as Field
import App.Type.Delegation as Delegation
import App.Templates.Table as Table
import Data.String (toLower)
-- FIXME: this import is related to messy types. A replacement should be found.
import App.Type.RRForm
import App.Type.RRModal (RRModal(..))
import App.Type.AcceptedRRTypes (AcceptedRRTypes(..))
@ -84,14 +80,14 @@ delegation_modal selected_domain form action_update_form action_validate action_
else HH.div_ [ ]
type Domain = String
type ActionUpdateForm i = (Field.Field -> i)
type ActionUpdateForm i = (RR.Field -> i)
type ActionNewToken i = (RRId -> i)
type ActionUpdateRR i = (RRUpdateValue -> i)
type ActionValidateNewRR i = (AcceptedRRTypes -> i)
type ActionValidateLocalRR :: forall k. k -> k
type ActionValidateLocalRR i = i
current_rr_modal :: forall w i.
Domain -> RRForm -> RRModal
Domain -> RR.Form -> RRModal
-> ActionUpdateForm i -> ActionNewToken i
-> ActionUpdateRR i -> ActionValidateNewRR i -> ActionValidateLocalRR i -> ActionCancelModal i
-> HH.HTML w i
@ -126,18 +122,18 @@ current_rr_modal selected_domain form rr_modal
, render_introduction_text x
, side_text_for_name_input ("domain" <> form._rr.rrtype)
, Web.input_with_side_text ("domain" <> form._rr.rrtype) "" "www"
(action_update_form <<< Field.Domain)
(action_update_form <<< RR.Domain)
form._rr.name
display_domain_side
, Web.box_input ("ttl" <> form._rr.rrtype) "TTL" "1800"
(action_update_form <<< Field.TTL)
(action_update_form <<< RR.TTL)
(show form._rr.ttl)
, case form._rr.rrtype of
"AAAA" -> Web.box_input ("target" <> form._rr.rrtype) "Target" "2001:db8::1" (action_update_form <<< Field.Target) form._rr.target
"TXT" -> Web.box_input ("target" <> form._rr.rrtype) "Your text" "blah blah" (action_update_form <<< Field.Target) form._rr.target
"CNAME" -> Web.box_input ("target" <> form._rr.rrtype) "Target" "www" (action_update_form <<< Field.Target) form._rr.target
"NS" -> Web.box_input ("target" <> form._rr.rrtype) "Target" "ns0.example.com." (action_update_form <<< Field.Target) form._rr.target
_ -> Web.box_input ("target" <> form._rr.rrtype) "Target" "198.51.100.5" (action_update_form <<< Field.Target) form._rr.target
"AAAA" -> Web.box_input ("target" <> form._rr.rrtype) "Target" "2001:db8::1" (action_update_form <<< RR.Target) form._rr.target
"TXT" -> Web.box_input ("target" <> form._rr.rrtype) "Your text" "blah blah" (action_update_form <<< RR.Target) form._rr.target
"CNAME" -> Web.box_input ("target" <> form._rr.rrtype) "Target" "www" (action_update_form <<< RR.Target) form._rr.target
"NS" -> Web.box_input ("target" <> form._rr.rrtype) "Target" "ns0.example.com." (action_update_form <<< RR.Target) form._rr.target
_ -> Web.box_input ("target" <> form._rr.rrtype) "Target" "198.51.100.5" (action_update_form <<< RR.Target) form._rr.target
] <> case rr_modal of
UpdateRRModal ->
if A.elem form._rr.rrtype ["A", "AAAA"]
@ -162,17 +158,17 @@ current_rr_modal selected_domain form rr_modal
, Web.quote Explanations.mx_introduction
, side_text_for_name_input "domainMX"
, Web.input_with_side_text "domainMX" "" "www"
(action_update_form <<< Field.Domain)
(action_update_form <<< RR.Domain)
form._rr.name
display_domain_side
, Web.box_input ("ttlMX") "TTL" "1800"
(action_update_form <<< Field.TTL)
(action_update_form <<< RR.TTL)
(show form._rr.ttl)
, Web.box_input ("targetMX") "Target" "www"
(action_update_form <<< Field.Target)
(action_update_form <<< RR.Target)
form._rr.target
, Web.box_input ("priorityMX") "Priority" "10"
(action_update_form <<< Field.Priority)
(action_update_form <<< RR.Priority)
(maybe "" show form._rr.priority)
]
@ -182,15 +178,15 @@ current_rr_modal selected_domain form rr_modal
, Web.quote Explanations.caa_introduction
, side_text_for_name_input "domainCAA"
, Web.input_with_side_text "domainCAA" "" "www"
(action_update_form <<< Field.Domain)
(action_update_form <<< RR.Domain)
form._rr.name
display_domain_side
, Web.box_input ("ttlCAA") "TTL" "1800"
(action_update_form <<< Field.TTL)
(action_update_form <<< RR.TTL)
(show form._rr.ttl)
, Web.hr
, Web.box_input ("flagCAA") "Flag" ""
(action_update_form <<< Field.CAA_flag)
(action_update_form <<< RR.CAA_flag)
(show (fromMaybe default_caa form._rr.caa).flag)
, Web.selection_field'' "tagCAA" "Tag" (action_update_rr <<< CAA_tag) (A.zip CAA.tags_txt CAA.tags_raw)
CAA.Issue
@ -198,7 +194,7 @@ current_rr_modal selected_domain form rr_modal
, HH.div [HP.classes [C.notification, C.is_warning]]
[ Web.p "⚠️​ CAA entries aren't thoroughly verified, yet. Also, do not put quotes."
]
, Web.box_input "valueCAA" "Value" "" (action_update_form <<< Field.CAA_value)
, Web.box_input "valueCAA" "Value" "" (action_update_form <<< RR.CAA_value)
(fromMaybe default_caa form._rr.caa).value
]
@ -207,27 +203,27 @@ current_rr_modal selected_domain form rr_modal
[ Web.quote Explanations.srv_introduction
, render_errors
, Web.box_input ("ttlSRV") "TTL" "1800"
(action_update_form <<< Field.TTL)
(action_update_form <<< RR.TTL)
(show form._rr.ttl)
, Web.box_input "domainSRV" "Service name" "service name"
(action_update_form <<< Field.Domain)
(action_update_form <<< RR.Domain)
form._rr.name
, Web.selection_field "protocolSRV" "Protocol" (action_update_rr <<< SRV_Protocol) RR.srv_protocols_txt
(maybe "udp" (toLower <<< show) form._rr.protocol)
, Web.box_input ("targetSRV") "Where the server is" "www"
(action_update_form <<< Field.Target)
(action_update_form <<< RR.Target)
form._rr.target
, Web.box_input ("portSRV") "Port of the service" "5061"
(action_update_form <<< Field.Port)
(action_update_form <<< RR.Port)
(maybe "" show form._rr.port)
, Web.quote [Web.p "The priority field is a numeric value that indicates the preference of the server (lower values indicate higher priority)."]
, Web.box_input ("prioritySRV") "Priority" "10"
(action_update_form <<< Field.Priority)
(action_update_form <<< RR.Priority)
(maybe "" show form._rr.priority)
-- Web.quote Explanations.spf_introduction, Web.p "Modifiers provide additional instructions, such as explanations for SPF failures or redirecting SPF checks to another domain."
, Web.quote [Web.p "The weight field is a relative weight used when multiple servers have the same priority, determining how often they should be used."]
, Web.box_input ("weightSRV") "Weight" "100"
(action_update_form <<< Field.Weight)
(action_update_form <<< RR.Weight)
(maybe "" show form._rr.weight)
]
@ -237,15 +233,15 @@ current_rr_modal selected_domain form rr_modal
, render_errors
, side_text_for_name_input "domainSPF"
, Web.input_with_side_text "domainSPF" "" "Let this alone."
(action_update_form <<< Field.Domain)
(action_update_form <<< RR.Domain)
form._rr.name
display_domain_side
, Web.box_input "ttlSPF" "TTL" "1800"
(action_update_form <<< Field.TTL)
(action_update_form <<< RR.TTL)
(show form._rr.ttl)
--, case form._rr.v of
-- Nothing -> Web.p "default value for the version (spf1)"
-- Just v -> Web.box_input "vSPF" "Version" "spf1" (action_update_form <<< Field.SPF_v) v
-- Just v -> Web.box_input "vSPF" "Version" "spf1" (action_update_form <<< RR.SPF_v) v
, Web.hr
, Web.box_with_tag [C.has_background_info_light] tag_mechanisms
[ Web.quote [Web.p "Mechanisms specify which mail servers are allowed to send mail for the domain and how to evaluate the sending mail server’s IP address."]
@ -291,11 +287,11 @@ current_rr_modal selected_domain form rr_modal
, render_errors
, side_text_for_name_input "domainDKIM"
, Web.input_with_side_text "domainDKIM" "" "default._domainkey"
(action_update_form <<< Field.Domain)
(action_update_form <<< RR.Domain)
form._rr.name
display_domain_side
, Web.box_input "ttlDKIM" "TTL" "1800"
(action_update_form <<< Field.TTL)
(action_update_form <<< RR.TTL)
(show form._rr.ttl)
, Web.hr
, Web.quote Explanations.dkim_default_algorithms
@ -317,10 +313,10 @@ current_rr_modal selected_domain form rr_modal
, render_errors
, side_text_for_name_input "domainDMARC"
, Web.input_with_side_text "domainDMARC" "" "_dmarc"
(action_update_form <<< Field.Domain)
(action_update_form <<< RR.Domain)
form._rr.name
display_domain_side
, Web.box_input "ttlDMARC" "TTL" "1800" (action_update_form <<< Field.TTL) (show form._rr.ttl)
, Web.box_input "ttlDMARC" "TTL" "1800" (action_update_form <<< RR.TTL) (show form._rr.ttl)
, Web.hr
, Web.quote Explanations.dmarc_policy

27
src/App/Type/Delegation.purs
View file

@ -3,16 +3,15 @@ module App.Type.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
}
data Field
= NameServer1 String
| NameServer2 String
-- | Empty delegation form, with default inputs.
mkEmptyDelegationForm :: Form
mkEmptyDelegationForm
= { nameserver1: "ns0.example.com"
@ -20,11 +19,27 @@ mkEmptyDelegationForm
, errors: []
}
update_delegation_field :: Form -> Field -> Form
update_delegation_field form updated_field = case updated_field of
-- | 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)

18
src/App/Type/Field.purs
View file

@ -1,18 +0,0 @@
module App.Type.Field where
import App.Type.ResourceRecord as RR
data Field
= Domain String
| TTL String
| Target String
| Priority String
| Weight String
| Port String
| SPF_v String
| SPF_mechanisms (Array RR.Mechanism)
| SPF_modifiers (Array RR.Modifier)
| SPF_q RR.Qualifier
| CAA_flag String
| CAA_value String

242
src/App/Type/RRForm.purs
View file

@ -1,242 +0,0 @@
-- | `App.Type.RRForm` provides types used to manage the modification
-- | of resource records.
-- | FIXME: this state is messy AF and should be replaced.
module App.Type.RRForm where
import Prelude (($), (-), (<>))
import Utils (id, attach_id, remove_id)
import App.Type.AcceptedRRTypes (AcceptedRRTypes(..))
import App.Type.DKIM as DKIM
import App.Type.DMARC as DMARC
import Data.Maybe (Maybe(..), fromMaybe, maybe)
import App.Type.ResourceRecord as RR
import App.Type.CAA as CAA
import App.Validation.Email as Email
import App.Validation.DNS as Validation
import Data.Array as A
import Data.Either (Either(..))
import Data.Int (fromString)
-- | 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
}
-- | `RRForm` is the necessary state to modify a resource record.
-- | It contains the currently manipulated record, detected errors, along with some temporary values.
type RRForm =
{ _rr :: RR.ResourceRecord
, _errors :: Array Validation.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 -> RR.ResourceRecord
default_rr t domain =
case t of
A -> RR.emptyRR { rrtype = "A", name = "server1", target = "192.0.2.1" }
AAAA -> RR.emptyRR { rrtype = "AAAA", name = "server1", target = "2001:db8::1" }
TXT -> RR.emptyRR { rrtype = "TXT", name = "txt", target = "some text" }
CNAME -> RR.emptyRR { rrtype = "CNAME", name = "www", target = "server1" }
NS -> RR.emptyRR { rrtype = "NS", name = (domain <> "."), target = "ns0.example.com." }
MX -> RR.emptyRR { rrtype = "MX", name = "mail", target = "server1", priority = Just 10 }
CAA -> RR.emptyRR { rrtype = "CAA", name = "", target = "", caa = Just default_caa }
SRV -> RR.emptyRR { rrtype = "SRV", name = "voip", target = "server1"
, port = Just 5061, weight = Just 100, priority = Just 10, protocol = Just RR.TCP }
SPF -> RR.emptyRR { rrtype = "SPF", name = "", target = ""
, mechanisms = Just default_mechanisms, q = Just RR.HardFail }
DKIM -> RR.emptyRR { rrtype = "DKIM", name = "default._domainkey", target = "" }
DMARC -> RR.emptyRR { rrtype = "DMARC", name = "_dmarc", target = "" }
where
default_mechanisms = maybe [] (\x -> [x]) $ RR.to_mechanism "pass" "mx" ""
mkEmptyRRForm :: RRForm
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 :: RRForm -> RRUpdateValue -> RRForm
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 = RR.srv_protocols A.!! v } }
SPF_Mechanism_q v -> form { tmp { spf { mechanism_q = maybe "pass" id $ RR.qualifier_types A.!! v }}}
SPF_Mechanism_t v -> form { tmp { spf { mechanism_t = maybe "a" id $ RR.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 $ RR.modifier_types A.!! v }}}
SPF_Modifier_v v -> form { tmp { spf { modifier_v = v }}}
SPF_Qualifier v -> form { _rr { q = RR.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]) (RR.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]) (RR.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 } } }

297
src/App/Type/ResourceRecord.purs
View file

@ -1,16 +1,24 @@
module App.Type.ResourceRecord where
import Prelude ((<>), map, bind, pure, class Show)
import Prelude (($), (-), (<>), map, bind, pure, 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 App.Type.AcceptedRRTypes (AcceptedRRTypes(..))
import Data.Array as A
import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Data.Either (Either(..))
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.DKIM as DKIM
import App.Type.DMARC as DMARC
@ -281,3 +289,288 @@ 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 Mechanism)
| SPF_modifiers (Array Modifier)
| SPF_q 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 Validation.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 HardFail }
DKIM -> emptyRR { rrtype = "DKIM", name = "default._domainkey", target = "" }
DMARC -> emptyRR { rrtype = "DMARC", name = "_dmarc", target = "" }
where
default_mechanisms = maybe [] (\x -> [x]) $ 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 $ qualifier_types A.!! v }}}
SPF_Mechanism_t v -> form { tmp { spf { mechanism_t = maybe "a" id $ 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 $ modifier_types A.!! v }}}
SPF_Modifier_v v -> form { tmp { spf { modifier_v = v }}}
SPF_Qualifier v -> form { _rr { q = 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]) (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]) (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

83
src/App/Validation/DNS.purs
View file

@ -11,7 +11,7 @@ import Data.String as S
import Data.Validation.Semigroup (V, invalid, toEither)
import App.Type.ResourceRecord (ResourceRecord, emptyRR, Mechanism, Modifier)
import App.Type.ResourceRecord (MechanismType(..), ModifierType(..)) as RR
import App.Type.ResourceRecord as RR
import GenericParser.SomeParsers as SomeParsers
import GenericParser.Parser as G
import GenericParser.DomainParser.Common (DomainError) as DomainParser
@ -25,50 +25,7 @@ import App.Type.CAA as CAA
import Utils (id)
-- | **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
type AVErrors = Array Error
type AVErrors = Array RR.Error
-- | Current default values.
min_ttl = 30 :: Int
@ -113,12 +70,12 @@ txt_parser = do pos <- G.current_position
-- | `parse` enables to run any parser based on `GenericParser` and provide a validation error.
-- | The actual validation error contains the parser's error including the position.
parse :: forall e v. G.Parser e v -> String -> ((G.Error e) -> Error) -> V (Array Error) v
parse :: forall e v. G.Parser e v -> String -> ((G.Error e) -> RR.Error) -> V (Array RR.Error) v
parse (G.Parser p) str c = case p { string: str, position: 0 } of
Left x -> invalid $ [c x]
Right x -> pure x.result
validationA :: ResourceRecord -> V (Array Error) ResourceRecord
validationA :: ResourceRecord -> V (Array RR.Error) ResourceRecord
validationA form = ado
name <- parse DomainParser.name form.name VEName
ttl <- is_between min_ttl max_ttl form.ttl VETTL
@ -126,7 +83,7 @@ validationA form = ado
in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "A", name = name, ttl = ttl, target = target
, token = form.token }
validationAAAA :: ResourceRecord -> V (Array Error) ResourceRecord
validationAAAA :: ResourceRecord -> V (Array RR.Error) ResourceRecord
validationAAAA form = ado
name <- parse DomainParser.name form.name VEName
ttl <- is_between min_ttl max_ttl form.ttl VETTL
@ -135,33 +92,33 @@ validationAAAA form = ado
in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "AAAA", name = name, ttl = ttl, target = target
, token = form.token }
validationTXT :: ResourceRecord -> V (Array Error) ResourceRecord
validationTXT :: ResourceRecord -> V (Array RR.Error) ResourceRecord
validationTXT form = ado
name <- parse DomainParser.name form.name VEName
ttl <- is_between min_ttl max_ttl form.ttl VETTL
target <- parse txt_parser form.target VETXT
in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "TXT", name = name, ttl = ttl, target = target }
validationCNAME :: ResourceRecord -> V (Array Error) ResourceRecord
validationCNAME :: ResourceRecord -> V (Array RR.Error) ResourceRecord
validationCNAME form = ado
name <- parse DomainParser.name form.name VEName
ttl <- is_between min_ttl max_ttl form.ttl VETTL
target <- parse DomainParser.sub_eof form.target VECNAME
in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "CNAME", name = name, ttl = ttl, target = target }
validationNS :: ResourceRecord -> V (Array Error) ResourceRecord
validationNS :: ResourceRecord -> V (Array RR.Error) ResourceRecord
validationNS form = ado
name <- parse DomainParser.name form.name VEName
ttl <- is_between min_ttl max_ttl form.ttl VETTL
target <- parse DomainParser.sub_eof form.target VENS
in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "NS", name = name, ttl = ttl, target = target }
is_between :: Int -> Int -> Int -> (Int -> Int -> Int -> Error) -> V (Array Error) Int
is_between :: Int -> Int -> Int -> (Int -> Int -> Int -> RR.Error) -> V (Array RR.Error) Int
is_between min max n ve = if between min max n
then pure n
else invalid [ve min max n]
validationMX :: ResourceRecord -> V (Array Error) ResourceRecord
validationMX :: ResourceRecord -> V (Array RR.Error) ResourceRecord
validationMX form = ado
name <- parse DomainParser.name form.name VEName
ttl <- is_between min_ttl max_ttl form.ttl VETTL
@ -170,7 +127,7 @@ validationMX form = ado
in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "MX"
, name = name, ttl = ttl, target = target, priority = Just priority }
validationSRV :: ResourceRecord -> V (Array Error) ResourceRecord
validationSRV :: ResourceRecord -> V (Array RR.Error) ResourceRecord
validationSRV form = ado
name <- parse DomainParser.name form.name VEName
ttl <- is_between min_ttl max_ttl form.ttl VETTL
@ -214,7 +171,7 @@ or_nothing p = do v <- G.tryMaybe p
-- | Also, some of them should accept a CIDR, which currently isn't a thing.
-- |
-- | TODO: I don't intend to implement the full RFC7208, but accepting CIDR can be done.
validate_SPF_mechanism :: Mechanism -> V (Array Error) Mechanism
validate_SPF_mechanism :: Mechanism -> V (Array RR.Error) Mechanism
validate_SPF_mechanism m = case m.t of
-- RFC: `a = "a" [ ":" domain-spec ] [ dual-cidr-length ]`
RR.A -> test (or_nothing DomainParser.sub_eof) VESPFMechanismName
@ -238,12 +195,12 @@ validate_SPF_mechanism m = case m.t of
RR.INCLUDE -> test DomainParser.sub_eof VESPFMechanismName
where
test :: forall e. G.Parser e String -> ((G.Error e) -> Error) -> V (Array Error) Mechanism
test :: forall e. G.Parser e String -> ((G.Error e) -> RR.Error) -> V (Array RR.Error) Mechanism
test p e = ado
name <- parse p m.v e
in first m name -- name is discarded
validate_SPF_modifier :: Modifier -> V (Array Error) Modifier
validate_SPF_modifier :: Modifier -> V (Array RR.Error) Modifier
validate_SPF_modifier m = case m.t of
RR.EXP -> ado
name <- parse DomainParser.sub_eof m.v VESPFModifierName
@ -252,7 +209,7 @@ validate_SPF_modifier m = case m.t of
name <- parse DomainParser.sub_eof m.v VESPFModifierName
in first m name -- name is discarded
validationSPF :: ResourceRecord -> V (Array Error) ResourceRecord
validationSPF :: ResourceRecord -> V (Array RR.Error) ResourceRecord
validationSPF form = ado
name <- parse DomainParser.name form.name VEName
ttl <- is_between min_ttl max_ttl form.ttl VETTL
@ -280,7 +237,7 @@ rsa_max_key_size = 1000 :: Int
-- | This key is converted directly in base64, leading to a simple 44-byte key representation.
ed25519_key_size = 44 :: Int
verify_public_key :: DKIM.SignatureAlgorithm -> DKIM.PublicKey -> V (Array Error) DKIM.PublicKey
verify_public_key :: DKIM.SignatureAlgorithm -> DKIM.PublicKey -> V (Array RR.Error) DKIM.PublicKey
verify_public_key signalgo key = case signalgo of
DKIM.RSA -> ado
k <- if between rsa_min_key_size rsa_max_key_size (S.length key)
@ -293,7 +250,7 @@ verify_public_key signalgo key = case signalgo of
else invalid [DKIMInvalidKeySize ed25519_key_size ed25519_key_size]
in k
validationDKIM :: ResourceRecord -> V (Array Error) ResourceRecord
validationDKIM :: ResourceRecord -> V (Array RR.Error) ResourceRecord
validationDKIM form =
let dkim = fromMaybe DKIM.emptyDKIMRR form.dkim
in ado
@ -307,7 +264,7 @@ validationDKIM form =
, name = name, ttl = ttl, target = "" -- `target` is discarded!
, dkim = Just $ dkim { p = p } }
validationDMARC :: ResourceRecord -> V (Array Error) ResourceRecord
validationDMARC :: ResourceRecord -> V (Array RR.Error) ResourceRecord
validationDMARC form =
let dmarc = fromMaybe DMARC.emptyDMARCRR form.dmarc
in ado
@ -321,7 +278,7 @@ validationDMARC form =
, name = name, ttl = ttl, target = "" -- `target` is discarded!
, dmarc = Just $ dmarc { pct = Just pct, ri = Just ri } }
validationCAA :: ResourceRecord -> V (Array Error) ResourceRecord
validationCAA :: ResourceRecord -> V (Array RR.Error) ResourceRecord
validationCAA form =
let caa = fromMaybe CAA.emptyCAARR form.caa
in ado
@ -337,7 +294,7 @@ validationCAA form =
-- | `validation` provides a way to validate the content of a RR.
validation :: ResourceRecord -> Either (Array Error) ResourceRecord
validation :: ResourceRecord -> Either (Array RR.Error) ResourceRecord
validation entry = case entry.rrtype of
"A" -> toEither $ validationA entry
"AAAA" -> toEither $ validationAAAA entry

5
src/App/Validation/Delegation.purs
View file

@ -6,7 +6,6 @@ import Data.Either (Either(..))
import Data.Validation.Semigroup (V, invalid, toEither)
import GenericParser.Parser as G
import GenericParser.DomainParser.Common (DomainError) as DomainParser
import GenericParser.DomainParser (name) as DomainParser
import App.Type.Delegation (mkEmptyDelegationForm, Form, Error(..)) as Delegation
@ -22,8 +21,8 @@ validation_nameservers :: Delegation.Form -> V (Array Delegation.Error) Delegati
validation_nameservers form = ado
nameserver1 <- parse DomainParser.name form.nameserver1 Delegation.VENameServer1
nameserver2 <- parse DomainParser.name form.nameserver2 Delegation.VENameServer2
in Delegation.mkEmptyDelegationForm
in Delegation.mkEmptyDelegationForm { nameserver1 = nameserver1, nameserver2 = nameserver2 }
-- | `validation` provides a way to validate the content of a RR.
-- | `validation` verifies the domain names of the provided name servers for the delegation.
validation :: Delegation.Form -> Either (Array Delegation.Error) Delegation.Form
validation entry = toEither $ validation_nameservers entry