Philippe Pittoli 2023-06-18 02:11:16 +02:00
parent de88796773
commit 7dc993ae26
4 changed files with 51 additions and 8 deletions

View File

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

View File

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

View File

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

View File

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