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

Refactoring WIP (ResourceRecord type).

Browse source
This commit is contained in:
Philippe Pittoli 2025-07-25 14:10:22 +02:00
parent f219115f73
commit e39e88dd2f
9 changed files with 430 additions and 414 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

96
src/App/DisplayErrors.purs
View file

@ -7,7 +7,7 @@ import Prelude (show, ($), (<>), (==))
import Data.Maybe (Maybe(..), maybe)
import Halogen.HTML as HH
import App.Validation.DNS as ValidationDNS
import App.Type.ResourceRecord as RR
import App.Validation.Login as L
import App.Validation.Email as E
import App.Validation.Password as P
@ -25,44 +25,44 @@ delegation_error_to_paragraph v = Web.error_message (Web.p $ show_delegation_err
)
where default_error = Web.p ""
error_to_paragraph :: forall w i. ValidationDNS.Error -> HH.HTML w i
error_to_paragraph :: forall w i. RR.Error -> HH.HTML w i
error_to_paragraph v = Web.error_message (Web.p $ show_error_title v)
(case v of
ValidationDNS.UNKNOWN -> Web.p "An internal error happened."
ValidationDNS.VEIPv4 err -> maybe default_error show_error_ip4 err.error
ValidationDNS.VEIPv6 err -> maybe default_error show_error_ip6 err.error
ValidationDNS.VEName err -> maybe default_error show_error_domain err.error
ValidationDNS.VETTL min max n ->
RR.UNKNOWN -> Web.p "An internal error happened."
RR.VEIPv4 err -> maybe default_error show_error_ip4 err.error
RR.VEIPv6 err -> maybe default_error show_error_ip6 err.error
RR.VEName err -> maybe default_error show_error_domain err.error
RR.VETTL min max n ->
Web.p $ "TTL should have a value between "
<> show min <> " and " <> show max <> ", current value: " <> show n <> "."
ValidationDNS.VEDMARCpct min max n ->
RR.VEDMARCpct min max n ->
Web.p $ "DMARC sample rate should have a value between "
<> show min <> " and " <> show max <> ", current value: " <> show n <> "."
ValidationDNS.VEDMARCri min max n ->
RR.VEDMARCri min max n ->
Web.p $ "DMARC report interval should have a value between "
<> show min <> " and " <> show max <> ", current value: " <> show n <> "."
ValidationDNS.VETXT err -> maybe default_error show_error_txt err.error
ValidationDNS.VECNAME err -> maybe default_error show_error_domain err.error
ValidationDNS.VENS err -> maybe default_error show_error_domain err.error
ValidationDNS.VEMX err -> maybe default_error show_error_domain err.error
ValidationDNS.VEPriority min max n -> Web.p $ "Priority should have a value between " <> show min <> " and " <> show max
RR.VETXT err -> maybe default_error show_error_txt err.error
RR.VECNAME err -> maybe default_error show_error_domain err.error
RR.VENS err -> maybe default_error show_error_domain err.error
RR.VEMX err -> maybe default_error show_error_domain err.error
RR.VEPriority min max n -> Web.p $ "Priority should have a value between " <> show min <> " and " <> show max
<> ", current value: " <> show n <> "."
ValidationDNS.VESRV err -> maybe default_error show_error_domain err.error
ValidationDNS.VEPort min max n -> Web.p $ "Port should have a value between " <> show min <> " and " <> show max
RR.VESRV err -> maybe default_error show_error_domain err.error
RR.VEPort min max n -> Web.p $ "Port should have a value between " <> show min <> " and " <> show max
<> ", current value: " <> show n <> "."
ValidationDNS.VEWeight min max n -> Web.p $ "Weight should have a value between " <> show min <> " and " <> show max
RR.VEWeight min max n -> Web.p $ "Weight should have a value between " <> show min <> " and " <> show max
<> ", current value: " <> show n <> "."
ValidationDNS.VECAAflag min max n -> Web.p $ "CAA flag should have a value between " <> show min <> " and " <> show max
RR.VECAAflag min max n -> Web.p $ "CAA flag should have a value between " <> show min <> " and " <> show max
<> ", current value: " <> show n <> "."
-- SPF dedicated RR
ValidationDNS.VESPFMechanismName err -> maybe default_error show_error_domain err.error
ValidationDNS.VESPFMechanismIPv4 err -> maybe default_error show_error_ip4 err.error
ValidationDNS.VESPFMechanismIPv6 err -> maybe default_error show_error_ip6 err.error
ValidationDNS.VESPFModifierName err -> maybe default_error show_error_domain err.error
RR.VESPFMechanismName err -> maybe default_error show_error_domain err.error
RR.VESPFMechanismIPv4 err -> maybe default_error show_error_ip4 err.error
RR.VESPFMechanismIPv6 err -> maybe default_error show_error_ip6 err.error
RR.VESPFModifierName err -> maybe default_error show_error_domain err.error
ValidationDNS.DKIMInvalidKeySize min max -> show_error_key_sizes min max
RR.DKIMInvalidKeySize min max -> show_error_key_sizes min max
)
where default_error = Web.p ""
@ -81,32 +81,32 @@ show_delegation_error_title v = case v of
Delegation.VENameServer2 _ -> "Invalid domain for name server 2"
-- | `show_error_title` provide a simple title string to display to the user in case of an error with an entry.
show_error_title :: ValidationDNS.Error -> String
show_error_title :: RR.Error -> String
show_error_title v = case v of
ValidationDNS.UNKNOWN -> "Unknown"
ValidationDNS.VEIPv4 _ -> "Invalid IPv4 address"
ValidationDNS.VEIPv6 _ -> "Invalid IPv6 address"
ValidationDNS.VEName _ -> "Invalid Name (domain label)"
ValidationDNS.VETTL _ _ _ -> "Invalid TTL"
ValidationDNS.VEDMARCpct _ _ _ -> "Invalid DMARC sample rate"
ValidationDNS.VEDMARCri _ _ _ -> "Invalid DMARC report interval"
ValidationDNS.VETXT _ -> "Invalid TXT"
ValidationDNS.VECNAME _ -> "Invalid CNAME"
ValidationDNS.VENS _ -> "Invalid NS Target"
ValidationDNS.VEMX _ -> "Invalid MX Target"
ValidationDNS.VEPriority _ _ _ -> "Invalid Priority"
ValidationDNS.VESRV _ -> "Invalid SRV Target"
ValidationDNS.VEPort _ _ _ -> "Invalid Port"
ValidationDNS.VEWeight _ _ _ -> "Invalid Weight"
ValidationDNS.VECAAflag _ _ _ -> "Invalid CAA Flag"
RR.UNKNOWN -> "Unknown"
RR.VEIPv4 _ -> "Invalid IPv4 address"
RR.VEIPv6 _ -> "Invalid IPv6 address"
RR.VEName _ -> "Invalid Name (domain label)"
RR.VETTL _ _ _ -> "Invalid TTL"
RR.VEDMARCpct _ _ _ -> "Invalid DMARC sample rate"
RR.VEDMARCri _ _ _ -> "Invalid DMARC report interval"
RR.VETXT _ -> "Invalid TXT"
RR.VECNAME _ -> "Invalid CNAME"
RR.VENS _ -> "Invalid NS Target"
RR.VEMX _ -> "Invalid MX Target"
RR.VEPriority _ _ _ -> "Invalid Priority"
RR.VESRV _ -> "Invalid SRV Target"
RR.VEPort _ _ _ -> "Invalid Port"
RR.VEWeight _ _ _ -> "Invalid Weight"
RR.VECAAflag _ _ _ -> "Invalid CAA Flag"
-- SPF dedicated RR
ValidationDNS.VESPFMechanismName _ -> "The domain name in a SPF mechanism is wrong"
ValidationDNS.VESPFMechanismIPv4 _ -> "The IPv4 address in a SPF mechanism is wrong"
ValidationDNS.VESPFMechanismIPv6 _ -> "The IPv6 address in a SPF mechanism is wrong"
RR.VESPFMechanismName _ -> "The domain name in a SPF mechanism is wrong"
RR.VESPFMechanismIPv4 _ -> "The IPv4 address in a SPF mechanism is wrong"
RR.VESPFMechanismIPv6 _ -> "The IPv6 address in a SPF mechanism is wrong"
ValidationDNS.VESPFModifierName _ -> "The domain name in a SPF modifier (EXP or REDIRECT) is wrong"
ValidationDNS.DKIMInvalidKeySize _ _ -> "Public key has an invalid length"
RR.VESPFModifierName _ -> "The domain name in a SPF modifier (EXP or REDIRECT) is wrong"
RR.DKIMInvalidKeySize _ _ -> "Public key has an invalid length"
show_error_domain :: forall w i. DomainParser.DomainError -> HH.HTML w i
show_error_domain e = case e of
@ -146,10 +146,10 @@ show_error_ip4 e = case e of
Web.p "IPv4 address has been unnecessarily shortened (with two '.')."
IPAddress.IP4InvalidRange -> Web.p "IPv4 address or range isn't valid."
show_error_txt :: forall w i. ValidationDNS.TXTError -> HH.HTML w i
show_error_txt :: forall w i. RR.TXTError -> HH.HTML w i
show_error_txt e = case e of
ValidationDNS.TXTInvalidCharacter -> Web.p "The TXT field contains some invalid characters."
ValidationDNS.TXTTooLong max n ->
RR.TXTInvalidCharacter -> Web.p "The TXT field contains some invalid characters."
RR.TXTTooLong max n ->
Web.p $ "An TXT field is limited to " <> show max <> " characters (currently there are "
<> show n <> " characters)."

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

@ -44,7 +44,6 @@ import App.Type.RRId (RRId)
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.DKIM as DKIM
import App.Type.DMARC as DMARC
@ -83,16 +82,16 @@ type Slot = H.Slot Query Output
type Input = String
-- | Steps to create a new RR:
-- | 1. `CreateNewRRModal AcceptedRRTypes`: create a modal with default values based on selected accepted type.
-- | 1. `CreateNewRRModal RR.AcceptedRRTypes`: create a modal with default values based on selected accepted type.
-- | 2. `UpdateCurrentRR Field`: modify the fields of the future new RR.
-- | 3. `ValidateRR AcceptedRRTypes`: validate the new RR stored in `_currentRR`.
-- | 3. `ValidateRR RR.AcceptedRRTypes`: validate the new RR stored in `_currentRR`.
-- | In case it works, automatically call `AddRR` then `CancelModal`.
-- | 4. `AddRR AcceptedRRTypes RR.ResourceRecord`: send a message to `dnsmanagerd`.
-- | 4. `AddRR RR.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.
-- | 3. `ValidateLocal RRId RR.AcceptedRRTypes`: validate the RR.
-- | 4. `SaveRR RR.ResourceRecord`: save the _validated_ RR by sending a message to `dnsmanagerd`.
data Action
@ -103,7 +102,7 @@ data Action
| CancelModal
-- | Create a new resource record modal (a form) for a certain type of component.
| CreateNewRRModal AcceptedRRTypes
| CreateNewRRModal RR.AcceptedRRTypes
-- | Delegation modal.
| CreateDelegationModal
@ -133,14 +132,14 @@ data Action
| SaveDelegation
-- | Validate a new resource record before adding it.
| ValidateRR AcceptedRRTypes
| ValidateRR RR.AcceptedRRTypes
-- | Validate the entries in an already existing resource record.
-- | Automatically calls for `SaveRR` once record is verified.
| ValidateLocal
-- | Add a new resource record to the zone.
| AddRR AcceptedRRTypes RR.ResourceRecord
| AddRR RR.AcceptedRRTypes RR.ResourceRecord
-- | Reset the different temporary values, such as SPF mechanisms or DMARC mail entry.
| ResetTemporaryValues
@ -359,8 +358,8 @@ handleAction = case _ of
-- TODO: should the code design change? Would the code be simplified by working only on _rr_form._rr.dkim?
-- Since _rr_form._rr.dkim isn't modified directly, it is copied from `State`.
_ <- case t of
DKIM -> H.modify_ \state -> state { _rr_form { _rr { dkim = Just state._rr_form.tmp.dkim } } }
DMARC -> H.modify_ \state -> state { _rr_form { _rr { dmarc = Just state._rr_form.tmp.dmarc } } }
RR.DKIM -> H.modify_ \state -> state { _rr_form { _rr { dkim = Just state._rr_form.tmp.dkim } } }
RR.DMARC -> H.modify_ \state -> state { _rr_form { _rr { dmarc = Just state._rr_form.tmp.dmarc } } }
_ -> pure unit
state <- H.get
@ -485,10 +484,10 @@ handleAction = case _ of
state <- H.get
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
DMARC_rua_Add -> handleAction $ ResetTemporaryValues
DMARC_ruf_Add -> handleAction $ ResetTemporaryValues
RR.SPF_Mechanism_Add -> handleAction $ ResetTemporaryValues
RR.SPF_Modifier_Add -> handleAction $ ResetTemporaryValues
RR.DMARC_rua_Add -> handleAction $ ResetTemporaryValues
RR.DMARC_ruf_Add -> handleAction $ ResetTemporaryValues
_ -> pure unit
where
@ -553,22 +552,22 @@ render_new_records _
[ Web.h1 "Adding new records"
-- use "level" to get horizontal buttons next to each other (probably vertical on mobile)
, Web.level [
Web.btn "A" (CreateNewRRModal A)
, Web.btn "AAAA" (CreateNewRRModal AAAA)
, Web.btn "TXT" (CreateNewRRModal TXT)
, Web.btn "CNAME" (CreateNewRRModal CNAME)
, Web.btn "NS" (CreateNewRRModal NS)
, Web.btn "MX" (CreateNewRRModal MX)
, Web.btn "SRV" (CreateNewRRModal SRV)
Web.btn "A" (CreateNewRRModal RR.A)
, Web.btn "AAAA" (CreateNewRRModal RR.AAAA)
, Web.btn "TXT" (CreateNewRRModal RR.TXT)
, Web.btn "CNAME" (CreateNewRRModal RR.CNAME)
, Web.btn "NS" (CreateNewRRModal RR.NS)
, Web.btn "MX" (CreateNewRRModal RR.MX)
, Web.btn "SRV" (CreateNewRRModal RR.SRV)
] []
, Web.hr
, Web.h1 "Special records about certifications and the mail system"
-- use "level" to get horizontal buttons next to each other (probably vertical on mobile)
, Web.level [
Web.btn "CAA" (CreateNewRRModal CAA)
, Web.btn "SPF" (CreateNewRRModal SPF)
, Web.btn "DKIM" (CreateNewRRModal DKIM)
, Web.btn "DMARC" (CreateNewRRModal DMARC)
Web.btn "CAA" (CreateNewRRModal RR.CAA)
, Web.btn "SPF" (CreateNewRRModal RR.SPF)
, Web.btn "DKIM" (CreateNewRRModal RR.DKIM)
, Web.btn "DMARC" (CreateNewRRModal RR.DMARC)
] []
, Web.hr
, Web.h1 "Delegation"

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

@ -25,9 +25,8 @@ import App.Templates.Table as Table
import Data.String (toLower)
import App.Type.RRModal (RRModal(..))
import App.Type.AcceptedRRTypes (AcceptedRRTypes(..))
import App.Type.ResourceRecord (mechanism_types, modifier_types, qualifier_types, show_qualifier)
import App.Type.ResourceRecord.SPF (mechanism_types, modifier_types, qualifier_types, show_qualifier) as SPF
import App.Type.ResourceRecord as RR
import App.DisplayErrors (error_to_paragraph, delegation_error_to_paragraph, show_error_email)
@ -82,8 +81,8 @@ delegation_modal selected_domain form action_update_form action_validate action_
type Domain = String
type ActionUpdateForm i = (RR.Field -> i)
type ActionNewToken i = (RRId -> i)
type ActionUpdateRR i = (RRUpdateValue -> i)
type ActionValidateNewRR i = (AcceptedRRTypes -> i)
type ActionUpdateRR i = (RR.RRUpdateValue -> i)
type ActionValidateNewRR i = (RR.AcceptedRRTypes -> i)
type ActionValidateLocalRR :: forall k. k -> k
type ActionValidateLocalRR i = i
current_rr_modal :: forall w i.
@ -95,17 +94,17 @@ current_rr_modal selected_domain form rr_modal
action_update_form action_new_token
action_update_rr action_validate_rr action_validate_local_rr action_cancel_modal =
case form._rr.rrtype of
"A" -> template (modal_content_simple A) (foot_content A)
"AAAA" -> template (modal_content_simple AAAA) (foot_content AAAA)
"TXT" -> template (modal_content_simple TXT) (foot_content TXT)
"CNAME" -> template (modal_content_simple CNAME) (foot_content CNAME)
"NS" -> template (modal_content_simple NS) (foot_content NS)
"MX" -> template modal_content_mx (foot_content MX)
"CAA" -> template modal_content_caa (foot_content CAA)
"SRV" -> template modal_content_srv (foot_content SRV)
"SPF" -> template modal_content_spf (foot_content SPF)
"DKIM" -> template modal_content_dkim (foot_content DKIM)
"DMARC" -> template modal_content_dmarc (foot_content DMARC)
"A" -> template (modal_content_simple RR.A) (foot_content RR.A)
"AAAA" -> template (modal_content_simple RR.AAAA) (foot_content RR.AAAA)
"TXT" -> template (modal_content_simple RR.TXT) (foot_content RR.TXT)
"CNAME" -> template (modal_content_simple RR.CNAME) (foot_content RR.CNAME)
"NS" -> template (modal_content_simple RR.NS) (foot_content RR.NS)
"MX" -> template modal_content_mx (foot_content RR.MX)
"CAA" -> template modal_content_caa (foot_content RR.CAA)
"SRV" -> template modal_content_srv (foot_content RR.SRV)
"SPF" -> template modal_content_spf (foot_content RR.SPF)
"DKIM" -> template modal_content_dkim (foot_content RR.DKIM)
"DMARC" -> template modal_content_dmarc (foot_content RR.DMARC)
_ -> Web.p $ "Invalid type: " <> form._rr.rrtype
where
side_text_for_name_input name_id
@ -116,7 +115,7 @@ current_rr_modal selected_domain form rr_modal
then HH.div_ $ [ Web.h3 "Errors: " ] <> map error_to_paragraph form._errors
else HH.div_ [ ]
modal_content_simple :: AcceptedRRTypes -> Array (HH.HTML w i)
modal_content_simple :: RR.AcceptedRRTypes -> Array (HH.HTML w i)
modal_content_simple x =
[ render_errors
, render_introduction_text x
@ -143,14 +142,14 @@ current_rr_modal selected_domain form rr_modal
else []
_ -> []
render_introduction_text :: AcceptedRRTypes -> HH.HTML w i
render_introduction_text :: RR.AcceptedRRTypes -> HH.HTML w i
render_introduction_text = case _ of
A -> Web.quote Explanations.a_introduction
AAAA -> Web.quote Explanations.aaaa_introduction
TXT -> Web.quote Explanations.txt_introduction
CNAME -> Web.quote Explanations.cname_introduction
NS -> Web.quote Explanations.ns_introduction
_ -> HH.p_ []
RR.A -> Web.quote Explanations.a_introduction
RR.AAAA -> Web.quote Explanations.aaaa_introduction
RR.TXT -> Web.quote Explanations.txt_introduction
RR.CNAME -> Web.quote Explanations.cname_introduction
RR.NS -> Web.quote Explanations.ns_introduction
_ -> HH.p_ []
modal_content_mx :: Array (HH.HTML w i)
modal_content_mx =
@ -187,15 +186,15 @@ current_rr_modal selected_domain form rr_modal
, Web.hr
, Web.box_input ("flagCAA") "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)
(show (fromMaybe RR.default_caa form._rr.caa).flag)
, Web.selection_field'' "tagCAA" "Tag" (action_update_rr <<< RR.CAA_tag) (A.zip CAA.tags_txt CAA.tags_raw)
CAA.Issue
(Just (fromMaybe default_caa form._rr.caa).tag)
(Just (fromMaybe RR.default_caa form._rr.caa).tag)
, 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 <<< RR.CAA_value)
(fromMaybe default_caa form._rr.caa).value
(fromMaybe RR.default_caa form._rr.caa).value
]
modal_content_srv :: Array (HH.HTML w i)
@ -208,7 +207,7 @@ current_rr_modal selected_domain form rr_modal
, Web.box_input "domainSRV" "Service name" "service name"
(action_update_form <<< RR.Domain)
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 <<< 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 <<< RR.Target)
@ -245,33 +244,33 @@ current_rr_modal selected_domain form rr_modal
, 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."]
, maybe (Web.p "You don't have any mechanism.") (Table.display_mechanisms (action_update_rr <<< SPF_remove_mechanism)) form._rr.mechanisms
, maybe (Web.p "You don't have any mechanism.") (Table.display_mechanisms (action_update_rr <<< RR.SPF_remove_mechanism)) form._rr.mechanisms
, Web.hr
, Web.h4 "New mechanism"
, Web.selection_field "idMechanismQ" "Policy" (action_update_rr <<< SPF_Mechanism_q) qualifier_types form.tmp.spf.mechanism_q
, Web.selection_field "idMechanismT" "Type" (action_update_rr <<< SPF_Mechanism_t) mechanism_types form.tmp.spf.mechanism_t
, Web.selection_field "idMechanismQ" "Policy" (action_update_rr <<< RR.SPF_Mechanism_q) SPF.qualifier_types form.tmp.spf.mechanism_q
, Web.selection_field "idMechanismT" "Type" (action_update_rr <<< RR.SPF_Mechanism_t) SPF.mechanism_types form.tmp.spf.mechanism_t
, Web.box_input "valueNewMechanismSPF" "Value" ""
(action_update_rr <<< SPF_Mechanism_v)
(action_update_rr <<< RR.SPF_Mechanism_v)
form.tmp.spf.mechanism_v
, Web.btn "Add a mechanism" (action_update_rr SPF_Mechanism_Add)
, Web.btn "Add a mechanism" (action_update_rr RR.SPF_Mechanism_Add)
]
, Web.hr
, Web.box_with_tag [C.has_background_success_light] tag_modifiers
[ Web.quote [Web.p "Modifiers provide additional instructions, such as explanations for SPF failures or redirecting SPF checks to another domain."]
, maybe (Web.p "You don't have any modifier.") (Table.display_modifiers (action_update_rr <<< SPF_remove_modifier)) form._rr.modifiers
, maybe (Web.p "You don't have any modifier.") (Table.display_modifiers (action_update_rr <<< RR.SPF_remove_modifier)) form._rr.modifiers
, Web.hr
, Web.h4 "New modifier"
, Web.selection_field "idModifierT" "Modifier" (action_update_rr <<< SPF_Modifier_t) modifier_types form.tmp.spf.modifier_t
, Web.selection_field "idModifierT" "Modifier" (action_update_rr <<< RR.SPF_Modifier_t) SPF.modifier_types form.tmp.spf.modifier_t
, Web.box_input "valueNewModifierSPF" "Value" ""
(action_update_rr <<< SPF_Modifier_v)
(action_update_rr <<< RR.SPF_Modifier_v)
form.tmp.spf.modifier_v
, Web.btn "Add a modifier" (action_update_rr SPF_Modifier_Add)
, Web.btn "Add a modifier" (action_update_rr RR.SPF_Modifier_Add)
]
, Web.hr
, Web.box
[ Web.h3 "Default behavior"
, Web.quote Explanations.spf_default_behavior
, Web.selection (action_update_rr <<< SPF_Qualifier) qualifier_types (maybe default_qualifier_str show_qualifier form._rr.q)
, Web.selection (action_update_rr <<< RR.SPF_Qualifier) SPF.qualifier_types (maybe RR.default_qualifier_str SPF.show_qualifier form._rr.q)
]
]
@ -296,15 +295,15 @@ current_rr_modal selected_domain form rr_modal
, Web.hr
, Web.quote Explanations.dkim_default_algorithms
, Web.selection_field "idDKIMSignature" "Signature algo"
(action_update_rr <<< DKIM_sign_algo)
(action_update_rr <<< RR.DKIM_sign_algo)
(map show DKIM.sign_algos)
(show $ fromMaybe DKIM.RSA form.tmp.dkim.k)
, Web.selection_field "idDKIMHash" "Hash algo"
(action_update_rr <<< DKIM_hash_algo)
(action_update_rr <<< RR.DKIM_hash_algo)
(map show DKIM.hash_algos)
(show $ fromMaybe DKIM.SHA256 form.tmp.dkim.h)
, Web.box_input "pkDKIM" "Public Key" "Your public key, such as \"MIIBIjANBgqh...\"" (action_update_rr <<< DKIM_pubkey) form.tmp.dkim.p
, Web.box_input "noteDKIM" "Note" "Note for fellow administrators." (action_update_rr <<< DKIM_note) (fromMaybe "" form.tmp.dkim.n)
, Web.box_input "pkDKIM" "Public Key" "Your public key, such as \"MIIBIjANBgqh...\"" (action_update_rr <<< RR.DKIM_pubkey) form.tmp.dkim.p
, Web.box_input "noteDKIM" "Note" "Note for fellow administrators." (action_update_rr <<< RR.DKIM_note) (fromMaybe "" form.tmp.dkim.n)
]
modal_content_dmarc :: Array (HH.HTML w i)
@ -320,30 +319,30 @@ current_rr_modal selected_domain form rr_modal
, Web.hr
, Web.quote Explanations.dmarc_policy
, Web.selection_field' "idDMARCPolicy" "Policy" (action_update_rr <<< DMARC_policy)
, Web.selection_field' "idDMARCPolicy" "Policy" (action_update_rr <<< RR.DMARC_policy)
(A.zip DMARC.policies_txt DMARC.policies_raw)
(show form.tmp.dmarc.p)
, Web.quote Explanations.dmarc_sp_policy
, Web.selection_field' "idDMARCPolicy_sp" "Policy for subdomains" (action_update_rr <<< DMARC_sp_policy)
, Web.selection_field' "idDMARCPolicy_sp" "Policy for subdomains" (action_update_rr <<< RR.DMARC_sp_policy)
(zip_nullable DMARC.policies_txt_with_null DMARC.policies_raw)
(maybe "-" show form.tmp.dmarc.sp)
, Web.hr
, Web.quote Explanations.dmarc_adkim
, Web.selection_field' "idDMARCadkim" "Consistency Policy for DKIM" (action_update_rr <<< DMARC_adkim)
, Web.selection_field' "idDMARCadkim" "Consistency Policy for DKIM" (action_update_rr <<< RR.DMARC_adkim)
(zip_nullable DMARC.consistency_policies_txt DMARC.consistency_policies_raw)
(maybe "-" show form.tmp.dmarc.adkim)
, Web.quote Explanations.dmarc_aspf
, Web.selection_field' "idDMARCaspf" "Consistency Policy for SPF" (action_update_rr <<< DMARC_aspf)
, Web.selection_field' "idDMARCaspf" "Consistency Policy for SPF" (action_update_rr <<< RR.DMARC_aspf)
(zip_nullable DMARC.consistency_policies_txt DMARC.consistency_policies_raw)
(maybe "-" show form.tmp.dmarc.aspf)
, Web.hr
, Web.quote Explanations.dmarc_pct
, Web.box_input "idDMARCpct" "Sample rate (between 0 and 100)" "100" (action_update_rr <<< DMARC_pct) (maybe "100" show form.tmp.dmarc.pct)
, Web.box_input "idDMARCpct" "Sample rate (between 0 and 100)" "100" (action_update_rr <<< RR.DMARC_pct) (maybe "100" show form.tmp.dmarc.pct)
, Web.hr
, Web.selection_field' "idDMARCfo" "When to send a report" (action_update_rr <<< DMARC_fo)
, Web.selection_field' "idDMARCfo" "When to send a report" (action_update_rr <<< RR.DMARC_fo)
(zip_nullable DMARC.report_occasions_txt DMARC.report_occasions_raw)
(maybe "-" show form.tmp.dmarc.fo)
@ -351,26 +350,26 @@ current_rr_modal selected_domain form rr_modal
, Web.quote Explanations.dmarc_contact
, Web.box_with_tag [C.has_background_info_light] tag_aggregated_reports
[ maybe (Web.p "There is no address to send aggregated reports to.")
(Table.display_dmarc_mail_addresses (action_update_rr <<< DMARC_remove_rua))
(Table.display_dmarc_mail_addresses (action_update_rr <<< RR.DMARC_remove_rua))
form.tmp.dmarc.rua
]
, Web.box_with_tag [C.has_background_success_light] tag_detailed_reports
[ maybe (Web.p "There is no address to send detailed reports to.")
(Table.display_dmarc_mail_addresses (action_update_rr <<< DMARC_remove_ruf))
(Table.display_dmarc_mail_addresses (action_update_rr <<< RR.DMARC_remove_ruf))
form.tmp.dmarc.ruf
]
, Web.hr
, render_dmarc_mail_errors
, Web.box_input "idDMARCmail" "Address to contact" "admin@example.com" (action_update_rr <<< DMARC_mail) form.tmp.dmarc_mail
, Web.box_input "idDMARCmaillimit" "Report size limit (in KB)" "2000" (action_update_rr <<< DMARC_mail_limit) (maybe "0" show form.tmp.dmarc_mail_limit)
, Web.level [ Web.btn_ [C.has_background_info_light] "New address for aggregated report" (action_update_rr DMARC_rua_Add)
, Web.btn_ [C.has_background_success_light] "New address for specific report" (action_update_rr DMARC_ruf_Add)
, Web.box_input "idDMARCmail" "Address to contact" "admin@example.com" (action_update_rr <<< RR.DMARC_mail) form.tmp.dmarc_mail
, Web.box_input "idDMARCmaillimit" "Report size limit (in KB)" "2000" (action_update_rr <<< RR.DMARC_mail_limit) (maybe "0" show form.tmp.dmarc_mail_limit)
, Web.level [ Web.btn_ [C.has_background_info_light] "New address for aggregated report" (action_update_rr RR.DMARC_rua_Add)
, Web.btn_ [C.has_background_success_light] "New address for specific report" (action_update_rr RR.DMARC_ruf_Add)
] []
, Web.hr
, Web.quote Explanations.dmarc_ri
, Web.box_input "idDMARCri" "Report interval (in seconds)" "86400" (action_update_rr <<< DMARC_ri) (maybe "0" show form.tmp.dmarc.ri)
, Web.box_input "idDMARCri" "Report interval (in seconds)" "86400" (action_update_rr <<< RR.DMARC_ri) (maybe "0" show form.tmp.dmarc.ri)
]
render_dmarc_mail_errors
@ -384,13 +383,13 @@ current_rr_modal selected_domain form rr_modal
newtokenbtn :: HH.HTML w i
newtokenbtn = Web.btn (maybe "🏁​ Ask for a token" (\_ -> "🏁​ Ask for a new token") form._rr.token) (action_new_token form._rr.rrid)
foot_content :: AcceptedRRTypes -> Array (HH.HTML w i)
foot_content :: RR.AcceptedRRTypes -> Array (HH.HTML w i)
foot_content x =
case rr_modal of
NewRRModal _ -> [Web.btn_add (action_validate_rr x)]
UpdateRRModal -> [Web.btn_save action_validate_local_rr ] <> case x of
A -> [newtokenbtn]
AAAA -> [newtokenbtn]
RR.A -> [newtokenbtn]
RR.AAAA -> [newtokenbtn]
_ -> []
_ -> [Web.p "rr_modal should either be NewRRModal or UpdateRRModal."]

32
src/App/Templates/Table.purs
View file

@ -31,11 +31,11 @@ import Data.String.CodePoints as CP
import Utils (id, attach_id)
import App.Type.DMARC as DMARC
import App.Type.ResourceRecord (ResourceRecord
, show_mechanism, show_mechanism_type
, show_modifier, show_modifier_type
, show_qualifier, show_qualifier_char)
import App.Type.ResourceRecord (Mechanism, Modifier, Qualifier) as RR
import App.Type.ResourceRecord (ResourceRecord)
import App.Type.ResourceRecord.SPF ( show_mechanism, show_mechanism_type
, show_modifier, show_modifier_type
, show_qualifier, show_qualifier_char
, Mechanism, Modifier, Qualifier) as SPF
import App.Type.DomainInfo (DomainInfo)
@ -206,8 +206,8 @@ resource_records records action_create_or_update_rr action_delete_rr action_new_
[ HH.td_ [ Web.p rr.name ]
, HH.td_ [ Web.p $ show rr.ttl ]
-- , HH.td_ [ Web.p $ maybe "(default)" id rr.v ] -- For now, version isn't displayed.
, HH.td_ [ Web.p $ maybe "" (A.fold <<< A.intersperse " " <<< map show_mechanism) rr.mechanisms ]
, HH.td_ [ Web.p $ maybe "" (A.fold <<< A.intersperse " " <<< map show_modifier) rr.modifiers ]
, HH.td_ [ Web.p $ maybe "" (A.fold <<< A.intersperse " " <<< map SPF.show_mechanism) rr.mechanisms ]
, HH.td_ [ Web.p $ maybe "" (A.fold <<< A.intersperse " " <<< map SPF.show_modifier) rr.modifiers ]
, HH.td_ [ Web.p $ maybe "" fancy_qualifier_display rr.q ]
, if rr.readonly
then HH.td_ [ Button.btn_readonly ]
@ -276,8 +276,8 @@ resource_records records action_create_or_update_rr action_delete_rr action_new_
"AAAA" -> Button.btn_ [C.is_small] "🏁​ Ask for a token" (action_new_token rr.rrid)
_ -> HH.text ""
fancy_qualifier_display :: RR.Qualifier -> String
fancy_qualifier_display qualifier = "(" <> show_qualifier_char qualifier <> ") " <> show_qualifier qualifier
fancy_qualifier_display :: SPF.Qualifier -> String
fancy_qualifier_display qualifier = "(" <> SPF.show_qualifier_char qualifier <> ") " <> SPF.show_qualifier qualifier
simple_table_header :: forall w i. HH.HTML w i
simple_table_header
@ -513,15 +513,15 @@ port_header = HH.abbr
[ HP.title "Related connection port" ]
[ HH.text "Port" ]
display_mechanisms :: forall w i. (Int -> i) -> Array RR.Mechanism -> HH.HTML w i
display_mechanisms :: forall w i. (Int -> i) -> Array SPF.Mechanism -> HH.HTML w i
display_mechanisms _ [] = Web.p "You don't have any mechanism."
display_mechanisms action_remove_mechanism ms =
Web.table [] [ mechanism_table_header, HH.tbody_ $ map render_mechanism_row $ attach_id 0 ms]
where
render_mechanism_row :: (Tuple Int RR.Mechanism) -> HH.HTML w i
render_mechanism_row :: (Tuple Int SPF.Mechanism) -> HH.HTML w i
render_mechanism_row (Tuple i m) = HH.tr_
[ txt_name $ maybe "" show_qualifier m.q
, HH.td_ [ Web.p $ show_mechanism_type m.t ]
[ txt_name $ maybe "" SPF.show_qualifier m.q
, HH.td_ [ Web.p $ SPF.show_mechanism_type m.t ]
, HH.td_ [ Web.p m.v ]
, HH.td_ [ Button.alert_btn "x" (action_remove_mechanism i) ]
]
@ -534,14 +534,14 @@ display_mechanisms action_remove_mechanism ms =
]
]
display_modifiers :: forall w i. (Int -> i) -> Array RR.Modifier -> HH.HTML w i
display_modifiers :: forall w i. (Int -> i) -> Array SPF.Modifier -> HH.HTML w i
display_modifiers _ [] = Web.p "You don't have any modifier."
display_modifiers action_remove_modifier ms =
Web.table [] [ modifier_table_header, HH.tbody_ $ map render_modifier_row $ attach_id 0 ms]
where
render_modifier_row :: (Tuple Int RR.Modifier) -> HH.HTML w i
render_modifier_row :: (Tuple Int SPF.Modifier) -> HH.HTML w i
render_modifier_row (Tuple i m) = HH.tr_
[ HH.td_ [ Web.p $ show_modifier_type m.t ]
[ HH.td_ [ Web.p $ SPF.show_modifier_type m.t ]
, HH.td_ [ Web.p m.v ]
, HH.td_ [ Button.alert_btn "x" (action_remove_modifier i) ]
]

26
src/App/Type/AcceptedRRTypes.purs
View file

@ -1,26 +0,0 @@
-- | The application accepts to add a few new entry types in a DNS zone.
-- | Each resource record has a specific form, with dedicated inputs and
-- | dedicated validation.
module App.Type.AcceptedRRTypes where
import Prelude
import Data.Generic.Rep (class Generic)
import Data.Show.Generic (genericShow)
data AcceptedRRTypes
= A
| AAAA
| TXT
| CNAME
| NS
| MX
| CAA
| SRV
| SPF
| DKIM
| DMARC
derive instance genericAcceptedRRTypes :: Generic AcceptedRRTypes _
instance showAcceptedRRTypes :: Show AcceptedRRTypes where
show = genericShow

2
src/App/Type/RRModal.purs
View file

@ -7,7 +7,7 @@
module App.Type.RRModal where
import App.Type.RRId
import App.Type.AcceptedRRTypes (AcceptedRRTypes)
import App.Type.ResourceRecord (AcceptedRRTypes)
data RRModal
= NoModal

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

@ -6,11 +6,14 @@ import Data.Generic.Rep (class Generic)
import App.Type.GenericSerialization (generic_serialization)
import Data.Show.Generic (genericShow)
import App.Type.AcceptedRRTypes (AcceptedRRTypes(..))
import Data.Array as A
import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Data.Either (Either(..))
import GenericParser.Parser as G
import GenericParser.IPAddress as IPAddress
import GenericParser.DomainParser.Common (DomainError) as DomainParser
import Utils (id, attach_id, remove_id)
import App.Validation.Email as Email
@ -22,6 +25,7 @@ import Data.Int (fromString)
import App.Type.DKIM as DKIM
import App.Type.DMARC as DMARC
import App.Type.ResourceRecord.SPF as SPF
import App.Type.CAA as CAA
type ResourceRecord
@ -53,9 +57,9 @@ type ResourceRecord
-- SPF specific entries.
, v :: Maybe String -- Default: spf1
, mechanisms :: Maybe (Array Mechanism)
, modifiers :: Maybe (Array Modifier)
, q :: Maybe Qualifier -- Qualifier for default mechanism (`all`).
, mechanisms :: Maybe (Array SPF.Mechanism)
, modifiers :: Maybe (Array SPF.Modifier)
, q :: Maybe SPF.Qualifier -- Qualifier for default mechanism (`all`).
, dkim :: Maybe DKIM.DKIM
, dmarc :: Maybe DMARC.DMARC
@ -93,119 +97,15 @@ codec = CA.object "ResourceRecord"
-- SPF specific entries.
, v: CAR.optional CA.string
, mechanisms: CAR.optional (CA.array codecMechanism)
, modifiers: CAR.optional (CA.array codecModifier)
, q: CAR.optional codecQualifier
, mechanisms: CAR.optional (CA.array SPF.codecMechanism)
, modifiers: CAR.optional (CA.array SPF.codecModifier)
, q: CAR.optional SPF.codecQualifier
, dkim: CAR.optional DKIM.codec
, dmarc: CAR.optional DMARC.codec
, caa: CAR.optional CAA.codec
})
type Mechanism
= { q :: Maybe Qualifier
, t :: MechanismType
, v :: String -- Value (IP addresses or ranges, or domains).
}
codecMechanism :: JsonCodec Mechanism
codecMechanism = CA.object "Mechanism"
(CAR.record
{ q: CAR.optional codecQualifier
, t: codecMechanismType
, v: CA.string
})
-- TODO: this is debug code, before actual validation.
to_mechanism :: String -> String -> String -> Maybe Mechanism
to_mechanism q t v = do
mechanism_type <- str_to_mechanism_type t
pure { q: str_to_qualifier q, t: mechanism_type, v }
to_modifier :: String -> String -> Maybe Modifier
to_modifier t v = do
modifier_type <- str_to_modifier_type t
pure { t: modifier_type, v }
-- | `show_modifier` acts like `show_mechanism` regarding the value (meaning: it can be discarded).
-- | But this probably shouldn't since both values of modifiers actually NEED a value.
show_modifier :: Modifier -> String
show_modifier m =
let mtype = show_modifier_type m.t
value = case m.v of
"" -> ""
_ -> "=" <> m.v
in mtype <> value
show_mechanism :: Mechanism -> String
show_mechanism m =
let qualifier = case maybe "" show_qualifier_char m.q of
"+" -> ""
v -> v
mtype = show_mechanism_type m.t
value = case m.v of
"" -> ""
_ -> "=" <> m.v
in qualifier <> mtype <> value
show_qualifier_char :: Qualifier -> String
show_qualifier_char = case _ of
Pass -> "+"
Neutral -> "?"
SoftFail -> "~"
HardFail -> "-"
data MechanismType = A | IP4 | IP6 | MX | PTR | EXISTS | INCLUDE
mechanism_types :: Array String
mechanism_types = map show_mechanism_type [ A, IP4, IP6, MX, PTR, EXISTS, INCLUDE ]
-- | Codec for just encoding a single value of type `MechanismType`.
codecMechanismType :: CA.JsonCodec MechanismType
codecMechanismType = CA.prismaticCodec "MechanismType" str_to_mechanism_type show_mechanism_type CA.string
str_to_mechanism_type :: String -> Maybe MechanismType
str_to_mechanism_type = case _ of
"a" -> Just A
"ip4" -> Just IP4
"ip6" -> Just IP6
"mx" -> Just MX
"ptr" -> Just PTR
"exists" -> Just EXISTS
"include" -> Just INCLUDE
_ -> Nothing
show_mechanism_type :: MechanismType -> String
show_mechanism_type = case _ of
A -> "a"
IP4 -> "ip4"
IP6 -> "ip6"
MX -> "mx"
PTR -> "ptr"
EXISTS -> "exists"
INCLUDE -> "include"
data ModifierType = EXP | REDIRECT
modifier_types :: Array String
modifier_types = ["exp", "redirect"]
show_modifier_type :: ModifierType -> String
show_modifier_type = case _ of
EXP -> "exp"
REDIRECT -> "redirect"
-- | Codec for just encoding a single value of type `ModifierType`.
codecModifierType :: CA.JsonCodec ModifierType
codecModifierType = CA.prismaticCodec "ModifierType" str_to_modifier_type show_modifier_type CA.string
str_to_modifier_type :: String -> Maybe ModifierType
str_to_modifier_type = case _ of
"exp" -> Just EXP
"redirect" -> Just REDIRECT
_ -> Nothing
type Modifier = { t :: ModifierType, v :: String {- Value (domain). -} }
codecModifier :: JsonCodec Modifier
codecModifier = CA.object "Modifier" (CAR.record { t: codecModifierType, v: CA.string })
emptyRR :: ResourceRecord
emptyRR
= { rrid: 0
@ -245,31 +145,6 @@ emptyRR
, caa: Nothing
}
data Qualifier = Pass | Neutral | SoftFail | HardFail
qualifiers :: Array Qualifier
qualifiers = [Pass, Neutral, SoftFail, HardFail]
qualifier_types :: Array String
qualifier_types = ["pass", "neutral", "soft_fail", "hard_fail"]
-- | Codec for just encoding a single value of type `Qualifier`.
codecQualifier :: CA.JsonCodec Qualifier
codecQualifier = CA.prismaticCodec "Qualifier" str_to_qualifier show_qualifier CA.string
str_to_qualifier :: String -> Maybe Qualifier
str_to_qualifier = case _ of
"pass" -> Just Pass -- +
"neutral" -> Just Neutral -- ?
"soft_fail" -> Just SoftFail -- ~
"hard_fail" -> Just HardFail -- -
_ -> Nothing
show_qualifier :: Qualifier -> String
show_qualifier = case _ of
Pass -> "pass"
Neutral -> "neutral"
SoftFail -> "soft_fail"
HardFail -> "hard_fail"
data SRVProtocol = TCP | UDP
srv_protocols :: Array SRVProtocol
srv_protocols = [TCP, UDP]
@ -298,9 +173,9 @@ data Field
| Weight String
| Port String
| SPF_v String
| SPF_mechanisms (Array Mechanism)
| SPF_modifiers (Array Modifier)
| SPF_q Qualifier
| SPF_mechanisms (Array SPF.Mechanism)
| SPF_modifiers (Array SPF.Modifier)
| SPF_q SPF.Qualifier
| CAA_flag String
| CAA_value String
@ -331,7 +206,7 @@ type TMP =
-- | FIXME: this form is messy AF and should be replaced.
type Form =
{ _rr :: ResourceRecord
, _errors :: Array Validation.Error
, _errors :: Array Error
, _dmarc_mail_errors :: Array Email.Error
, _zonefile :: Maybe String
, tmp :: TMP
@ -351,13 +226,13 @@ default_rr t domain =
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 }
, 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 }
, mechanisms = Just default_mechanisms, q = Just SPF.HardFail }
DKIM -> emptyRR { rrtype = "DKIM", name = "default._domainkey", target = "" }
DMARC -> emptyRR { rrtype = "DMARC", name = "_dmarc", target = "" }
where
default_mechanisms = maybe [] (\x -> [x]) $ to_mechanism "pass" "mx" ""
default_mechanisms = maybe [] (\x -> [x]) $ SPF.to_mechanism "pass" "mx" ""
mkEmptyRRForm :: Form
mkEmptyRRForm =
@ -448,12 +323,12 @@ update_form form new_field_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_Mechanism_q v -> form { tmp { spf { mechanism_q = maybe "pass" id $ SPF.qualifier_types A.!! v }}}
SPF_Mechanism_t v -> form { tmp { spf { mechanism_t = maybe "a" id $ SPF.mechanism_types A.!! v }}}
SPF_Mechanism_v v -> form { tmp { spf { mechanism_v = v }}}
SPF_Modifier_t v -> form { tmp { spf { modifier_t = maybe "redirect" id $ SPF.modifier_types A.!! v }}}
SPF_Modifier_v v -> form { tmp { spf { modifier_v = v }}}
SPF_Qualifier v -> form { _rr { q = SPF.qualifiers A.!! v }}
SPF_remove_mechanism i ->
form { _rr { mechanisms = case form._rr.mechanisms of
Just ms -> Just (remove_id i $ attach_id 0 ms)
@ -470,7 +345,7 @@ update_form form new_field_value =
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_list_of_mechanisms = maybe [] id m <> maybe [] (\x -> [x]) (SPF.to_mechanism m_q m_t m_v)
new_value = case new_list_of_mechanisms of
[] -> Nothing
v -> Just v
@ -480,7 +355,7 @@ update_form form new_field_value =
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_list_of_modifiers = maybe [] id m <> maybe [] (\x -> [x]) (SPF.to_modifier m_t m_v)
new_value = case new_list_of_modifiers of
[] -> Nothing
v -> Just v
@ -574,3 +449,28 @@ data Error
| VESPFModifierName (G.Error DomainParser.DomainError)
| DKIMInvalidKeySize Int Int
-- | The application accepts to add a few new entry types in a DNS zone.
-- | Each resource record has a specific form, with dedicated inputs and
-- | dedicated validation.
data AcceptedRRTypes
= A
| AAAA
| TXT
| CNAME
| NS
| MX
| CAA
| SRV
| SPF
| DKIM
| DMARC
derive instance genericAcceptedRRTypes :: Generic AcceptedRRTypes _
instance showAcceptedRRTypes :: Show AcceptedRRTypes where
show = genericShow
data TXTError
= TXTInvalidCharacter
| TXTTooLong Int Int -- max current

145
src/App/Type/ResourceRecord/SPF.purs Normal file
View file

@ -0,0 +1,145 @@
module App.Type.ResourceRecord.SPF where
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.Array as A
import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Data.Either (Either(..))
import Data.Codec.Argonaut (JsonCodec)
import Data.Codec.Argonaut as CA
import Data.Codec.Argonaut.Record as CAR
import Data.Int (fromString)
data Qualifier = Pass | Neutral | SoftFail | HardFail
qualifiers :: Array Qualifier
qualifiers = [Pass, Neutral, SoftFail, HardFail]
qualifier_types :: Array String
qualifier_types = ["pass", "neutral", "soft_fail", "hard_fail"]
-- | Codec for just encoding a single value of type `Qualifier`.
codecQualifier :: CA.JsonCodec Qualifier
codecQualifier = CA.prismaticCodec "Qualifier" str_to_qualifier show_qualifier CA.string
str_to_qualifier :: String -> Maybe Qualifier
str_to_qualifier = case _ of
"pass" -> Just Pass -- +
"neutral" -> Just Neutral -- ?
"soft_fail" -> Just SoftFail -- ~
"hard_fail" -> Just HardFail -- -
_ -> Nothing
show_qualifier :: Qualifier -> String
show_qualifier = case _ of
Pass -> "pass"
Neutral -> "neutral"
SoftFail -> "soft_fail"
HardFail -> "hard_fail"
type Mechanism
= { q :: Maybe Qualifier
, t :: MechanismType
, v :: String -- Value (IP addresses or ranges, or domains).
}
codecMechanism :: JsonCodec Mechanism
codecMechanism = CA.object "Mechanism"
(CAR.record
{ q: CAR.optional codecQualifier
, t: codecMechanismType
, v: CA.string
})
-- TODO: this is debug code, before actual validation.
to_mechanism :: String -> String -> String -> Maybe Mechanism
to_mechanism q t v = do
mechanism_type <- str_to_mechanism_type t
pure { q: str_to_qualifier q, t: mechanism_type, v }
to_modifier :: String -> String -> Maybe Modifier
to_modifier t v = do
modifier_type <- str_to_modifier_type t
pure { t: modifier_type, v }
-- | `show_modifier` acts like `show_mechanism` regarding the value (meaning: it can be discarded).
-- | But this probably shouldn't since both values of modifiers actually NEED a value.
show_modifier :: Modifier -> String
show_modifier m =
let mtype = show_modifier_type m.t
value = case m.v of
"" -> ""
_ -> "=" <> m.v
in mtype <> value
show_mechanism :: Mechanism -> String
show_mechanism m =
let qualifier = case maybe "" show_qualifier_char m.q of
"+" -> ""
v -> v
mtype = show_mechanism_type m.t
value = case m.v of
"" -> ""
_ -> "=" <> m.v
in qualifier <> mtype <> value
show_qualifier_char :: Qualifier -> String
show_qualifier_char = case _ of
Pass -> "+"
Neutral -> "?"
SoftFail -> "~"
HardFail -> "-"
data MechanismType = A | IP4 | IP6 | MX | PTR | EXISTS | INCLUDE
mechanism_types :: Array String
mechanism_types = map show_mechanism_type [ A, IP4, IP6, MX, PTR, EXISTS, INCLUDE ]
-- | Codec for just encoding a single value of type `MechanismType`.
codecMechanismType :: CA.JsonCodec MechanismType
codecMechanismType = CA.prismaticCodec "MechanismType" str_to_mechanism_type show_mechanism_type CA.string
str_to_mechanism_type :: String -> Maybe MechanismType
str_to_mechanism_type = case _ of
"a" -> Just A
"ip4" -> Just IP4
"ip6" -> Just IP6
"mx" -> Just MX
"ptr" -> Just PTR
"exists" -> Just EXISTS
"include" -> Just INCLUDE
_ -> Nothing
show_mechanism_type :: MechanismType -> String
show_mechanism_type = case _ of
A -> "a"
IP4 -> "ip4"
IP6 -> "ip6"
MX -> "mx"
PTR -> "ptr"
EXISTS -> "exists"
INCLUDE -> "include"
data ModifierType = EXP | REDIRECT
modifier_types :: Array String
modifier_types = ["exp", "redirect"]
show_modifier_type :: ModifierType -> String
show_modifier_type = case _ of
EXP -> "exp"
REDIRECT -> "redirect"
-- | Codec for just encoding a single value of type `ModifierType`.
codecModifierType :: CA.JsonCodec ModifierType
codecModifierType = CA.prismaticCodec "ModifierType" str_to_modifier_type show_modifier_type CA.string
str_to_modifier_type :: String -> Maybe ModifierType
str_to_modifier_type = case _ of
"exp" -> Just EXP
"redirect" -> Just REDIRECT
_ -> Nothing
type Modifier = { t :: ModifierType, v :: String {- Value (domain). -} }
codecModifier :: JsonCodec Modifier
codecModifier = CA.object "Modifier" (CAR.record { t: codecModifierType, v: CA.string })

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

@ -10,11 +10,10 @@ import Data.String.CodeUnits as CU
import Data.String as S
import Data.Validation.Semigroup (V, invalid, toEither)
import App.Type.ResourceRecord (ResourceRecord, emptyRR, Mechanism, Modifier)
import App.Type.ResourceRecord as RR
import App.Type.ResourceRecord.SPF as SPF
import GenericParser.SomeParsers as SomeParsers
import GenericParser.Parser as G
import GenericParser.DomainParser.Common (DomainError) as DomainParser
import GenericParser.DomainParser (name, sub_eof) as DomainParser
import GenericParser.IPAddress as IPAddress
import GenericParser.RFC5234 as RFC5234
@ -51,22 +50,19 @@ type RRRetry = Maybe Int
type RRExpire = Maybe Int
type RRMinttl = Maybe Int
data TXTError
= TXTInvalidCharacter
| TXTTooLong Int Int -- max current
-- | TODO: `txt_parser` is currently accepting any printable character (`vchar + sp`).
txt_parser :: G.Parser TXTError String
txt_parser :: G.Parser RR.TXTError String
txt_parser = do pos <- G.current_position
v <- A.many (RFC5234.vchar <|> RFC5234.sp)
e <- G.tryMaybe SomeParsers.eof
pos2 <- G.current_position
case e of
Nothing -> G.errorParser $ Just TXTInvalidCharacter
Nothing -> G.errorParser $ Just RR.TXTInvalidCharacter
Just _ -> do
let nbchar = pos2 - pos
if nbchar < max_txt
then pure $ CU.fromCharArray v
else G.Parser \_ -> G.failureError pos (Just $ TXTTooLong max_txt nbchar)
else G.Parser \_ -> G.failureError pos (Just $ RR.TXTTooLong max_txt nbchar)
-- | `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.
@ -75,69 +71,72 @@ 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 RR.Error) ResourceRecord
validationA :: RR.ResourceRecord -> V (Array RR.Error) RR.ResourceRecord
validationA form = ado
name <- parse DomainParser.name form.name VEName
ttl <- is_between min_ttl max_ttl form.ttl VETTL
target <- parse IPAddress.ipv4 form.target VEIPv4
in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "A", name = name, ttl = ttl, target = target
, token = form.token }
name <- parse DomainParser.name form.name RR.VEName
ttl <- is_between min_ttl max_ttl form.ttl RR.VETTL
target <- parse IPAddress.ipv4 form.target RR.VEIPv4
in RR.emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "A"
, name = name, ttl = ttl, target = target, token = form.token }
validationAAAA :: ResourceRecord -> V (Array RR.Error) ResourceRecord
validationAAAA :: RR.ResourceRecord -> V (Array RR.Error) RR.ResourceRecord
validationAAAA form = ado
name <- parse DomainParser.name form.name VEName
ttl <- is_between min_ttl max_ttl form.ttl VETTL
name <- parse DomainParser.name form.name RR.VEName
ttl <- is_between min_ttl max_ttl form.ttl RR.VETTL
-- use read_input to get unaltered input (the IPv6 parser expands the input)
target <- parse (G.read_input IPAddress.ipv6) form.target VEIPv6
in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "AAAA", name = name, ttl = ttl, target = target
, token = form.token }
target <- parse (G.read_input IPAddress.ipv6) form.target RR.VEIPv6
in RR.emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "AAAA"
, name = name, ttl = ttl, target = target, token = form.token }
validationTXT :: ResourceRecord -> V (Array RR.Error) ResourceRecord
validationTXT :: RR.ResourceRecord -> V (Array RR.Error) RR.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 }
name <- parse DomainParser.name form.name RR.VEName
ttl <- is_between min_ttl max_ttl form.ttl RR.VETTL
target <- parse txt_parser form.target RR.VETXT
in RR.emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "TXT"
, name = name, ttl = ttl, target = target }
validationCNAME :: ResourceRecord -> V (Array RR.Error) ResourceRecord
validationCNAME :: RR.ResourceRecord -> V (Array RR.Error) RR.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 }
name <- parse DomainParser.name form.name RR.VEName
ttl <- is_between min_ttl max_ttl form.ttl RR.VETTL
target <- parse DomainParser.sub_eof form.target RR.VECNAME
in RR.emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "CNAME"
, name = name, ttl = ttl, target = target }
validationNS :: ResourceRecord -> V (Array RR.Error) ResourceRecord
validationNS :: RR.ResourceRecord -> V (Array RR.Error) RR.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 }
name <- parse DomainParser.name form.name RR.VEName
ttl <- is_between min_ttl max_ttl form.ttl RR.VETTL
target <- parse DomainParser.sub_eof form.target RR.VENS
in RR.emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "NS"
, name = name, ttl = ttl, target = target }
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 RR.Error) ResourceRecord
validationMX :: RR.ResourceRecord -> V (Array RR.Error) RR.ResourceRecord
validationMX 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 VEMX
priority <- is_between min_priority max_priority (maybe 0 id form.priority) VEPriority
in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "MX"
, name = name, ttl = ttl, target = target, priority = Just priority }
name <- parse DomainParser.name form.name RR.VEName
ttl <- is_between min_ttl max_ttl form.ttl RR.VETTL
target <- parse DomainParser.sub_eof form.target RR.VEMX
priority <- is_between min_priority max_priority (maybe 0 id form.priority) RR.VEPriority
in RR.emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "MX"
, name = name, ttl = ttl, target = target, priority = Just priority }
validationSRV :: ResourceRecord -> V (Array RR.Error) ResourceRecord
validationSRV :: RR.ResourceRecord -> V (Array RR.Error) RR.ResourceRecord
validationSRV 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 VESRV
priority <- is_between min_priority max_priority (maybe 0 id form.priority) VEPriority
port <- is_between min_port max_port (maybe 0 id form.port) VEPort
weight <- is_between min_weight max_weight (maybe 0 id form.weight) VEWeight
in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "SRV"
, name = name, ttl = ttl, target = target
, priority = Just priority, port = Just port, protocol = form.protocol, weight = Just weight }
name <- parse DomainParser.name form.name RR.VEName
ttl <- is_between min_ttl max_ttl form.ttl RR.VETTL
target <- parse DomainParser.sub_eof form.target RR.VESRV
priority <- is_between min_priority max_priority (maybe 0 id form.priority) RR.VEPriority
port <- is_between min_port max_port (maybe 0 id form.port) RR.VEPort
weight <- is_between min_weight max_weight (maybe 0 id form.weight) RR.VEWeight
in RR.emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "SRV"
, name = name, ttl = ttl, target = target
, priority = Just priority, port = Just port, protocol = form.protocol, weight = Just weight }
-- My version of "map" lol.
verification_loop :: forall a e. (a -> V (Array e) a) -> Array a -> V (Array e) (Array a)
@ -171,53 +170,53 @@ 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 RR.Error) Mechanism
validate_SPF_mechanism :: SPF.Mechanism -> V (Array RR.Error) SPF.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
SPF.A -> test (or_nothing DomainParser.sub_eof) RR.VESPFMechanismName
-- RFC: `mx = "mx" [ ":" domain-spec ] [ dual-cidr-length ]`
RR.MX -> test (or_nothing DomainParser.sub_eof) VESPFMechanismName
SPF.MX -> test (or_nothing DomainParser.sub_eof) RR.VESPFMechanismName
-- RFC: `exists = "exists" ":" domain-spec`
RR.EXISTS -> test DomainParser.sub_eof VESPFMechanismName
SPF.EXISTS -> test DomainParser.sub_eof RR.VESPFMechanismName
-- RFC: `ptr = "ptr" [ ":" domain-spec ]`
RR.PTR -> test (or_nothing DomainParser.sub_eof) VESPFMechanismName
SPF.PTR -> test (or_nothing DomainParser.sub_eof) RR.VESPFMechanismName
-- RFC: `ip4 = "ip4" ":" ip4-network [ ip4-cidr-length ]`
RR.IP4 -> test (IPAddress.ipv4_range <|> IPAddress.ipv4) VESPFMechanismIPv4
SPF.IP4 -> test (IPAddress.ipv4_range <|> IPAddress.ipv4) RR.VESPFMechanismIPv4
-- RFC: `ip6 = "ip6" ":" ip6-network [ ip6-cidr-length ]`
RR.IP6 -> test (IPAddress.ipv6_range <|> IPAddress.ipv6) VESPFMechanismIPv6
SPF.IP6 -> test (IPAddress.ipv6_range <|> IPAddress.ipv6) RR.VESPFMechanismIPv6
-- RFC: `include = "include" ":" domain-spec`
RR.INCLUDE -> test DomainParser.sub_eof VESPFMechanismName
SPF.INCLUDE -> test DomainParser.sub_eof RR.VESPFMechanismName
where
test :: forall e. G.Parser e String -> ((G.Error e) -> RR.Error) -> V (Array RR.Error) Mechanism
test :: forall e. G.Parser e String -> ((G.Error e) -> RR.Error) -> V (Array RR.Error) SPF.Mechanism
test p e = ado
name <- parse p m.v e
in first m name -- name is discarded
validate_SPF_modifier :: Modifier -> V (Array RR.Error) Modifier
validate_SPF_modifier :: SPF.Modifier -> V (Array RR.Error) SPF.Modifier
validate_SPF_modifier m = case m.t of
RR.EXP -> ado
name <- parse DomainParser.sub_eof m.v VESPFModifierName
SPF.EXP -> ado
name <- parse DomainParser.sub_eof m.v RR.VESPFModifierName
in first m name -- name is discarded
RR.REDIRECT -> ado
name <- parse DomainParser.sub_eof m.v VESPFModifierName
SPF.REDIRECT -> ado
name <- parse DomainParser.sub_eof m.v RR.VESPFModifierName
in first m name -- name is discarded
validationSPF :: ResourceRecord -> V (Array RR.Error) ResourceRecord
validationSPF :: RR.ResourceRecord -> V (Array RR.Error) RR.ResourceRecord
validationSPF form = ado
name <- parse DomainParser.name form.name VEName
ttl <- is_between min_ttl max_ttl form.ttl VETTL
name <- parse DomainParser.name form.name RR.VEName
ttl <- is_between min_ttl max_ttl form.ttl RR.VETTL
mechanisms <- verification_loop validate_SPF_mechanism (maybe [] id form.mechanisms)
modifiers <- verification_loop validate_SPF_modifier (maybe [] id form.modifiers)
-- No need to validate the target, actually, it will be completely discarded.
-- The different specific entries replace `target` completely.
in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "SPF"
in RR.emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "SPF"
, name = name, ttl = ttl, target = "" -- `target` is discarded!
, v = form.v, mechanisms = Just mechanisms
, modifiers = Just modifiers, q = form.q }
@ -242,59 +241,59 @@ 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)
then pure key
else invalid [DKIMInvalidKeySize rsa_min_key_size rsa_max_key_size]
else invalid [RR.DKIMInvalidKeySize rsa_min_key_size rsa_max_key_size]
in k
DKIM.ED25519 -> ado
k <- if S.length key == ed25519_key_size
then pure key
else invalid [DKIMInvalidKeySize ed25519_key_size ed25519_key_size]
else invalid [RR.DKIMInvalidKeySize ed25519_key_size ed25519_key_size]
in k
validationDKIM :: ResourceRecord -> V (Array RR.Error) ResourceRecord
validationDKIM :: RR.ResourceRecord -> V (Array RR.Error) RR.ResourceRecord
validationDKIM form =
let dkim = fromMaybe DKIM.emptyDKIMRR form.dkim
in ado
name <- parse DomainParser.name form.name VEName
ttl <- is_between min_ttl max_ttl form.ttl VETTL
name <- parse DomainParser.name form.name RR.VEName
ttl <- is_between min_ttl max_ttl form.ttl RR.VETTL
-- TODO: v n
p <- verify_public_key (fromMaybe DKIM.RSA dkim.k) dkim.p
-- No need to validate the target, actually, it will be completely discarded.
-- The different specific entries replace `target` completely.
in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "DKIM"
in RR.emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "DKIM"
, name = name, ttl = ttl, target = "" -- `target` is discarded!
, dkim = Just $ dkim { p = p } }
validationDMARC :: ResourceRecord -> V (Array RR.Error) ResourceRecord
validationDMARC :: RR.ResourceRecord -> V (Array RR.Error) RR.ResourceRecord
validationDMARC form =
let dmarc = fromMaybe DMARC.emptyDMARCRR form.dmarc
in ado
name <- parse DomainParser.name form.name VEName
ttl <- is_between min_ttl max_ttl form.ttl VETTL
pct <- is_between 0 100 (fromMaybe 100 dmarc.pct) VEDMARCpct
ri <- is_between 0 1000000 (fromMaybe 86400 dmarc.ri) VEDMARCri
name <- parse DomainParser.name form.name RR.VEName
ttl <- is_between min_ttl max_ttl form.ttl RR.VETTL
pct <- is_between 0 100 (fromMaybe 100 dmarc.pct) RR.VEDMARCpct
ri <- is_between 0 1000000 (fromMaybe 86400 dmarc.ri) RR.VEDMARCri
-- No need to validate the target, actually, it will be completely discarded.
-- The different specific entries replace `target` completely.
in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "DMARC"
in RR.emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "DMARC"
, name = name, ttl = ttl, target = "" -- `target` is discarded!
, dmarc = Just $ dmarc { pct = Just pct, ri = Just ri } }
validationCAA :: ResourceRecord -> V (Array RR.Error) ResourceRecord
validationCAA :: RR.ResourceRecord -> V (Array RR.Error) RR.ResourceRecord
validationCAA form =
let caa = fromMaybe CAA.emptyCAARR form.caa
in ado
name <- parse DomainParser.name form.name VEName
ttl <- is_between min_ttl max_ttl form.ttl VETTL
flag <- is_between 0 255 caa.flag VECAAflag
name <- parse DomainParser.name form.name RR.VEName
ttl <- is_between min_ttl max_ttl form.ttl RR.VETTL
flag <- is_between 0 255 caa.flag RR.VECAAflag
-- TODO: verify the `value` field.
-- No need to validate the target, actually, it will be completely discarded.
-- The different specific entries replace `target` completely.
in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "CAA"
in RR.emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "CAA"
, name = name, ttl = ttl, target = "" -- `target` is discarded!
, caa = Just $ caa { flag = flag } }
-- | `validation` provides a way to validate the content of a RR.
validation :: ResourceRecord -> Either (Array RR.Error) ResourceRecord
validation :: RR.ResourceRecord -> Either (Array RR.Error) RR.ResourceRecord
validation entry = case entry.rrtype of
"A" -> toEither $ validationA entry
"AAAA" -> toEither $ validationAAAA entry
@ -307,4 +306,4 @@ validation entry = case entry.rrtype of
"SPF" -> toEither $ validationSPF entry
"DKIM" -> toEither $ validationDKIM entry
"DMARC" -> toEither $ validationDMARC entry
_ -> toEither $ invalid [UNKNOWN]
_ -> toEither $ invalid [RR.UNKNOWN]