From 7dc993ae26f0e383f10671133298933ae74de745 Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Sun, 18 Jun 2023 02:11:16 +0200 Subject: [PATCH] WIP --- .../AuthenticationDaemonAdminInterface.purs | 4 ++- src/App/Container.purs | 16 ++++++++-- src/App/DNSManagerDomainsInterface.purs | 32 ++++++++++++++++--- src/App/Messages/DNSManagerDaemon.purs | 7 ++++ 4 files changed, 51 insertions(+), 8 deletions(-) diff --git a/src/App/AuthenticationDaemonAdminInterface.purs b/src/App/AuthenticationDaemonAdminInterface.purs index 94d51a0..8a90f98 100644 --- a/src/App/AuthenticationDaemonAdminInterface.purs +++ b/src/App/AuthenticationDaemonAdminInterface.purs @@ -4,6 +4,8 @@ module App.AuthenticationDaemonAdminInterface where This interface should allow to: - TODO: add, remove, search, validate users - TODO: raise a user to admin + + TODO: authenticate -} import Prelude (Unit, Void, bind, discard, map, otherwise, pure, show, void, when, ($), (&&), (-), (<), (<$>), (<<<), (<>), (>=>), (>>=), not) @@ -163,7 +165,7 @@ type State = { messages :: Array String , messageHistoryLength :: Int - , addUserForm :: StateAddUserForm + , addUserForm :: StateAddUserForm -- TODO: put network stuff in a record. , wsUrl :: String diff --git a/src/App/Container.purs b/src/App/Container.purs index 70d8cdf..36f41fa 100644 --- a/src/App/Container.purs +++ b/src/App/Container.purs @@ -8,6 +8,7 @@ import Data.Maybe (Maybe(..)) import Data.Tuple (Tuple(..)) import App.AuthenticationForm as AF import App.AuthenticationDaemonAdminInterface as AAI +import App.DNSManagerDomainsInterface as NewDomainInterface import Halogen as H import Halogen.HTML as HH import Type.Proxy (Proxy(..)) @@ -21,10 +22,12 @@ type State = { token :: Maybe String, uid :: Maybe Int } type ChildSlots = ( af :: AF.Slot Unit , aai :: AAI.Slot Unit + , ndi :: NewDomainInterface.Slot Unit ) _af = Proxy :: Proxy "af" _aai = Proxy :: Proxy "aai" +_ndi = Proxy :: Proxy "ndi" component :: forall q i o m. MonadAff m => H.Component q i o m component = @@ -42,6 +45,7 @@ render state = HH.div_ $ [ render_auth_form , render_authd_admin_interface + , render_newdomain_interface , div_token ] where @@ -50,17 +54,25 @@ render state render_auth_form :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad render_auth_form = Bulma.box $ case state.token of - Nothing -> [ HH.slot _af unit AF.component "ws://127.0.0.1:8081" Authenticated ] + Nothing -> [ HH.slot _af unit AF.component "ws://127.0.0.1:8080" Authenticated ] Just current_token -> [ Bulma.p ("Token is: " <> current_token) ] render_authd_admin_interface :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad render_authd_admin_interface = Bulma.box $ case state.token of Just _ -> [ Bulma.h1 "Administrative interface for authd" - , HH.slot_ _aai unit AAI.component "ws://127.0.0.1:8081" + , HH.slot_ _aai unit AAI.component "ws://127.0.0.1:8080" ] Nothing -> [ Bulma.p "Here will be the administrative box." ] + render_newdomain_interface :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad + render_newdomain_interface = Bulma.box $ case state.token of + Just _ -> + [ Bulma.h1 "New domain interface!" + , HH.slot_ _ndi unit NewDomainInterface.component "ws://127.0.0.1:8081" + ] + Nothing -> [ Bulma.p "Here will be the new domain box." ] + handleAction :: forall o monad. MonadAff monad => Action -> H.HalogenM State Action ChildSlots o monad Unit handleAction = case _ of Authenticated (AF.AuthToken (Tuple uid token)) -> H.modify_ _ { uid = Just uid, token = Just token } diff --git a/src/App/DNSManagerDomainsInterface.purs b/src/App/DNSManagerDomainsInterface.purs index 2cf716b..944f905 100644 --- a/src/App/DNSManagerDomainsInterface.purs +++ b/src/App/DNSManagerDomainsInterface.purs @@ -7,6 +7,8 @@ module App.DNSManagerDomainsInterface where Some messages are lacking: - TODO: get the list of TLDs (netlib.re, codelib.re, etc.) + + Also: must log user! -} import Prelude @@ -139,7 +141,8 @@ type Slot = H.Slot Query Output type Query :: forall k. k -> Type type Query = Const Void -type Input = String +-- Input = url token +type Input = Tuple String String data NewDomainFormAction = INP_newdomain String @@ -149,6 +152,8 @@ data Action | WebSocketParseError String | ConnectWebSocket + | AuthenticateToDNSManager + | HandleNewDomainInput NewDomainFormAction | NewDomainAttempt Event @@ -156,13 +161,14 @@ data Action | HandleWebSocket (WebSocketEvent WebSocketMessageType) -- TODO: TLD -type NewDomainForm = { new_domain :: String } +type NewDomainFormState = { new_domain :: String } type State = { messages :: Array String , messageHistoryLength :: Int - , newDomainForm :: NewDomainForm + , token :: String + , newDomainForm :: NewDomainFormState -- TODO: put network stuff in a record. , wsUrl :: String @@ -183,14 +189,15 @@ component = } initialState :: Input -> State -initialState input = +initialState (Tuple url token) = { messages: [] , messageHistoryLength: 10 + , token: token , newDomainForm: { new_domain: "" } -- TODO: put network stuff in a record. - , wsUrl: input + , wsUrl: url , wsConnection: Nothing , canReconnect: false } @@ -280,6 +287,16 @@ handleAction = case _ of H.liftEffect $ WS.setBinaryType webSocket ArrayBuffer H.modify_ _ { wsConnection = Just webSocket } void $ H.subscribe (HandleWebSocket <$> webSocketEmitter webSocket) + handleAction AuthenticateToDNSManager + + AuthenticateToDNSManager -> do + { wsConnection, token } <- H.get + appendMessage $ "[🤖] Trying to authenticate..." + case wsConnection of + Nothing -> appendMessage $ "[🤖] Can't authenticate, websocket is down!" + Just webSocket -> H.liftEffect $ do + ab <- DNSManager.serialize $ DNSManager.MkLogin { token: token } + sendArrayBuffer webSocket ab HandleNewDomainInput adduserinp -> do case adduserinp of @@ -339,6 +356,11 @@ handleAction = case _ of -- The authentication failed. (DNSManager.MkError errmsg) -> do appendMessage $ "[😈] Failed, reason is: " <> errmsg.reason + (DNSManager.MkErrorUserNotLogged _) -> do + appendMessage $ "[😈] Failed! The user isn't connected!" + handleAction AuthenticateToDNSManager + (DNSManager.MkErrorInvalidToken _) -> do + appendMessage $ "[😈] Failed connection! Invalid token!" (DNSManager.MkDomainAlreadyExists _) -> do appendMessage $ "[😈] Failed! The domain already exists." (DNSManager.MkSuccess _) -> do diff --git a/src/App/Messages/DNSManagerDaemon.purs b/src/App/Messages/DNSManagerDaemon.purs index a9c4564..bf1b801 100644 --- a/src/App/Messages/DNSManagerDaemon.purs +++ b/src/App/Messages/DNSManagerDaemon.purs @@ -104,6 +104,11 @@ type DomainAlreadyExists = { } codecDomainAlreadyExists ∷ CA.JsonCodec DomainAlreadyExists codecDomainAlreadyExists = CA.object "DomainAlreadyExists" (CAR.record { }) +{- 4 -} +type ErrorUserNotLogged = { } +codecErrorUserNotLogged ∷ CA.JsonCodec ErrorUserNotLogged +codecErrorUserNotLogged = CA.object "ErrorUserNotLogged" (CAR.record { }) + {- 10 -} -- For now, Error is just an alias on String. -- type InvalidZone = { errors : Array(Storage::Zone::Error) } @@ -162,6 +167,7 @@ data AnswerMessage | MkSuccess Success -- 1 | MkErrorInvalidToken ErrorInvalidToken -- 2 | MkDomainAlreadyExists DomainAlreadyExists -- 3 + | MkErrorUserNotLogged ErrorUserNotLogged -- 4 | MkInvalidZone InvalidZone -- 10 | MkDomainChanged DomainChanged -- 11 | MkZone Zone -- 12 @@ -199,6 +205,7 @@ decode number string 1 -> error_management codecSuccess MkSuccess 2 -> error_management codecErrorInvalidToken MkErrorInvalidToken 3 -> error_management codecDomainAlreadyExists MkDomainAlreadyExists + 4 -> error_management codecErrorUserNotLogged MkErrorUserNotLogged 10 -> error_management codecInvalidZone MkInvalidZone 11 -> error_management codecDomainChanged MkDomainChanged 12 -> error_management codecZone MkZone