handle tokens
This commit is contained in:
parent
2086cb1d9b
commit
917ac0b5ff
4
makefile
4
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/
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user