WIP: SPF interface. Different types were implemented (Mechanism, Modifier, Qualifier).

dev
Philippe Pittoli 2024-02-29 19:19:49 +01:00
parent 4a8451a388
commit 8f75a4e88b
3 changed files with 86 additions and 18 deletions

View File

@ -1,6 +1,6 @@
module App.ResourceRecord where module App.ResourceRecord where
import Prelude ((<>)) import Prelude ((<>), map)
import Data.Maybe (Maybe(..), maybe) import Data.Maybe (Maybe(..), maybe)
@ -91,12 +91,13 @@ codecMechanism = CA.object "Mechanism"
, v: CA.string , 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 :: Mechanism -> String
show_mechanism m = maybe "" show_qualifier m.q <> show_mechanism_type m.t <> "=" <> m.v 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`. -- | Codec for just encoding a single value of type `MechanismType`.
codecMechanismType :: CA.JsonCodec MechanismType codecMechanismType :: CA.JsonCodec MechanismType
codecMechanismType = codecMechanismType =
@ -123,13 +124,29 @@ show_mechanism_type = case _ of
EXISTS -> "exists" EXISTS -> "exists"
INCLUDE -> "include" INCLUDE -> "include"
type Modifier data ModifierType = EXP | REDIRECT
= { t :: Int -- Type of modifier (0 = EXP, 1 = REDIRECT) modifier_types :: Array String
, v :: String -- Value (domain). 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 :: 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 :: ResourceRecord
emptyRR emptyRR
@ -165,6 +182,8 @@ emptyRR
} }
data Qualifier = Pass | None | SoftFail | HardFail 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`. -- | Codec for just encoding a single value of type `Qualifier`.
codecQualifier :: CA.JsonCodec Qualifier codecQualifier :: CA.JsonCodec Qualifier

View File

@ -39,8 +39,10 @@ import Bulma as Bulma
import CSSClasses as C import CSSClasses as C
import App.AcceptedRRTypes (AcceptedRRTypes(..)) import App.AcceptedRRTypes (AcceptedRRTypes(..))
import App.ResourceRecord (ResourceRecord, emptyRR, Mechanism, Modifier, Qualifier import App.ResourceRecord (ResourceRecord, emptyRR
, show_qualifier, show_mechanism_type) , 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) import App.DisplayErrors (error_to_paragraph)
@ -87,9 +89,9 @@ data Field
| Field_Weight String | Field_Weight String
| Field_Port String | Field_Port String
| Field_SPF_v String | Field_SPF_v String
| Field_SPF_mechanisms (Array Mechanism) | Field_SPF_mechanisms (Array RR.Mechanism)
| Field_SPF_modifiers (Array Modifier) | Field_SPF_modifiers (Array RR.Modifier)
| Field_SPF_q Qualifier | Field_SPF_q RR.Qualifier
-- | Steps to create a new RR: -- | Steps to create a new RR:
-- | 1. `CreateNewRRModal AcceptedRRTypes`: create a modal with default values based on selected accepted type. -- | 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. -- | Ask `dnsmanagerd` for the generated zone file.
| AskZoneFile | AskZoneFile
| SPF_Select_Mechanism_q Int
| SPF_Select_Mechanism_t Int
| SPF_Select_Modifier Int
| SPF_Select_Qualifier Int
data RRModal data RRModal
= NoModal = NoModal
| NewRRModal AcceptedRRTypes | NewRRModal AcceptedRRTypes
@ -186,6 +193,10 @@ type State =
-- Unique RR form. -- Unique RR form.
, _currentRR :: ResourceRecord , _currentRR :: ResourceRecord
, _currentRR_errors :: Array Validation.Error , _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 , _zonefile :: Maybe String
} }
@ -228,6 +239,11 @@ initialState domain =
-- List of errors within the form in new RR modal. -- List of errors within the form in new RR modal.
, _currentRR_errors: [] , _currentRR_errors: []
, _zonefile: Nothing , _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) type SortableRecord l = Record (rrtype :: String, rrid :: Int | l)
@ -376,9 +392,22 @@ render state
, case state._currentRR.v of , case state._currentRR.v of
Nothing -> Bulma.p "default value for the version (spf1)" 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 , maybe (Bulma.p "no mechanism") display_mechanisms state._currentRR.mechanisms
, Bulma.p "TODO: modifiers" , Bulma.box
, Bulma.p "TODO: qualifier" [ 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)) 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 } $ DNSManager.MkAskGeneratedZoneFile { domain: state._domain }
H.raise $ MessageToSend message 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 :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
handleQuery = case _ of handleQuery = case _ of
@ -719,12 +760,12 @@ render_resources records
, HH.td_ [ Bulma.btn_delete (DeleteRRModal rr.rrid) ] , 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 = display_mechanisms ms =
Bulma.box_ C.has_background_warning_light Bulma.box_ C.has_background_warning_light
[ Bulma.table [] [ Bulma.mechanism_table_header, HH.tbody_ $ map render_mechanism_row ms] ] [ Bulma.table [] [ Bulma.mechanism_table_header, HH.tbody_ $ map render_mechanism_row ms] ]
where where
render_mechanism_row :: Mechanism -> HH.HTML w Action render_mechanism_row :: RR.Mechanism -> HH.HTML w Action
render_mechanism_row m = HH.tr_ render_mechanism_row m = HH.tr_
[ Bulma.txt_name $ maybe "" show_qualifier m.q [ Bulma.txt_name $ maybe "" show_qualifier m.q
, HH.td_ [ Bulma.p $ show_mechanism_type m.t ] , HH.td_ [ Bulma.p $ show_mechanism_type m.t ]

View File

@ -447,3 +447,11 @@ modal title body foot =
, modal_card [modal_header title, modal_body body] , modal_card [modal_header title, modal_body body]
, modal_foot foot , 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
]