From 0beba6ea6d98fa34e39514ad4a0ae942eca825b7 Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Thu, 29 Feb 2024 04:01:58 +0100 Subject: [PATCH] WIP: SPF interface. --- src/App/AcceptedRRTypes.purs | 1 + src/App/DisplayErrors.purs | 2 + src/App/ResourceRecord.purs | 4 +- src/App/Setup.purs | 5 +- src/App/Validation/DNS.purs | 12 +++++ src/App/ZoneInterface.purs | 101 +++++++++++++++++++++++++++++------ src/Bulma.purs | 17 ++++++ 7 files changed, 119 insertions(+), 23 deletions(-) diff --git a/src/App/AcceptedRRTypes.purs b/src/App/AcceptedRRTypes.purs index 9ac8aeb..aa0cb98 100644 --- a/src/App/AcceptedRRTypes.purs +++ b/src/App/AcceptedRRTypes.purs @@ -15,6 +15,7 @@ data AcceptedRRTypes | NS | MX | SRV + | SPF derive instance genericMyADT :: Generic AcceptedRRTypes _ diff --git a/src/App/DisplayErrors.purs b/src/App/DisplayErrors.purs index 4558c18..5aab35a 100644 --- a/src/App/DisplayErrors.purs +++ b/src/App/DisplayErrors.purs @@ -34,6 +34,7 @@ error_to_paragraph v = Bulma.error_message (Bulma.p $ show_error_title v) <> ", current value: " <> show n <> "." ValidationDNS.VEWeight min max n -> Bulma.p $ "Weight should have a value between " <> show min <> " and " <> show max <> ", current value: " <> show n <> "." + ValidationDNS.VESPF err -> maybe default_error show_error_domain err.error ) where default_error = Bulma.p "" @@ -54,6 +55,7 @@ show_error_title v = case v of ValidationDNS.VEProtocol err -> "The Protocol input is wrong (position: " <> show err.position <> ")" ValidationDNS.VEPort min max n -> "Invalid Port (min: " <> show min <> ", max: " <> show max <> ", n: " <> show n <> ")" ValidationDNS.VEWeight min max n -> "Invalid Weight (min: " <> show min <> ", max: " <> show max <> ", n: " <> show n <> ")" + ValidationDNS.VESPF err -> "The SPF target input is wrong (position: " <> show err.position <> ")" show_error_domain :: forall w i. DomainParser.DomainError -> HH.HTML w i show_error_domain e = case e of diff --git a/src/App/ResourceRecord.purs b/src/App/ResourceRecord.purs index 4d9f44b..713dd2e 100644 --- a/src/App/ResourceRecord.purs +++ b/src/App/ResourceRecord.purs @@ -35,7 +35,7 @@ type ResourceRecord , v :: Maybe String -- Default: spf1 , mechanisms :: Maybe (Array Mechanism) , modifiers :: Maybe (Array Modifier) - , q :: Maybe Int -- Qualifier for default mechanism (`all`). + , q :: Maybe String -- Qualifier for default mechanism (`all`). -- TODO: DKIM specific entries. -- TODO: DMARC specific entries. @@ -72,7 +72,7 @@ codec = CA.object "ResourceRecord" , v: CAR.optional CA.string , mechanisms: CAR.optional (CA.array codecMechanism) , modifiers: CAR.optional (CA.array codecModifier) - , q: CAR.optional CA.int + , q: CAR.optional CA.string }) type Mechanism diff --git a/src/App/Setup.purs b/src/App/Setup.purs index 4c39f5c..f8ba19a 100644 --- a/src/App/Setup.purs +++ b/src/App/Setup.purs @@ -2,11 +2,9 @@ -- | Users can also erase their account. module App.SetupInterface where -import Prelude (Unit, bind, discard, pure, ($), (<<<), (<>), (==)) +import Prelude (Unit, bind, discard, pure, ($), (<<<), (==)) -import Data.ArrayBuffer.Types (ArrayBuffer) import Data.Maybe (Maybe(..)) -import Data.Tuple (Tuple(..)) import Effect.Aff.Class (class MonadAff) import Halogen as H import Halogen.HTML as HH @@ -17,7 +15,6 @@ import Web.Event.Event (Event) import Bulma as Bulma -import App.Email as Email import App.LogMessage import App.Messages.AuthenticationDaemon as AuthD diff --git a/src/App/Validation/DNS.purs b/src/App/Validation/DNS.purs index dbfc1cb..6c384f0 100644 --- a/src/App/Validation/DNS.purs +++ b/src/App/Validation/DNS.purs @@ -44,6 +44,7 @@ data Error | VEMX (G.Error DomainParser.DomainError) | VEPriority Int Int Int | VESRV (G.Error DomainParser.DomainError) + | VESPF (G.Error DomainParser.DomainError) | VEProtocol (G.Error ProtocolError) | VEPort Int Int Int | VEWeight Int Int Int @@ -178,6 +179,16 @@ validationSRV form = ado , name = name, ttl = ttl, target = target , priority = Just priority, port = Just port, protocol = Just protocol, weight = Just weight } +validationSPF :: ResourceRecord -> V (Array Error) ResourceRecord +validationSPF form = ado + name <- parse DomainParser.sub_eof form.name VEName + ttl <- is_between min_ttl max_ttl form.ttl VETTL + target <- parse DomainParser.sub_eof form.target VESPF + in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "SPF" + , name = name, ttl = ttl, target = target + , v = form.v, mechanisms = maybe (Just []) Just form.mechanisms + , modifiers = form.modifiers, q = form.q } + validation :: ResourceRecord -> Either (Array Error) ResourceRecord validation entry = case entry.rrtype of "A" -> toEither $ validationA entry @@ -187,6 +198,7 @@ validation entry = case entry.rrtype of "NS" -> toEither $ validationNS entry "MX" -> toEither $ validationMX entry "SRV" -> toEither $ validationSRV entry + "SPF" -> toEither $ validationSPF entry _ -> toEither $ invalid [UNKNOWN] id :: forall a. a -> a diff --git a/src/App/ZoneInterface.purs b/src/App/ZoneInterface.purs index 0e88b7e..bf9a886 100644 --- a/src/App/ZoneInterface.purs +++ b/src/App/ZoneInterface.purs @@ -2,6 +2,7 @@ -- | -- | This interface allows to: -- | - display all resource records of a zone (SOA, NS, A, AAAA, CNAME, TXT, MX, SRV) +-- | - TODO: dedicated interfaces for: SPF, DKIM, DMARC -- | - add, modify, remove resource records -- | -- | **WIP**: Display relevant information for each record type in the (add/mod) modal. @@ -38,7 +39,7 @@ import Bulma as Bulma import CSSClasses as C import App.AcceptedRRTypes (AcceptedRRTypes(..)) -import App.ResourceRecord (ResourceRecord, emptyRR) +import App.ResourceRecord (ResourceRecord, emptyRR, Mechanism, Modifier) import App.DisplayErrors (error_to_paragraph) @@ -84,6 +85,10 @@ data Field | Field_Protocol String | Field_Weight String | Field_Port String + | Field_SPF_v String + | Field_SPF_mechanisms (Array Mechanism) + | Field_SPF_modifiers (Array Modifier) + | Field_SPF_q String -- | Steps to create a new RR: -- | 1. `CreateNewRRModal AcceptedRRTypes`: create a modal with default values based on selected accepted type. @@ -152,6 +157,7 @@ show_accepted_type = case _ of NS -> "NS" MX -> "MX" SRV -> "SRV" + SPF -> "SPF" string_to_acceptedtype :: String -> Maybe AcceptedRRTypes string_to_acceptedtype str = case str of @@ -162,6 +168,7 @@ string_to_acceptedtype str = case str of "NS" -> Just NS "MX" -> Just MX "SRV" -> Just SRV + "SPF" -> Just SPF _ -> Nothing type State = @@ -270,6 +277,7 @@ render state "NS" -> template content_simple (foot_content NS) "MX" -> template content_mx (foot_content MX) "SRV" -> template content_srv (foot_content SRV) + "SPF" -> template content_spf (foot_content SPF) _ -> Bulma.p $ "Invalid type: " <> state._currentRR.rrtype where -- DRY @@ -349,6 +357,34 @@ render state (fromMaybe "tcp" state._currentRR.protocol) should_be_disabled ] + content_spf :: Array (HH.HTML w Action) + content_spf = + [ render_errors + , Bulma.input_with_side_text "domainSPF" "Name" "www" -- id, title, placeholder + (updateForm Field_Domain) -- action + state._currentRR.name -- value + ("." <> state._domain) -- sidetext + , Bulma.box_input ("ttlSPF") "TTL" "600" + (updateForm Field_TTL) + (show state._currentRR.ttl) + should_be_disabled + , Bulma.box_input ("targetSPF") "Target" "www" + (updateForm Field_Target) + state._currentRR.target + should_be_disabled + , case state._currentRR.v of + Nothing -> Bulma.p "default value for the version (spf1)" + Just v -> Bulma.box_input ("vSPF") "Version" "spf1" (updateForm Field_SPF_v) v should_be_disabled + , Bulma.p "TODO: mechanisms" + , Bulma.p "TODO: modifiers" + , Bulma.p "TODO: qualifier" + --case state._currentRR.mechanisms of + -- Nothing -> Bulma.p "no mechanisms" + -- Just ms -> Bulma.box_input ("mechanismsSPF") "Mechanisms" "" + -- (updateForm Field_SPF_mechanisms) + -- (maybe "" show state._currentRR.v) + -- should_be_disabled + ] should_be_disabled = (if true then (HP.enabled true) else (HP.disabled true)) foot_content x = [ case state.rr_modal of @@ -397,6 +433,8 @@ handleAction = case _ of default_rr_MX = emptyRR { rrtype = "MX", name = "mail", target = "www", priority = Just 10 } default_rr_SRV = emptyRR { rrtype = "SRV", name = "_sip._tcp", target = "www" , port = Just 5061, weight = Just 100, priority = Just 10, protocol = Just "tcp" } + default_rr_SPF = emptyRR { rrtype = "SPF", name = "", target = "www" } + case t of A -> H.modify_ _ { _currentRR = default_rr_A } AAAA -> H.modify_ _ { _currentRR = default_rr_AAAA } @@ -405,6 +443,7 @@ handleAction = case _ of NS -> H.modify_ _ { _currentRR = default_rr_NS } MX -> H.modify_ _ { _currentRR = default_rr_MX } SRV -> H.modify_ _ { _currentRR = default_rr_SRV } + SPF -> H.modify_ _ { _currentRR = default_rr_SPF } -- | Initialize the ZoneInterface component: ask for the domain zone to `dnsmanagerd`. Initialize -> do @@ -568,17 +607,19 @@ render_resources [] , Bulma.subtitle "No records for now" ] render_resources records - = HH.div_ [ render_soa $ A.head $ A.filter (\rr -> rr.rrtype == "SOA") records - , Bulma.box [ basic_records_section ] - , Bulma.box [ mx_records_section ] - , Bulma.box [ srv_records_section ] - , Bulma.box_ C.has_background_warning_light [ basic_readonly_records_section ] - ] + = HH.div_ $ [ render_soa $ A.head $ A.filter (\rr -> rr.rrtype == "SOA") records ] + <> (if A.length all_basic_rr > 0 then [Bulma.box [basic_records_section]] else []) + <> (if A.length all_mx_rr > 0 then [Bulma.box [mx_records_section ]] else []) + <> (if A.length all_srv_rr > 0 then [Bulma.box [srv_records_section ]] else []) + <> (if A.length all_spf_rr > 0 then [Bulma.box [spf_records_section ]] else []) + <> (if A.length all_basic_ro_rr > 0 + then [Bulma.box_ C.has_background_warning_light [basic_readonly_records_section]] else []) where all_basic_rr = A.filter (\rr -> A.elem rr.rrtype baseRecords && not rr.readonly) records all_basic_ro_rr = A.filter (\rr -> A.elem rr.rrtype baseRecords && rr.readonly) records - all_mx_rr = A.filter (\rr -> rr.rrtype == "MX") records - all_srv_rr = A.filter (\rr -> rr.rrtype == "SRV") records + all_mx_rr = A.filter (\rr -> rr.rrtype == "MX") records + all_srv_rr = A.filter (\rr -> rr.rrtype == "SRV") records + all_spf_rr = A.filter (\rr -> rr.rrtype == "SPF") records basic_records_section = if A.length all_basic_rr > 0 @@ -600,9 +641,15 @@ render_resources records then Bulma.table [] [ Bulma.srv_table_header, render_srv_records ] else Bulma.p "no srv records" + spf_records_section + = if A.length all_spf_rr > 0 + then Bulma.table [] [ Bulma.spf_table_header, render_spf_records ] + else Bulma.p "no spf records" + render_basic_records _rrs = table_content_with_separations _rrs render_mx_records = table_content all_mx_rr render_srv_records = table_content all_srv_rr + render_spf_records = table_content all_spf_rr table_content_with_separations records_ = HH.tbody_ $ A.groupAllBy (comparing (_.rrtype)) records_ -- [x x y y z] -> [NE[xx], NE[yy], NE[z]] @@ -637,6 +684,22 @@ render_resources records then HH.td_ [ Bulma.btn_readonly ] else HH.td_ [ Bulma.btn_delete (DeleteRRModal rr.rrid) ] ] + "SPF" -> + [ Bulma.txt_name rr.rrtype + , HH.td_ [ Bulma.p rr.name] + , HH.td_ [ Bulma.p $ show rr.ttl ] + , HH.td_ [ Bulma.p rr.target ] + , HH.td_ [ Bulma.p $ maybe "spf1 (default)" id rr.v ] + , HH.td_ [ Bulma.p $ maybe "" (\ _ -> "TODO: mechanisms") rr.mechanisms ] + , HH.td_ [ Bulma.p $ maybe "" (\ _ -> "TODO: modifiers") rr.modifiers ] + , HH.td_ [ Bulma.p $ maybe "qualifier" (\ _ -> "qualifier") rr.q ] + , if rr.readonly + then HH.td_ [ Bulma.btn_readonly ] + else HH.td_ [ Bulma.btn_modify (CreateUpdateRRModal rr.rrid) ] + , if rr.readonly + then HH.td_ [ Bulma.btn_readonly ] + else HH.td_ [ Bulma.btn_delete (DeleteRRModal rr.rrid) ] + ] "MX" -> [ Bulma.txt_name rr.rrtype , HH.td_ [ Bulma.p rr.name] @@ -684,7 +747,7 @@ render_new_records _ , Bulma.h1 "Special records about the mail system (soon)" -- use "level" to get horizontal buttons next to each other (probably vertical on mobile) , Bulma.level [ - Bulma.btn_ro (C.is_small <> C.is_warning) "SPF" + Bulma.btn "SPF" (CreateNewRRModal SPF) , Bulma.btn_ro (C.is_small <> C.is_warning) "DKIM" , Bulma.btn_ro (C.is_small <> C.is_warning) "DMARC" ] [] @@ -715,10 +778,14 @@ loopE f a = case (A.head a) of update_field :: ResourceRecord -> Field -> ResourceRecord update_field rr updated_field = case updated_field of - Field_Domain val -> rr { name = val } - Field_Target val -> rr { target = val } - Field_TTL val -> rr { ttl = fromMaybe 0 (fromString val) } - Field_Priority val -> rr { priority = fromString val } - Field_Protocol val -> rr { protocol = Just val } - Field_Weight val -> rr { weight = fromString val } - Field_Port val -> rr { port = fromString val } + Field_Domain val -> rr { name = val } + Field_Target val -> rr { target = val } + Field_TTL val -> rr { ttl = fromMaybe 0 (fromString val) } + Field_Priority val -> rr { priority = fromString val } + Field_Protocol val -> rr { protocol = Just val } + Field_Weight val -> rr { weight = fromString val } + Field_Port val -> rr { port = fromString val } + Field_SPF_v val -> rr { v = Just val } + Field_SPF_mechanisms val -> rr { mechanisms = Just val } + Field_SPF_modifiers val -> rr { modifiers = Just val } + Field_SPF_q val -> rr { q = Just val } diff --git a/src/Bulma.purs b/src/Bulma.purs index e47c574..408b519 100644 --- a/src/Bulma.purs +++ b/src/Bulma.purs @@ -106,6 +106,23 @@ srv_table_header ] ] +spf_table_header :: forall w i. HH.HTML w i +spf_table_header + = HH.thead_ [ HH.tr_ [ HH.th [ HP.style "width: 50px;" ] [ HH.text "Type" ] + , HH.th_ [ HH.text "Name" ] + , HH.th_ [ HH.text "TTL" ] + , HH.th_ [ HH.text "Target" ] + , HH.th_ [ HH.text "Version" ] + , HH.th_ [ HH.text "Mechanisms" ] + , HH.th_ [ HH.text "Modifiers" ] + , HH.th_ [ HH.text "Qualifier" ] + , HH.th_ [ HH.text "" ] + , HH.th_ [ HH.text "" ] + , HH.th_ [ HH.text "" ] + , HH.th_ [ HH.text "" ] + ] + ] + soa_table_header :: forall w i. HH.HTML w i soa_table_header = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "name"]