From 8f75a4e88b35f676d9f471d7703ca693a9846b48 Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Thu, 29 Feb 2024 19:19:49 +0100 Subject: [PATCH] WIP: SPF interface. Different types were implemented (Mechanism, Modifier, Qualifier). --- src/App/ResourceRecord.purs | 37 +++++++++++++++++------ src/App/ZoneInterface.purs | 59 +++++++++++++++++++++++++++++++------ src/Bulma.purs | 8 +++++ 3 files changed, 86 insertions(+), 18 deletions(-) diff --git a/src/App/ResourceRecord.purs b/src/App/ResourceRecord.purs index 533acfb..dc0e94d 100644 --- a/src/App/ResourceRecord.purs +++ b/src/App/ResourceRecord.purs @@ -1,6 +1,6 @@ module App.ResourceRecord where -import Prelude ((<>)) +import Prelude ((<>), map) import Data.Maybe (Maybe(..), maybe) @@ -91,12 +91,13 @@ codecMechanism = CA.object "Mechanism" , v: CA.string }) +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 - -data MechanismType = A | IP4 | IP6 | MX | PTR | EXISTS | INCLUDE - -- | Codec for just encoding a single value of type `MechanismType`. codecMechanismType :: CA.JsonCodec MechanismType codecMechanismType = @@ -123,13 +124,29 @@ show_mechanism_type = case _ of EXISTS -> "exists" INCLUDE -> "include" -type Modifier - = { t :: Int -- Type of modifier (0 = EXP, 1 = REDIRECT) - , v :: String -- Value (domain). - } +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" from show_modifier_type CA.string + where + from :: String -> Maybe ModifierType + from = 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: CA.int, v: CA.string }) +codecModifier = CA.object "Modifier" (CAR.record { t: codecModifierType, v: CA.string }) emptyRR :: ResourceRecord emptyRR @@ -165,6 +182,8 @@ emptyRR } data Qualifier = Pass | None | SoftFail | HardFail +qualifier_types :: Array String +qualifier_types = ["pass", "none", "soft_fail", "hard_fail"] -- | Codec for just encoding a single value of type `Qualifier`. codecQualifier :: CA.JsonCodec Qualifier diff --git a/src/App/ZoneInterface.purs b/src/App/ZoneInterface.purs index 2524f8c..04c96d2 100644 --- a/src/App/ZoneInterface.purs +++ b/src/App/ZoneInterface.purs @@ -39,8 +39,10 @@ import Bulma as Bulma import CSSClasses as C import App.AcceptedRRTypes (AcceptedRRTypes(..)) -import App.ResourceRecord (ResourceRecord, emptyRR, Mechanism, Modifier, Qualifier - , show_qualifier, show_mechanism_type) +import App.ResourceRecord (ResourceRecord, emptyRR + , show_qualifier, show_mechanism_type + , mechanism_types, qualifier_types, modifier_types) +import App.ResourceRecord (Mechanism(..), Modifier(..), Qualifier(..)) as RR import App.DisplayErrors (error_to_paragraph) @@ -87,9 +89,9 @@ data Field | Field_Weight String | Field_Port String | Field_SPF_v String - | Field_SPF_mechanisms (Array Mechanism) - | Field_SPF_modifiers (Array Modifier) - | Field_SPF_q Qualifier + | Field_SPF_mechanisms (Array RR.Mechanism) + | Field_SPF_modifiers (Array RR.Modifier) + | Field_SPF_q RR.Qualifier -- | Steps to create a new RR: -- | 1. `CreateNewRRModal AcceptedRRTypes`: create a modal with default values based on selected accepted type. @@ -143,6 +145,11 @@ data Action -- | Ask `dnsmanagerd` for the generated zone file. | AskZoneFile + | SPF_Select_Mechanism_q Int + | SPF_Select_Mechanism_t Int + | SPF_Select_Modifier Int + | SPF_Select_Qualifier Int + data RRModal = NoModal | NewRRModal AcceptedRRTypes @@ -186,6 +193,10 @@ type State = -- Unique RR form. , _currentRR :: ResourceRecord , _currentRR_errors :: Array Validation.Error + , _current_selected_mechanism_q :: String + , _current_selected_mechanism_t :: String + , _current_selected_modifier :: String + , _current_selected_qualifier :: String , _zonefile :: Maybe String } @@ -228,6 +239,11 @@ initialState domain = -- List of errors within the form in new RR modal. , _currentRR_errors: [] , _zonefile: Nothing + + , _current_selected_mechanism_q: "pass" + , _current_selected_mechanism_t: "a" + , _current_selected_modifier: "redirect" + , _current_selected_qualifier: "none" } type SortableRecord l = Record (rrtype :: String, rrid :: Int | l) @@ -376,9 +392,22 @@ render state , 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.hr , maybe (Bulma.p "no mechanism") display_mechanisms state._currentRR.mechanisms - , Bulma.p "TODO: modifiers" - , Bulma.p "TODO: qualifier" + , Bulma.box + [ Bulma.h3 "New mechanism" + , Bulma.selection SPF_Select_Mechanism_q qualifier_types state._current_selected_mechanism_q + , Bulma.selection SPF_Select_Mechanism_t mechanism_types state._current_selected_mechanism_t + ] + , Bulma.hr + , Bulma.box + [ Bulma.h3 "New modifier" + , Bulma.selection SPF_Select_Modifier modifier_types state._current_selected_modifier + ] + , Bulma.box + [ Bulma.h3 "Default behavior" + , Bulma.selection SPF_Select_Qualifier qualifier_types state._current_selected_qualifier + ] ] should_be_disabled = (if true then (HP.enabled true) else (HP.disabled true)) @@ -514,6 +543,18 @@ handleAction = case _ of $ DNSManager.MkAskGeneratedZoneFile { domain: state._domain } H.raise $ MessageToSend message + SPF_Select_Mechanism_q v -> do + H.modify_ _ { _current_selected_mechanism_q = maybe "pass" id $ qualifier_types A.!! v } + + SPF_Select_Mechanism_t v -> do + H.modify_ _ { _current_selected_mechanism_t = maybe "a" id $ mechanism_types A.!! v } + + SPF_Select_Modifier v -> do + H.modify_ _ { _current_selected_modifier = maybe "redirect" id $ modifier_types A.!! v } + + SPF_Select_Qualifier v -> do + H.modify_ _ { _current_selected_qualifier = maybe "none" id $ qualifier_types A.!! v } + handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a) handleQuery = case _ of @@ -719,12 +760,12 @@ render_resources records , HH.td_ [ Bulma.btn_delete (DeleteRRModal rr.rrid) ] ] -display_mechanisms :: forall w. Array Mechanism -> HH.HTML w Action +display_mechanisms :: forall w. Array RR.Mechanism -> HH.HTML w Action display_mechanisms ms = Bulma.box_ C.has_background_warning_light [ Bulma.table [] [ Bulma.mechanism_table_header, HH.tbody_ $ map render_mechanism_row ms] ] where - render_mechanism_row :: Mechanism -> HH.HTML w Action + render_mechanism_row :: RR.Mechanism -> HH.HTML w Action render_mechanism_row m = HH.tr_ [ Bulma.txt_name $ maybe "" show_qualifier m.q , HH.td_ [ Bulma.p $ show_mechanism_type m.t ] diff --git a/src/Bulma.purs b/src/Bulma.purs index 9f137e6..22325d0 100644 --- a/src/Bulma.purs +++ b/src/Bulma.purs @@ -447,3 +447,11 @@ modal title body foot = , modal_card [modal_header title, modal_body body] , modal_foot foot ] + +-- selection: create a "select" input. +-- Get the changes with "onSelectedIndexChange" which provides an index. +selection :: forall w i. (Int -> i) -> Array String -> String -> HH.HTML w i +selection action values selected = HH.div [HP.classes $ C.select <> C.is_normal] + [ HH.select [ HE.onSelectedIndexChange action ] + $ map (\n -> HH.option [HP.value n, HP.selected (n == selected)] [HH.text n]) values + ]