From 27e11b20b06f2f2dbfb56c0998a63169b4b8abc4 Mon Sep 17 00:00:00 2001 From: Joris Date: Wed, 8 Nov 2017 23:47:26 +0100 Subject: Use a better project structure --- server/src/Model/SignIn.hs | 66 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 66 insertions(+) create mode 100644 server/src/Model/SignIn.hs (limited to 'server/src/Model/SignIn.hs') diff --git a/server/src/Model/SignIn.hs b/server/src/Model/SignIn.hs new file mode 100644 index 0000000..c5182f0 --- /dev/null +++ b/server/src/Model/SignIn.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Model.SignIn + ( SignIn(..) + , createSignInToken + , getSignIn + , signInTokenToUsed + , isLastTokenValid + ) where + +import Data.Int (Int64) +import Data.Maybe (listToMaybe) +import Data.Text (Text) +import Data.Time.Clock (getCurrentTime) +import Data.Time.Clock (UTCTime) +import Database.SQLite.Simple (Only(Only), FromRow(fromRow)) +import qualified Database.SQLite.Simple as SQLite + +import Model.Query (Query(Query)) +import Model.UUID (generateUUID) + +type SignInId = Int64 + +data SignIn = SignIn + { id :: SignInId + , token :: Text + , creation :: UTCTime + , email :: Text + , isUsed :: Bool + } deriving Show + +instance FromRow SignIn where + fromRow = SignIn <$> + SQLite.field <*> + SQLite.field <*> + SQLite.field <*> + SQLite.field <*> + SQLite.field + +createSignInToken :: Text -> Query Text +createSignInToken signInEmail = + Query (\conn -> do + now <- getCurrentTime + signInToken <- generateUUID + SQLite.execute conn "INSERT INTO sign_in (token, creation, email, is_used) VALUES (?, ?, ?, ?)" (signInToken, now, signInEmail, False) + return signInToken + ) + +getSignIn :: Text -> Query (Maybe SignIn) +getSignIn signInToken = + Query (\conn -> do + listToMaybe <$> (SQLite.query conn "SELECT * from sign_in WHERE token = ? LIMIT 1" (Only signInToken) :: IO [SignIn]) + ) + +signInTokenToUsed :: SignInId -> Query () +signInTokenToUsed tokenId = + Query (\conn -> + SQLite.execute conn "UPDATE sign_in SET is_used = ? WHERE id = ?" (True, tokenId) + ) + +isLastTokenValid :: SignIn -> Query Bool +isLastTokenValid signIn = + Query (\conn -> do + [ Only lastToken ] <- SQLite.query conn "SELECT token from sign_in WHERE email = ? AND is_used = ? ORDER BY creation DESC LIMIT 1" (email signIn, True) + return . maybe False (== (token signIn)) $ lastToken + ) -- cgit v1.2.3 From 5a63f7be9375e3ab888e4232dd7ef72c2f1ffae1 Mon Sep 17 00:00:00 2001 From: Joris Date: Mon, 13 Nov 2017 23:56:40 +0100 Subject: Setup stylish-haskell --- server/src/Model/SignIn.hs | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) (limited to 'server/src/Model/SignIn.hs') diff --git a/server/src/Model/SignIn.hs b/server/src/Model/SignIn.hs index c5182f0..6f38fe7 100644 --- a/server/src/Model/SignIn.hs +++ b/server/src/Model/SignIn.hs @@ -8,25 +8,25 @@ module Model.SignIn , isLastTokenValid ) where -import Data.Int (Int64) -import Data.Maybe (listToMaybe) -import Data.Text (Text) -import Data.Time.Clock (getCurrentTime) -import Data.Time.Clock (UTCTime) -import Database.SQLite.Simple (Only(Only), FromRow(fromRow)) +import Data.Int (Int64) +import Data.Maybe (listToMaybe) +import Data.Text (Text) +import Data.Time.Clock (getCurrentTime) +import Data.Time.Clock (UTCTime) +import Database.SQLite.Simple (FromRow (fromRow), Only (Only)) import qualified Database.SQLite.Simple as SQLite -import Model.Query (Query(Query)) -import Model.UUID (generateUUID) +import Model.Query (Query (Query)) +import Model.UUID (generateUUID) type SignInId = Int64 data SignIn = SignIn - { id :: SignInId - , token :: Text + { id :: SignInId + , token :: Text , creation :: UTCTime - , email :: Text - , isUsed :: Bool + , email :: Text + , isUsed :: Bool } deriving Show instance FromRow SignIn where -- cgit v1.2.3 From 7194cddb28656c721342c2ef604f9f9fb0692960 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 19 Nov 2017 00:20:25 +0100 Subject: Show payment count and partition - Also fixes exceedingPayer in back by using only punctual payments --- server/src/Model/SignIn.hs | 2 -- 1 file changed, 2 deletions(-) (limited to 'server/src/Model/SignIn.hs') diff --git a/server/src/Model/SignIn.hs b/server/src/Model/SignIn.hs index 6f38fe7..0cc4a03 100644 --- a/server/src/Model/SignIn.hs +++ b/server/src/Model/SignIn.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module Model.SignIn ( SignIn(..) , createSignInToken -- cgit v1.2.3 From c0ea63f8c1a8c7123b78798cec99726b113fb1f3 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 17 Nov 2019 18:08:28 +0100 Subject: Optimize and refactor payments --- server/src/Model/SignIn.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'server/src/Model/SignIn.hs') diff --git a/server/src/Model/SignIn.hs b/server/src/Model/SignIn.hs index 0cc4a03..bcdce61 100644 --- a/server/src/Model/SignIn.hs +++ b/server/src/Model/SignIn.hs @@ -7,7 +7,7 @@ module Model.SignIn ) where import Data.Int (Int64) -import Data.Maybe (listToMaybe) +import qualified Data.Maybe as Maybe import Data.Text (Text) import Data.Time.Clock (getCurrentTime) import Data.Time.Clock (UTCTime) @@ -47,7 +47,7 @@ createSignInToken signInEmail = getSignIn :: Text -> Query (Maybe SignIn) getSignIn signInToken = Query (\conn -> do - listToMaybe <$> (SQLite.query conn "SELECT * from sign_in WHERE token = ? LIMIT 1" (Only signInToken) :: IO [SignIn]) + Maybe.listToMaybe <$> (SQLite.query conn "SELECT * from sign_in WHERE token = ? LIMIT 1" (Only signInToken) :: IO [SignIn]) ) signInTokenToUsed :: SignInId -> Query () -- cgit v1.2.3 From af8353c6164aaaaa836bfed181f883ac86bb76a5 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 19 Jan 2020 14:03:31 +0100 Subject: Sign in with email and password --- server/src/Model/SignIn.hs | 60 +++------------------------------------------- 1 file changed, 3 insertions(+), 57 deletions(-) (limited to 'server/src/Model/SignIn.hs') diff --git a/server/src/Model/SignIn.hs b/server/src/Model/SignIn.hs index bcdce61..a217bae 100644 --- a/server/src/Model/SignIn.hs +++ b/server/src/Model/SignIn.hs @@ -1,64 +1,10 @@ module Model.SignIn ( SignIn(..) - , createSignInToken - , getSignIn - , signInTokenToUsed - , isLastTokenValid ) where -import Data.Int (Int64) -import qualified Data.Maybe as Maybe -import Data.Text (Text) -import Data.Time.Clock (getCurrentTime) -import Data.Time.Clock (UTCTime) -import Database.SQLite.Simple (FromRow (fromRow), Only (Only)) -import qualified Database.SQLite.Simple as SQLite - -import Model.Query (Query (Query)) -import Model.UUID (generateUUID) - -type SignInId = Int64 +import Common.Model (Email, Password) data SignIn = SignIn - { id :: SignInId - , token :: Text - , creation :: UTCTime - , email :: Text - , isUsed :: Bool + { _signIn_email :: Email + , _signIn_password :: Password } deriving Show - -instance FromRow SignIn where - fromRow = SignIn <$> - SQLite.field <*> - SQLite.field <*> - SQLite.field <*> - SQLite.field <*> - SQLite.field - -createSignInToken :: Text -> Query Text -createSignInToken signInEmail = - Query (\conn -> do - now <- getCurrentTime - signInToken <- generateUUID - SQLite.execute conn "INSERT INTO sign_in (token, creation, email, is_used) VALUES (?, ?, ?, ?)" (signInToken, now, signInEmail, False) - return signInToken - ) - -getSignIn :: Text -> Query (Maybe SignIn) -getSignIn signInToken = - Query (\conn -> do - Maybe.listToMaybe <$> (SQLite.query conn "SELECT * from sign_in WHERE token = ? LIMIT 1" (Only signInToken) :: IO [SignIn]) - ) - -signInTokenToUsed :: SignInId -> Query () -signInTokenToUsed tokenId = - Query (\conn -> - SQLite.execute conn "UPDATE sign_in SET is_used = ? WHERE id = ?" (True, tokenId) - ) - -isLastTokenValid :: SignIn -> Query Bool -isLastTokenValid signIn = - Query (\conn -> do - [ Only lastToken ] <- SQLite.query conn "SELECT token from sign_in WHERE email = ? AND is_used = ? ORDER BY creation DESC LIMIT 1" (email signIn, True) - return . maybe False (== (token signIn)) $ lastToken - ) -- cgit v1.2.3