New authd API on request functions: complete. Still subject to changes, though.
This commit is contained in:
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…
Reference in New Issue
Block a user