diff options
author | Joris | 2020-01-30 11:35:31 +0000 |
---|---|---|
committer | Joris | 2020-01-30 11:35:31 +0000 |
commit | 960fa7cb7ae4c57d01306f78cd349f3a8337d0ab (patch) | |
tree | 5077cc720525fb025e4dba65a9a8b631862cbcc8 /server/src/Persistence/User.hs | |
parent | 14bdbc8c937f5d0b35c61350dba28cb41c3737cd (diff) | |
parent | 6a04e640955051616c3ad0874605830c448f2d75 (diff) | |
download | budget-960fa7cb7ae4c57d01306f78cd349f3a8337d0ab.tar.gz budget-960fa7cb7ae4c57d01306f78cd349f3a8337d0ab.tar.bz2 budget-960fa7cb7ae4c57d01306f78cd349f3a8337d0ab.zip |
Merge branch 'with-ghcjs' into 'master'
Use Haskell on the frontend
See merge request guyonvarch/shared-cost!2
Diffstat (limited to 'server/src/Persistence/User.hs')
-rw-r--r-- | server/src/Persistence/User.hs | 78 |
1 files changed, 78 insertions, 0 deletions
diff --git a/server/src/Persistence/User.hs b/server/src/Persistence/User.hs new file mode 100644 index 0000000..12145ac --- /dev/null +++ b/server/src/Persistence/User.hs @@ -0,0 +1,78 @@ +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 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 + +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 id, creation, email, name from user ORDER BY creation DESC" + ) + +get :: Text -> Query (Maybe User) +get token = + Query (\conn -> do + fmap (\(Row u) -> u) . Maybe.listToMaybe <$> + SQLite.queryNamed + conn + "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 + ) |