From e39e88dd2fe69a634110d379d958129cd32603dc Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Fri, 25 Jul 2025 14:10:22 +0200 Subject: [PATCH] Refactoring WIP (ResourceRecord type). --- src/App/DisplayErrors.purs | 96 ++++++------- src/App/Page/Zone.purs | 49 ++++--- src/App/Templates/Modal.purs | 115 ++++++++------- src/App/Templates/Table.purs | 32 ++--- src/App/Type/AcceptedRRTypes.purs | 26 ---- src/App/Type/RRModal.purs | 2 +- src/App/Type/ResourceRecord.purs | 202 +++++++-------------------- src/App/Type/ResourceRecord/SPF.purs | 145 +++++++++++++++++++ src/App/Validation/DNS.purs | 177 ++++++++++++----------- 9 files changed, 430 insertions(+), 414 deletions(-) delete mode 100644 src/App/Type/AcceptedRRTypes.purs create mode 100644 src/App/Type/ResourceRecord/SPF.purs diff --git a/src/App/DisplayErrors.purs b/src/App/DisplayErrors.purs index 6989b5a..d6ad67e 100644 --- a/src/App/DisplayErrors.purs +++ b/src/App/DisplayErrors.purs @@ -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)." diff --git a/src/App/Page/Zone.purs b/src/App/Page/Zone.purs index 39d4542..5cab811 100644 --- a/src/App/Page/Zone.purs +++ b/src/App/Page/Zone.purs @@ -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" diff --git a/src/App/Templates/Modal.purs b/src/App/Templates/Modal.purs index f7a8e92..121b28e 100644 --- a/src/App/Templates/Modal.purs +++ b/src/App/Templates/Modal.purs @@ -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."] diff --git a/src/App/Templates/Table.purs b/src/App/Templates/Table.purs index 9baccd7..1a66a6b 100644 --- a/src/App/Templates/Table.purs +++ b/src/App/Templates/Table.purs @@ -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) ] ] diff --git a/src/App/Type/AcceptedRRTypes.purs b/src/App/Type/AcceptedRRTypes.purs deleted file mode 100644 index 9a6aaa4..0000000 --- a/src/App/Type/AcceptedRRTypes.purs +++ /dev/null @@ -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 diff --git a/src/App/Type/RRModal.purs b/src/App/Type/RRModal.purs index a531a34..90fe696 100644 --- a/src/App/Type/RRModal.purs +++ b/src/App/Type/RRModal.purs @@ -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 diff --git a/src/App/Type/ResourceRecord.purs b/src/App/Type/ResourceRecord.purs index 08bc266..2909b41 100644 --- a/src/App/Type/ResourceRecord.purs +++ b/src/App/Type/ResourceRecord.purs @@ -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 diff --git a/src/App/Type/ResourceRecord/SPF.purs b/src/App/Type/ResourceRecord/SPF.purs new file mode 100644 index 0000000..3577506 --- /dev/null +++ b/src/App/Type/ResourceRecord/SPF.purs @@ -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 }) diff --git a/src/App/Validation/DNS.purs b/src/App/Validation/DNS.purs index 45d1bff..2c32ac1 100644 --- a/src/App/Validation/DNS.purs +++ b/src/App/Validation/DNS.purs @@ -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]