From 4a8451a388cc242079fecd01c29449b72fc3fc68 Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Thu, 29 Feb 2024 17:03:37 +0100 Subject: [PATCH] Display mechanisms. --- src/App/ResourceRecord.purs | 54 ++++++++++++++++++++++++++++++------- src/App/ZoneInterface.purs | 24 +++++++++++------ src/Bulma.purs | 9 +++++++ 3 files changed, 69 insertions(+), 18 deletions(-) diff --git a/src/App/ResourceRecord.purs b/src/App/ResourceRecord.purs index bd1f617..533acfb 100644 --- a/src/App/ResourceRecord.purs +++ b/src/App/ResourceRecord.purs @@ -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,9 +179,9 @@ codecQualifier = "hard_fail" -> Just HardFail -- - _ -> Nothing - to :: Qualifier -> String - to = case _ of - Pass -> "pass" - None -> "none" - SoftFail -> "soft_fail" - HardFail -> "hard_fail" +show_qualifier :: Qualifier -> String +show_qualifier = case _ of + Pass -> "pass" + None -> "none" + SoftFail -> "soft_fail" + HardFail -> "hard_fail" diff --git a/src/App/ZoneInterface.purs b/src/App/ZoneInterface.purs index 2f5dcc3..2524f8c 100644 --- a/src/App/ZoneInterface.purs +++ b/src/App/ZoneInterface.purs @@ -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" ] diff --git a/src/Bulma.purs b/src/Bulma.purs index 408b519..9f137e6 100644 --- a/src/Bulma.purs +++ b/src/Bulma.purs @@ -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" ]