DNSManager Interface: first draft (WIP).

beta
Philippe Pittoli 2023-06-18 01:10:36 +02:00
parent 2352d2a3bb
commit de88796773
1 changed files with 46 additions and 69 deletions

View File

@ -1,12 +1,15 @@
module App.AuthenticationDaemonAdminInterface where
module App.DNSManagerDomainsInterface where
{- Administration interface for the authentication daemon.
{- Simple component with the list of own domains and a form to add a new domain.
This interface should allow to:
- TODO: add, remove, search, validate users
- TODO: raise a user to admin
- TODO: display the list of own domains
- TODO: create new domains (with different TLDs)
Some messages are lacking:
- TODO: get the list of TLDs (netlib.re, codelib.re, etc.)
-}
import Prelude (Unit, Void, bind, discard, map, otherwise, pure, show, void, when, ($), (&&), (-), (<), (<$>), (<<<), (<>), (>=>), (>>=), not)
import Prelude
import Bulma as Bulma
@ -40,9 +43,7 @@ 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 App.Messages.DNSManagerDaemon as DNSManager
import Data.ArrayBuffer.Types (ArrayBuffer)
import Web.Socket.BinaryType (BinaryType(ArrayBuffer))
@ -140,7 +141,7 @@ type Query :: forall k. k -> Type
type Query = Const Void
type Input = String
data NewDomainForm
data NewDomainFormAction
= INP_newdomain String
data Action
@ -148,19 +149,20 @@ data Action
| WebSocketParseError String
| ConnectWebSocket
| HandleNewDomainInput NewDomainForm
| HandleNewDomainInput NewDomainFormAction
| AddUserAttempt Event
| NewDomainAttempt Event
-- | Finalize
| HandleWebSocket (WebSocketEvent WebSocketMessageType)
type StateAddUserForm = { login :: String, admin :: Boolean, email :: String, pass :: String }
-- TODO: TLD
type NewDomainForm = { new_domain :: String }
type State =
{ messages :: Array String
, messageHistoryLength :: Int
, newDomainForm :: StateAddUserForm
, newDomainForm :: NewDomainForm
-- TODO: put network stuff in a record.
, wsUrl :: String
@ -200,43 +202,30 @@ render {
canReconnect,
newDomainForm }
= HH.div_
[ Bulma.columns_ [ Bulma.column_ adduser_form ]
[ Bulma.columns_ [ Bulma.column_ newdomain_form, Bulma.column_ list_of_own_domains ]
, render_messages
--, renderMaxHistoryLength messageHistoryLength
, renderReconnectButton (isNothing wsConnection && canReconnect)
]
where
adduser_form
= [ Bulma.h3 "Add a new user"
newdomain_form
= [ Bulma.h3 "Add a domain!"
, render_adduser_form
]
list_of_own_domains
= [ Bulma.h3 "You domains: (TODO)" ]
should_be_disabled = (maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection)
render_adduser_form = HH.form
[ HE.onSubmit AddUserAttempt ]
[ HE.onSubmit NewDomainAttempt ]
[ Bulma.box_input "Your new domain" "awesomewebsite" -- title, placeholder
(HandleNewDomainInput <<< INP_newdomain) -- action
newDomainForm.new_domain -- value
true -- validity (TODO)
should_be_disabled -- condition
, Bulma.btn
(show newDomainForm.admin) -- value
(HandleNewDomainInput ADDUSER_toggle_admin) -- action1
(HandleNewDomainInput ADDUSER_toggle_admin) -- action2
true -- validity (TODO)
-- should_be_disabled -- condition
, Bulma.box_input "User email" "email" -- title, placeholder
(HandleNewDomainInput <<< ADDUSER_INP_email) -- action
newDomainForm.email -- value
true -- validity (TODO)
should_be_disabled -- condition
, Bulma.box_password "User password" "password" -- title, placeholder
(HandleNewDomainInput <<< ADDUSER_INP_pass) -- action
newDomainForm.pass -- value
true -- validity (TODO)
should_be_disabled -- condition
-- TODO: list of options for TLD
, HH.div_
[ HH.button
[ HP.style "padding: 0.5rem 1.25rem;"
@ -293,35 +282,23 @@ handleAction = case _ of
void $ H.subscribe (HandleWebSocket <$> webSocketEmitter webSocket)
HandleNewDomainInput adduserinp -> do
{ newDomainForm } <- H.get
case adduserinp of
ADDUSER_INP_login v -> H.modify_ _ { newDomainForm { login = v } }
ADDUSER_INP_email v -> H.modify_ _ { newDomainForm { email = v } }
ADDUSER_toggle_admin -> H.modify_ _ { newDomainForm { admin = not newDomainForm.admin } }
ADDUSER_INP_pass v -> H.modify_ _ { newDomainForm { pass = v } }
INP_newdomain v -> H.modify_ _ { newDomainForm { new_domain = v } }
AddUserAttempt ev -> do
NewDomainAttempt ev -> do
H.liftEffect $ Event.preventDefault ev
{ wsConnection, newDomainForm } <- H.get
let login = newDomainForm.login
email = newDomainForm.email
pass = newDomainForm.pass
let new_domain = newDomainForm.new_domain
case wsConnection, login, email, pass of
Nothing, _, _, _ ->
case wsConnection, new_domain of
Nothing, _ ->
unableToSend "Not connected to server."
Just _, "", _, _ ->
unableToSend "Write the user's login!"
Just _, "" ->
unableToSend "You didn't enter the new domain!"
Just _, _, "", _ ->
unableToSend "Write the user's email!"
Just _, _, _, "" ->
unableToSend "Write the user's password!"
Just webSocket, _, _, _ -> do
Just webSocket, _ -> do
H.liftEffect (WS.readyState webSocket) >>= case _ of
Connecting ->
unableToSend "Still connecting to server."
@ -337,35 +314,35 @@ handleAction = case _ of
Open -> do
H.liftEffect $ do
ab <- AuthD.serialize $ AuthD.MkAddUser { login: login
, admin: newDomainForm.admin
, email: Just (Email.Email email)
, password: pass }
-- TODO: put chosen TLD
ab <- DNSManager.serialize $ DNSManager.MkNewDomain { domain: new_domain }
sendArrayBuffer webSocket ab
appendMessageReset "[😇] Trying to add a user"
appendMessageReset "[😇] Trying to add a new domain"
HandleWebSocket wsEvent ->
case wsEvent of
WebSocketMessage messageEvent -> do
receivedMessage <- H.liftEffect $ AuthD.deserialize messageEvent.message
receivedMessage <- H.liftEffect $ DNSManager.deserialize messageEvent.message
case receivedMessage of
-- Cases where we didn't understand the message.
Left err -> do
case err of
(AuthD.JSONERROR jerr) -> do
(DNSManager.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")
handleAction $ WebSocketParseError ("JSON parsing error: " <> jerr)
(DNSManager.UnknownError unerr) -> handleAction $ WebSocketParseError ("Parsing error: DNSManager.UnknownError" <> (show unerr))
(DNSManager.UnknownNumber ) -> handleAction $ WebSocketParseError ("Parsing error: DNSManager.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
(DNSManager.MkError errmsg) -> do
appendMessage $ "[😈] Failed, reason is: " <> errmsg.reason
(DNSManager.MkDomainAlreadyExists _) -> do
appendMessage $ "[😈] Failed! The domain already exists."
(DNSManager.MkSuccess _) -> do
appendMessage $ "[😈] Success!"
-- WTH?!
_ -> do
appendMessage $ "[😈] Failed! Authentication server didn't send a valid message."
@ -419,7 +396,7 @@ appendMessageGeneric clearField msg = do
histSize <- H.gets _.messageHistoryLength
if clearField
then H.modify_ \st ->
st { messages = appendSingle histSize msg st.messages, newDomainForm { login = "" }}
st { messages = appendSingle histSize msg st.messages, newDomainForm { new_domain = "" }}
else H.modify_ \st ->
st { messages = appendSingle histSize msg st.messages }
where