WIP: SPF interface. Different types were implemented (Mechanism, Modifier, Qualifier).
parent
4a8451a388
commit
8f75a4e88b
|
@ -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
|
||||
|
|
|
@ -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 ]
|
||||
|
|
|
@ -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
|
||||
]
|
||||
|
|
Loading…
Reference in New Issue