handle tokens

makefile

@@ -6,6 +6,10 @@ clone-generic-parser:
 build: clone-generic-parser
 	spago build
 
+bundle-mini:
+	PATH=$$PATH:node_modules/.bin spago bundle-app -y
+	mv index.js app/
+
 bundle: install-esbuild
 	PATH=$$PATH:node_modules/.bin spago bundle-app
 	mv index.js app/

src/App/Messages/DNSManagerDaemon.purs

@@ -90,6 +90,11 @@ type AskGeneratedZoneFile = { domain :: String }
 codecAskGeneratedZoneFile ∷ CA.JsonCodec AskGeneratedZoneFile
 codecAskGeneratedZoneFile = CA.object "AskGeneratedZoneFile" (CAR.record { domain: CA.string })
 
+{- 18  -}
+type NewToken = { domain :: String, rrid :: Int }
+codecNewToken ∷ CA.JsonCodec NewToken
+codecNewToken = CA.object "NewToken" (CAR.record { domain: CA.string, rrid: CA.int })
+
 {- 100 -}
 type GenerateAllZoneFiles = {}
 codecGenerateAllZoneFiles ∷ CA.JsonCodec GenerateAllZoneFiles
@@ -269,6 +274,8 @@ data RequestMessage
   | MkUpdateRR             UpdateRR             -- 15
   | MkDeleteRR             DeleteRR             -- 16
   | MkAskGeneratedZoneFile AskGeneratedZoneFile -- 17
+  | MkNewToken             NewToken             -- 18
+  --| MkUseToken           UseToken             -- 19
   | MkGenerateAllZoneFiles GenerateAllZoneFiles -- 100
   | MkGenerateZoneFile     GenerateZoneFile     -- 101
   | MkKeepAlive            KeepAlive            -- 250
@@ -317,6 +324,8 @@ encode m = case m of
     (MkUpdateRR             request) -> get_tuple 15  codecUpdateRR             request
     (MkDeleteRR             request) -> get_tuple 16  codecDeleteRR             request
     (MkAskGeneratedZoneFile request) -> get_tuple 17  codecAskGeneratedZoneFile request
+    (MkNewToken             request) -> get_tuple 18  codecNewToken             request
+    --(MkUseToken           request) -> get_tuple 19  codecUseToken             request
     (MkGenerateAllZoneFiles request) -> get_tuple 100 codecGenerateAllZoneFiles request
     (MkGenerateZoneFile     request) -> get_tuple 101 codecGenerateZoneFile     request
     (MkKeepAlive            request) -> get_tuple 250 codecKeepAlive            request

src/App/ResourceRecord.purs

@@ -35,6 +35,8 @@ type ResourceRecord
     , expire  :: Maybe Int
     , minttl  :: Maybe Int
 
+    , token   :: Maybe String
+
     -- SPF specific entries.
     , v :: Maybe String -- Default: spf1
     , mechanisms :: Maybe (Array Mechanism)
@@ -73,6 +75,8 @@ codec = CA.object "ResourceRecord"
     , expire:  CAR.optional CA.int
     , minttl:  CAR.optional CA.int
 
+    , token:   CAR.optional CA.string
+
     -- SPF specific entries.
     , v:          CAR.optional CA.string
     , mechanisms: CAR.optional (CA.array codecMechanism)
@@ -212,6 +216,8 @@ emptyRR
     , expire:       Nothing
     , minttl:       Nothing
 
+    , token:        Nothing
+
     -- SPF specific entries.
     , v:            Nothing
     , mechanisms:   Nothing

src/App/Validation/DNS.purs

@@ -117,7 +117,8 @@ validationA form = ado
   name   <- parse DomainParser.sub_eof form.name   VEName
   ttl    <- is_between min_ttl max_ttl form.ttl    VETTL
   target <- parse IPAddress.ipv4       form.target VEIPv4
-  in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "A", name = name, ttl = ttl, target = target }
+  in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "A", name = name, ttl = ttl, target = target
+             , token = form.token }
 
 validationAAAA :: ResourceRecord -> V (Array Error) ResourceRecord
 validationAAAA form = ado
@@ -125,7 +126,8 @@ validationAAAA form = ado
   ttl    <- is_between min_ttl max_ttl form.ttl  VETTL
   -- use read_input to get unaltered input (the IPv6 parser expands the input)
   target <- parse (G.read_input IPAddress.ipv6) form.target VEIPv6
-  in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "AAAA", name = name, ttl = ttl, target = target }
+  in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "AAAA", name = name, ttl = ttl, target = target
+             , token = form.token }
 
 validationTXT :: ResourceRecord -> V (Array Error) ResourceRecord
 validationTXT form = ado

src/App/ZoneInterface.purs

@@ -151,6 +151,9 @@ data Action
   -- | Automatically closes the modal.
   | RemoveRR RRId
 
+  -- | Ask a (new) token for a RR.
+  | NewToken RRId
+
   -- | Ask `dnsmanagerd` for the generated zone file.
   | AskZoneFile
 
@@ -355,7 +358,14 @@ render state
               (updateForm Field_Target)
               state._currentRR.target
               should_be_disabled
+          ] <> case state.rr_modal of
+                 UpdateRRModal ->
+                   if A.elem state._currentRR.rrtype ["A", "AAAA"]
+                   then [ Bulma.labeled_field ("token" <> state._currentRR.rrtype) "Token"
+                            (Bulma.p $ fromMaybe "❌​" state._currentRR.token)
                         ]
+                   else []
+                 _             -> []
         modal_content_mx :: Array (HH.HTML w Action)
         modal_content_mx =
           [ render_errors
@@ -485,17 +495,21 @@ render state
 
         display_domain_side = (if state._currentRR.name == (state._domain <> ".") then "" else "." <> state._domain)
         should_be_disabled = (if true then (HP.enabled true) else (HP.disabled true))
-        foot_content x = [ case state.rr_modal of
+        newtokenbtn = Bulma.btn "🏁​ Ask for a token!" (NewToken state._currentRR.rrid)
-                             NewRRModal _ -> Bulma.btn_add (ValidateRR x)
+        foot_content x =
-                             UpdateRRModal -> Bulma.btn_save ValidateLocal
+          case state.rr_modal of
-                             _ -> Bulma.p "state.rr_modal should either be NewRRModal or UpdateRRModal."
+            NewRRModal _  -> [Bulma.btn_add (ValidateRR x)]
-                         ]
+            UpdateRRModal -> [Bulma.btn_save ValidateLocal] <> case x of
+              A    -> [newtokenbtn]
+              AAAA -> [newtokenbtn]
+              _    -> []
+            _ -> [Bulma.p "state.rr_modal should either be NewRRModal or UpdateRRModal."]
         template content foot_ = Bulma.modal title content foot
           where
           title = case state.rr_modal of
             NoModal             -> "Error: no modal should be displayed"
             NewRRModal t_       -> "New " <> show_accepted_type t_ <> " resource record"
-            UpdateRRModal       -> "Update RR " <> show state._currentRR.rrid <> " resource record"
+            UpdateRRModal       -> "Update RR " <> show state._currentRR.rrid
             RemoveRRModal rr_id -> "Error: should display removal modal instead (for RR " <> show rr_id <> ")"
           foot = foot_ <> [Bulma.cancel_button CancelModal]
 
@@ -636,6 +650,15 @@ handleAction = case _ of
     -- Modal doesn't need to be active anymore.
     handleAction CancelModal
 
+  NewToken rr_id -> do
+    { _domain } <- H.get
+    H.raise $ Log $ SystemLog $ "Ask a token for rrid " <> show rr_id
+    -- Send a NewToken message.
+    message <- H.liftEffect
+      $ DNSManager.serialize
+      $ DNSManager.MkNewToken { domain: _domain, rrid: rr_id }
+    H.raise $ MessageToSend message
+
   AskZoneFile -> do
     state <- H.get
     H.raise $ Log $ SystemLog $ "Asking for the '" <> state._domain <> "' zonefile"
@@ -845,10 +868,7 @@ render_resources records
         , HH.td_ [ Bulma.p rr.target ]
         , if rr.readonly
           then HH.td_ [ Bulma.btn_readonly ]
-          else HH.td_ [ Bulma.btn_modify (CreateUpdateRRModal rr.rrid) ]
+          else HH.td_ [ Bulma.btn_modify (CreateUpdateRRModal rr.rrid), Bulma.btn_delete (DeleteRRModal rr.rrid) ]
-        , if rr.readonly
-          then HH.td_ [ Bulma.btn_readonly ]
-          else HH.td_ [ Bulma.btn_delete (DeleteRRModal rr.rrid) ]
         ]
       "SPF"  ->
         [ HH.td_ [ Bulma.p rr.name ]
@@ -859,10 +879,7 @@ render_resources records
         , HH.td_ [ Bulma.p $ maybe "" fancy_qualifier_display rr.q ]
         , if rr.readonly
           then HH.td_ [ Bulma.btn_readonly ]
-          else HH.td_ [ Bulma.btn_modify (CreateUpdateRRModal rr.rrid) ]
+          else HH.td_ [ Bulma.btn_modify (CreateUpdateRRModal rr.rrid), Bulma.btn_delete (DeleteRRModal rr.rrid) ]
-        , if rr.readonly
-          then HH.td_ [ Bulma.btn_readonly ]
-          else HH.td_ [ Bulma.btn_delete (DeleteRRModal rr.rrid) ]
         ]
       "DKIM"  ->
         [ HH.td_ [ Bulma.p rr.name ]
@@ -877,10 +894,7 @@ render_resources records
             , HH.td_ [ Bulma.p $ fromMaybe ""                            dkim.n ]
             , if rr.readonly
               then HH.td_ [ Bulma.btn_readonly ]
-              else HH.td_ [ Bulma.btn_modify (CreateUpdateRRModal rr.rrid) ]
+              else HH.td_ [ Bulma.btn_modify (CreateUpdateRRModal rr.rrid), Bulma.btn_delete (DeleteRRModal rr.rrid) ]
-            , if rr.readonly
-              then HH.td_ [ Bulma.btn_readonly ]
-              else HH.td_ [ Bulma.btn_delete (DeleteRRModal rr.rrid) ]
             ]
           Nothing -> [Bulma.p "Problem: there is no DKIM data." ]
       "MX"  ->
@@ -890,10 +904,7 @@ render_resources records
         , HH.td_ [ Bulma.p rr.target ]
         , if rr.readonly
           then HH.td_ [ Bulma.btn_readonly ]
-          else HH.td_ [ Bulma.btn_modify (CreateUpdateRRModal rr.rrid) ]
+          else HH.td_ [ Bulma.btn_modify (CreateUpdateRRModal rr.rrid), Bulma.btn_delete (DeleteRRModal rr.rrid) ]
-        , if rr.readonly
-          then HH.td_ [ Bulma.btn_readonly ]
-          else HH.td_ [ Bulma.btn_delete (DeleteRRModal rr.rrid) ]
         ]
       _     ->
         [ Bulma.txt_name rr.rrtype
@@ -902,8 +913,8 @@ render_resources records
         , HH.td_ [ Bulma.p rr.target ]
         ] <> if rr.readonly
           then [ HH.td_ [ Bulma.btn_readonly ] ]
-          else [ HH.td_ [ Bulma.btn_modify (CreateUpdateRRModal rr.rrid) ]
+          else [ HH.td_ [ Bulma.btn_modify (CreateUpdateRRModal rr.rrid), Bulma.btn_delete (DeleteRRModal rr.rrid) ]
-               , HH.td_ [ Bulma.btn_delete (DeleteRRModal rr.rrid) ]
+               , HH.td_ [ Bulma.p $ fromMaybe "" rr.token ]
                ]
 
   fancy_qualifier_display :: RR.Qualifier -> String

src/Bulma.purs

@@ -84,7 +84,7 @@ simple_table_header
                        , HH.th_ [ HH.text "TTL" ]
                        , HH.th_ [ HH.text "Target" ]
                        , HH.th_ [ HH.text "" ]
-                       , HH.th_ [ HH.text "" ]
+                       , HH.th_ [ HH.text "Token" ]
                        ]
               ]
 
@@ -106,7 +106,6 @@ mx_table_header
                        , HH.th_ [ HH.text "Priority" ]
                        , HH.th_ [ HH.text "Target" ]
                        , HH.th_ [ HH.text "" ]
-                       , HH.th_ [ HH.text "" ]
                        ]
               ]
 
@@ -120,7 +119,6 @@ srv_table_header
                        , HH.th_ [ HH.text "Port" ]
                        , HH.th_ [ HH.text "Target" ]
                        , HH.th_ [ HH.text "" ]
-                       , HH.th_ [ HH.text "" ]
                        ]
               ]
 
@@ -133,7 +131,6 @@ spf_table_header
                        , HH.th_ [ HH.text "Modifiers" ]
                        , HH.th_ [ HH.text "Default Policy" ]
                        , HH.th_ [ HH.text "" ]
-                       , HH.th_ [ HH.text "" ]
                        ]
               ]
 
@@ -147,7 +144,6 @@ dkim_table_header
                        , HH.th_ [ HH.text "Public Key" ]
                        , HH.th_ [ HH.text "Notes" ]
                        , HH.th_ [ HH.text "" ]
-                       , HH.th_ [ HH.text "" ]
                        ]
               ]
 
@@ -286,6 +282,13 @@ btn_labeled id title button_text action
           ] [ HH.text button_text ]
       ]
 
+labeled_field :: forall w i. String -> String -> HH.HTML w i -> HH.HTML w i
+labeled_field id title content
+  = div_field
+      [ div_field_label id title
+      , div_field_content content
+      ]
+
 box_input :: forall w i.
   String -> String -> String -> (String -> i) -> String -> (HP.IProp DHI.HTMLinput i) -> HH.HTML w i
 box_input = field_inner false