Display mechanisms.
This commit is contained in:
parent
73fcdd0b7c
commit
4a8451a388
@ -1,6 +1,8 @@
|
||||
module App.ResourceRecord where
|
||||
|
||||
import Data.Maybe (Maybe(..))
|
||||
import Prelude ((<>))
|
||||
|
||||
import Data.Maybe (Maybe(..), maybe)
|
||||
|
||||
import Data.Codec.Argonaut (JsonCodec)
|
||||
import Data.Codec.Argonaut as CA
|
||||
@ -77,7 +79,7 @@ codec = CA.object "ResourceRecord"
|
||||
|
||||
type Mechanism
|
||||
= { q :: Maybe Qualifier
|
||||
, t :: Int -- Type of mechanism (0 = A, 1 = IP4, 2 = IP6, 3 = MX, 4 = PTR, 5 = EXISTS, 6 = INCLUDE)
|
||||
, t :: MechanismType
|
||||
, v :: String -- Value (IP addresses or ranges, or domains).
|
||||
}
|
||||
|
||||
@ -85,10 +87,42 @@ codecMechanism :: JsonCodec Mechanism
|
||||
codecMechanism = CA.object "Mechanism"
|
||||
(CAR.record
|
||||
{ q: CAR.optional codecQualifier
|
||||
, t: CA.int
|
||||
, t: codecMechanismType
|
||||
, v: CA.string
|
||||
})
|
||||
|
||||
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 =
|
||||
CA.prismaticCodec "MechanismType" from show_mechanism_type CA.string
|
||||
where
|
||||
from :: String -> Maybe MechanismType
|
||||
from = case _ of
|
||||
"a" -> Just A
|
||||
"ip4" -> Just IP4
|
||||
"ip6" -> Just IP6
|
||||
"mx" -> Just MX
|
||||
"ptr" -> Just PTR
|
||||
"exists" -> Just EXISTS
|
||||
"include" -> Just INCLUDE
|
||||
_ -> Nothing
|
||||
|
||||
show_mechanism_type :: MechanismType -> String
|
||||
show_mechanism_type = case _ of
|
||||
A -> "a"
|
||||
IP4 -> "ip4"
|
||||
IP6 -> "ip6"
|
||||
MX -> "mx"
|
||||
PTR -> "ptr"
|
||||
EXISTS -> "exists"
|
||||
INCLUDE -> "include"
|
||||
|
||||
type Modifier
|
||||
= { t :: Int -- Type of modifier (0 = EXP, 1 = REDIRECT)
|
||||
, v :: String -- Value (domain).
|
||||
@ -135,7 +169,7 @@ data Qualifier = Pass | None | SoftFail | HardFail
|
||||
-- | Codec for just encoding a single value of type `Qualifier`.
|
||||
codecQualifier :: CA.JsonCodec Qualifier
|
||||
codecQualifier =
|
||||
CA.prismaticCodec "Qualifier" from to CA.string
|
||||
CA.prismaticCodec "Qualifier" from show_qualifier CA.string
|
||||
where
|
||||
from :: String -> Maybe Qualifier
|
||||
from = case _ of
|
||||
@ -145,8 +179,8 @@ codecQualifier =
|
||||
"hard_fail" -> Just HardFail -- -
|
||||
_ -> Nothing
|
||||
|
||||
to :: Qualifier -> String
|
||||
to = case _ of
|
||||
show_qualifier :: Qualifier -> String
|
||||
show_qualifier = case _ of
|
||||
Pass -> "pass"
|
||||
None -> "none"
|
||||
SoftFail -> "soft_fail"
|
||||
|
@ -39,7 +39,8 @@ import Bulma as Bulma
|
||||
import CSSClasses as C
|
||||
|
||||
import App.AcceptedRRTypes (AcceptedRRTypes(..))
|
||||
import App.ResourceRecord (ResourceRecord, emptyRR, Mechanism, Modifier, Qualifier)
|
||||
import App.ResourceRecord (ResourceRecord, emptyRR, Mechanism, Modifier, Qualifier
|
||||
, show_qualifier, show_mechanism_type)
|
||||
|
||||
import App.DisplayErrors (error_to_paragraph)
|
||||
|
||||
@ -375,15 +376,9 @@ 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.p "TODO: mechanisms"
|
||||
, maybe (Bulma.p "no mechanism") display_mechanisms state._currentRR.mechanisms
|
||||
, Bulma.p "TODO: modifiers"
|
||||
, Bulma.p "TODO: qualifier"
|
||||
--case state._currentRR.mechanisms of
|
||||
-- Nothing -> Bulma.p "no mechanisms"
|
||||
-- Just ms -> Bulma.box_input ("mechanismsSPF") "Mechanisms" ""
|
||||
-- (updateForm Field_SPF_mechanisms)
|
||||
-- (maybe "" show state._currentRR.v)
|
||||
-- should_be_disabled
|
||||
]
|
||||
|
||||
should_be_disabled = (if true then (HP.enabled true) else (HP.disabled true))
|
||||
@ -724,6 +719,19 @@ render_resources records
|
||||
, HH.td_ [ Bulma.btn_delete (DeleteRRModal rr.rrid) ]
|
||||
]
|
||||
|
||||
display_mechanisms :: forall w. Array 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 m = HH.tr_
|
||||
[ Bulma.txt_name $ maybe "" show_qualifier m.q
|
||||
, HH.td_ [ Bulma.p $ show_mechanism_type m.t ]
|
||||
, HH.td_ [ Bulma.p m.v ]
|
||||
, HH.td_ [ Bulma.btn_readonly ]
|
||||
]
|
||||
|
||||
baseRecords :: Array String
|
||||
baseRecords = [ "A", "AAAA", "CNAME", "TXT", "NS" ]
|
||||
|
||||
|
@ -57,6 +57,15 @@ input_classes = C.input <> C.is_small <> C.is_info
|
||||
table :: forall w i. HH.Node DHI.HTMLtable w i
|
||||
table prop xs = HH.table ([ HP.classes $ C.table ] <> prop) xs
|
||||
|
||||
mechanism_table_header :: forall w i. HH.HTML w i
|
||||
mechanism_table_header
|
||||
= HH.thead_ [ HH.tr_ [ HH.th [ HP.style "width: 50px;" ] [ HH.text "Qualifier" ]
|
||||
, HH.th_ [ 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" ]
|
||||
|
Loading…
Reference in New Issue
Block a user