Administrative interface for authd now in a new container.

master
Philippe Pittoli 9 months ago
parent 7576bc682c
commit 3831b275b4

@ -0,0 +1,505 @@
module App.AuthenticationDaemonAdminInterface where
{- Administration interface for the authentication daemon.
This interface should allow to:
- TODO: add, remove, search, validate users
- TODO: raise a user to admin
-}
import Prelude (Unit, Void, bind, discard, map, otherwise, pure, show, void, when, ($), (&&), (-), (<), (<$>), (<<<), (<>), (>=>), (>>=))
import Control.Monad.Except (runExcept)
import Control.Monad.State (class MonadState)
import Data.Array as A
import Data.Tuple (Tuple(..))
import Data.Bifunctor (lmap)
import Data.Const (Const)
import Data.Either (Either(..))
import Data.Maybe (Maybe(..), isJust, isNothing, maybe)
import Data.String as String
import Effect (Effect)
import Effect.Aff.Class (class MonadAff)
import Foreign (Foreign)
import Foreign as F
import Halogen as H
import Halogen.HTML as HH
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties as HP
import Halogen.Query.Event as HQE
import Halogen.Subscription as HS
import Web.Event.Event (Event)
import Web.Event.Event as Event
import Web.Socket.Event.CloseEvent as WSCE
import Web.Socket.Event.EventTypes as WSET
import Web.Socket.Event.MessageEvent as WSME
import Web.Socket.ReadyState (ReadyState(Connecting, Open, Closing, Closed))
import Web.Socket.WebSocket as WS
import Effect.Class (class MonadEffect)
import App.IPC as IPC
import App.Email as Email
import App.Messages.AuthenticationDaemon as AuthD
import Data.ArrayBuffer.Types (ArrayBuffer)
import Web.Socket.BinaryType (BinaryType(ArrayBuffer))
--------------------------------------------------------------------------------
-- WebSocketEvent type
--------------------------------------------------------------------------------
data WebSocketEvent :: Type -> Type
data WebSocketEvent msg
= WebSocketMessage { message :: msg, origin :: String, lastEventId :: String }
| WebSocketOpen
| WebSocketClose { code :: Int, reason :: String, wasClean :: Boolean }
| WebSocketError ErrorType
webSocketEmitter :: WS.WebSocket -> HS.Emitter (WebSocketEvent WebSocketMessageType)
webSocketEmitter socket = do
HS.makeEmitter \push -> do
openId <- HS.subscribe openEmitter push
errorId <- HS.subscribe errorEmitter push
closeId <- HS.subscribe closeEmitter push
messageId <- HS.subscribe messageEmitter push
pure do
HS.unsubscribe openId
HS.unsubscribe errorId
HS.unsubscribe closeId
HS.unsubscribe messageId
where
target = WS.toEventTarget socket
openEmitter :: HS.Emitter (WebSocketEvent WebSocketMessageType)
openEmitter =
HQE.eventListener WSET.onOpen target \_ ->
Just WebSocketOpen
errorEmitter :: HS.Emitter (WebSocketEvent WebSocketMessageType)
errorEmitter =
HQE.eventListener WSET.onError target \_ ->
Just (WebSocketError UnknownWebSocketError)
closeEmitter :: HS.Emitter (WebSocketEvent WebSocketMessageType)
closeEmitter =
HQE.eventListener WSET.onClose target \event ->
WSCE.fromEvent event >>= \closeEvent ->
Just $ WebSocketClose { code: WSCE.code closeEvent
, reason: WSCE.reason closeEvent
, wasClean: WSCE.wasClean closeEvent
}
messageEmitter :: HS.Emitter (WebSocketEvent WebSocketMessageType)
messageEmitter = HQE.eventListener WSET.onMessage target (WSME.fromEvent >=> decodeMessageEvent)
decodeMessageEvent :: WSME.MessageEvent -> Maybe (WebSocketEvent WebSocketMessageType)
decodeMessageEvent = \msgEvent -> do
let
foreign' :: Foreign
foreign' = WSME.data_ msgEvent
case foreignToArrayBuffer foreign' of
Left errs -> pure $ WebSocketError $ UnknownError errs
Right arrayBuffer -> pure $ WebSocketMessage { message: arrayBuffer, origin: WSME.origin msgEvent, lastEventId: WSME.lastEventId msgEvent }
---------------------------
-- Errors
---------------------------
data ErrorType
= UnknownError String
| UnknownWebSocketError
renderError :: ErrorType -> String
renderError = case _ of
UnknownError str ->
"Unknown error: " <> str
UnknownWebSocketError ->
"Unknown 'error' event has been fired by WebSocket event listener"
--------------------------------------------------------------------------------
-- WebSocket message type
--------------------------------------------------------------------------------
type WebSocketMessageType = ArrayBuffer
--------------------------------------------------------------------------------
-- Root component module
--------------------------------------------------------------------------------
data Output = Void
type Slot = H.Slot Query Output
type Query :: forall k. k -> Type
type Query = Const Void
type Input = String
data AddUserInput
= ADDUSER_INP_secret String
| ADDUSER_INP_login String
| ADDUSER_INP_email String
| ADDUSER_INP_pass String
data Action
= Initialize
| WebSocketParseError String
| ConnectWebSocket
| HandleAddUserInput AddUserInput
| AddUserAttempt Event
-- | Finalize
| HandleWebSocket (WebSocketEvent WebSocketMessageType)
type StateAuthenticationForm = { login :: String, pass :: String }
type StateRegistrationForm = { login :: String, email :: String, pass :: String }
type StateAddUserForm = { secretKey :: String, login :: String, email :: String, pass :: String }
type State =
{ messages :: Array String
, messageHistoryLength :: Int
, addUserForm :: StateAddUserForm
-- TODO: put network stuff in a record.
, wsUrl :: String
, wsConnection :: Maybe WS.WebSocket
, canReconnect :: Boolean
}
component :: forall m. MonadAff m => H.Component Query Input Output m
component =
H.mkComponent
{ initialState
, render
, eval: H.mkEval $ H.defaultEval
{ initialize = Just Initialize
, handleAction = handleAction
-- , finalize = Just Finalize
}
}
initialState :: Input -> State
initialState input =
{ messages: []
, messageHistoryLength: 10
, addUserForm: { secretKey: "", login: "", email: "", pass: "" }
-- TODO: put network stuff in a record.
, wsUrl: input
, wsConnection: Nothing
, canReconnect: false
}
wrapperStyle :: String
wrapperStyle =
"""
display: block;
flex-direction: column;
justify-content: space-between;
height: calc(100vh - 30px);
background: #282c34;
color: #e06c75;
font-family: 'Consolas';
padding: 5px 20px 5px 20px;
"""
render :: forall m. State -> H.ComponentHTML Action () m
render {
messages,
wsConnection,
canReconnect,
addUserForm }
= HH.div
[ HP.style wrapperStyle ]
[ render_adduser_form
, render_messages
--, renderMaxHistoryLength messageHistoryLength
, renderReconnectButton (isNothing wsConnection && canReconnect)
]
where
render_adduser_form = HH.form
[ HE.onSubmit AddUserAttempt ]
[ HH.h2_ [ HH.text "(admin) Add User!" ]
, HH.p_
[ HH.div_
[ HH.input
[ inputCSS
, HP.type_ HP.InputText
, HP.value addUserForm.secretKey
, HE.onValueInput $ HandleAddUserInput <<< ADDUSER_INP_secret
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
]
]
, HH.div_
[ HH.input
[ inputCSS
, HP.type_ HP.InputText
, HP.value addUserForm.login
, HE.onValueInput $ HandleAddUserInput <<< ADDUSER_INP_login
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
]
]
, HH.div_
[ HH.input
[ inputCSS
, HP.type_ HP.InputText
, HP.value addUserForm.email
, HE.onValueInput $ HandleAddUserInput <<< ADDUSER_INP_email
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
]
]
, HH.div_
[ HH.input
[ inputCSS
, HP.type_ HP.InputPassword
, HP.value addUserForm.pass
, HE.onValueInput $ HandleAddUserInput <<< ADDUSER_INP_pass
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
]
]
, HH.div_
[ HH.button
[ HP.style "padding: 0.5rem 1.25rem;"
, HP.type_ HP.ButtonSubmit
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
]
[ HH.text "Send Message to Server" ]
]
]
]
render_messages = HH.ul_ $ map (\msg -> HH.li_ [ HH.text msg ]) messages
renderFootnote :: String -> H.ComponentHTML Action () m
renderFootnote txt =
HH.div [ HP.style "margin-bottom: 0.125rem; color: grey;" ] [ HH.small_ [ HH.text txt ] ]
renderReconnectButton :: Boolean -> H.ComponentHTML Action () m
renderReconnectButton cond =
if cond
then
HH.p_
[ HH.button
[ HP.type_ HP.ButtonButton
, HE.onClick \_ -> ConnectWebSocket
]
[ HH.text "Reconnect?" ]
]
else
HH.p_
[ renderFootnote "NOTE: A 'Reconnect?' button will appear if the connection drops"
]
handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
handleAction = case _ of
Initialize ->
handleAction ConnectWebSocket
-- Finalize -> do
-- { wsConnection } <- H.get
-- systemMessage "Finalize"
-- case wsConnection of
-- Nothing -> systemMessage "No socket? How is that even possible?"
-- Just socket -> H.liftEffect $ WS.close socket
WebSocketParseError error ->
systemMessage $ renderError (UnknownError error)
ConnectWebSocket -> do
{ wsUrl } <- H.get
systemMessage ("Connecting to \"" <> wsUrl <> "\"...")
webSocket <- H.liftEffect $ WS.create wsUrl []
H.liftEffect $ WS.setBinaryType webSocket ArrayBuffer
H.modify_ _ { wsConnection = Just webSocket }
void $ H.subscribe (HandleWebSocket <$> webSocketEmitter webSocket)
HandleAddUserInput adduserinp -> do
case adduserinp of
ADDUSER_INP_secret v -> H.modify_ _ { addUserForm { secretKey = v } }
ADDUSER_INP_login v -> H.modify_ _ { addUserForm { login = v } }
ADDUSER_INP_email v -> H.modify_ _ { addUserForm { email = v } }
ADDUSER_INP_pass v -> H.modify_ _ { addUserForm { pass = v } }
AddUserAttempt ev -> do
H.liftEffect $ Event.preventDefault ev
{ wsConnection, addUserForm } <- H.get
let secret = addUserForm.secretKey
login = addUserForm.login
email = addUserForm.email
pass = addUserForm.pass
case wsConnection, secret, login, email, pass of
Nothing, _, _, _, _ ->
unableToSend "Not connected to server."
Just _, "", _, _, _ ->
unableToSend "Write your secret key!"
Just _, _, "", _, _ ->
unableToSend "Write your login!"
Just _, _, _, "", _ ->
unableToSend "Write your email!"
Just _, _, _, _, "" ->
unableToSend "Write your password!"
Just webSocket, _, _, _, _ -> do
H.liftEffect (WS.readyState webSocket) >>= case _ of
Connecting ->
unableToSend "Still connecting to server."
Closing ->
unableToSend "Connection to server is closing."
Closed -> do
unableToSend "Connection to server has been closed."
maybeCurrentConnection <- H.gets _.wsConnection
when (isJust maybeCurrentConnection) do
H.modify_ _ { wsConnection = Nothing, canReconnect = true }
Open -> do
H.liftEffect $ do
ab <- AuthD.serialize $ AuthD.MkAddUser { shared_key: secret
, login: login
, email: Just (Email.Email email)
, password: pass
, phone: Nothing}
sendArrayBuffer webSocket ab
appendMessageReset "[😇] Trying to add a user"
HandleWebSocket wsEvent ->
case wsEvent of
WebSocketMessage messageEvent -> do
receivedMessage <- H.liftEffect $ AuthD.deserialize messageEvent.message
case receivedMessage of
-- Cases where we didn't understand the message.
Left err -> do
case err of
(AuthD.JSONERROR jerr) -> do
print_json_string messageEvent.message
handleAction $ WebSocketParseError ("JSON parsing error: " <> jerr <> " JSON is: " <> jerr)
(AuthD.UnknownError unerr) -> handleAction $ WebSocketParseError ("Parsing error: AuthD.UnknownError" <> (show unerr))
(AuthD.UnknownNumber ) -> handleAction $ WebSocketParseError ("Parsing error: AuthD.UnknownNumber")
-- Cases where we understood the message.
Right response -> do
case response of
-- The authentication failed.
(AuthD.GotError errmsg) -> do
appendMessage $ "[😈] Failed: " <> maybe "server didn't tell why" (\v -> v) errmsg.reason
(AuthD.GotUserAdded msg) -> do
appendMessage $ "[😈] Success! Server added user: " <> show msg.user
-- WTH?!
_ -> do
appendMessage $ "[😈] Failed! Authentication server didn't send a valid message."
WebSocketOpen -> do
{ wsUrl } <- H.get
systemMessage ("Successfully connected to WebSocket at \"" <> wsUrl <> "\"!🎉")
WebSocketClose { code, reason, wasClean } -> do
systemMessage $ renderCloseMessage code wasClean reason
maybeCurrentConnection <- H.gets _.wsConnection
when (isJust maybeCurrentConnection) do
H.modify_ _ { wsConnection = Nothing, canReconnect = true }
WebSocketError errorType ->
systemMessage $ renderError errorType
where
renderCloseMessage
:: Int
-> Boolean
-> String
-> String
renderCloseMessage code wasClean = case _ of
"" -> baseCloseMessage
reason -> baseCloseMessage <> "Reason: " <> reason
where
baseCloseMessage :: String
baseCloseMessage =
String.joinWith " "
[ "Connection to WebSocket closed"
, "[ CODE:"
, show code
, "|"
, if wasClean then "CLEAN" else "DIRTY"
, "]"
]
sendArrayBuffer :: WS.WebSocket -> ArrayBuffer -> Effect Unit
sendArrayBuffer = WS.sendArrayBuffer
--------------------------------------------------------------------------------
-- Helpers for updating the array of messages sent/received
--------------------------------------------------------------------------------
-- Append a new message to the chat history, with a boolean that allows you to
-- clear the text input field or not. The number of displayed `messages` in the
-- chat history (including system) is controlled by the `messageHistoryLength`
-- field in the component `State`.
appendMessageGeneric :: forall m. MonadState State m => Boolean -> String -> m Unit
appendMessageGeneric clearField msg = do
histSize <- H.gets _.messageHistoryLength
if clearField
then H.modify_ \st ->
st { messages = appendSingle histSize msg st.messages, addUserForm { login = "" }}
else H.modify_ \st ->
st { messages = appendSingle histSize msg st.messages }
where
-- Limits the nnumber of recent messages to `maxHist`
appendSingle :: Int -> String -> Array String -> Array String
appendSingle maxHist x xs
| A.length xs < maxHist = xs `A.snoc` x
| otherwise = (A.takeEnd (maxHist-1) xs) `A.snoc` x
-- Append a new message to the chat history, while not clearing
-- the user input field
appendMessage :: forall m. MonadState State m => String -> m Unit
appendMessage = appendMessageGeneric false
-- Append a new message to the chat history and also clear
-- the user input field
appendMessageReset :: forall m. MonadState State m => String -> m Unit
appendMessageReset = appendMessageGeneric true
-- Append a system message to the chat log.
systemMessage :: forall m. MonadState State m => String -> m Unit
systemMessage msg = appendMessage ("[🤖] System: " <> msg)
-- As above, but also clears the user input field. e.g. in
-- the case of a "/disconnect" command
systemMessageReset :: forall m. MonadState State m => String -> m Unit
systemMessageReset msg = appendMessageReset ("[🤖] System: " <> msg)
-- A system message to use when a message cannot be sent.
unableToSend :: forall m. MonadState State m => String -> m Unit
unableToSend reason = systemMessage ("Unable to send. " <> reason)
foreignToArrayBuffer :: Foreign -> Either String ArrayBuffer
foreignToArrayBuffer
= lmap renderForeignErrors
<<< runExcept
<<< F.unsafeReadTagged "ArrayBuffer"
where
renderForeignErrors :: F.MultipleErrors -> String
renderForeignErrors =
String.joinWith "; " <<< A.fromFoldable <<< map F.renderForeignError
inputCSS = HP.style "padding: 0.5rem 0.75rem; margin-bottom: 0.25rem;"
print_json_string :: forall m. MonadEffect m => MonadState State m => ArrayBuffer -> m Unit
print_json_string arraybuffer = do
-- fromTypedIPC :: ArrayBuffer -> Effect (Either ParseError (Tuple UInt String))
value <- H.liftEffect $ IPC.fromTypedIPC arraybuffer
appendMessage $ case (value) of
Left _ -> "Cannot even fromTypedIPC the message."
Right (Tuple messageTypeNumber string) -> "Number is: " <> show messageTypeNumber <> ", received string: " <> string

@ -141,12 +141,6 @@ data RegisterInput
| REG_INP_email String
| REG_INP_pass String
data AddUserInput
= ADDUSER_INP_secret String
| ADDUSER_INP_login String
| ADDUSER_INP_email String
| ADDUSER_INP_pass String
data Action
= Initialize
| WebSocketParseError String
@ -154,17 +148,14 @@ data Action
| HandleAuthenticationInput AuthenticationInput
| HandleRegisterInput RegisterInput
| HandleAddUserInput AddUserInput -- admin operation
| AuthenticationAttempt Event
| RegisterAttempt Event
| AddUserAttempt Event
| Finalize
| HandleWebSocket (WebSocketEvent WebSocketMessageType)
type StateAuthenticationForm = { login :: String, pass :: String }
type StateRegistrationForm = { login :: String, email :: String, pass :: String }
type StateAddUserForm = { secretKey :: String, login :: String, email :: String, pass :: String }
type State =
{ messages :: Array String
@ -172,7 +163,6 @@ type State =
, authenticationForm :: StateAuthenticationForm
, registrationForm :: StateRegistrationForm
, addUserForm :: StateAddUserForm
-- TODO: put network stuff in a record.
, wsUrl :: String
@ -199,7 +189,6 @@ initialState input =
, authenticationForm: { login: "", pass: "" }
, registrationForm: { login: "", email: "", pass: "" }
, addUserForm: { secretKey: "", login: "", email: "", pass: "" }
-- TODO: put network stuff in a record.
, wsUrl: input
@ -227,13 +216,11 @@ render {
canReconnect,
authenticationForm,
registrationForm,
addUserForm }
registrationForm }
= HH.div
[ HP.style wrapperStyle ]
[ render_auth_form
, render_register_form
, render_adduser_form
, render_messages
--, renderMaxHistoryLength messageHistoryLength
, renderReconnectButton (isNothing wsConnection && canReconnect)
@ -315,67 +302,12 @@ render {
]
]
render_adduser_form = HH.form
[ HE.onSubmit AddUserAttempt ]
[ HH.h2_ [ HH.text "(admin) Add User!" ]
, HH.p_
[ HH.div_
[ HH.input
[ inputCSS
, HP.type_ HP.InputText
, HP.value addUserForm.secretKey
, HE.onValueInput $ HandleAddUserInput <<< ADDUSER_INP_secret
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
]
]
, HH.div_
[ HH.input
[ inputCSS
, HP.type_ HP.InputText
, HP.value addUserForm.login
, HE.onValueInput $ HandleAddUserInput <<< ADDUSER_INP_login
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
]
]
, HH.div_
[ HH.input
[ inputCSS
, HP.type_ HP.InputText
, HP.value addUserForm.email
, HE.onValueInput $ HandleAddUserInput <<< ADDUSER_INP_email
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
]
]
, HH.div_
[ HH.input
[ inputCSS
, HP.type_ HP.InputPassword
, HP.value addUserForm.pass
, HE.onValueInput $ HandleAddUserInput <<< ADDUSER_INP_pass
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
]
]
, HH.div_
[ HH.button
[ HP.style "padding: 0.5rem 1.25rem;"
, HP.type_ HP.ButtonSubmit
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
]
[ HH.text "Send Message to Server" ]
]
]
]
render_messages = HH.ul_ $ map (\msg -> HH.li_ [ HH.text msg ]) messages
renderFootnote :: String -> H.ComponentHTML Action () m
renderFootnote txt =
HH.div [ HP.style "margin-bottom: 0.125rem; color: grey;" ] [ HH.small_ [ HH.text txt ] ]
-- renderMaxHistoryLength :: Int -> H.ComponentHTML Action () m
-- renderMaxHistoryLength len =
-- renderFootnote ("NOTE: Maximum chat history length is " <> show len <> " messages")
renderReconnectButton :: Boolean -> H.ComponentHTML Action () m
renderReconnectButton cond =
if cond
@ -426,13 +358,6 @@ handleAction = case _ of
REG_INP_email v -> H.modify_ _ { registrationForm { email = v } }
REG_INP_pass v -> H.modify_ _ { registrationForm { pass = v } }
HandleAddUserInput adduserinp -> do
case adduserinp of
ADDUSER_INP_secret v -> H.modify_ _ { addUserForm { secretKey = v } }
ADDUSER_INP_login v -> H.modify_ _ { addUserForm { login = v } }
ADDUSER_INP_email v -> H.modify_ _ { addUserForm { email = v } }
ADDUSER_INP_pass v -> H.modify_ _ { addUserForm { pass = v } }
RegisterAttempt ev -> do
H.liftEffect $ Event.preventDefault ev
@ -477,55 +402,6 @@ handleAction = case _ of
sendArrayBuffer webSocket ab
appendMessageReset "[😇] Trying to register"
AddUserAttempt ev -> do
H.liftEffect $ Event.preventDefault ev
{ wsConnection, addUserForm } <- H.get
let secret = addUserForm.secretKey
login = addUserForm.login
email = addUserForm.email
pass = addUserForm.pass
case wsConnection, secret, login, email, pass of
Nothing, _, _, _, _ ->
unableToSend "Not connected to server."
Just _, "", _, _, _ ->
unableToSend "Write your secret key!"
Just _, _, "", _, _ ->
unableToSend "Write your login!"
Just _, _, _, "", _ ->
unableToSend "Write your email!"
Just _, _, _, _, "" ->
unableToSend "Write your password!"
Just webSocket, _, _, _, _ -> do
H.liftEffect (WS.readyState webSocket) >>= case _ of
Connecting ->
unableToSend "Still connecting to server."
Closing ->
unableToSend "Connection to server is closing."
Closed -> do
unableToSend "Connection to server has been closed."
maybeCurrentConnection <- H.gets _.wsConnection
when (isJust maybeCurrentConnection) do
H.modify_ _ { wsConnection = Nothing, canReconnect = true }
Open -> do
H.liftEffect $ do
ab <- AuthD.serialize $ AuthD.MkAddUser { shared_key: secret
, login: login
, email: Just (Email.Email email)
, password: pass
, phone: Nothing}
sendArrayBuffer webSocket ab
appendMessageReset "[😇] Trying to add a user"
AuthenticationAttempt ev -> do
H.liftEffect $ Event.preventDefault ev

@ -4,6 +4,7 @@ import Prelude
import Data.Maybe (Maybe(..))
import App.AuthenticationForm as AF
import App.AuthenticationDaemonAdminInterface as AAI
import Halogen as H
import Halogen.HTML as HH
-- import Halogen.HTML.Events as HE
@ -17,10 +18,12 @@ data Action
type State = { token :: Maybe String }
type ChildSlots =
( af :: AF.Slot Unit
( af :: AF.Slot Unit
, aai :: AAI.Slot Unit
)
_af = Proxy :: Proxy "af"
_aai = Proxy :: Proxy "aai"
component :: forall q i o m. MonadAff m => H.Component q i o m
component =
@ -37,6 +40,7 @@ render :: forall m. MonadAff m => State -> H.ComponentHTML Action ChildSlots m
render state
= HH.div_ $
[ render_auth_form
, render_authd_admin_interface
, div_token
]
where
@ -57,6 +61,16 @@ render state
[ HP.class_ (H.ClassName "box") ]
[ HH.p_ [ HH.text ("Token is: " <> current_token) ] ]
render_authd_admin_interface :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
render_authd_admin_interface = case state.token of
Just _ -> HH.div
[ HP.class_ (H.ClassName "box") ]
[ HH.h1_ [ HH.text "Administrative interface for authd" ]
, HH.slot_ _aai unit AAI.component "ws://127.0.0.1:8081"
]
Nothing -> HH.div
[ HP.class_ (H.ClassName "box") ]
[ HH.p_ [ HH.text ("Here will be the administrative box.") ] ]
handleAction :: forall o monad. MonadAff monad => Action -> H.HalogenM State Action ChildSlots o monad Unit
handleAction = case _ of

Loading…
Cancel
Save