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: This interface should allow to:
- TODO: add, remove, search, validate users - TODO: add, remove, search, validate users
- TODO: raise a user to admin - TODO: raise a user to admin
TODO: authenticate
-} -}
import Prelude (Unit, Void, bind, discard, map, otherwise, pure, show, void, when, ($), (&&), (-), (<), (<$>), (<<<), (<>), (>=>), (>>=), not) import Prelude (Unit, Void, bind, discard, map, otherwise, pure, show, void, when, ($), (&&), (-), (<), (<$>), (<<<), (<>), (>=>), (>>=), not)

View File

@ -8,6 +8,7 @@ import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import App.AuthenticationForm as AF import App.AuthenticationForm as AF
import App.AuthenticationDaemonAdminInterface as AAI import App.AuthenticationDaemonAdminInterface as AAI
import App.DNSManagerDomainsInterface as NewDomainInterface
import Halogen as H import Halogen as H
import Halogen.HTML as HH import Halogen.HTML as HH
import Type.Proxy (Proxy(..)) import Type.Proxy (Proxy(..))
@ -21,10 +22,12 @@ type State = { token :: Maybe String, uid :: Maybe Int }
type ChildSlots = type ChildSlots =
( af :: AF.Slot Unit ( af :: AF.Slot Unit
, aai :: AAI.Slot Unit , aai :: AAI.Slot Unit
, ndi :: NewDomainInterface.Slot Unit
) )
_af = Proxy :: Proxy "af" _af = Proxy :: Proxy "af"
_aai = Proxy :: Proxy "aai" _aai = Proxy :: Proxy "aai"
_ndi = Proxy :: Proxy "ndi"
component :: forall q i o m. MonadAff m => H.Component q i o m component :: forall q i o m. MonadAff m => H.Component q i o m
component = component =
@ -42,6 +45,7 @@ render state
= HH.div_ $ = HH.div_ $
[ render_auth_form [ render_auth_form
, render_authd_admin_interface , render_authd_admin_interface
, render_newdomain_interface
, div_token , div_token
] ]
where where
@ -50,17 +54,25 @@ render state
render_auth_form :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad render_auth_form :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
render_auth_form = Bulma.box $ case state.token of 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) ] 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 :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
render_authd_admin_interface = Bulma.box $ case state.token of render_authd_admin_interface = Bulma.box $ case state.token of
Just _ -> Just _ ->
[ Bulma.h1 "Administrative interface for authd" [ 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." ] 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 :: forall o monad. MonadAff monad => Action -> H.HalogenM State Action ChildSlots o monad Unit
handleAction = case _ of handleAction = case _ of
Authenticated (AF.AuthToken (Tuple uid token)) -> H.modify_ _ { uid = Just uid, token = Just token } 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: Some messages are lacking:
- TODO: get the list of TLDs (netlib.re, codelib.re, etc.) - TODO: get the list of TLDs (netlib.re, codelib.re, etc.)
Also: must log user!
-} -}
import Prelude import Prelude
@ -139,7 +141,8 @@ type Slot = H.Slot Query Output
type Query :: forall k. k -> Type type Query :: forall k. k -> Type
type Query = Const Void type Query = Const Void
type Input = String -- Input = url token
type Input = Tuple String String
data NewDomainFormAction data NewDomainFormAction
= INP_newdomain String = INP_newdomain String
@ -149,6 +152,8 @@ data Action
| WebSocketParseError String | WebSocketParseError String
| ConnectWebSocket | ConnectWebSocket
| AuthenticateToDNSManager
| HandleNewDomainInput NewDomainFormAction | HandleNewDomainInput NewDomainFormAction
| NewDomainAttempt Event | NewDomainAttempt Event
@ -156,13 +161,14 @@ data Action
| HandleWebSocket (WebSocketEvent WebSocketMessageType) | HandleWebSocket (WebSocketEvent WebSocketMessageType)
-- TODO: TLD -- TODO: TLD
type NewDomainForm = { new_domain :: String } type NewDomainFormState = { new_domain :: String }
type State = type State =
{ messages :: Array String { messages :: Array String
, messageHistoryLength :: Int , messageHistoryLength :: Int
, newDomainForm :: NewDomainForm , token :: String
, newDomainForm :: NewDomainFormState
-- TODO: put network stuff in a record. -- TODO: put network stuff in a record.
, wsUrl :: String , wsUrl :: String
@ -183,14 +189,15 @@ component =
} }
initialState :: Input -> State initialState :: Input -> State
initialState input = initialState (Tuple url token) =
{ messages: [] { messages: []
, messageHistoryLength: 10 , messageHistoryLength: 10
, token: token
, newDomainForm: { new_domain: "" } , newDomainForm: { new_domain: "" }
-- TODO: put network stuff in a record. -- TODO: put network stuff in a record.
, wsUrl: input , wsUrl: url
, wsConnection: Nothing , wsConnection: Nothing
, canReconnect: false , canReconnect: false
} }
@ -280,6 +287,16 @@ handleAction = case _ of
H.liftEffect $ WS.setBinaryType webSocket ArrayBuffer H.liftEffect $ WS.setBinaryType webSocket ArrayBuffer
H.modify_ _ { wsConnection = Just webSocket } H.modify_ _ { wsConnection = Just webSocket }
void $ H.subscribe (HandleWebSocket <$> webSocketEmitter 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 HandleNewDomainInput adduserinp -> do
case adduserinp of case adduserinp of
@ -339,6 +356,11 @@ handleAction = case _ of
-- The authentication failed. -- The authentication failed.
(DNSManager.MkError errmsg) -> do (DNSManager.MkError errmsg) -> do
appendMessage $ "[😈] Failed, reason is: " <> errmsg.reason 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 (DNSManager.MkDomainAlreadyExists _) -> do
appendMessage $ "[😈] Failed! The domain already exists." appendMessage $ "[😈] Failed! The domain already exists."
(DNSManager.MkSuccess _) -> do (DNSManager.MkSuccess _) -> do

View File

@ -104,6 +104,11 @@ type DomainAlreadyExists = { }
codecDomainAlreadyExists ∷ CA.JsonCodec DomainAlreadyExists codecDomainAlreadyExists ∷ CA.JsonCodec DomainAlreadyExists
codecDomainAlreadyExists = CA.object "DomainAlreadyExists" (CAR.record { }) codecDomainAlreadyExists = CA.object "DomainAlreadyExists" (CAR.record { })
{- 4 -}
type ErrorUserNotLogged = { }
codecErrorUserNotLogged ∷ CA.JsonCodec ErrorUserNotLogged
codecErrorUserNotLogged = CA.object "ErrorUserNotLogged" (CAR.record { })
{- 10 -} {- 10 -}
-- For now, Error is just an alias on String. -- For now, Error is just an alias on String.
-- type InvalidZone = { errors : Array(Storage::Zone::Error) } -- type InvalidZone = { errors : Array(Storage::Zone::Error) }
@ -162,6 +167,7 @@ data AnswerMessage
| MkSuccess Success -- 1 | MkSuccess Success -- 1
| MkErrorInvalidToken ErrorInvalidToken -- 2 | MkErrorInvalidToken ErrorInvalidToken -- 2
| MkDomainAlreadyExists DomainAlreadyExists -- 3 | MkDomainAlreadyExists DomainAlreadyExists -- 3
| MkErrorUserNotLogged ErrorUserNotLogged -- 4
| MkInvalidZone InvalidZone -- 10 | MkInvalidZone InvalidZone -- 10
| MkDomainChanged DomainChanged -- 11 | MkDomainChanged DomainChanged -- 11
| MkZone Zone -- 12 | MkZone Zone -- 12
@ -199,6 +205,7 @@ decode number string
1 -> error_management codecSuccess MkSuccess 1 -> error_management codecSuccess MkSuccess
2 -> error_management codecErrorInvalidToken MkErrorInvalidToken 2 -> error_management codecErrorInvalidToken MkErrorInvalidToken
3 -> error_management codecDomainAlreadyExists MkDomainAlreadyExists 3 -> error_management codecDomainAlreadyExists MkDomainAlreadyExists
4 -> error_management codecErrorUserNotLogged MkErrorUserNotLogged
10 -> error_management codecInvalidZone MkInvalidZone 10 -> error_management codecInvalidZone MkInvalidZone
11 -> error_management codecDomainChanged MkDomainChanged 11 -> error_management codecDomainChanged MkDomainChanged
12 -> error_management codecZone MkZone 12 -> error_management codecZone MkZone