From 917ac0b5ffc5372dd778de844b1136a428f26e5e Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Wed, 13 Mar 2024 04:03:27 +0100 Subject: [PATCH] handle tokens --- makefile | 4 ++ src/App/Messages/DNSManagerDaemon.purs | 9 ++++ src/App/ResourceRecord.purs | 6 +++ src/App/Validation/DNS.purs | 6 ++- src/App/ZoneInterface.purs | 61 +++++++++++++++----------- src/Bulma.purs | 13 +++--- 6 files changed, 67 insertions(+), 32 deletions(-) diff --git a/makefile b/makefile index 555fda2..d05d8fd 100644 --- a/makefile +++ b/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/ diff --git a/src/App/Messages/DNSManagerDaemon.purs b/src/App/Messages/DNSManagerDaemon.purs index d710988..1d6545f 100644 --- a/src/App/Messages/DNSManagerDaemon.purs +++ b/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 diff --git a/src/App/ResourceRecord.purs b/src/App/ResourceRecord.purs index b79fb84..d537545 100644 --- a/src/App/ResourceRecord.purs +++ b/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 diff --git a/src/App/Validation/DNS.purs b/src/App/Validation/DNS.purs index c1585d8..e3e0cfd 100644 --- a/src/App/Validation/DNS.purs +++ b/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 diff --git a/src/App/ZoneInterface.purs b/src/App/ZoneInterface.purs index 9b8e2d2..ac1396c 100644 --- a/src/App/ZoneInterface.purs +++ b/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 - NewRRModal _ -> Bulma.btn_add (ValidateRR x) - UpdateRRModal -> Bulma.btn_save ValidateLocal - _ -> Bulma.p "state.rr_modal should either be NewRRModal or UpdateRRModal." - ] + newtokenbtn = Bulma.btn "🏁​ Ask for a token!" (NewToken state._currentRR.rrid) + foot_content x = + case state.rr_modal of + 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) ] - , if rr.readonly - then HH.td_ [ Bulma.btn_readonly ] - else HH.td_ [ Bulma.btn_delete (DeleteRRModal rr.rrid) ] + else HH.td_ [ Bulma.btn_modify (CreateUpdateRRModal rr.rrid), 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) ] - , if rr.readonly - then HH.td_ [ Bulma.btn_readonly ] - else HH.td_ [ Bulma.btn_delete (DeleteRRModal rr.rrid) ] + else HH.td_ [ Bulma.btn_modify (CreateUpdateRRModal rr.rrid), 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) ] - , if rr.readonly - then HH.td_ [ Bulma.btn_readonly ] - else HH.td_ [ Bulma.btn_delete (DeleteRRModal rr.rrid) ] + else HH.td_ [ Bulma.btn_modify (CreateUpdateRRModal rr.rrid), 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) ] - , if rr.readonly - then HH.td_ [ Bulma.btn_readonly ] - else HH.td_ [ Bulma.btn_delete (DeleteRRModal rr.rrid) ] + else HH.td_ [ Bulma.btn_modify (CreateUpdateRRModal rr.rrid), 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) ] - , HH.td_ [ Bulma.btn_delete (DeleteRRModal rr.rrid) ] + else [ HH.td_ [ Bulma.btn_modify (CreateUpdateRRModal rr.rrid), Bulma.btn_delete (DeleteRRModal rr.rrid) ] + , HH.td_ [ Bulma.p $ fromMaybe "" rr.token ] ] fancy_qualifier_display :: RR.Qualifier -> String diff --git a/src/Bulma.purs b/src/Bulma.purs index 16cce0a..5452ff1 100644 --- a/src/Bulma.purs +++ b/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