karchnu/halogen-websocket-ipc-playzone
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

SPF: interface ± done. Works as expected. Next step: validations.

Browse Source
This commit is contained in:
Philippe Pittoli 2024-03-01 18:30:45 +01:00
parent 7593702398
commit c35544f55e
3 changed files with 87 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
src/App/ResourceRecord.purs
View File

@ -96,6 +96,20 @@ 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 =
@ -155,14 +169,13 @@ show_modifier_type = case _ of
-- | 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
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
@ -202,6 +215,8 @@ emptyRR
}
data Qualifier = Pass | None | SoftFail | HardFail
all_qualifiers :: Array Qualifier
all_qualifiers = [Pass, None, SoftFail, HardFail]
qualifier_types :: Array String
qualifier_types = ["pass", "none", "soft_fail", "hard_fail"]

67
src/App/ZoneInterface.purs
View File

@ -41,7 +41,10 @@ import CSSClasses as C
import App.AcceptedRRTypes (AcceptedRRTypes(..))
import App.ResourceRecord (ResourceRecord, emptyRR
, show_qualifier, show_qualifier_char, show_mechanism_type, show_mechanism, to_mechanism
, show_qualifier, show_qualifier_char
, show_mechanism_type, show_mechanism, to_mechanism
, show_modifier_type, show_modifier, to_modifier
, all_qualifiers
, mechanism_types, qualifier_types, modifier_types)
import App.ResourceRecord (Mechanism, Modifier, Qualifier) as RR
@ -149,12 +152,15 @@ data Action
| SPF_Mechanism_q Int
| SPF_Mechanism_t Int
| SPF_Mechanism_v String
| SPF_Modifier Int
| SPF_Modifier_t Int
| SPF_Modifier_v String
| SPF_Qualifier Int
| SPF_remove_mechanism Int
| SPF_remove_modifier Int
| SPF_Mechanism_Add
| SPF_Modifier_Add
data RRModal
= NoModal
@ -202,8 +208,8 @@ type State =
, spf_mechanism_q :: String
, spf_mechanism_t :: String
, spf_mechanism_v :: String
, spf_modifier :: String
, spf_qualifier :: String
, spf_modifier_t :: String
, spf_modifier_v :: String
, _zonefile :: Maybe String
}
@ -250,8 +256,8 @@ initialState domain =
, spf_mechanism_q: "pass"
, spf_mechanism_t: "a"
, spf_mechanism_v: ""
, spf_modifier: "redirect"
, spf_qualifier: "none"
, spf_modifier_t: "redirect"
, spf_modifier_v: ""
}
type SortableRecord l = Record (rrtype :: String, rrid :: Int | l)
@ -409,16 +415,25 @@ render state
, Bulma.btn "Add" SPF_Mechanism_Add
]
, Bulma.hr
, maybe (Bulma.p "no modifier") display_modifiers state._currentRR.modifiers
, Bulma.box
[ Bulma.h3 "New modifier"
, Bulma.selection SPF_Modifier modifier_types state.spf_modifier
, Bulma.selection SPF_Modifier_t modifier_types state.spf_modifier_t
, Bulma.box_input "valueNewModifierSPF" "Value" ""
SPF_Modifier_v
state.spf_modifier_v
should_be_disabled
, Bulma.btn "Add" SPF_Modifier_Add
]
, Bulma.hr
, Bulma.box
[ Bulma.h3 "Default behavior"
, Bulma.selection SPF_Qualifier qualifier_types state.spf_qualifier
, Bulma.selection SPF_Qualifier qualifier_types (maybe default_qualifier_str show_qualifier state._currentRR.q)
]
]
default_qualifier_str = "none" :: String
display_domain_side = (if state._currentRR.name == (state._domain <> ".") then "" else "." <> state._domain)
should_be_disabled = (if true then (HP.enabled true) else (HP.disabled true))
foot_content x = [ case state.rr_modal of
@ -562,14 +577,21 @@ 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_Modifier_t v -> H.modify_ _ { spf_modifier_t = maybe "redirect" id $ modifier_types A.!! v }
SPF_Modifier_v v -> H.modify_ _ { spf_modifier_v = v }
SPF_Qualifier v -> H.modify_ _ { _currentRR { q = all_qualifiers A.!! v } }
SPF_remove_mechanism i ->
H.modify_ \s -> s { _currentRR { mechanisms = case s._currentRR.mechanisms of
Just ms -> Just (remove_id i $ attach_id 0 ms)
Nothing -> Nothing
}
}
SPF_remove_modifier i ->
H.modify_ \s -> s { _currentRR { modifiers = case s._currentRR.modifiers of
Just ms -> Just (remove_id i $ attach_id 0 ms)
Nothing -> Nothing
}
}
SPF_Mechanism_Add -> do
state <- H.get
@ -582,6 +604,17 @@ handleAction = case _ of
[] -> Nothing
v -> Just v
H.modify_ _ { _currentRR { mechanisms = new_value }}
SPF_Modifier_Add -> do
state <- H.get
let m = state._currentRR.modifiers
m_t = state.spf_modifier_t
m_v = state.spf_modifier_v
new_list_of_modifiers = maybe [] id m <> maybe [] (\x -> [x]) (to_modifier m_t m_v)
new_value = case new_list_of_modifiers of
[] -> Nothing
v -> Just v
H.modify_ _ { _currentRR { modifiers = new_value }}
where
-- In case the `name` part of the resource record is empty replace it with the domain name.
replace_name domain rr = case rr.name of
@ -760,7 +793,7 @@ render_resources records
, HH.td_ [ Bulma.p rr.target ]
, HH.td_ [ Bulma.p $ maybe "spf1 (default)" id rr.v ]
, 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 "" (A.fold <<< A.intersperse " " <<< map show_modifier) rr.modifiers ]
, HH.td_ [ Bulma.p $ maybe "" show_qualifier_char rr.q ]
, if rr.readonly
then HH.td_ [ Bulma.btn_readonly ]
@ -806,6 +839,18 @@ display_mechanisms ms =
, HH.td_ [ Bulma.alert_btn "x" (SPF_remove_mechanism i) ]
]
display_modifiers :: forall w. Array RR.Modifier -> HH.HTML w Action
display_modifiers ms =
Bulma.box_ C.has_background_warning_light
[ Bulma.table [] [ Bulma.modifier_table_header, HH.tbody_ $ map render_modifier_row $ attach_id 0 ms] ]
where
render_modifier_row :: (Tuple Int RR.Modifier) -> HH.HTML w Action
render_modifier_row (Tuple i m) = HH.tr_
[ HH.td_ [ Bulma.p $ show_modifier_type m.t ]
, HH.td_ [ Bulma.p m.v ]
, HH.td_ [ Bulma.alert_btn "x" (SPF_remove_modifier i) ]
]
baseRecords :: Array String
baseRecords = [ "A", "AAAA", "CNAME", "TXT", "NS" ]

8
src/Bulma.purs
View File

@ -66,6 +66,14 @@ mechanism_table_header
]
]
modifier_table_header :: forall w i. HH.HTML w i
modifier_table_header
= HH.thead_ [ HH.tr_ [ HH.th [ HP.style "width: 50px;" ] [ HH.text "Type" ]
, HH.th_ [ HH.text "Value" ]
, HH.th_ [ HH.text "" ]
]
]
simple_table_header :: forall w i. HH.HTML w i
simple_table_header
= HH.thead_ [ HH.tr_ [ HH.th [ HP.style "width: 50px;" ] [ HH.text "Type" ]