From 33b85b7f12798f5762d940ed5c30f775cdd7b751 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 28 Jan 2018 12:13:09 +0100 Subject: WIP --- server/src/Persistence/User.hs | 37 +++++++++++++++++++++++++++++++++++++ 1 file changed, 37 insertions(+) create mode 100644 server/src/Persistence/User.hs (limited to 'server/src/Persistence/User.hs') diff --git a/server/src/Persistence/User.hs b/server/src/Persistence/User.hs new file mode 100644 index 0000000..4ec2dcf --- /dev/null +++ b/server/src/Persistence/User.hs @@ -0,0 +1,37 @@ +module Persistence.User + ( list + , get + ) where + +import Data.Maybe (listToMaybe) +import Data.Text (Text) +import Database.SQLite.Simple (FromRow (fromRow), Only (Only)) +import qualified Database.SQLite.Simple as SQLite +import Prelude hiding (id) + +import Common.Model (User (..)) + +import Model.Query (Query (Query)) + +newtype Row = Row User + +instance FromRow Row where + fromRow = Row <$> (User <$> + SQLite.field <*> + SQLite.field <*> + SQLite.field <*> + SQLite.field) + +list :: Query [User] +list = + Query (\conn -> do + map (\(Row u) -> u) <$> + SQLite.query_ conn "SELECT * from user ORDER BY creation DESC" + ) + +get :: Text -> Query (Maybe User) +get userEmail = + Query (\conn -> do + fmap (\(Row u) -> u) . listToMaybe <$> + SQLite.query conn "SELECT * FROM user WHERE email = ? LIMIT 1" (Only userEmail) + ) -- 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/Persistence/User.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'server/src/Persistence/User.hs') diff --git a/server/src/Persistence/User.hs b/server/src/Persistence/User.hs index 4ec2dcf..3c3a2b1 100644 --- a/server/src/Persistence/User.hs +++ b/server/src/Persistence/User.hs @@ -3,7 +3,7 @@ module Persistence.User , get ) where -import Data.Maybe (listToMaybe) +import qualified Data.Maybe as Maybe import Data.Text (Text) import Database.SQLite.Simple (FromRow (fromRow), Only (Only)) import qualified Database.SQLite.Simple as SQLite @@ -32,6 +32,6 @@ list = get :: Text -> Query (Maybe User) get userEmail = Query (\conn -> do - fmap (\(Row u) -> u) . listToMaybe <$> + fmap (\(Row u) -> u) . Maybe.listToMaybe <$> SQLite.query conn "SELECT * FROM user WHERE email = ? LIMIT 1" (Only userEmail) ) -- cgit v1.2.3 From fff99e6fb1c03235e219a94ce52acf5a50d3fb62 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 5 Jan 2020 16:03:48 +0100 Subject: Use named parameters instead of positional parameters in persistence queries --- server/src/Persistence/User.hs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) (limited to 'server/src/Persistence/User.hs') diff --git a/server/src/Persistence/User.hs b/server/src/Persistence/User.hs index 3c3a2b1..89eb57d 100644 --- a/server/src/Persistence/User.hs +++ b/server/src/Persistence/User.hs @@ -5,7 +5,7 @@ module Persistence.User import qualified Data.Maybe as Maybe import Data.Text (Text) -import Database.SQLite.Simple (FromRow (fromRow), Only (Only)) +import Database.SQLite.Simple (FromRow (fromRow), NamedParam ((:=))) import qualified Database.SQLite.Simple as SQLite import Prelude hiding (id) @@ -30,8 +30,11 @@ list = ) get :: Text -> Query (Maybe User) -get userEmail = +get email = Query (\conn -> do fmap (\(Row u) -> u) . Maybe.listToMaybe <$> - SQLite.query conn "SELECT * FROM user WHERE email = ? LIMIT 1" (Only userEmail) + SQLite.queryNamed + conn + "SELECT * FROM user WHERE email = :email LIMIT 1" + [ ":email" := email ] ) -- 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/Persistence/User.hs | 48 +++++++++++++++++++++++++++++++++++++----- 1 file changed, 43 insertions(+), 5 deletions(-) (limited to 'server/src/Persistence/User.hs') diff --git a/server/src/Persistence/User.hs b/server/src/Persistence/User.hs index 89eb57d..12145ac 100644 --- a/server/src/Persistence/User.hs +++ b/server/src/Persistence/User.hs @@ -1,17 +1,21 @@ module Persistence.User ( list , get + , checkPassword + , createSignInToken ) where import qualified Data.Maybe as Maybe import Data.Text (Text) import Database.SQLite.Simple (FromRow (fromRow), NamedParam ((:=))) import qualified Database.SQLite.Simple as SQLite -import Prelude hiding (id) -import Common.Model (User (..)) +import Common.Model (Email (..), Password (..), User (..)) +import Model.HashedPassword (HashedPassword (..)) +import qualified Model.HashedPassword as HashedPassword import Model.Query (Query (Query)) +import qualified Model.UUID as UUID newtype Row = Row User @@ -26,15 +30,49 @@ list :: Query [User] list = Query (\conn -> do map (\(Row u) -> u) <$> - SQLite.query_ conn "SELECT * from user ORDER BY creation DESC" + SQLite.query_ conn "SELECT id, creation, email, name from user ORDER BY creation DESC" ) get :: Text -> Query (Maybe User) -get email = +get token = Query (\conn -> do fmap (\(Row u) -> u) . Maybe.listToMaybe <$> SQLite.queryNamed conn - "SELECT * FROM user WHERE email = :email LIMIT 1" + "SELECT id, creation, email, name FROM user WHERE sign_in_token = :sign_in_token LIMIT 1" + [ ":sign_in_token" := token ] + ) + +data HashedPasswordRow = HashedPasswordRow HashedPassword + +instance FromRow HashedPasswordRow where + fromRow = HashedPasswordRow <$> (HashedPassword <$> SQLite.field) + +checkPassword :: Email -> Password -> Query Bool +checkPassword (Email email) password = + Query (\conn -> do + hashedPassword <- fmap (\(HashedPasswordRow p) -> p) . Maybe.listToMaybe <$> + SQLite.queryNamed + conn + "SELECT password FROM user WHERE email = :email LIMIT 1" [ ":email" := email ] + case hashedPassword of + Just h -> + return (HashedPassword.check password h) + + Nothing -> + return False + ) + +createSignInToken :: Email -> Query Text +createSignInToken (Email email) = + Query (\conn -> do + token <- UUID.generateUUID + SQLite.executeNamed + conn + "UPDATE user SET sign_in_token = :sign_in_token WHERE email = :email" + [ ":sign_in_token" := token + , ":email" := email + ] + return token ) -- cgit v1.2.3