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

New RRUpdated & RRReadOnly return messages.

Browse Source
This commit is contained in:
Philippe Pittoli 2023-07-12 16:08:02 +02:00
parent d23699d85a
commit 297f0312bd
2 changed files with 43 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -194,6 +194,15 @@ type InvalidRR = { errors :: Array String }
codecInvalidRR ∷ CA.JsonCodec InvalidRR
codecInvalidRR = CA.object "InvalidRR" (CAR.record { errors: CA.array CA.string })
{- 21 -}
type RRUpdated = { domain :: String, rr :: ResourceRecord.ResourceRecord }
codecRRUpdated ∷ CA.JsonCodec RRUpdated
codecRRUpdated = CA.object "RRUpdated" (CAR.record { domain: CA.string, rr: ResourceRecord.codec })
{- 21 -}
type RRReadOnly = { domain :: String, rr :: ResourceRecord.ResourceRecord }
codecRRReadOnly ∷ CA.JsonCodec RRReadOnly
codecRRReadOnly = CA.object "RRReadOnly" (CAR.record { domain: CA.string, rr: ResourceRecord.codec })
{- 50 -}
type UnknownUser = { }
@ -242,6 +251,8 @@ data AnswerMessage
| MkRRDeleted RRDeleted -- 18
| MkRRAdded RRAdded -- 19
| MkInvalidRR InvalidRR -- 20
| MkRRUpdated RRUpdated -- 21
| MkRRReadOnly RRReadOnly -- 22
| MkUnknownUser UnknownUser -- 50
| MkNoOwnership NoOwnership -- 51
@ -291,6 +302,8 @@ decode number string
18 -> error_management codecRRDeleted MkRRDeleted
19 -> error_management codecRRAdded MkRRAdded
20 -> error_management codecInvalidRR MkInvalidRR
21 -> error_management codecRRUpdated MkRRUpdated
22 -> error_management codecRRReadOnly MkRRReadOnly
50 -> error_management codecUnknownUser MkUnknownUser
51 -> error_management codecNoOwnership MkNoOwnership
_ -> Left UnknownNumber

37
src/App/ZoneInterface.purs
View File

@ -524,17 +524,25 @@ handleQuery = case _ of
(DNSManager.MkDomainAdded response) -> do
H.raise $ Log $ SimpleLog $ "[TODO] Domain added: " <> response.domain
(DNSManager.MkRRReadOnly response) -> do
H.raise $ Log $ SimpleLog $ "[😈] Trying to modify a read-only resource! "
<> "domain: " <> response.domain
<> "resource id: " <> show response.rr.rrid
(DNSManager.MkRRUpdated response) -> do
H.raise $ Log $ SimpleLog $ "[🎉] Resource updated!"
replace_entry response.rr
(DNSManager.MkRRAdded response) -> do
state <- H.get
let new_rr = response.rr
H.raise $ Log $ SimpleLog
$ "[TODO] Resource Record added: " <> response.domain
<> " rrid: " <> show new_rr.rrid
<> " rrtype: " <> new_rr.rrtype
<> " name: " <> new_rr.name
<> " ttl: " <> show new_rr.ttl
<> " target: " <> new_rr.target
<> " readonly: " <> show new_rr.readonly
-- H.raise $ Log $ SimpleLog $ "Resource Record added: " <> response.domain
-- <> " rrid: " <> show new_rr.rrid
-- <> " rrtype: " <> new_rr.rrtype
-- <> " name: " <> new_rr.name
-- <> " ttl: " <> show new_rr.ttl
-- <> " target: " <> new_rr.target
-- <> " readonly: " <> show new_rr.readonly
case add_entry state new_rr of
Left error_message -> H.raise $ Log $ SimpleLog $ "Error while adding new entry: " <> error_message
Right new_state -> H.put new_state
@ -575,6 +583,19 @@ handleQuery = case _ of
pure (Just a)
where
-- replace_entry :: RRId
replace_entry new_rr = do
state <- H.get
H.modify_ _ { _srr = A.filter (\rr -> rr.id /= new_rr.rrid) state._srr
, _mxrr = A.filter (\rr -> rr.id /= new_rr.rrid) state._mxrr
, _srvrr = A.filter (\rr -> rr.id /= new_rr.rrid) state._srvrr
}
new_state <- H.get
case add_entry new_state new_rr of
Left errmsg -> H.raise $ Log $ SimpleLog $ "Error while replacing a resource record: " <> errmsg
Right s -> H.put s
add_entries [] = H.raise $ Log $ SimpleLog "[🎉] Zone fully loaded!"
add_entries arr = do
state <- H.get