Using persona to validate emails

63 files changed, 431 insertions, 424 deletions

diff --git a/src/client/Main.elm b/src/client/Main.elm
deleted file mode 100644
index 4f96675..0000000
--- a/src/client/Main.elm
+++ /dev/null
@@ -1,101 +0,0 @@
-module Main
-  ( main
-  ) where
-
-import Graphics.Element exposing (..)
-
-import Html exposing (Html)
-
-import Http
-import Task exposing (..)
-import Time exposing (..)
-import Json.Decode as Json exposing ((:=))
-import Dict
-
-import Model exposing (Model, initialModel)
-import Model.User exposing (Users, usersDecoder, UserId, userIdDecoder)
-import Model.Payment exposing (Payments, paymentsDecoder, perPage)
-import Model.Payer exposing (Payers, payersDecoder)
-import Model.Translations exposing (..)
-import Model.Config exposing (..)
-
-import Update exposing (Action(..), actions, updateModel)
-import Update.SignIn exposing (..)
-
-import View.Page exposing (renderPage)
-
-import ServerCommunication exposing (serverCommunications, sendRequest)
-
-main : Signal Html
-main = Signal.map renderPage model
-
-model : Signal Model
-model = Signal.foldp updateModel (initialModel initialTime translations config) update
-
-update : Signal Action
-update = Signal.mergeMany
-  [ Signal.map UpdateTime (Time.every 1000)
-  , actions.signal
-  ]
-
----------------------------------------
-
-port signInError : Maybe String
-
----------------------------------------
-
-port initialTime : Time
-
----------------------------------------
-
-port translations : String
-
----------------------------------------
-
-port config : String
-
----------------------------------------
-
-port initView : Task Http.Error ()
-port initView =
-  case signInError of
-    Just msg ->
-      Signal.send actions.address (SignInError msg)
-    Nothing ->
-      Task.onError goLoggedInView (\_ -> Signal.send actions.address GoSignInView)
-
-goLoggedInView : Task Http.Error ()
-goLoggedInView =
-  Task.andThen getUsers <| \users ->
-  Task.andThen whoAmI <| \me ->
-  Task.andThen getMonthlyPayments <| \monthlyPayments ->
-  Task.andThen getPayments <| \payments ->
-  Task.andThen getPaymentsCount <| \paymentsCount ->
-  Task.andThen getPayers <| \payers ->
-    Signal.send actions.address (GoLoggedInView users me monthlyPayments payments paymentsCount payers)
-
-getUsers : Task Http.Error Users
-getUsers = Http.get usersDecoder "/users"
-
-whoAmI : Task Http.Error UserId
-whoAmI = Http.get ("id" := userIdDecoder) "/whoAmI"
-
-getMonthlyPayments : Task Http.Error Payments
-getMonthlyPayments = Http.get paymentsDecoder "/monthlyPayments"
-
-getPayments : Task Http.Error Payments
-getPayments = Http.get paymentsDecoder ("/payments?page=1&perPage=" ++ toString perPage)
-
-getPaymentsCount : Task Http.Error Int
-getPaymentsCount = Http.get ("number" := Json.int) "/payments/count"
-
-getPayers : Task Http.Error Payers
-getPayers = Http.get payersDecoder "/payers"
-
----------------------------------------
-
-port serverCommunicationsPort : Signal (Task Http.RawError ())
-port serverCommunicationsPort =
-  Signal.map
-    (\comm -> sendRequest comm `Task.andThen` (Signal.send actions.address))
-    serverCommunications.signal
diff --git a/src/client/ServerCommunication.elm b/src/client/ServerCommunication.elm
deleted file mode 100644
index 55bf947..0000000
--- a/src/client/ServerCommunication.elm
+++ /dev/null
@@ -1,143 +0,0 @@
-module ServerCommunication
-  ( Communication(..)
-  , sendRequest
-  , serverCommunications
-  ) where
-
-import Signal
-import Task as Task exposing (Task)
-import Http
-import Json.Decode exposing (..)
-import Date
-import Time exposing (Time)
-
-import Model.User exposing (UserId)
-import Model.Payment exposing (..)
-import Model.View.LoggedIn.Add exposing (Frequency(..))
-
-import Update as U
-import Update.SignIn exposing (..)
-import Update.LoggedIn as UL
-import Update.LoggedIn.Monthly as UM
-import Update.LoggedIn.Account as UA
-
-type Communication =
-  NoCommunication
-  | SignIn String
-  | AddPayment UserId String Int
-  | AddMonthlyPayment String Int
-  | SetIncome Time Int
-  | DeletePayment Payment Int
-  | DeleteMonthlyPayment PaymentId
-  | UpdatePage Int
-  | SignOut
-
-serverCommunications : Signal.Mailbox Communication
-serverCommunications = Signal.mailbox NoCommunication
-
-sendRequest : Communication -> Task Http.RawError U.Action
-sendRequest communication =
-  case getRequest communication of
-    Nothing ->
-      Task.succeed U.NoOp
-    Just request ->
-      Http.send Http.defaultSettings request
-        |> flip Task.andThen (serverResult communication)
-
-getRequest : Communication -> Maybe Http.Request
-getRequest communication =
-  case communication of
-    NoCommunication                -> Nothing
-    SignIn login                   -> Just (simple "post" ("/signIn?login=" ++ login))
-    AddPayment userId name cost    -> Just (addPaymentRequest name cost Punctual)
-    AddMonthlyPayment name cost    -> Just (addPaymentRequest name cost Monthly)
-    SetIncome _ amount               -> Just (simple "post" ("/income?amount=" ++ (toString amount)))
-    DeletePayment payment _  -> Just (deletePaymentRequest payment.id)
-    DeleteMonthlyPayment paymentId -> Just (deletePaymentRequest paymentId)
-    UpdatePage page                -> Just (updatePageRequest page)
-    SignOut                        -> Just (simple "post"  "/signOut")
-
-addPaymentRequest : String -> Int -> Frequency -> Http.Request
-addPaymentRequest name cost frequency =
-  simple "post" ("/payment/add?name=" ++ name ++ "&cost=" ++ (toString cost) ++ "&frequency=" ++ (toString frequency))
-
-deletePaymentRequest : PaymentId -> Http.Request
-deletePaymentRequest id =
-  simple "post" ("payment/delete?id=" ++ (toString id))
-
-updatePageRequest : Int -> Http.Request
-updatePageRequest page =
-  simple "get" ("payments?page=" ++ toString page ++ "&perPage=" ++ toString perPage)
-
-simple : String -> String -> Http.Request
-simple method url =
-  { verb = method
-  , headers = []
-  , url = url
-  , body = Http.empty
-  }
-
-serverResult : Communication -> Http.Response -> Task Http.RawError U.Action
-serverResult communication response =
-  case response.status of
-    200 ->
-      case communication of
-        NoCommunication ->
-          Task.succeed U.NoOp
-        SignIn login ->
-          Task.succeed << U.UpdateSignIn <| ValidLogin login
-        AddPayment userId name cost ->
-          Http.send Http.defaultSettings (updatePageRequest 1)
-            |> flip Task.andThen (decodeOkResponse paymentsDecoder (\payments ->
-                 Task.succeed <| U.UpdateLoggedIn (UL.AddPayment userId name cost payments)
-               ))
-        AddMonthlyPayment name cost ->
-          decodeResponse
-            ("id" := paymentIdDecoder)
-            (\id -> Task.succeed <| U.UpdateLoggedIn (UL.AddMonthlyPayment id name cost))
-            response
-        SetIncome currentTime amount ->
-          Task.succeed <| U.UpdateLoggedIn (UL.UpdateAccount (UA.UpdateIncome currentTime amount))
-        DeletePayment payment currentPage ->
-          Http.send Http.defaultSettings (updatePageRequest currentPage)
-            |> flip Task.andThen (decodeOkResponse paymentsDecoder (\payments ->
-                 Task.succeed <| U.UpdateLoggedIn (UL.DeletePayment payment payments)
-               ))
-        DeleteMonthlyPayment id ->
-          Task.succeed <| U.UpdateLoggedIn (UL.UpdateMonthly (UM.DeletePayment id))
-        UpdatePage page ->
-          decodeResponse
-            paymentsDecoder
-            (\payments -> Task.succeed <| U.UpdateLoggedIn (UL.UpdatePage page payments))
-            response
-        SignOut ->
-          Task.succeed (U.GoSignInView)
-    errorStatus ->
-      case communication of
-        SignIn _ ->
-          decodeResponse
-            ("error" := string)
-            (\error ->
-              Task.succeed <| U.UpdateSignIn (ErrorLogin error)
-            )
-            response
-        _ ->
-          Task.succeed <| U.NoOp
-
-decodeOkResponse : Decoder a -> (a -> Task b U.Action) -> Http.Response -> Task b U.Action
-decodeOkResponse decoder responseToAction response =
-  if response.status == 200
-    then decodeResponse decoder responseToAction response
-    else Task.succeed U.NoOp
-
-decodeResponse : Decoder a -> (a -> Task b U.Action) -> Http.Response -> Task b U.Action
-decodeResponse decoder responseToAction response =
-  case response.value of
-    Http.Text text ->
-      case decodeString decoder text of
-        Ok x ->
-          responseToAction x
-        Err _ ->
-          Task.succeed U.NoOp
-    Http.Blob _ ->
-      Task.succeed U.NoOp
diff --git a/src/client/elm/InitViewAction.elm b/src/client/elm/InitViewAction.elm
new file mode 100644
index 0000000..7c353a7
--- /dev/null
+++ b/src/client/elm/InitViewAction.elm
@@ -0,0 +1,25 @@
+module InitViewAction
+  ( initViewAction
+  ) where
+
+import Task exposing (..)
+import Http
+import Json.Decode as Json exposing ((:=))
+
+import Update exposing (Action(GoLoggedInView, GoSignInView))
+
+import Model.Payment exposing (Payments, paymentsDecoder, perPage)
+import Model.Payer exposing (Payers, payersDecoder)
+import Model.User exposing (Users, usersDecoder, UserId, userIdDecoder)
+
+initViewAction : Task Http.Error Action
+initViewAction = Task.onError loggedInView (always <| Task.succeed GoSignInView)
+
+loggedInView : Task Http.Error Action
+loggedInView =
+  Task.map GoLoggedInView (Http.get usersDecoder "/users")
+    `Task.andMap` (Http.get ("id" := userIdDecoder) "/whoAmI")
+    `Task.andMap` (Http.get paymentsDecoder "/monthlyPayments")
+    `Task.andMap` (Http.get paymentsDecoder ("/payments?page=1&perPage=" ++ toString perPage))
+    `Task.andMap` (Http.get ("number" := Json.int) "/payments/count")
+    `Task.andMap` (Http.get payersDecoder "/payers")
diff --git a/src/client/elm/Main.elm b/src/client/elm/Main.elm
new file mode 100644
index 0000000..f79d6a0
--- /dev/null
+++ b/src/client/elm/Main.elm
@@ -0,0 +1,89 @@
+module Main
+  ( main
+  ) where
+
+import Graphics.Element exposing (..)
+
+import Html exposing (Html)
+
+import Http
+import Task exposing (..)
+import Time exposing (..)
+import Json.Decode as Json
+import Dict
+import String
+
+import Model exposing (Model, initialModel)
+import Model.Translations exposing (..)
+import Model.Config exposing (..)
+
+import Update exposing (Action(..), actions, updateModel)
+import Update.SignIn exposing (..)
+
+import View.Page exposing (renderPage)
+
+import ServerCommunication as SC exposing (serverCommunications, sendRequest)
+
+import Persona as Persona exposing (operations)
+
+import InitViewAction exposing (initViewAction)
+
+import Sign
+
+main : Signal Html
+main = Signal.map renderPage model
+
+model : Signal Model
+model = Signal.foldp updateModel (initialModel initialTime translations config) update
+
+update : Signal Action
+update = Signal.mergeMany
+  [ Signal.map UpdateTime (Time.every 1000)
+  , actions.signal
+  ]
+
+---------------------------------------
+
+port initialTime : Time
+
+---------------------------------------
+
+port translations : String
+
+---------------------------------------
+
+port config : String
+
+---------------------------------------
+
+port ready : Signal String
+port ready = Signal.constant "ready"
+
+---------------------------------------
+
+port initView : Task Http.Error ()
+port initView = initViewAction `Task.andThen` (Signal.send actions.address)
+
+---------------------------------------
+
+port serverCommunicationsPort : Signal (Task Http.Error ())
+port serverCommunicationsPort =
+  Signal.map
+    (\comm ->
+      sendRequest comm
+        |> flip Task.andThen (\action -> Signal.send actions.address action)
+    )
+    (Signal.merge signCommunication serverCommunications.signal)
+
+---------------------------------------
+
+port persona : Signal String
+port persona = Signal.map Persona.toString operations.signal
+
+---------------------------------------
+
+port sign : Signal Json.Value
+
+signCommunication : Signal SC.Communication
+signCommunication =
+  Signal.map (Sign.toServerCommunication << Sign.decodeOperation) sign
diff --git a/src/client/Model.elm b/src/client/elm/Model.elm
index 43a19c5..43a19c5 100644
--- a/src/client/Model.elm
+++ b/src/client/elm/Model.elm
diff --git a/src/client/Model/Config.elm b/src/client/elm/Model/Config.elm
index e47b032..e47b032 100644
--- a/src/client/Model/Config.elm
+++ b/src/client/elm/Model/Config.elm
diff --git a/src/client/Model/Date.elm b/src/client/elm/Model/Date.elm
index 1c56de4..1c56de4 100644
--- a/src/client/Model/Date.elm
+++ b/src/client/elm/Model/Date.elm
diff --git a/src/client/Model/Income.elm b/src/client/elm/Model/Income.elm
index 97a5652..97a5652 100644
--- a/src/client/Model/Income.elm
+++ b/src/client/elm/Model/Income.elm
diff --git a/src/client/Model/Payer.elm b/src/client/elm/Model/Payer.elm
index 9fd1bb5..9fd1bb5 100644
--- a/src/client/Model/Payer.elm
+++ b/src/client/elm/Model/Payer.elm
diff --git a/src/client/Model/Payment.elm b/src/client/elm/Model/Payment.elm
index c4a8963..c4a8963 100644
--- a/src/client/Model/Payment.elm
+++ b/src/client/elm/Model/Payment.elm
diff --git a/src/client/Model/Translations.elm b/src/client/elm/Model/Translations.elm
index bec8c9b..bec8c9b 100644
--- a/src/client/Model/Translations.elm
+++ b/src/client/elm/Model/Translations.elm
diff --git a/src/client/Model/User.elm b/src/client/elm/Model/User.elm
index 1412913..1412913 100644
--- a/src/client/Model/User.elm
+++ b/src/client/elm/Model/User.elm
diff --git a/src/client/Model/View.elm b/src/client/elm/Model/View.elm
index 90c0e53..90c0e53 100644
--- a/src/client/Model/View.elm
+++ b/src/client/elm/Model/View.elm
diff --git a/src/client/Model/View/LoggedIn/Account.elm b/src/client/elm/Model/View/LoggedIn/Account.elm
index 2bb3ae7..2bb3ae7 100644
--- a/src/client/Model/View/LoggedIn/Account.elm
+++ b/src/client/elm/Model/View/LoggedIn/Account.elm
diff --git a/src/client/Model/View/LoggedIn/Add.elm b/src/client/elm/Model/View/LoggedIn/Add.elm
index 5598084..5598084 100644
--- a/src/client/Model/View/LoggedIn/Add.elm
+++ b/src/client/elm/Model/View/LoggedIn/Add.elm
diff --git a/src/client/Model/View/LoggedIn/Edition.elm b/src/client/elm/Model/View/LoggedIn/Edition.elm
index da6d7b0..da6d7b0 100644
--- a/src/client/Model/View/LoggedIn/Edition.elm
+++ b/src/client/elm/Model/View/LoggedIn/Edition.elm
diff --git a/src/client/Model/View/LoggedIn/Monthly.elm b/src/client/elm/Model/View/LoggedIn/Monthly.elm
index 3c6f66a..3c6f66a 100644
--- a/src/client/Model/View/LoggedIn/Monthly.elm
+++ b/src/client/elm/Model/View/LoggedIn/Monthly.elm
diff --git a/src/client/Model/View/LoggedInView.elm b/src/client/elm/Model/View/LoggedInView.elm
index 122c4be..122c4be 100644
--- a/src/client/Model/View/LoggedInView.elm
+++ b/src/client/elm/Model/View/LoggedInView.elm
diff --git a/src/client/Model/View/SignInView.elm b/src/client/elm/Model/View/SignInView.elm
index 0fbce39..0fbce39 100644
--- a/src/client/Model/View/SignInView.elm
+++ b/src/client/elm/Model/View/SignInView.elm
diff --git a/src/client/Native/Reads.js b/src/client/elm/Native/Reads.js
index 5785aed..5785aed 100644
--- a/src/client/Native/Reads.js
+++ b/src/client/elm/Native/Reads.js
diff --git a/src/client/elm/Persona.elm b/src/client/elm/Persona.elm
new file mode 100644
index 0000000..51b5fc6
--- /dev/null
+++ b/src/client/elm/Persona.elm
@@ -0,0 +1,28 @@
+module Persona
+  ( Operation(..)
+  , operations
+  , fromString
+  , toString
+  ) where
+
+type Operation =
+  NoOp
+  | SignIn
+  | SignOut
+
+operations : Signal.Mailbox Operation
+operations = Signal.mailbox NoOp
+
+fromString : String -> Operation
+fromString str =
+  case str of
+    "SignIn" -> SignIn
+    "SignOut" -> SignOut
+    _ -> NoOp
+
+toString : Operation -> String
+toString operation =
+  case operation of
+    SignIn -> "SignIn"
+    SignOut -> "SignOut"
+    _ -> "NoOp"
diff --git a/src/client/Reads.elm b/src/client/elm/Reads.elm
index f855802..f855802 100644
--- a/src/client/Reads.elm
+++ b/src/client/elm/Reads.elm
diff --git a/src/client/elm/ServerCommunication.elm b/src/client/elm/ServerCommunication.elm
new file mode 100644
index 0000000..70612cb
--- /dev/null
+++ b/src/client/elm/ServerCommunication.elm
@@ -0,0 +1,95 @@
+module ServerCommunication
+  ( Communication(..)
+  , sendRequest
+  , serverCommunications
+  ) where
+
+import Signal
+import Task as Task exposing (Task)
+import Http
+import Json.Decode exposing (..)
+import Date
+import Time exposing (Time)
+import Debug
+
+import SimpleHTTP exposing (..)
+
+import Model.User exposing (UserId)
+import Model.Payment exposing (..)
+import Model.View.LoggedIn.Add exposing (Frequency(..))
+
+import Update as U
+import Update.SignIn exposing (..)
+import Update.LoggedIn as UL
+import Update.LoggedIn.Monthly as UM
+import Update.LoggedIn.Account as UA
+
+import InitViewAction exposing (initViewAction)
+
+type Communication =
+  NoCommunication
+  | SignIn String
+  | AddPayment UserId String Int
+  | AddMonthlyPayment String Int
+  | SetIncome Time Int
+  | DeletePayment Payment Int
+  | DeleteMonthlyPayment PaymentId
+  | UpdatePage Int
+  | SignOut
+
+serverCommunications : Signal.Mailbox Communication
+serverCommunications = Signal.mailbox NoCommunication
+
+sendRequest : Communication -> Task Http.Error U.Action
+sendRequest communication =
+  case communication of
+
+    NoCommunication ->
+      Task.succeed U.NoOp
+
+    SignIn assertion ->
+      post ("/signIn?assertion=" ++ assertion)
+        |> flip Task.andThen (always initViewAction)
+
+    AddPayment userId name cost ->
+      post (addPaymentURL name cost Punctual)
+        |> flip Task.andThen (always (getPaymentsAtPage 1))
+        |> Task.map (\payments -> U.UpdateLoggedIn (UL.AddPayment userId name cost payments))
+
+    AddMonthlyPayment name cost ->
+      post (addPaymentURL name cost Monthly)
+        |> flip Task.andThen (decodeHttpValue <| "id" := paymentIdDecoder)
+        |> Task.map (\id -> U.UpdateLoggedIn (UL.AddMonthlyPayment id name cost))
+
+    DeletePayment payment currentPage ->
+      post (deletePaymentURL payment.id)
+        |> flip Task.andThen (always (getPaymentsAtPage currentPage))
+        |> Task.map (\payments -> U.UpdateLoggedIn (UL.DeletePayment payment payments))
+
+    DeleteMonthlyPayment id ->
+      post (deletePaymentURL id)
+        |> Task.map (always (U.UpdateLoggedIn (UL.UpdateMonthly (UM.DeletePayment id))))
+
+    UpdatePage page ->
+      getPaymentsAtPage page
+        |> flip Task.andThen (Task.succeed << U.UpdateLoggedIn << UL.UpdatePage page)
+
+    SetIncome currentTime amount ->
+      post ("/income?amount=" ++ (toString amount))
+        |> Task.map (always (U.UpdateLoggedIn (UL.UpdateAccount (UA.UpdateIncome currentTime amount))))
+
+    SignOut ->
+      post "/signOut"
+        |> Task.map (always U.GoSignInView)
+
+getPaymentsAtPage : Int -> Task Http.Error Payments
+getPaymentsAtPage page =
+  Http.get paymentsDecoder ("payments?page=" ++ toString page ++ "&perPage=" ++ toString perPage)
+
+addPaymentURL : String -> Int -> Frequency -> String
+addPaymentURL name cost frequency =
+  "/payment/add?name=" ++ name ++ "&cost=" ++ (toString cost) ++ "&frequency=" ++ (toString frequency)
+
+deletePaymentURL : PaymentId -> String
+deletePaymentURL id =
+  "payment/delete?id=" ++ (toString id)
diff --git a/src/client/elm/Sign.elm b/src/client/elm/Sign.elm
new file mode 100644
index 0000000..44f23b8
--- /dev/null
+++ b/src/client/elm/Sign.elm
@@ -0,0 +1,43 @@
+module Sign
+  ( Operation(..)
+  , decodeOperation
+  , toServerCommunication
+  ) where
+
+import Json.Decode as Json
+import Json.Decode exposing (Value, Decoder, (:=))
+import Maybe
+
+import ServerCommunication as SC
+
+type Operation =
+  NoOp
+  | SignIn String
+  | SignOut
+
+decodeOperation : Value -> Operation
+decodeOperation value =
+  Json.decodeValue operationDecoder value
+    |> Result.toMaybe
+    |> Maybe.withDefault NoOp
+
+toServerCommunication : Operation -> SC.Communication
+toServerCommunication operation =
+  case operation of
+    NoOp -> SC.NoCommunication
+    SignIn assertion -> SC.SignIn assertion
+    SignOut -> SC.SignOut
+
+operationDecoder : Decoder Operation
+operationDecoder =
+  ("operation" := Json.string) `Json.andThen` operationDecoderWithTag
+
+operationDecoderWithTag : String -> Decoder Operation
+operationDecoderWithTag operation =
+  case operation of
+    "SignIn" ->
+      Json.map SignIn ("assertion" := Json.string)
+    "SignOut" ->
+      Json.succeed SignOut
+    _ ->
+      Json.succeed NoOp
diff --git a/src/client/elm/SimpleHTTP.elm b/src/client/elm/SimpleHTTP.elm
new file mode 100644
index 0000000..99a7056
--- /dev/null
+++ b/src/client/elm/SimpleHTTP.elm
@@ -0,0 +1,41 @@
+module SimpleHTTP
+  ( post
+  , decodeHttpValue
+  ) where
+
+import Http exposing (..)
+import Task exposing (..)
+import Json.Decode as Json exposing (Decoder)
+
+post : String -> Task Error Value
+post url =
+  { verb = "POST"
+  , headers = []
+  , url = url
+  , body = empty
+  }
+    |> Http.send defaultSettings
+    |> mapError promoteError
+    |> flip Task.andThen handleResponse
+
+handleResponse : Response -> Task Error Value
+handleResponse response =
+  if 200 <= response.status && response.status < 300
+    then Task.succeed response.value
+    else fail (BadResponse response.status response.statusText)
+
+promoteError : RawError -> Error
+promoteError rawError =
+  case rawError of
+    RawTimeout -> Timeout
+    RawNetworkError -> NetworkError
+
+decodeHttpValue : Decoder a -> Value -> Task Error a
+decodeHttpValue decoder value =
+  case value of
+    Text str ->
+      case Json.decodeString decoder str of
+        Ok v -> succeed v
+        Err msg -> fail (UnexpectedPayload msg)
+    _ ->
+      fail (UnexpectedPayload "Response body is a blob, expecting a string.")
diff --git a/src/client/Update.elm b/src/client/elm/Update.elm
index 3c4614a..3c4614a 100644
--- a/src/client/Update.elm
+++ b/src/client/elm/Update.elm
diff --git a/src/client/Update/LoggedIn.elm b/src/client/elm/Update/LoggedIn.elm
index e477094..e477094 100644
--- a/src/client/Update/LoggedIn.elm
+++ b/src/client/elm/Update/LoggedIn.elm
diff --git a/src/client/Update/LoggedIn/Account.elm b/src/client/elm/Update/LoggedIn/Account.elm
index cf4c834..cf4c834 100644
--- a/src/client/Update/LoggedIn/Account.elm
+++ b/src/client/elm/Update/LoggedIn/Account.elm
diff --git a/src/client/Update/LoggedIn/Add.elm b/src/client/elm/Update/LoggedIn/Add.elm
index 1f28997..1f28997 100644
--- a/src/client/Update/LoggedIn/Add.elm
+++ b/src/client/elm/Update/LoggedIn/Add.elm
diff --git a/src/client/Update/LoggedIn/Monthly.elm b/src/client/elm/Update/LoggedIn/Monthly.elm
index 1379323..1379323 100644
--- a/src/client/Update/LoggedIn/Monthly.elm
+++ b/src/client/elm/Update/LoggedIn/Monthly.elm
diff --git a/src/client/Update/SignIn.elm b/src/client/elm/Update/SignIn.elm
index 0aa7c84..cabe4cb 100644
--- a/src/client/Update/SignIn.elm
+++ b/src/client/elm/Update/SignIn.elm
@@ -6,19 +6,10 @@ module Update.SignIn
 import Model.View.SignInView exposing (..)
 
 type SignInAction =
-  UpdateLogin String
-  | ValidLogin String
-  | ErrorLogin String
+  ErrorLogin String
 
 updateSignIn : SignInAction -> SignInView -> SignInView
 updateSignIn action signInView =
   case action of
-    UpdateLogin login ->
-      { signInView | login <- login }
-    ValidLogin message ->
-      { signInView
-      | login <- ""
-      , result <- Just (Ok message)
-      }
     ErrorLogin message ->
       { signInView | result <- Just (Err message) }
diff --git a/src/client/Utils/Dict.elm b/src/client/elm/Utils/Dict.elm
index dc01b17..dc01b17 100644
--- a/src/client/Utils/Dict.elm
+++ b/src/client/elm/Utils/Dict.elm
diff --git a/src/client/Utils/Either.elm b/src/client/elm/Utils/Either.elm
index 10c40e3..10c40e3 100644
--- a/src/client/Utils/Either.elm
+++ b/src/client/elm/Utils/Either.elm
diff --git a/src/client/Utils/Maybe.elm b/src/client/elm/Utils/Maybe.elm
index d954ae0..d954ae0 100644
--- a/src/client/Utils/Maybe.elm
+++ b/src/client/elm/Utils/Maybe.elm
diff --git a/src/client/Utils/Validation.elm b/src/client/elm/Utils/Validation.elm
index b9bccb3..b9bccb3 100644
--- a/src/client/Utils/Validation.elm
+++ b/src/client/elm/Utils/Validation.elm
diff --git a/src/client/View/Date.elm b/src/client/elm/View/Date.elm
index 81c5112..81c5112 100644
--- a/src/client/View/Date.elm
+++ b/src/client/elm/View/Date.elm
diff --git a/src/client/View/Events.elm b/src/client/elm/View/Events.elm
index 1eb9027..1eb9027 100644
--- a/src/client/View/Events.elm
+++ b/src/client/elm/View/Events.elm
diff --git a/src/client/View/Expand.elm b/src/client/elm/View/Expand.elm
index 53b4fe5..53b4fe5 100644
--- a/src/client/View/Expand.elm
+++ b/src/client/elm/View/Expand.elm
diff --git a/src/client/View/Header.elm b/src/client/elm/View/Header.elm
index 9d31183..3a6241b 100644
--- a/src/client/View/Header.elm
+++ b/src/client/elm/View/Header.elm
@@ -6,8 +6,7 @@ import Html exposing (..)
 import Html.Attributes exposing (..)
 import Html.Events exposing (..)
 
-import ServerCommunication as SC
-import ServerCommunication exposing (serverCommunications)
+import Persona exposing (operations)
 
 import Model exposing (Model)
 import Model.View exposing (..)
@@ -26,11 +25,15 @@ renderHeader model =
         LoadingView ->
           text ""
         SignInView _ ->
-          text ""
+          button
+            [ class "icon"
+            , onClick operations.address Persona.SignIn
+            ]
+            [ renderIcon "sign-in" ]
         LoggedInView _ ->
           button
-            [ class "signOut"
-            , onClick serverCommunications.address SC.SignOut
+            [ class "icon"
+            , onClick operations.address Persona.SignOut
             ]
-            [ renderIcon "power-off" ]
+            [ renderIcon "sign-out" ]
     ]
diff --git a/src/client/View/Icon.elm b/src/client/elm/View/Icon.elm
index f22c1a2..f22c1a2 100644
--- a/src/client/View/Icon.elm
+++ b/src/client/elm/View/Icon.elm
diff --git a/src/client/View/Loading.elm b/src/client/elm/View/Loading.elm
index f8c6cd6..f8c6cd6 100644
--- a/src/client/View/Loading.elm
+++ b/src/client/elm/View/Loading.elm
diff --git a/src/client/View/LoggedIn.elm b/src/client/elm/View/LoggedIn.elm
index 96916e0..96916e0 100644
--- a/src/client/View/LoggedIn.elm
+++ b/src/client/elm/View/LoggedIn.elm
diff --git a/src/client/View/LoggedIn/Account.elm b/src/client/elm/View/LoggedIn/Account.elm
index 706f7cc..706f7cc 100644
--- a/src/client/View/LoggedIn/Account.elm
+++ b/src/client/elm/View/LoggedIn/Account.elm
diff --git a/src/client/View/LoggedIn/Add.elm b/src/client/elm/View/LoggedIn/Add.elm
index 572bdf6..572bdf6 100644
--- a/src/client/View/LoggedIn/Add.elm
+++ b/src/client/elm/View/LoggedIn/Add.elm
diff --git a/src/client/View/LoggedIn/Monthly.elm b/src/client/elm/View/LoggedIn/Monthly.elm
index a274015..a274015 100644
--- a/src/client/View/LoggedIn/Monthly.elm
+++ b/src/client/elm/View/LoggedIn/Monthly.elm
diff --git a/src/client/View/LoggedIn/Paging.elm b/src/client/elm/View/LoggedIn/Paging.elm
index 93d7f1d..93d7f1d 100644
--- a/src/client/View/LoggedIn/Paging.elm
+++ b/src/client/elm/View/LoggedIn/Paging.elm
diff --git a/src/client/View/LoggedIn/Table.elm b/src/client/elm/View/LoggedIn/Table.elm
index f5a08b5..f5a08b5 100644
--- a/src/client/View/LoggedIn/Table.elm
+++ b/src/client/elm/View/LoggedIn/Table.elm
diff --git a/src/client/View/Page.elm b/src/client/elm/View/Page.elm
index 763734d..763734d 100644
--- a/src/client/View/Page.elm
+++ b/src/client/elm/View/Page.elm
diff --git a/src/client/View/Price.elm b/src/client/elm/View/Price.elm
index 286bcaa..286bcaa 100644
--- a/src/client/View/Price.elm
+++ b/src/client/elm/View/Price.elm
diff --git a/src/client/View/SignIn.elm b/src/client/elm/View/SignIn.elm
index 2a6cbca..8fcac16 100644
--- a/src/client/View/SignIn.elm
+++ b/src/client/elm/View/SignIn.elm
@@ -24,18 +24,7 @@ renderSignIn : Model -> SignInView -> Html
 renderSignIn model signInView =
   div
     [ class "signIn" ]
-    [ H.form
-        [ onSubmitPrevDefault serverCommunications.address (SC.SignIn signInView.login) ]
-        [ input
-            [ value signInView.login
-            , on "input" targetValue (Signal.message actions.address << UpdateSignIn << UpdateLogin)
-            ]
-            []
-        , button
-            []
-            [ text (getMessage "SignIn" model.translations)]
-        ]
-    , div
+    [ div
         [ class "result" ]
         [ signInResult model signInView ]
     ]
diff --git a/src/client/js/main.js b/src/client/js/main.js
new file mode 100644
index 0000000..12593e6
--- /dev/null
+++ b/src/client/js/main.js
@@ -0,0 +1,28 @@
+var app = Elm.fullscreen(Elm.Main, {
+  initialTime: new Date().getTime(),
+  translations: document.getElementById('messages').innerHTML,
+  config: document.getElementById('config').innerHTML,
+  sign: null
+});
+
+navigator.id.watch({
+  loggedInUser: null,
+  onlogin: function(assertion) {
+    app.ports.sign.send({
+      operation: 'SignIn',
+      assertion: assertion
+    });
+  },
+  onlogout: function() {}
+});
+
+app.ports.persona.subscribe(function(communication) {
+  if(communication === 'SignIn') {
+    navigator.id.request();
+  } else if(communication === 'SignOut') {
+    navigator.id.logout();
+    app.ports.sign.send({
+      operation: 'SignOut'
+    });
+  }
+});
diff --git a/src/server/Config.hs b/src/server/Config.hs
index bd7f325..37f57ec 100644
--- a/src/server/Config.hs
+++ b/src/server/Config.hs
@@ -18,7 +18,6 @@ import Control.Arrow (left)
 data Config = Config
   { hostname :: Text
   , port :: Int
-  , signInExpirationMn :: Int
   , currency :: Text
   } deriving (Read, Eq, Show)
 
@@ -29,6 +28,5 @@ getConfig filePath =
     Config <$>
       (T.pack <$> get cp "DEFAULT" "hostname") <*>
       (get cp "DEFAULT" "port") <*>
-      (get cp "DEFAULT" "sign-in-expiration-mn") <*>
       (T.pack <$> get cp "DEFAULT" "currency")
   )
diff --git a/src/server/Controller/SignIn.hs b/src/server/Controller/SignIn.hs
index 31cd510..8eceb56 100644
--- a/src/server/Controller/SignIn.hs
+++ b/src/server/Controller/SignIn.hs
@@ -2,32 +2,21 @@
 
 module Controller.SignIn
   ( signIn
-  , validateSignIn
   ) where
 
 import Web.Scotty
 
 import Network.HTTP.Types.Status (ok200)
 
-import Database.Persist
-
 import Control.Monad.IO.Class (liftIO)
 
 import Data.Text (Text)
-import qualified Data.Text as T
-import qualified Data.Text.Lazy as TL
-import qualified Data.Text.Encoding as TE
-import Data.Time.Clock (getCurrentTime, diffUTCTime)
 import Data.Maybe (isJust)
 
 import qualified LoginSession
 
 import Config
 
-import SendMail
-
-import Text.Email.Validate as Email
-
 import Model.Database
 import Model.User
 import Model.SignIn
@@ -36,65 +25,20 @@ import Model.Message (getMessage)
 
 import Json (jsonError)
 
-import Secure (getUserFromToken)
-
-import qualified View.Mail.SignIn as SignIn
+import Persona (verifyEmail)
 
 signIn :: Config -> Text -> ActionM ()
-signIn config login =
-  if Email.isValid (TE.encodeUtf8 login)
-    then do
-      maybeUser <- liftIO . runDb $ getUser login
-      case maybeUser of
-        Just user -> do
-          token <- liftIO . runDb $ createSignInToken login
-          let url = T.concat ["http://", hostname config, "/validateSignIn?token=", token]
-          maybeSentMail <- liftIO . sendMail $ SignIn.getMail (entityVal user) url [login]
-          case maybeSentMail of
-            Right _ ->
-              status ok200
-            Left _ ->
-              jsonError (getMessage SendEmailFail)
-        Nothing ->
-            jsonError (getMessage Unauthorized)
-    else
-      jsonError (getMessage EnterValidEmail)
-
-validateSignIn :: Config -> Text -> ActionM ()
-validateSignIn config textToken = do
-  alreadySigned <- isAlreadySigned
-  if alreadySigned
-    then
-      redirect "/"
-    else do
-      mbSignIn <- liftIO . runDb $ getSignInToken textToken
-      now <- liftIO getCurrentTime
-      case mbSignIn of
-        Just signIn ->
-          if signInIsUsed . entityVal $ signIn
-            then
-              redirectError (getMessage SignInUsed)
-            else
-              let diffTime = now `diffUTCTime` (signInCreation . entityVal $ signIn)
-              in  if diffTime > (fromIntegral $ (signInExpirationMn config) * 60)
-                    then
-                      redirectError (getMessage SignInExpired)
-                    else do
-                      LoginSession.put (signInToken . entityVal $ signIn)
-                      liftIO . runDb . signInTokenToUsed . entityKey $ signIn
-                      redirect "/"
-        Nothing ->
-          redirectError (getMessage SignInInvalid)
-
-isAlreadySigned :: ActionM Bool
-isAlreadySigned = do
-  mbToken <- LoginSession.get
-  case mbToken of
+signIn config assertion = do
+  mbEmail <- liftIO $ verifyEmail config assertion
+  case mbEmail of
     Nothing ->
-      return False
-    Just token -> do
-      liftIO . runDb . fmap isJust $ getUserFromToken token
-
-redirectError :: Text -> ActionM ()
-redirectError msg =
-  redirect . TL.fromStrict . T.concat $ ["/?signInError=", msg]
+      jsonError (getMessage InvalidEmail)
+    Just email -> do
+      isAuthorized <- liftIO . fmap isJust . runDb $ getUser email
+      if isAuthorized
+        then do
+          token <- liftIO . runDb $ createSignInToken email
+          LoginSession.put token
+          status ok200
+        else
+          jsonError (getMessage Unauthorized)
diff --git a/src/server/Design/Header.hs b/src/server/Design/Header.hs
index 7b82577..9f83778 100644
--- a/src/server/Design/Header.hs
+++ b/src/server/Design/Header.hs
@@ -25,7 +25,7 @@ headerDesign =
       marginBottom blockMarginBottom
       paddingLeft sidePercent
 
-    button # ".signOut" ? do
+    button # ".icon" ? do
       let iconHeight = 50
       let sideMargin = ((headerHeight - iconHeight) `Prelude.div` 2)
       position absolute
diff --git a/src/server/Design/SignIn.hs b/src/server/Design/SignIn.hs
index 6bacc3a..7aff720 100644
--- a/src/server/Design/SignIn.hs
+++ b/src/server/Design/SignIn.hs
@@ -15,26 +15,6 @@ signInDesign =
 
   ".signIn" ? do
 
-    opacityAnimation
-
-    form ? do
-      let inputHeight = 50
-      width (px 500)
-      marginTop (px 100)
-      marginLeft auto
-      marginRight auto
-
-      input ? do
-        defaultInput inputHeight
-        display block
-        width (pct 100)
-        marginBottom (px 10)
-
-      button ? do
-        defaultButton C.red C.white (px inputHeight)
-        display block
-        width (pct 100)
-
     ".result" ? do
       marginTop (px 40)
       textAlign (alignSide sideCenter)
diff --git a/src/server/Main.hs b/src/server/Main.hs
index 3d61481..3539120 100644
--- a/src/server/Main.hs
+++ b/src/server/Main.hs
@@ -8,7 +8,7 @@ import Control.Concurrent (forkIO)
 import MonthlyPaymentJob (monthlyPaymentJobListener)
 
 import Data.Text (Text)
-import qualified Data.Text.IO as TIO
+import qualified Data.Text.IO as T
 
 import Controller.Index
 import Controller.SignIn
@@ -28,7 +28,7 @@ main = do
   eitherConfig <- Config.getConfig "config.txt"
   case eitherConfig of
     Left errorMessage ->
-      TIO.putStrLn errorMessage
+      T.putStrLn errorMessage
     Right config -> do
       scotty (Config.port config) $ do
         middleware $
@@ -40,12 +40,8 @@ main = do
         -- SignIn
 
         post "/signIn" $ do
-          login <- param "login" :: ActionM Text
-          signIn config login
-
-        get "/validateSignIn" $ do
-          token <- param "token" :: ActionM Text
-          validateSignIn config token
+          assertion <- param "assertion" :: ActionM Text
+          signIn config assertion
 
         -- Users
 
diff --git a/src/server/Model/Database.hs b/src/server/Model/Database.hs
index 8d1da25..67cc8b3 100644
--- a/src/server/Model/Database.hs
+++ b/src/server/Model/Database.hs
@@ -44,7 +44,6 @@ SignIn
   token Text
   creation UTCTime
   email Text
-  isUsed Bool
   UniqSignInToken token
   deriving Show
 Job
diff --git a/src/server/Model/Message/Key.hs b/src/server/Model/Message/Key.hs
index e9f8ef6..7f49ae7 100644
--- a/src/server/Model/Message/Key.hs
+++ b/src/server/Model/Message/Key.hs
@@ -12,12 +12,8 @@ data Key =
 
   | SharedCost
   | SignIn
-  | SendEmailFail
+  | InvalidEmail
   | Unauthorized
-  | EnterValidEmail
-  | SignInUsed
-  | SignInExpired
-  | SignInInvalid
   | SignInMailTitle
   | SignInMail
   | SignInEmailSent
diff --git a/src/server/Model/Message/Translations.hs b/src/server/Model/Message/Translations.hs
index a2e9a30..29b21ea 100644
--- a/src/server/Model/Message/Translations.hs
+++ b/src/server/Model/Message/Translations.hs
@@ -34,36 +34,16 @@ m l SignIn =
     English -> "Sign in"
     French  -> "Connexion"
 
-m l SendEmailFail =
+m l InvalidEmail =
   case l of
-    English -> "Sorry, we failed to send you the sign up email."
-    French  -> "Désolé, nous n'avons pas pu t'envoyer le courriel de connexion."
+    English -> "Your email is not valid."
+    French  -> "Votre courriel n'est pas valide."
 
 m l Unauthorized =
   case l of
     English -> "You are not authorized to sign in."
     French  -> "Tu n'es pas autorisé à te connecter."
 
-m l EnterValidEmail =
-  case l of
-    English -> "Please enter a valid email address."
-    French  -> "Ton courriel n'est pas valide."
-
-m l SignInUsed =
-  case l of
-    English -> "You already used this link, please sign in again."
-    French  -> "Tu as déjà utilisé ce lien, connecte-toi à nouveau."
-
-m l SignInExpired =
-  case l of
-    English -> "The link expired, please sign in again."
-    French  -> "Le lien sur lequel tu as cliqué a expiré, connecte-toi à nouveau."
-
-m l SignInInvalid =
-  case l of
-    English -> "The link is invalid, please sign in again."
-    French  -> "Le lien sur lequel tu as cliqué est invalide, connecte-toi à nouveau."
-
 m l SignInMailTitle =
   case l of
     English -> T.concat ["Sign in to ", m l SharedCost]
diff --git a/src/server/Model/SignIn.hs b/src/server/Model/SignIn.hs
index 117b8b5..b475fdb 100644
--- a/src/server/Model/SignIn.hs
+++ b/src/server/Model/SignIn.hs
@@ -1,8 +1,6 @@
 module Model.SignIn
   ( createSignInToken
   , getSignInToken
-  , signInTokenToUsed
-  , isLastValidToken
   ) where
 
 import Data.Text (Text)
@@ -19,22 +17,9 @@ createSignInToken :: Text -> Persist Text
 createSignInToken email = do
   now <- liftIO getCurrentTime
   token <- liftIO generateUUID
-  _ <- insert $ SignIn token now email False
+  _ <- insert $ SignIn token now email
   return token
 
 getSignInToken :: Text -> Persist (Maybe (Entity SignIn))
 getSignInToken token =
   selectFirst [SignInToken ==. token] []
-
-signInTokenToUsed :: SignInId -> Persist ()
-signInTokenToUsed tokenId =
-  update tokenId [SignInIsUsed =. True]
-
-isLastValidToken :: SignIn -> Persist Bool
-isLastValidToken signIn = do
-  maybe False ((== (signInToken signIn)) . signInToken . entityVal) <$>
-    selectFirst
-      [ SignInEmail ==. (signInEmail signIn)
-      , SignInIsUsed ==. True
-      ]
-      [ Desc SignInCreation ]
diff --git a/src/server/Persona.hs b/src/server/Persona.hs
new file mode 100644
index 0000000..8055e8b
--- /dev/null
+++ b/src/server/Persona.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Persona
+  ( verifyEmail
+  ) where
+
+import Control.Monad (guard)
+
+import Network.HTTP.Conduit
+
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.ByteString.Lazy (fromStrict, toStrict)
+import Data.Text.Encoding (encodeUtf8, decodeUtf8)
+import Data.Aeson
+import Data.Aeson.Types (parseMaybe)
+
+import Config
+
+verifyEmail :: Config -> Text -> IO (Maybe Text)
+verifyEmail config assertion = do
+
+  initReq <- parseUrl "https://verifier.login.persona.org/verify"
+
+  let request =
+        (flip urlEncodedBody) initReq $
+          [ ("assertion", encodeUtf8 $ assertion)
+          , ("audience", encodeUtf8 $ hostname config)
+          ]
+
+  manager <- newManager tlsManagerSettings
+  response <- httpLbs request manager
+
+  return . parseEmail . decodeUtf8 . toStrict . responseBody $ response
+
+parseEmail :: Text -> Maybe Text
+parseEmail payload = do
+  result <- decode . fromStrict . encodeUtf8 $ payload
+  flip parseMaybe result $ \obj -> do
+    status <- T.pack <$> obj .: "status"
+    guard (status == "okay")
+    obj .: "email"
diff --git a/src/server/Secure.hs b/src/server/Secure.hs
index 192fa10..7b6e6de 100644
--- a/src/server/Secure.hs
+++ b/src/server/Secure.hs
@@ -12,7 +12,7 @@ import Network.HTTP.Types.Status (forbidden403)
 import Database.Persist (Entity, entityVal)
 
 import Model.User (getUser)
-import Model.SignIn (getSignInToken, isLastValidToken)
+import Model.SignIn (getSignInToken)
 import Model.Database
 
 import Control.Monad.IO.Class (liftIO)
@@ -44,9 +44,6 @@ getUserFromToken token = do
   mbSignIn <- fmap entityVal <$> getSignInToken token
   case mbSignIn of
     Just signIn -> do
-      isValid <- isLastValidToken signIn
-      if isValid
-        then getUser (signInEmail signIn)
-        else return Nothing
+      getUser (signInEmail signIn)
     Nothing ->
       return Nothing
diff --git a/src/server/View/Page.hs b/src/server/View/Page.hs
index 2865337..7310fbb 100644
--- a/src/server/View/Page.hs
+++ b/src/server/View/Page.hs
@@ -26,7 +26,9 @@ page config =
   renderHtml . docTypeHtml $ do
     H.head $ do
       meta ! charset "UTF-8"
+      meta ! httpEquiv "X-UA-Compatible" ! content "IE=Edge" -- IE8+ only is valid to use with persona
       H.title (toHtml $ getMessage SharedCost)
+      script ! src "https://login.persona.org/include.js" $ ""
       script ! src "javascripts/client.js" $ ""
       script ! A.id "messages" ! type_ "application/json" $ toHtml . decodeUtf8 . encode $ getTranslations
       script ! A.id "config" ! type_ "application/json" $ toHtml . decodeUtf8 . encode $ config
@@ -35,4 +37,4 @@ page config =
       link ! rel "icon" ! type_ "image/png" ! href "images/icon.png"
       H.style $ toHtml globalDesign
     body $ do
-      script ! src "javascripts/elmLauncher.js" $ ""
+      script ! src "javascripts/main.js" $ ""