New authd API on request functions: complete. Still subject to changes, though.

master
Philippe Pittoli 9 months ago
parent 82902c20b0
commit 597243a9f5

@ -141,8 +141,7 @@ type Query = Const Void
type Input = String
data AddUserInput
= ADDUSER_INP_secret String
| ADDUSER_INP_login String
= ADDUSER_INP_login String
| ADDUSER_INP_email String
| ADDUSER_INP_pass String
@ -157,9 +156,7 @@ data Action
-- | 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 StateAddUserForm = { login :: String, email :: String, pass :: String }
type State =
{ messages :: Array String
@ -190,7 +187,7 @@ initialState input =
{ messages: []
, messageHistoryLength: 10
, addUserForm: { secretKey: "", login: "", email: "", pass: "" }
, addUserForm: { login: "", email: "", pass: "" }
-- TODO: put network stuff in a record.
, wsUrl: input
@ -221,12 +218,7 @@ render {
render_adduser_form = HH.form
[ HE.onSubmit AddUserAttempt ]
[ Bulma.box_input "Secret" "shared secret with authd" -- title, placeholder
(HandleAddUserInput <<< ADDUSER_INP_secret) -- action
addUserForm.secretKey -- value
true -- validity (TODO)
should_be_disabled -- condition
, Bulma.box_input "User login" "login" -- title, placeholder
[ Bulma.box_input "User login" "login" -- title, placeholder
(HandleAddUserInput <<< ADDUSER_INP_login) -- action
addUserForm.login -- value
true -- validity (TODO)
@ -298,7 +290,6 @@ handleAction = case _ of
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 } }
@ -307,28 +298,24 @@ handleAction = case _ of
H.liftEffect $ Event.preventDefault ev
{ wsConnection, addUserForm } <- H.get
let secret = addUserForm.secretKey
login = addUserForm.login
let login = addUserForm.login
email = addUserForm.email
pass = addUserForm.pass
case wsConnection, secret, login, email, pass of
Nothing, _, _, _, _ ->
case wsConnection, login, email, pass of
Nothing, _, _, _ ->
unableToSend "Not connected to server."
Just _, "", _, _, _ ->
unableToSend "Write the secret key with authd!"
Just _, _, "", _, _ ->
Just _, "", _, _ ->
unableToSend "Write the user's login!"
Just _, _, _, "", _ ->
Just _, _, "", _ ->
unableToSend "Write the user's email!"
Just _, _, _, _, "" ->
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."
@ -344,11 +331,10 @@ handleAction = case _ of
Open -> do
H.liftEffect $ do
ab <- AuthD.serialize $ AuthD.MkAddUser { shared_key: secret
, login: login
ab <- AuthD.serialize $ AuthD.MkAddUser { login: login
, admin: false
, email: Just (Email.Email email)
, password: pass
, phone: Nothing}
, password: pass }
sendArrayBuffer webSocket ab
appendMessageReset "[😇] Trying to add a user"

@ -365,8 +365,7 @@ handleAction = case _ of
H.liftEffect $ do
ab <- AuthD.serialize $ AuthD.MkRegister { login: login
, email: Just (Email.Email email)
, password: pass
, phone: Nothing}
, password: pass }
sendArrayBuffer webSocket ab
appendMessageReset "[😇] Trying to register"
@ -429,8 +428,6 @@ handleAction = case _ of
(AuthD.GotToken msg) -> do
appendMessage $ "[😈] Success! user " <> (show msg.uid) <> " has token: " <> msg.token
H.raise $ AuthToken (Tuple msg.uid msg.token)
(AuthD.GotUserAdded msg) -> do
appendMessage $ "[😈] Success! Server added user: " <> show msg.user
-- WTH?!
_ -> do
appendMessage $ "[😈] Failed! Authentication server didn't send a valid message."

@ -58,6 +58,13 @@ type Password = String
{- UserID should be in a separate module with a dedicated codec. -}
type UserID = Int -- UserID is either a login or an uid number
{-
REQUESTS
General notes:
- when the "UserID" is optional, the server will work on the requesting user
-}
{- 0 -}
type Login = { login :: String, password :: String }
codecLogin ∷ CA.JsonCodec Login
@ -149,11 +156,11 @@ codecAddUser
{-, profile :: Maybe Hash(String, JSON::Any) -} })
{- 10 -}
type CheckPermission = { user :: UserID, service :: String, resource :: String }
type CheckPermission = { user :: Maybe UserID, service :: String, resource :: String }
codecCheckPermission ∷ CA.JsonCodec CheckPermission
codecCheckPermission
= CA.object "CheckPermission" (CAR.record
{ user: CA.int
{ user: CAR.optional CA.int
, service: CA.string
, resource: CA.string })

Loading…
Cancel
Save