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.Text.Explanations as Explanations
import App.Type.RRId (RRId) import App.Type.RRId (RRId)
import App.Type.Field as Field import App.Type.ResourceRecord as RR
import App.Type.Delegation (mkEmptyDelegationForm, update_delegation_field, Form, Field) as Delegation import App.Type.Delegation (mkEmptyDelegationForm, update, Form, Field) as Delegation
import App.Type.RRModal (RRModal(..)) import App.Type.RRModal (RRModal(..))
import App.Type.AcceptedRRTypes (AcceptedRRTypes(..)) import App.Type.AcceptedRRTypes (AcceptedRRTypes(..))
import App.Type.ResourceRecord (ResourceRecord)
import App.Type.DKIM as DKIM import App.Type.DKIM as DKIM
import App.Type.DMARC as DMARC 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.DNS as Validation
import App.Validation.Delegation as ValidationDelegation 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 -- | `App.Page.Zone` can send messages through websocket interface
-- | connected to dnsmanagerd. See `App.WS`. -- | connected to dnsmanagerd. See `App.WS`.
-- | -- |
@ -69,9 +66,9 @@ data Output
| AskZoneFile String | AskZoneFile String
| AskNewToken String Int | AskNewToken String Int
| AskDeleteRR String Int | AskDeleteRR String Int
| AskSaveRR String ResourceRecord | AskSaveRR String RR.ResourceRecord
| AskSaveDelegation String String String | AskSaveDelegation String String String
| AskAddRR String ResourceRecord | AskAddRR String RR.ResourceRecord
| AskGetZone String | AskGetZone String
-- | `App.Page.Zone` can receive messages from `dnsmanagerd`. -- | `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. -- | 2. `UpdateCurrentRR Field`: modify the fields of the future new RR.
-- | 3. `ValidateRR AcceptedRRTypes`: validate the new RR stored in `_currentRR`. -- | 3. `ValidateRR AcceptedRRTypes`: validate the new RR stored in `_currentRR`.
-- | In case it works, automatically call `AddRR` then `CancelModal`. -- | 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: -- | Steps to update an entry:
-- | 1. `CreateUpdateRRModal RRId`: create a modal from the values of the RR in `_resources` to update. -- | 1. `CreateUpdateRRModal RRId`: create a modal from the values of the RR in `_resources` to update.
-- | 2. `UpdateCurrentRR Field`: modify the currently displayed RR. -- | 2. `UpdateCurrentRR Field`: modify the currently displayed RR.
-- | 3. `ValidateLocal RRId AcceptedRRTypes`: validate the 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 data Action
-- | Initiate the component. This means asking the content of the zone to `dnsmanagerd`. -- | Initiate the component. This means asking the content of the zone to `dnsmanagerd`.
@ -124,7 +121,7 @@ data Action
| ReturnToDomainList | ReturnToDomainList
-- | Update new entry form (in the `rr_modal` modal). -- | 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). -- | Update a delegation form field (new nameservers for the domain).
| UpdateDelegationForm Delegation.Field | UpdateDelegationForm Delegation.Field
@ -143,13 +140,13 @@ data Action
| ValidateLocal | ValidateLocal
-- | Add a new resource record to the zone. -- | 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. -- | Reset the different temporary values, such as SPF mechanisms or DMARC mail entry.
| ResetTemporaryValues | ResetTemporaryValues
-- | Save the changes done in an already existing resource record. -- | Save the changes done in an already existing resource record.
| SaveRR ResourceRecord | SaveRR RR.ResourceRecord
-- | Send a message to remove a resource record. -- | Send a message to remove a resource record.
-- | Automatically closes the modal. -- | Automatically closes the modal.
@ -159,7 +156,7 @@ data Action
| AskGeneratedZoneFile | AskGeneratedZoneFile
-- | Modification of any attribute of the current RR. -- | Modification of any attribute of the current RR.
| RRUpdate RRUpdateValue | RRUpdate RR.RRUpdateValue
-- | Ask a (new) token for a resource record. -- | Ask a (new) token for a resource record.
| NewToken RRId | NewToken RRId
@ -180,11 +177,11 @@ type State =
, rr_modal :: RRModal , rr_modal :: RRModal
-- | All resource records. -- | All resource records.
, _resources :: Array ResourceRecord , _resources :: Array RR.ResourceRecord
--, _local_errors :: Hash.HashMap RRId (Array Validation.Error) --, _local_errors :: Hash.HashMap RRId (Array Validation.Error)
-- Unique RR form. -- Unique RR form.
, _rr_form :: RRForm , _rr_form :: RR.Form
-- DelegationForm -- DelegationForm
, _delegation_form :: Delegation.Form , _delegation_form :: Delegation.Form
@ -220,7 +217,7 @@ initialState domain =
, _resources: [] , _resources: []
--, _local_errors: Hash.empty --, _local_errors: Hash.empty
, _rr_form: mkEmptyRRForm , _rr_form: RR.mkEmptyRRForm
, _delegation_form: Delegation.mkEmptyDelegationForm , _delegation_form: Delegation.mkEmptyDelegationForm
@ -331,7 +328,7 @@ handleAction = case _ of
-- | Each time a "new RR" button is clicked, the form resets. -- | Each time a "new RR" button is clicked, the form resets.
CreateNewRRModal t -> do CreateNewRRModal t -> do
state <- H.get 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). -- | Delegation modal presents a simple form with two entries (chosen nameservers).
CreateDelegationModal -> do CreateDelegationModal -> do
@ -400,8 +397,7 @@ handleAction = case _ of
-- | Update the delegation form. -- | Update the delegation form.
UpdateDelegationForm field -> do UpdateDelegationForm field -> do
state <- H.get state <- H.get
let newDelegationForm = Delegation.update_delegation_field state._delegation_form field H.modify_ _ { _delegation_form = Delegation.update state._delegation_form field }
H.modify_ _ { _delegation_form = newDelegationForm }
-- | Validate any local RR with the new `_resources` and `_local_errors`. -- | Validate any local RR with the new `_resources` and `_local_errors`.
ValidateLocal -> do ValidateLocal -> do
@ -487,7 +483,7 @@ handleAction = case _ of
RRUpdate value_to_update -> do RRUpdate value_to_update -> do
state <- H.get 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 case value_to_update of
SPF_Mechanism_Add -> handleAction $ ResetTemporaryValues SPF_Mechanism_Add -> handleAction $ ResetTemporaryValues
SPF_Modifier_Add -> handleAction $ ResetTemporaryValues SPF_Modifier_Add -> handleAction $ ResetTemporaryValues
@ -531,7 +527,7 @@ handleQuery = case _ of
pure (Just a) pure (Just a)
where where
-- replace_entry :: ResourceRecord -- replace_entry :: RR.ResourceRecord
replace_entry new_rr = do replace_entry new_rr = do
state <- H.get state <- H.get
H.modify_ _ { _resources = A.filter (\rr -> rr.rrid /= new_rr.rrid) state._resources } 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 H.put $ add_RR state new_rr
add_entries $ fromMaybe [] tail 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 ]) } add_RR state new_rr = state { _resources = (state._resources <> [ new_rr ]) }
render_new_records :: forall (w :: Type). State -> HH.HTML w Action 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 Nothing -> pure unit
Just xs -> loopE f xs 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 update_field rr updated_field = case updated_field of
Field.Domain val -> rr { name = toLower val } RR.Domain val -> rr { name = toLower val }
Field.Target val -> rr { target = val } RR.Target val -> rr { target = val }
Field.TTL val -> rr { ttl = fromMaybe 0 (fromString val) } RR.TTL val -> rr { ttl = fromMaybe 0 (fromString val) }
Field.Priority val -> rr { priority = fromString val } RR.Priority val -> rr { priority = fromString val }
Field.Weight val -> rr { weight = fromString val } RR.Weight val -> rr { weight = fromString val }
Field.Port val -> rr { port = fromString val } RR.Port val -> rr { port = fromString val }
Field.SPF_v val -> rr { v = Just val } RR.SPF_v val -> rr { v = Just val }
Field.SPF_mechanisms val -> rr { mechanisms = Just val } RR.SPF_mechanisms val -> rr { mechanisms = Just val }
Field.SPF_modifiers val -> rr { modifiers = Just val } RR.SPF_modifiers val -> rr { modifiers = Just val }
Field.SPF_q val -> rr { q = Just val } RR.SPF_q val -> rr { q = Just val }
Field.CAA_flag val -> RR.CAA_flag val ->
let new_caa = (fromMaybe default_caa rr.caa) { flag = fromMaybe 0 $ fromString val } let new_caa = (fromMaybe RR.default_caa rr.caa) { flag = fromMaybe 0 $ fromString val }
in rr { caa = Just new_caa } in rr { caa = Just new_caa }
Field.CAA_value val -> RR.CAA_value val ->
let new_caa = (fromMaybe default_caa rr.caa) { value = val } let new_caa = (fromMaybe RR.default_caa rr.caa) { value = val }
in rr { caa = Just new_caa } 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.RRId (RRId)
import App.Type.DMARC as DMARC import App.Type.DMARC as DMARC
import App.Type.DKIM as DKIM import App.Type.DKIM as DKIM
import App.Type.Field as Field
import App.Type.Delegation as Delegation import App.Type.Delegation as Delegation
import App.Templates.Table as Table import App.Templates.Table as Table
import Data.String (toLower) 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.RRModal (RRModal(..))
import App.Type.AcceptedRRTypes (AcceptedRRTypes(..)) import App.Type.AcceptedRRTypes (AcceptedRRTypes(..))
@ -84,14 +80,14 @@ delegation_modal selected_domain form action_update_form action_validate action_
else HH.div_ [ ] else HH.div_ [ ]
type Domain = String type Domain = String
type ActionUpdateForm i = (Field.Field -> i) type ActionUpdateForm i = (RR.Field -> i)
type ActionNewToken i = (RRId -> i) type ActionNewToken i = (RRId -> i)
type ActionUpdateRR i = (RRUpdateValue -> i) type ActionUpdateRR i = (RRUpdateValue -> i)
type ActionValidateNewRR i = (AcceptedRRTypes -> i) type ActionValidateNewRR i = (AcceptedRRTypes -> i)
type ActionValidateLocalRR :: forall k. k -> k type ActionValidateLocalRR :: forall k. k -> k
type ActionValidateLocalRR i = i type ActionValidateLocalRR i = i
current_rr_modal :: forall w i. current_rr_modal :: forall w i.
Domain -> RRForm -> RRModal Domain -> RR.Form -> RRModal
-> ActionUpdateForm i -> ActionNewToken i -> ActionUpdateForm i -> ActionNewToken i
-> ActionUpdateRR i -> ActionValidateNewRR i -> ActionValidateLocalRR i -> ActionCancelModal i -> ActionUpdateRR i -> ActionValidateNewRR i -> ActionValidateLocalRR i -> ActionCancelModal i
-> HH.HTML w i -> HH.HTML w i
@ -126,18 +122,18 @@ current_rr_modal selected_domain form rr_modal
, render_introduction_text x , render_introduction_text x
, side_text_for_name_input ("domain" <> form._rr.rrtype) , side_text_for_name_input ("domain" <> form._rr.rrtype)
, Web.input_with_side_text ("domain" <> form._rr.rrtype) "" "www" , Web.input_with_side_text ("domain" <> form._rr.rrtype) "" "www"
(action_update_form <<< Field.Domain) (action_update_form <<< RR.Domain)
form._rr.name form._rr.name
display_domain_side display_domain_side
, Web.box_input ("ttl" <> form._rr.rrtype) "TTL" "1800" , Web.box_input ("ttl" <> form._rr.rrtype) "TTL" "1800"
(action_update_form <<< Field.TTL) (action_update_form <<< RR.TTL)
(show form._rr.ttl) (show form._rr.ttl)
, case form._rr.rrtype of , 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 "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 <<< Field.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 <<< Field.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 <<< Field.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 <<< Field.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 ] <> case rr_modal of
UpdateRRModal -> UpdateRRModal ->
if A.elem form._rr.rrtype ["A", "AAAA"] 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 , Web.quote Explanations.mx_introduction
, side_text_for_name_input "domainMX" , side_text_for_name_input "domainMX"
, Web.input_with_side_text "domainMX" "" "www" , Web.input_with_side_text "domainMX" "" "www"
(action_update_form <<< Field.Domain) (action_update_form <<< RR.Domain)
form._rr.name form._rr.name
display_domain_side display_domain_side
, Web.box_input ("ttlMX") "TTL" "1800" , Web.box_input ("ttlMX") "TTL" "1800"
(action_update_form <<< Field.TTL) (action_update_form <<< RR.TTL)
(show form._rr.ttl) (show form._rr.ttl)
, Web.box_input ("targetMX") "Target" "www" , Web.box_input ("targetMX") "Target" "www"
(action_update_form <<< Field.Target) (action_update_form <<< RR.Target)
form._rr.target form._rr.target
, Web.box_input ("priorityMX") "Priority" "10" , Web.box_input ("priorityMX") "Priority" "10"
(action_update_form <<< Field.Priority) (action_update_form <<< RR.Priority)
(maybe "" show 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 , Web.quote Explanations.caa_introduction
, side_text_for_name_input "domainCAA" , side_text_for_name_input "domainCAA"
, Web.input_with_side_text "domainCAA" "" "www" , Web.input_with_side_text "domainCAA" "" "www"
(action_update_form <<< Field.Domain) (action_update_form <<< RR.Domain)
form._rr.name form._rr.name
display_domain_side display_domain_side
, Web.box_input ("ttlCAA") "TTL" "1800" , Web.box_input ("ttlCAA") "TTL" "1800"
(action_update_form <<< Field.TTL) (action_update_form <<< RR.TTL)
(show form._rr.ttl) (show form._rr.ttl)
, Web.hr , Web.hr
, Web.box_input ("flagCAA") "Flag" "" , 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) (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) , Web.selection_field'' "tagCAA" "Tag" (action_update_rr <<< CAA_tag) (A.zip CAA.tags_txt CAA.tags_raw)
CAA.Issue CAA.Issue
@ -198,7 +194,7 @@ current_rr_modal selected_domain form rr_modal
, HH.div [HP.classes [C.notification, C.is_warning]] , HH.div [HP.classes [C.notification, C.is_warning]]
[ Web.p "⚠️​ CAA entries aren't thoroughly verified, yet. Also, do not put quotes." [ 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 (fromMaybe default_caa form._rr.caa).value
] ]
@ -207,27 +203,27 @@ current_rr_modal selected_domain form rr_modal
[ Web.quote Explanations.srv_introduction [ Web.quote Explanations.srv_introduction
, render_errors , render_errors
, Web.box_input ("ttlSRV") "TTL" "1800" , Web.box_input ("ttlSRV") "TTL" "1800"
(action_update_form <<< Field.TTL) (action_update_form <<< RR.TTL)
(show form._rr.ttl) (show form._rr.ttl)
, Web.box_input "domainSRV" "Service name" "service name" , Web.box_input "domainSRV" "Service name" "service name"
(action_update_form <<< Field.Domain) (action_update_form <<< RR.Domain)
form._rr.name form._rr.name
, Web.selection_field "protocolSRV" "Protocol" (action_update_rr <<< SRV_Protocol) RR.srv_protocols_txt , Web.selection_field "protocolSRV" "Protocol" (action_update_rr <<< SRV_Protocol) RR.srv_protocols_txt
(maybe "udp" (toLower <<< show) form._rr.protocol) (maybe "udp" (toLower <<< show) form._rr.protocol)
, Web.box_input ("targetSRV") "Where the server is" "www" , Web.box_input ("targetSRV") "Where the server is" "www"
(action_update_form <<< Field.Target) (action_update_form <<< RR.Target)
form._rr.target form._rr.target
, Web.box_input ("portSRV") "Port of the service" "5061" , Web.box_input ("portSRV") "Port of the service" "5061"
(action_update_form <<< Field.Port) (action_update_form <<< RR.Port)
(maybe "" show 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.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" , Web.box_input ("prioritySRV") "Priority" "10"
(action_update_form <<< Field.Priority) (action_update_form <<< RR.Priority)
(maybe "" show 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 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.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" , Web.box_input ("weightSRV") "Weight" "100"
(action_update_form <<< Field.Weight) (action_update_form <<< RR.Weight)
(maybe "" show form._rr.weight) (maybe "" show form._rr.weight)
] ]
@ -237,15 +233,15 @@ current_rr_modal selected_domain form rr_modal
, render_errors , render_errors
, side_text_for_name_input "domainSPF" , side_text_for_name_input "domainSPF"
, Web.input_with_side_text "domainSPF" "" "Let this alone." , Web.input_with_side_text "domainSPF" "" "Let this alone."
(action_update_form <<< Field.Domain) (action_update_form <<< RR.Domain)
form._rr.name form._rr.name
display_domain_side display_domain_side
, Web.box_input "ttlSPF" "TTL" "1800" , Web.box_input "ttlSPF" "TTL" "1800"
(action_update_form <<< Field.TTL) (action_update_form <<< RR.TTL)
(show form._rr.ttl) (show form._rr.ttl)
--, case form._rr.v of --, case form._rr.v of
-- Nothing -> Web.p "default value for the version (spf1)" -- 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.hr
, Web.box_with_tag [C.has_background_info_light] tag_mechanisms , 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."] [ 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 , render_errors
, side_text_for_name_input "domainDKIM" , side_text_for_name_input "domainDKIM"
, Web.input_with_side_text "domainDKIM" "" "default._domainkey" , Web.input_with_side_text "domainDKIM" "" "default._domainkey"
(action_update_form <<< Field.Domain) (action_update_form <<< RR.Domain)
form._rr.name form._rr.name
display_domain_side display_domain_side
, Web.box_input "ttlDKIM" "TTL" "1800" , Web.box_input "ttlDKIM" "TTL" "1800"
(action_update_form <<< Field.TTL) (action_update_form <<< RR.TTL)
(show form._rr.ttl) (show form._rr.ttl)
, Web.hr , Web.hr
, Web.quote Explanations.dkim_default_algorithms , Web.quote Explanations.dkim_default_algorithms
@ -317,10 +313,10 @@ current_rr_modal selected_domain form rr_modal
, render_errors , render_errors
, side_text_for_name_input "domainDMARC" , side_text_for_name_input "domainDMARC"
, Web.input_with_side_text "domainDMARC" "" "_dmarc" , Web.input_with_side_text "domainDMARC" "" "_dmarc"
(action_update_form <<< Field.Domain) (action_update_form <<< RR.Domain)
form._rr.name form._rr.name
display_domain_side 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.hr
, Web.quote Explanations.dmarc_policy , 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.Parser as G
import GenericParser.DomainParser.Common (DomainError) as DomainParser 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 type Form
= { nameserver1 :: String = { nameserver1 :: String
, nameserver2 :: String , nameserver2 :: String
, errors :: Array Error , errors :: Array Error
} }
data Field -- | Empty delegation form, with default inputs.
= NameServer1 String
| NameServer2 String
mkEmptyDelegationForm :: Form mkEmptyDelegationForm :: Form
mkEmptyDelegationForm mkEmptyDelegationForm
= { nameserver1: "ns0.example.com" = { nameserver1: "ns0.example.com"
@ -20,11 +19,27 @@ mkEmptyDelegationForm
, errors: [] , errors: []
} }
update_delegation_field :: Form -> Field -> Form -- | What are the **fields** of our delegation form?
update_delegation_field form updated_field = case updated_field of -- | 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 } NameServer1 val -> form { nameserver1 = val }
NameServer2 val -> form { nameserver2 = val } NameServer2 val -> form { nameserver2 = val }
-- | Possible errors regarding the form (domain parsing errors).
data Error data Error
= VENameServer1 (G.Error DomainParser.DomainError) = VENameServer1 (G.Error DomainParser.DomainError)
| VENameServer2 (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 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.String (toLower)
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import App.Type.GenericSerialization (generic_serialization) import App.Type.GenericSerialization (generic_serialization)
import Data.Show.Generic (genericShow) 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 (JsonCodec)
import Data.Codec.Argonaut as CA import Data.Codec.Argonaut as CA
import Data.Codec.Argonaut.Record as CAR import Data.Codec.Argonaut.Record as CAR
import Data.Int (fromString)
import App.Type.DKIM as DKIM import App.Type.DKIM as DKIM
import App.Type.DMARC as DMARC import App.Type.DMARC as DMARC
@ -281,3 +289,288 @@ str_to_srv_protocol = case _ of
"tcp" -> Just TCP "tcp" -> Just TCP
"udp" -> Just UDP "udp" -> Just UDP
_ -> Nothing _ -> 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 Data.Validation.Semigroup (V, invalid, toEither)
import App.Type.ResourceRecord (ResourceRecord, emptyRR, Mechanism, Modifier) 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.SomeParsers as SomeParsers
import GenericParser.Parser as G import GenericParser.Parser as G
import GenericParser.DomainParser.Common (DomainError) as DomainParser import GenericParser.DomainParser.Common (DomainError) as DomainParser
@ -25,50 +25,7 @@ import App.Type.CAA as CAA
import Utils (id) import Utils (id)
-- | **History:** type AVErrors = Array RR.Error
-- | 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
-- | Current default values. -- | Current default values.
min_ttl = 30 :: Int 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. -- | `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. -- | 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 parse (G.Parser p) str c = case p { string: str, position: 0 } of
Left x -> invalid $ [c x] Left x -> invalid $ [c x]
Right x -> pure x.result Right x -> pure x.result
validationA :: ResourceRecord -> V (Array Error) ResourceRecord validationA :: ResourceRecord -> V (Array RR.Error) ResourceRecord
validationA form = ado validationA form = ado
name <- parse DomainParser.name form.name VEName name <- parse DomainParser.name form.name VEName
ttl <- is_between min_ttl max_ttl form.ttl VETTL 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 in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "A", name = name, ttl = ttl, target = target
, token = form.token } , token = form.token }
validationAAAA :: ResourceRecord -> V (Array Error) ResourceRecord validationAAAA :: ResourceRecord -> V (Array RR.Error) ResourceRecord
validationAAAA form = ado validationAAAA form = ado
name <- parse DomainParser.name form.name VEName name <- parse DomainParser.name form.name VEName
ttl <- is_between min_ttl max_ttl form.ttl VETTL 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 in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "AAAA", name = name, ttl = ttl, target = target
, token = form.token } , token = form.token }
validationTXT :: ResourceRecord -> V (Array Error) ResourceRecord validationTXT :: ResourceRecord -> V (Array RR.Error) ResourceRecord
validationTXT form = ado validationTXT form = ado
name <- parse DomainParser.name form.name VEName name <- parse DomainParser.name form.name VEName
ttl <- is_between min_ttl max_ttl form.ttl VETTL ttl <- is_between min_ttl max_ttl form.ttl VETTL
target <- parse txt_parser form.target VETXT target <- parse txt_parser form.target VETXT
in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "TXT", name = name, ttl = ttl, target = target } 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 validationCNAME form = ado
name <- parse DomainParser.name form.name VEName name <- parse DomainParser.name form.name VEName
ttl <- is_between min_ttl max_ttl form.ttl VETTL ttl <- is_between min_ttl max_ttl form.ttl VETTL
target <- parse DomainParser.sub_eof form.target VECNAME target <- parse DomainParser.sub_eof form.target VECNAME
in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "CNAME", name = name, ttl = ttl, target = target } 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 validationNS form = ado
name <- parse DomainParser.name form.name VEName name <- parse DomainParser.name form.name VEName
ttl <- is_between min_ttl max_ttl form.ttl VETTL ttl <- is_between min_ttl max_ttl form.ttl VETTL
target <- parse DomainParser.sub_eof form.target VENS target <- parse DomainParser.sub_eof form.target VENS
in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "NS", name = name, ttl = ttl, target = target } 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 is_between min max n ve = if between min max n
then pure n then pure n
else invalid [ve min max n] else invalid [ve min max n]
validationMX :: ResourceRecord -> V (Array Error) ResourceRecord validationMX :: ResourceRecord -> V (Array RR.Error) ResourceRecord
validationMX form = ado validationMX form = ado
name <- parse DomainParser.name form.name VEName name <- parse DomainParser.name form.name VEName
ttl <- is_between min_ttl max_ttl form.ttl VETTL 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" in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "MX"
, name = name, ttl = ttl, target = target, priority = Just priority } , 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 validationSRV form = ado
name <- parse DomainParser.name form.name VEName name <- parse DomainParser.name form.name VEName
ttl <- is_between min_ttl max_ttl form.ttl VETTL 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. -- | 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. -- | 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 validate_SPF_mechanism m = case m.t of
-- RFC: `a = "a" [ ":" domain-spec ] [ dual-cidr-length ]` -- RFC: `a = "a" [ ":" domain-spec ] [ dual-cidr-length ]`
RR.A -> test (or_nothing DomainParser.sub_eof) VESPFMechanismName 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 RR.INCLUDE -> test DomainParser.sub_eof VESPFMechanismName
where 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 test p e = ado
name <- parse p m.v e name <- parse p m.v e
in first m name -- name is discarded 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 validate_SPF_modifier m = case m.t of
RR.EXP -> ado RR.EXP -> ado
name <- parse DomainParser.sub_eof m.v VESPFModifierName 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 name <- parse DomainParser.sub_eof m.v VESPFModifierName
in first m name -- name is discarded in first m name -- name is discarded
validationSPF :: ResourceRecord -> V (Array Error) ResourceRecord validationSPF :: ResourceRecord -> V (Array RR.Error) ResourceRecord
validationSPF form = ado validationSPF form = ado
name <- parse DomainParser.name form.name VEName name <- parse DomainParser.name form.name VEName
ttl <- is_between min_ttl max_ttl form.ttl VETTL 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. -- | This key is converted directly in base64, leading to a simple 44-byte key representation.
ed25519_key_size = 44 :: Int 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 verify_public_key signalgo key = case signalgo of
DKIM.RSA -> ado DKIM.RSA -> ado
k <- if between rsa_min_key_size rsa_max_key_size (S.length key) 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] else invalid [DKIMInvalidKeySize ed25519_key_size ed25519_key_size]
in k in k
validationDKIM :: ResourceRecord -> V (Array Error) ResourceRecord validationDKIM :: ResourceRecord -> V (Array RR.Error) ResourceRecord
validationDKIM form = validationDKIM form =
let dkim = fromMaybe DKIM.emptyDKIMRR form.dkim let dkim = fromMaybe DKIM.emptyDKIMRR form.dkim
in ado in ado
@ -307,7 +264,7 @@ validationDKIM form =
, name = name, ttl = ttl, target = "" -- `target` is discarded! , name = name, ttl = ttl, target = "" -- `target` is discarded!
, dkim = Just $ dkim { p = p } } , dkim = Just $ dkim { p = p } }
validationDMARC :: ResourceRecord -> V (Array Error) ResourceRecord validationDMARC :: ResourceRecord -> V (Array RR.Error) ResourceRecord
validationDMARC form = validationDMARC form =
let dmarc = fromMaybe DMARC.emptyDMARCRR form.dmarc let dmarc = fromMaybe DMARC.emptyDMARCRR form.dmarc
in ado in ado
@ -321,7 +278,7 @@ validationDMARC form =
, name = name, ttl = ttl, target = "" -- `target` is discarded! , name = name, ttl = ttl, target = "" -- `target` is discarded!
, dmarc = Just $ dmarc { pct = Just pct, ri = Just ri } } , dmarc = Just $ dmarc { pct = Just pct, ri = Just ri } }
validationCAA :: ResourceRecord -> V (Array Error) ResourceRecord validationCAA :: ResourceRecord -> V (Array RR.Error) ResourceRecord
validationCAA form = validationCAA form =
let caa = fromMaybe CAA.emptyCAARR form.caa let caa = fromMaybe CAA.emptyCAARR form.caa
in ado in ado
@ -337,7 +294,7 @@ validationCAA form =
-- | `validation` provides a way to validate the content of a RR. -- | `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 validation entry = case entry.rrtype of
"A" -> toEither $ validationA entry "A" -> toEither $ validationA entry
"AAAA" -> toEither $ validationAAAA 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 Data.Validation.Semigroup (V, invalid, toEither)
import GenericParser.Parser as G import GenericParser.Parser as G
import GenericParser.DomainParser.Common (DomainError) as DomainParser
import GenericParser.DomainParser (name) as DomainParser import GenericParser.DomainParser (name) as DomainParser
import App.Type.Delegation (mkEmptyDelegationForm, Form, Error(..)) as Delegation 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 validation_nameservers form = ado
nameserver1 <- parse DomainParser.name form.nameserver1 Delegation.VENameServer1 nameserver1 <- parse DomainParser.name form.nameserver1 Delegation.VENameServer1
nameserver2 <- parse DomainParser.name form.nameserver2 Delegation.VENameServer2 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 :: Delegation.Form -> Either (Array Delegation.Error) Delegation.Form
validation entry = toEither $ validation_nameservers entry validation entry = toEither $ validation_nameservers entry