From 82bf6b57b4cd74dd104a12331c6f9a060675bd38 Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Thu, 29 Feb 2024 20:30:45 +0100 Subject: [PATCH] WIP: SPF. Display mechanisms. --- src/App/ResourceRecord.purs | 73 +++++++++++++++++++++++-------------- src/App/ZoneInterface.purs | 68 +++++++++++++++++++++------------- 2 files changed, 89 insertions(+), 52 deletions(-) diff --git a/src/App/ResourceRecord.purs b/src/App/ResourceRecord.purs index dc0e94d..3db0dff 100644 --- a/src/App/ResourceRecord.purs +++ b/src/App/ResourceRecord.purs @@ -1,6 +1,6 @@ module App.ResourceRecord where -import Prelude ((<>), map) +import Prelude ((<>), map, bind, pure) import Data.Maybe (Maybe(..), maybe) @@ -91,28 +91,48 @@ codecMechanism = CA.object "Mechanism" , 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 } + +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 -> "+" + None -> "?" + 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 ] -show_mechanism :: Mechanism -> String -show_mechanism m = maybe "" show_qualifier m.q <> show_mechanism_type m.t <> "=" <> m.v - -- | Codec for just encoding a single value of type `MechanismType`. codecMechanismType :: CA.JsonCodec MechanismType -codecMechanismType = - CA.prismaticCodec "MechanismType" from show_mechanism_type CA.string - where - from :: String -> Maybe MechanismType - from = case _ of - "a" -> Just A - "ip4" -> Just IP4 - "ip6" -> Just IP6 - "mx" -> Just MX - "ptr" -> Just PTR - "exists" -> Just EXISTS - "include" -> Just INCLUDE - _ -> Nothing +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 @@ -187,16 +207,15 @@ qualifier_types = ["pass", "none", "soft_fail", "hard_fail"] -- | Codec for just encoding a single value of type `Qualifier`. codecQualifier :: CA.JsonCodec Qualifier -codecQualifier = - CA.prismaticCodec "Qualifier" from show_qualifier CA.string - where - from :: String -> Maybe Qualifier - from = case _ of - "pass" -> Just Pass -- + - "none" -> Just None -- ? - "soft_fail" -> Just SoftFail -- ~ - "hard_fail" -> Just HardFail -- - - _ -> Nothing +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 -- + + "none" -> Just None -- ? + "soft_fail" -> Just SoftFail -- ~ + "hard_fail" -> Just HardFail -- - + _ -> Nothing show_qualifier :: Qualifier -> String show_qualifier = case _ of diff --git a/src/App/ZoneInterface.purs b/src/App/ZoneInterface.purs index e8509c3..9d59f1c 100644 --- a/src/App/ZoneInterface.purs +++ b/src/App/ZoneInterface.purs @@ -40,7 +40,7 @@ import CSSClasses as C import App.AcceptedRRTypes (AcceptedRRTypes(..)) import App.ResourceRecord (ResourceRecord, emptyRR - , show_qualifier, show_mechanism_type + , show_qualifier, show_mechanism_type, show_mechanism, to_mechanism , mechanism_types, qualifier_types, modifier_types) import App.ResourceRecord (Mechanism, Modifier, Qualifier) as RR @@ -147,9 +147,12 @@ data Action | SPF_Mechanism_q Int | SPF_Mechanism_t Int + | SPF_Mechanism_v String | SPF_Modifier Int | SPF_Qualifier Int + | SPF_Mechanism_Add + data RRModal = NoModal | NewRRModal AcceptedRRTypes @@ -195,6 +198,7 @@ type State = , _currentRR_errors :: Array Validation.Error , spf_mechanism_q :: String , spf_mechanism_t :: String + , spf_mechanism_v :: String , spf_modifier :: String , spf_qualifier :: String @@ -242,6 +246,7 @@ initialState domain = , spf_mechanism_q: "pass" , spf_mechanism_t: "a" + , spf_mechanism_v: "" , spf_modifier: "redirect" , spf_qualifier: "none" } @@ -305,14 +310,10 @@ render state content_simple :: Array (HH.HTML w Action) content_simple = [ render_errors - --, Bulma.box_input ("domain" <> state._currentRR.rrtype) "Name" "www" -- id, title, placeholder - -- (updateForm Field_Domain) -- action - -- state._currentRR.name -- value - -- should_be_disabled -- condition - , Bulma.input_with_side_text ("domain" <> state._currentRR.rrtype) "Name" "www" -- id, title, placeholder - (updateForm Field_Domain) -- action - state._currentRR.name -- value - ("." <> state._domain) -- sidetext + , Bulma.input_with_side_text ("domain" <> state._currentRR.rrtype) "Name" "www" + (updateForm Field_Domain) + state._currentRR.name + ("." <> state._domain) , Bulma.box_input ("ttl" <> state._currentRR.rrtype) "TTL" "600" (updateForm Field_TTL) (show state._currentRR.ttl) @@ -325,10 +326,10 @@ render state content_mx :: Array (HH.HTML w Action) content_mx = [ render_errors - , Bulma.input_with_side_text "domainMX" "Name" "www" -- id, title, placeholder - (updateForm Field_Domain) -- action - state._currentRR.name -- value - ("." <> state._domain) -- sidetext + , Bulma.input_with_side_text "domainMX" "Name" "www" + (updateForm Field_Domain) + state._currentRR.name + ("." <> state._domain) , Bulma.box_input ("ttlMX") "TTL" "600" (updateForm Field_TTL) (show state._currentRR.ttl) @@ -345,10 +346,10 @@ render state content_srv :: Array (HH.HTML w Action) content_srv = [ render_errors - , Bulma.input_with_side_text "domainSRV" "Name" "www" -- id, title, placeholder - (updateForm Field_Domain) -- action - state._currentRR.name -- value - ("." <> state._domain) -- sidetext + , Bulma.input_with_side_text "domainSRV" "Name" "www" + (updateForm Field_Domain) + state._currentRR.name + ("." <> state._domain) , Bulma.box_input ("ttlSRV") "TTL" "600" (updateForm Field_TTL) (show state._currentRR.ttl) @@ -377,27 +378,32 @@ render state 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" + , Bulma.input_with_side_text "domainSPF" "Name" "www" + (updateForm Field_Domain) + state._currentRR.name + ("." <> state._domain) + , Bulma.box_input "ttlSPF" "TTL" "600" (updateForm Field_TTL) (show state._currentRR.ttl) should_be_disabled - , Bulma.box_input ("targetSPF") "Target" "www" + , 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 + Just v -> Bulma.box_input "vSPF" "Version" "spf1" (updateForm Field_SPF_v) v should_be_disabled , Bulma.hr , maybe (Bulma.p "no mechanism") display_mechanisms state._currentRR.mechanisms , Bulma.box [ Bulma.h3 "New mechanism" , Bulma.selection SPF_Mechanism_q qualifier_types state.spf_mechanism_q , Bulma.selection SPF_Mechanism_t mechanism_types state.spf_mechanism_t + , Bulma.box_input "valueNewMechanismSPF" "Value" "" + SPF_Mechanism_v + state.spf_mechanism_v + should_be_disabled + , Bulma.btn "Add" SPF_Mechanism_Add ] , Bulma.hr , Bulma.box @@ -545,8 +551,20 @@ handleAction = case _ of SPF_Mechanism_q v -> H.modify_ _ { spf_mechanism_q = maybe "pass" id $ qualifier_types A.!! v } SPF_Mechanism_t v -> H.modify_ _ { spf_mechanism_t = maybe "a" id $ mechanism_types A.!! v } + SPF_Mechanism_v v -> H.modify_ _ { spf_mechanism_v = v } SPF_Modifier v -> H.modify_ _ { spf_modifier = maybe "redirect" id $ modifier_types A.!! v } SPF_Qualifier v -> H.modify_ _ { spf_qualifier = maybe "none" id $ qualifier_types A.!! v } + SPF_Mechanism_Add -> do + state <- H.get + let m = state._currentRR.mechanisms + m_q = state.spf_mechanism_q + m_t = state.spf_mechanism_t + m_v = state.spf_mechanism_v + new_list_of_mechanisms = maybe [] id m <> maybe [] (\x -> [x]) (to_mechanism m_q m_t m_v) + new_value = case new_list_of_mechanisms of + [] -> Nothing + v -> Just v + H.modify_ _ { _currentRR { mechanisms = new_value }} handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a) handleQuery = case _ of @@ -719,7 +737,7 @@ render_resources records , 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 "" (A.fold <<< A.intersperse " " <<< map show_mechanism) rr.mechanisms ] , HH.td_ [ Bulma.p $ maybe "" (\ _ -> "TODO: modifiers") rr.modifiers ] , HH.td_ [ Bulma.p $ maybe "qualifier" (\ _ -> "qualifier") rr.q ] , if rr.readonly