summaryrefslogtreecommitdiff
path: root/src/login
diff options
context:
space:
mode:
Diffstat (limited to 'src/login')
-rw-r--r--src/login/src/Action/Session.elm4
-rw-r--r--src/login/src/Comm/Send.elm2
-rw-r--r--src/login/src/Comm/SendRecovery.elm40
-rw-r--r--src/login/src/Comm/SendSignIn.elm2
-rw-r--r--src/login/src/Comm/SendSignUp.elm4
-rw-r--r--src/login/src/Constants/IO.elm.m47
-rw-r--r--src/login/src/ElmModule/Update.elm39
-rw-r--r--src/login/src/ElmModule/View.elm25
-rw-r--r--src/login/src/Struct/Event.elm10
-rw-r--r--src/login/src/Struct/Model.elm12
-rw-r--r--src/login/src/Update/HandleServerReply.elm60
-rw-r--r--src/login/src/Update/SendRecovery.elm29
-rw-r--r--src/login/src/View/AccountRecovery.elm22
-rw-r--r--src/login/src/View/Header.elm.m413
-rw-r--r--src/login/src/View/SignIn.elm31
-rw-r--r--src/login/src/View/SignUp.elm56
16 files changed, 298 insertions, 58 deletions
diff --git a/src/login/src/Action/Session.elm b/src/login/src/Action/Session.elm
new file mode 100644
index 0000000..eab1658
--- /dev/null
+++ b/src/login/src/Action/Session.elm
@@ -0,0 +1,4 @@
+port module Action.Session exposing (..)
+
+port store_new_session : (String, String) -> (Cmd msg)
+port reset_session : () -> (Cmd msg)
diff --git a/src/login/src/Comm/Send.elm b/src/login/src/Comm/Send.elm
index ddaa047..e488d77 100644
--- a/src/login/src/Comm/Send.elm
+++ b/src/login/src/Comm/Send.elm
@@ -25,7 +25,7 @@ internal_decoder : String -> (Json.Decode.Decoder Struct.ServerReply.Type)
internal_decoder reply_type =
case reply_type of
"okay" -> (Comm.Okay.decode)
- "set_session" -> (Comm.SetSession.decode)
+ "sse" -> (Comm.SetSession.decode)
other ->
(Json.Decode.fail
(
diff --git a/src/login/src/Comm/SendRecovery.elm b/src/login/src/Comm/SendRecovery.elm
new file mode 100644
index 0000000..e9fd3a9
--- /dev/null
+++ b/src/login/src/Comm/SendRecovery.elm
@@ -0,0 +1,40 @@
+module Comm.SendRecovery exposing (try)
+
+-- Elm -------------------------------------------------------------------------
+import Json.Encode
+
+-- Map -------------------------------------------------------------------
+import Comm.Send
+
+import Constants.IO
+
+import Struct.Event
+import Struct.Model
+
+--------------------------------------------------------------------------------
+-- TYPES ------------------------------------------------------------------------
+--------------------------------------------------------------------------------
+
+--------------------------------------------------------------------------------
+-- LOCAL -----------------------------------------------------------------------
+--------------------------------------------------------------------------------
+try_encoding : Struct.Model.Type -> (Maybe Json.Encode.Value)
+try_encoding model =
+ (Just
+ (Json.Encode.object
+ [
+ ("eml", (Json.Encode.string model.email1))
+ ]
+ )
+ )
+
+--------------------------------------------------------------------------------
+-- EXPORTED --------------------------------------------------------------------
+--------------------------------------------------------------------------------
+try : Struct.Model.Type -> (Maybe (Cmd Struct.Event.Type))
+try model =
+ (Comm.Send.try_sending
+ model
+ Constants.IO.login_recovery_handler
+ try_encoding
+ )
diff --git a/src/login/src/Comm/SendSignIn.elm b/src/login/src/Comm/SendSignIn.elm
index bf1c7c3..723b8d3 100644
--- a/src/login/src/Comm/SendSignIn.elm
+++ b/src/login/src/Comm/SendSignIn.elm
@@ -24,7 +24,7 @@ try_encoding model =
(Json.Encode.object
[
("usr", (Json.Encode.string model.username)),
- ("pwd", (Json.Encode.string model.password))
+ ("pwd", (Json.Encode.string model.password1))
]
)
)
diff --git a/src/login/src/Comm/SendSignUp.elm b/src/login/src/Comm/SendSignUp.elm
index 0094178..546416c 100644
--- a/src/login/src/Comm/SendSignUp.elm
+++ b/src/login/src/Comm/SendSignUp.elm
@@ -24,8 +24,8 @@ try_encoding model =
(Json.Encode.object
[
("usr", (Json.Encode.string model.username)),
- ("pwd", (Json.Encode.string model.password)),
- ("eml", (Json.Encode.string model.email))
+ ("pwd", (Json.Encode.string model.password1)),
+ ("eml", (Json.Encode.string model.email1))
]
)
)
diff --git a/src/login/src/Constants/IO.elm.m4 b/src/login/src/Constants/IO.elm.m4
index 674f910..fdb5ed3 100644
--- a/src/login/src/Constants/IO.elm.m4
+++ b/src/login/src/Constants/IO.elm.m4
@@ -7,7 +7,10 @@ login_handler_url : String
login_handler_url = (base_url ++ "/handler/login")
login_sign_in_handler : String
-login_sign_in_handler = (login_handler_url ++ "/plr_sign_in")
+login_sign_in_handler = (login_handler_url ++ "/lgn_sign_in")
login_sign_up_handler : String
-login_sign_up_handler = (login_handler_url ++ "/plr_sign_up")
+login_sign_up_handler = (login_handler_url ++ "/lgn_sign_up")
+
+login_recovery_handler : String
+login_recovery_handler = (login_handler_url ++ "/lgn_recovery")
diff --git a/src/login/src/ElmModule/Update.elm b/src/login/src/ElmModule/Update.elm
index 6245ae1..babb5b5 100644
--- a/src/login/src/ElmModule/Update.elm
+++ b/src/login/src/ElmModule/Update.elm
@@ -9,6 +9,7 @@ import Struct.Model
import Update.HandleServerReply
import Update.SendSignIn
import Update.SendSignUp
+import Update.SendRecovery
import Update.SelectTab
--------------------------------------------------------------------------------
@@ -40,15 +41,49 @@ update event model =
(Struct.Event.ServerReplied result) ->
(Update.HandleServerReply.apply_to model result)
- Struct.Event.SendSignInRequested ->
+ Struct.Event.SignInRequested ->
(Update.SendSignIn.apply_to new_model)
- Struct.Event.SendSignUpRequested ->
+ Struct.Event.SignUpRequested ->
(Update.SendSignUp.apply_to model)
+ Struct.Event.RecoveryRequested ->
+ (Update.SendRecovery.apply_to model)
+
(Struct.Event.TabSelected tab) ->
(Update.SelectTab.apply_to new_model tab)
(Struct.Event.RequestedHelp _) ->
-- TODO
(model, Cmd.none)
+
+ (Struct.Event.SetUsername str) ->
+ (
+ {model | username = str},
+ Cmd.none
+ )
+
+ (Struct.Event.SetPassword1 str) ->
+ (
+ {model | password1 = str},
+ Cmd.none
+ )
+
+ (Struct.Event.SetPassword2 str) ->
+ (
+ {model | password2 = str},
+ Cmd.none
+ )
+
+ (Struct.Event.SetEmail1 str) ->
+ (
+ {model | email1 = str},
+ Cmd.none
+ )
+
+ (Struct.Event.SetEmail2 str) ->
+ (
+ {model | email2 = str},
+ Cmd.none
+ )
+
diff --git a/src/login/src/ElmModule/View.elm b/src/login/src/ElmModule/View.elm
index 874eb01..657e063 100644
--- a/src/login/src/ElmModule/View.elm
+++ b/src/login/src/ElmModule/View.elm
@@ -6,10 +6,13 @@ import Html.Lazy
import Html.Attributes
-- Map -------------------------------------------------------------------
+import Struct.Error
import Struct.Event
import Struct.Model
import Struct.UI
+import Util.Html
+
import View.AccountRecovery
import View.Header
import View.MainMenu
@@ -40,11 +43,25 @@ view model =
),
(
case (Struct.UI.try_getting_displayed_tab model.ui) of
- (Just Struct.UI.SignInTab) -> (View.SignIn.get_html)
- (Just Struct.UI.SignUpTab) -> (View.SignUp.get_html)
+ (Just Struct.UI.SignInTab) -> (View.SignIn.get_html model)
+ (Just Struct.UI.SignUpTab) -> (View.SignUp.get_html model)
(Just Struct.UI.RecoveryTab) ->
- (View.AccountRecovery.get_html)
- _ -> (View.SignIn.get_html)
+ (View.AccountRecovery.get_html model)
+
+ _ -> (View.SignIn.get_html model)
+ ),
+ (
+ case model.error of
+ Nothing -> (Util.Html.nothing)
+ (Just err) ->
+ (Html.div
+ [
+ (Html.Attributes.class "error-msg")
+ ]
+ [
+ (Html.text (Struct.Error.to_string err))
+ ]
+ )
)
]
)
diff --git a/src/login/src/Struct/Event.elm b/src/login/src/Struct/Event.elm
index b473475..662b768 100644
--- a/src/login/src/Struct/Event.elm
+++ b/src/login/src/Struct/Event.elm
@@ -16,8 +16,14 @@ type Type =
None
| Failed Struct.Error.Type
| RequestedHelp Struct.HelpRequest.Type
- | SendSignInRequested
- | SendSignUpRequested
+ | SignInRequested
+ | SignUpRequested
+ | RecoveryRequested
+ | SetUsername String
+ | SetPassword1 String
+ | SetPassword2 String
+ | SetEmail1 String
+ | SetEmail2 String
| ServerReplied (Result Http.Error (List Struct.ServerReply.Type))
| TabSelected Struct.UI.Tab
diff --git a/src/login/src/Struct/Model.elm b/src/login/src/Struct/Model.elm
index 787d6ba..cb7bf35 100644
--- a/src/login/src/Struct/Model.elm
+++ b/src/login/src/Struct/Model.elm
@@ -25,8 +25,10 @@ type alias Type =
help_request: Struct.HelpRequest.Type,
error: (Maybe Struct.Error.Type),
username: String,
- password: String,
- email: String,
+ password1: String,
+ password2: String,
+ email1: String,
+ email2: String,
player_id: String,
session_token: String,
ui: Struct.UI.Type
@@ -48,8 +50,10 @@ new flags =
help_request = Struct.HelpRequest.None,
error = Nothing,
username = "",
- password = "",
- email = "",
+ password1 = "",
+ password2 = "",
+ email1 = "",
+ email2 = "",
player_id = flags.user_id,
session_token = flags.token,
ui = (Struct.UI.default)
diff --git a/src/login/src/Update/HandleServerReply.elm b/src/login/src/Update/HandleServerReply.elm
index cdad752..8720457 100644
--- a/src/login/src/Update/HandleServerReply.elm
+++ b/src/login/src/Update/HandleServerReply.elm
@@ -8,6 +8,8 @@ import Dict
import Http
-- Map -------------------------------------------------------------------
+import Action.Session
+
import Struct.Error
import Struct.Event
import Struct.Model
@@ -24,26 +26,46 @@ import Struct.UI
set_session : (
String ->
String ->
- (Struct.Model.Type, (Maybe Struct.Error.Type)) ->
- (Struct.Model.Type, (Maybe Struct.Error.Type))
+ (
+ Struct.Model.Type,
+ (Maybe Struct.Error.Type),
+ (List (Cmd Struct.Event.Type))
+ ) ->
+ (
+ Struct.Model.Type,
+ (Maybe Struct.Error.Type),
+ (List (Cmd Struct.Event.Type))
+ )
)
set_session pid stk current_state =
case current_state of
- (_, (Just _)) -> current_state
+ (_, (Just _), _) -> current_state
- (model, _) ->
+ (model, _, cmd_list) ->
(
{model |
player_id = pid,
session_token = stk
},
- Nothing
+ Nothing,
+ (
+ (Action.Session.store_new_session (pid, stk))
+ :: cmd_list
+ )
)
apply_command : (
Struct.ServerReply.Type ->
- (Struct.Model.Type, (Maybe Struct.Error.Type)) ->
- (Struct.Model.Type, (Maybe Struct.Error.Type))
+ (
+ Struct.Model.Type,
+ (Maybe Struct.Error.Type),
+ (List (Cmd Struct.Event.Type))
+ ) ->
+ (
+ Struct.Model.Type,
+ (Maybe Struct.Error.Type),
+ (List (Cmd Struct.Event.Type))
+ )
)
apply_command command current_state =
case command of
@@ -73,10 +95,22 @@ apply_to model query_result =
(Result.Ok commands) ->
(
- (
- case (List.foldl (apply_command) (model, Nothing) commands) of
- (updated_model, Nothing) -> updated_model
- (_, (Just error)) -> (Struct.Model.invalidate error model)
- ),
- Cmd.none
+ case
+ (List.foldl
+ (apply_command)
+ (model, Nothing, [])
+ commands
+ )
+ of
+ (updated_model, Nothing, cmds) ->
+ (
+ updated_model,
+ (Cmd.batch cmds)
+ )
+
+ (_, (Just error), _) ->
+ (
+ (Struct.Model.invalidate error model),
+ Cmd.none
+ )
)
diff --git a/src/login/src/Update/SendRecovery.elm b/src/login/src/Update/SendRecovery.elm
new file mode 100644
index 0000000..313477b
--- /dev/null
+++ b/src/login/src/Update/SendRecovery.elm
@@ -0,0 +1,29 @@
+module Update.SendRecovery exposing (apply_to)
+-- Elm -------------------------------------------------------------------------
+
+-- Map -------------------------------------------------------------------
+import Comm.SendRecovery
+
+import Struct.Event
+import Struct.Model
+
+--------------------------------------------------------------------------------
+-- LOCAL -----------------------------------------------------------------------
+--------------------------------------------------------------------------------
+
+--------------------------------------------------------------------------------
+-- EXPORTED --------------------------------------------------------------------
+--------------------------------------------------------------------------------
+apply_to : (
+ Struct.Model.Type ->
+ (Struct.Model.Type, (Cmd Struct.Event.Type))
+ )
+apply_to model =
+ (
+ model,
+ (case (Comm.SendRecovery.try model) of
+ (Just cmd) -> cmd
+ Nothing -> Cmd.none
+ )
+ )
+
diff --git a/src/login/src/View/AccountRecovery.elm b/src/login/src/View/AccountRecovery.elm
index 0004053..5010bb1 100644
--- a/src/login/src/View/AccountRecovery.elm
+++ b/src/login/src/View/AccountRecovery.elm
@@ -7,6 +7,7 @@ import Html.Events
-- Map -------------------------------------------------------------------
import Struct.Event
+import Struct.Model
import Struct.UI
--------------------------------------------------------------------------------
@@ -16,8 +17,8 @@ import Struct.UI
--------------------------------------------------------------------------------
-- EXPORTED --------------------------------------------------------------------
--------------------------------------------------------------------------------
-get_html : (Html.Html Struct.Event.Type)
-get_html =
+get_html : Struct.Model.Type -> (Html.Html Struct.Event.Type)
+get_html model =
(Html.article
[]
[
@@ -27,12 +28,23 @@ get_html =
]
[
(Html.h1 [] [(Html.text "Email")]),
- (Html.input [] [])
+ (Html.input
+ [
+ (Html.Events.onInput Struct.Event.SetEmail1),
+ (Html.Attributes.value model.email1)
+ ]
+ [
+ ]
+ )
]
),
(Html.button
- []
- [ (Html.text "Send") ]
+ [
+ (Html.Events.onClick Struct.Event.RecoveryRequested)
+ ]
+ [
+ (Html.text "Send")
+ ]
)
]
)
diff --git a/src/login/src/View/Header.elm.m4 b/src/login/src/View/Header.elm.m4
index 81ac132..c14e1d5 100644
--- a/src/login/src/View/Header.elm.m4
+++ b/src/login/src/View/Header.elm.m4
@@ -16,7 +16,7 @@ link_html : String -> String -> Bool -> (Html.Html Struct.Event.Type)
link_html src label is_active =
(Html.a
[
- (Html.Attributes.src src)
+ (Html.Attributes.href src)
]
[
(
@@ -54,11 +54,18 @@ get_html =
(Html.Attributes.class "main-server-logo")
]
[
- (Html.img
+ (Html.a
[
- (Html.Attributes.src "__CONF_SERVER_LOGO")
+ (Html.Attributes.href "__CONF_SERVER_URL")
]
[
+ (Html.img
+ [
+ (Html.Attributes.src "__CONF_SERVER_LOGO")
+ ]
+ [
+ ]
+ )
]
)
]
diff --git a/src/login/src/View/SignIn.elm b/src/login/src/View/SignIn.elm
index 2c24526..d758263 100644
--- a/src/login/src/View/SignIn.elm
+++ b/src/login/src/View/SignIn.elm
@@ -7,6 +7,7 @@ import Html.Events
-- Map -------------------------------------------------------------------
import Struct.Event
+import Struct.Model
import Struct.UI
--------------------------------------------------------------------------------
@@ -16,8 +17,8 @@ import Struct.UI
--------------------------------------------------------------------------------
-- EXPORTED --------------------------------------------------------------------
--------------------------------------------------------------------------------
-get_html : (Html.Html Struct.Event.Type)
-get_html =
+get_html : Struct.Model.Type -> (Html.Html Struct.Event.Type)
+get_html model =
(Html.article
[]
[
@@ -26,8 +27,15 @@ get_html =
(Html.Attributes.class "user-input")
]
[
- (Html.h1 [] [(Html.text "Username")]),
- (Html.input [] [])
+ (Html.h1 [] [ (Html.text "Username") ]),
+ (Html.input
+ [
+ (Html.Events.onInput Struct.Event.SetUsername),
+ (Html.Attributes.value model.username)
+ ]
+ [
+ ]
+ )
]
),
(Html.div
@@ -38,15 +46,22 @@ get_html =
(Html.h1 [] [(Html.text "Password")]),
(Html.input
[
- (Html.Attributes.type_ "password")
+ (Html.Attributes.type_ "password"),
+ (Html.Events.onInput Struct.Event.SetPassword1),
+ (Html.Attributes.value model.password1)
+ ]
+ [
]
- []
)
]
),
(Html.button
- []
- [ (Html.text "Send") ]
+ [
+ (Html.Events.onClick Struct.Event.SignInRequested)
+ ]
+ [
+ (Html.text "Send")
+ ]
)
]
)
diff --git a/src/login/src/View/SignUp.elm b/src/login/src/View/SignUp.elm
index 3737fed..fe7a8a3 100644
--- a/src/login/src/View/SignUp.elm
+++ b/src/login/src/View/SignUp.elm
@@ -7,6 +7,7 @@ import Html.Events
-- Map -------------------------------------------------------------------
import Struct.Event
+import Struct.Model
import Struct.UI
--------------------------------------------------------------------------------
@@ -16,8 +17,8 @@ import Struct.UI
--------------------------------------------------------------------------------
-- EXPORTED --------------------------------------------------------------------
--------------------------------------------------------------------------------
-get_html : (Html.Html Struct.Event.Type)
-get_html =
+get_html : Struct.Model.Type -> (Html.Html Struct.Event.Type)
+get_html model =
(Html.article
[]
[
@@ -27,7 +28,14 @@ get_html =
]
[
(Html.h1 [] [(Html.text "Username")]),
- (Html.input [] [])
+ (Html.input
+ [
+ (Html.Events.onInput Struct.Event.SetUsername),
+ (Html.Attributes.value model.username)
+ ]
+ [
+ ]
+ )
]
),
(Html.p
@@ -69,15 +77,26 @@ get_html =
[
(Html.input
[
- (Html.Attributes.type_ "password")
+ (Html.Attributes.type_ "password"),
+ (Html.Events.onInput Struct.Event.SetPassword1),
+ (Html.Attributes.value model.password1)
+ ]
+ [
]
- []
),
(Html.input
[
- (Html.Attributes.type_ "password")
+ (Html.Attributes.type_ "password"),
+ (Html.Events.onInput Struct.Event.SetPassword2),
+ (Html.Attributes.value model.password2),
+ (
+ if (model.password1 == model.password2)
+ then (Html.Attributes.class "correct")
+ else (Html.Attributes.class "incorrect")
+ )
+ ]
+ [
]
- []
)
]
)
@@ -107,13 +126,24 @@ get_html =
[
(Html.input
[
+ (Html.Events.onInput Struct.Event.SetEmail1),
+ (Html.Attributes.value model.email1)
+ ]
+ [
]
- []
),
(Html.input
[
+ (Html.Events.onInput Struct.Event.SetEmail2),
+ (Html.Attributes.value model.email2),
+ (
+ if (model.email1 == model.email2)
+ then (Html.Attributes.class "correct")
+ else (Html.Attributes.class "incorrect")
+ )
+ ]
+ [
]
- []
)
]
)
@@ -137,8 +167,12 @@ get_html =
]
),
(Html.button
- []
- [ (Html.text "Send") ]
+ [
+ (Html.Events.onClick Struct.Event.SignUpRequested)
+ ]
+ [
+ (Html.text "Send")
+ ]
)
]
)