Display mechanisms.
This commit is contained in:
parent
73fcdd0b7c
commit
4a8451a388
@ -1,6 +1,8 @@
|
|||||||
module App.ResourceRecord where
|
module App.ResourceRecord where
|
||||||
|
|
||||||
import Data.Maybe (Maybe(..))
|
import Prelude ((<>))
|
||||||
|
|
||||||
|
import Data.Maybe (Maybe(..), maybe)
|
||||||
|
|
||||||
import Data.Codec.Argonaut (JsonCodec)
|
import Data.Codec.Argonaut (JsonCodec)
|
||||||
import Data.Codec.Argonaut as CA
|
import Data.Codec.Argonaut as CA
|
||||||
@ -77,7 +79,7 @@ codec = CA.object "ResourceRecord"
|
|||||||
|
|
||||||
type Mechanism
|
type Mechanism
|
||||||
= { q :: Maybe Qualifier
|
= { 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).
|
, v :: String -- Value (IP addresses or ranges, or domains).
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -85,10 +87,42 @@ codecMechanism :: JsonCodec Mechanism
|
|||||||
codecMechanism = CA.object "Mechanism"
|
codecMechanism = CA.object "Mechanism"
|
||||||
(CAR.record
|
(CAR.record
|
||||||
{ q: CAR.optional codecQualifier
|
{ q: CAR.optional codecQualifier
|
||||||
, t: CA.int
|
, t: codecMechanismType
|
||||||
, v: CA.string
|
, 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
|
type Modifier
|
||||||
= { t :: Int -- Type of modifier (0 = EXP, 1 = REDIRECT)
|
= { t :: Int -- Type of modifier (0 = EXP, 1 = REDIRECT)
|
||||||
, v :: String -- Value (domain).
|
, v :: String -- Value (domain).
|
||||||
@ -135,7 +169,7 @@ data Qualifier = Pass | None | SoftFail | HardFail
|
|||||||
-- | 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
|
||||||
codecQualifier =
|
codecQualifier =
|
||||||
CA.prismaticCodec "Qualifier" from to CA.string
|
CA.prismaticCodec "Qualifier" from show_qualifier CA.string
|
||||||
where
|
where
|
||||||
from :: String -> Maybe Qualifier
|
from :: String -> Maybe Qualifier
|
||||||
from = case _ of
|
from = case _ of
|
||||||
@ -145,8 +179,8 @@ codecQualifier =
|
|||||||
"hard_fail" -> Just HardFail -- -
|
"hard_fail" -> Just HardFail -- -
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
|
|
||||||
to :: Qualifier -> String
|
show_qualifier :: Qualifier -> String
|
||||||
to = case _ of
|
show_qualifier = case _ of
|
||||||
Pass -> "pass"
|
Pass -> "pass"
|
||||||
None -> "none"
|
None -> "none"
|
||||||
SoftFail -> "soft_fail"
|
SoftFail -> "soft_fail"
|
||||||
|
@ -39,7 +39,8 @@ 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, Mechanism, Modifier, Qualifier
|
||||||
|
, show_qualifier, show_mechanism_type)
|
||||||
|
|
||||||
import App.DisplayErrors (error_to_paragraph)
|
import App.DisplayErrors (error_to_paragraph)
|
||||||
|
|
||||||
@ -375,15 +376,9 @@ 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.p "TODO: mechanisms"
|
, maybe (Bulma.p "no mechanism") display_mechanisms state._currentRR.mechanisms
|
||||||
, Bulma.p "TODO: modifiers"
|
, Bulma.p "TODO: modifiers"
|
||||||
, Bulma.p "TODO: qualifier"
|
, 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))
|
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) ]
|
, 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 :: Array String
|
||||||
baseRecords = [ "A", "AAAA", "CNAME", "TXT", "NS" ]
|
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 :: forall w i. HH.Node DHI.HTMLtable w i
|
||||||
table prop xs = HH.table ([ HP.classes $ C.table ] <> prop) xs
|
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 :: forall w i. HH.HTML w i
|
||||||
simple_table_header
|
simple_table_header
|
||||||
= HH.thead_ [ HH.tr_ [ HH.th [ HP.style "width: 50px;" ] [ HH.text "Type" ]
|
= HH.thead_ [ HH.tr_ [ HH.th [ HP.style "width: 50px;" ] [ HH.text "Type" ]
|
||||||
|
Loading…
Reference in New Issue
Block a user