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

Allow self-termination.

Browse Source
This commit is contained in:
Philippe Pittoli 2024-03-16 07:45:10 +01:00
parent 38b8deeecf
commit ef96c61758
2 changed files with 21 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
src/App/Container.purs
View File

@ -376,15 +376,25 @@ handleAction = case _ of
SetupInterfaceEvent ev -> case ev of
SetupInterface.DeleteUserAccount -> do
handleAction $ Log $ ErrorLog "TODO: delete the user account"
handleAction $ Log $ SystemLog "Self termination. 😿"
{- no user id, it's self termination -}
dns_message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkDeleteUser { user_id: Nothing }
auth_message <- H.liftEffect $ AuthD.serialize $ AuthD.MkDeleteUser { user: Nothing }
H.tell _ws_dns unit (WS.ToSend dns_message)
H.tell _ws_auth unit (WS.ToSend auth_message)
-- Once the user has been deleted, just act like it was just a disconnection.
handleAction $ Disconnection
SetupInterface.ChangePassword pass -> do
message <- H.liftEffect $ AuthD.serialize $ AuthD.MkModUser { user: Nothing
, admin: Nothing
, password: Just pass
, email: Nothing
}
H.tell _ws_auth unit (WS.ToSend message)
SetupInterface.Log message -> H.tell _log unit (AppLog.Log message)
AdministrationEvent ev -> case ev of
@ -556,6 +566,8 @@ handleAction = case _ of
sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
H.liftEffect $ Storage.clear sessionstorage
handleAction $ Routing Home
-- | `dnsmanagerd websocket component` wants to do something.
DNSManagerDaemonEvent ev -> case ev of
WS.MessageReceived (Tuple _ message) -> do

7
src/App/Message/DNSManagerDaemon.purs
View File

@ -34,6 +34,11 @@ type Login = { token :: String }
codecLogin ∷ CA.JsonCodec Login
codecLogin = CA.object "Login" (CAR.record { token: CA.string })
{- 1 -}
type DeleteUser = { user_id :: Maybe Int }
codecDeleteUser ∷ CA.JsonCodec DeleteUser
codecDeleteUser = CA.object "DeleteUser" (CAR.record { user_id: CAR.optional CA.int })
{- 7 -}
type Maintenance = { subject :: MaintenanceSubject.MaintenanceSubject
, int :: Maybe Int
@ -264,6 +269,7 @@ codecInsufficientRights = CA.object "InsufficientRights" (CAR.record { })
-- All possible requests.
data RequestMessage
= MkLogin Login -- 0
| MkDeleteUser DeleteUser -- 1
| MkMaintenance Maintenance -- 7
| MkNewDomain NewDomain -- 9
| MkDeleteDomain DeleteDomain -- 10
@ -314,6 +320,7 @@ data AnswerMessage
encode ∷ RequestMessage -> Tuple UInt String
encode m = case m of
(MkLogin request) -> get_tuple 0 codecLogin request
(MkDeleteUser request) -> get_tuple 1 codecDeleteUser request
(MkMaintenance request) -> get_tuple 7 codecMaintenance request
(MkNewDomain request) -> get_tuple 9 codecNewDomain request
(MkDeleteDomain request) -> get_tuple 10 codecDeleteDomain request