karchnu
/
halogen-websocket-ipc-playzone
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

handle tokens

dev
Philippe Pittoli 2024-03-13 04:03:27 +01:00
parent 2086cb1d9b
commit 917ac0b5ff
6 changed files with 67 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
makefile
View File

@ -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/

9
src/App/Messages/DNSManagerDaemon.purs
View File

@ -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

6
src/App/ResourceRecord.purs
View File

@ -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

6
src/App/Validation/DNS.purs
View File

@ -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

61
src/App/ZoneInterface.purs
View File

@ -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

13
src/Bulma.purs
View File

@ -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