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