Display mechanisms.

dev
Philippe Pittoli 2024-02-29 17:03:37 +01:00
parent 73fcdd0b7c
commit 4a8451a388
3 changed files with 69 additions and 18 deletions

View File

@ -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"

View File

@ -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" ]

View File

@ -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" ]