2020-07-30 19:38:46 +02:00
|
|
|
{-# LANGUAGE RecordWildCards #-}
|
2020-07-28 19:38:30 +02:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
module Accounts where
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
import Database.SQLite.Simple
|
|
|
|
|
2020-07-30 19:38:46 +02:00
|
|
|
import qualified PendingAccounts
|
2020-07-28 19:38:30 +02:00
|
|
|
import qualified Types as T
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
|
2020-07-30 19:38:46 +02:00
|
|
|
-- | Delete the account in PendingAccounts and create on in Accounts.
|
|
|
|
transferFromPending :: FilePath -> T.PendingAccount -> IO ()
|
|
|
|
transferFromPending dbFile T.PendingAccount{..} = withConnection dbFile $
|
|
|
|
\conn -> withTransaction conn $ do
|
|
|
|
PendingAccounts.delete dbFile pendingAccountUsername
|
|
|
|
execute conn "INSERT INTO Accounts (username,password,email,role) VALUES (?,?,?,?)"
|
|
|
|
( pendingAccountUsername
|
|
|
|
, pendingAccountPassword
|
|
|
|
, pendingAccountEmail
|
|
|
|
, pendingAccountRole
|
|
|
|
)
|
|
|
|
|
2020-07-28 19:38:30 +02:00
|
|
|
-- | Create a new account in the Accounts table.
|
|
|
|
create :: FilePath -> T.Username -> T.ClearTextPassword -> T.Email -> T.Role -> IO ()
|
|
|
|
create dbFile username password email role = withConnection dbFile $ \conn -> do
|
|
|
|
hashed <- T.hashPassword password
|
|
|
|
execute conn "INSERT INTO Accounts (username,password,email,role) VALUES (?,?,?,?)"
|
|
|
|
(username, hashed, email, role)
|
|
|
|
|
|
|
|
-- | Delete `username` from `dbFile`.
|
|
|
|
delete :: FilePath -> T.Username -> IO ()
|
|
|
|
delete dbFile username = withConnection dbFile $ \conn -> do
|
|
|
|
execute conn "DELETE FROM Accounts WHERE username = ?"
|
|
|
|
(Only username)
|
|
|
|
|
|
|
|
-- | Attempt to find `username` in the Account table of `dbFile`.
|
|
|
|
lookup :: FilePath -> T.Username -> IO (Maybe T.Account)
|
|
|
|
lookup dbFile username = withConnection dbFile $ \conn -> do
|
2020-07-30 20:52:04 +02:00
|
|
|
res <- query conn "SELECT username,password,email,role,profilePicture FROM Accounts WHERE username = ?" (Only username)
|
2020-07-28 19:38:30 +02:00
|
|
|
case res of
|
|
|
|
[x] -> pure (Just x)
|
|
|
|
_ -> pure Nothing
|
|
|
|
|
|
|
|
-- | Return a list of accounts with the sensitive data removed.
|
|
|
|
list :: FilePath -> IO [T.User]
|
|
|
|
list dbFile = withConnection dbFile $ \conn -> do
|
2020-07-30 20:52:04 +02:00
|
|
|
accounts <- query_ conn "SELECT username,password,email,role,profilePicture FROM Accounts"
|
2020-07-28 19:38:30 +02:00
|
|
|
pure $ T.userFromAccount <$> accounts
|