Display mechanisms.

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"

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

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