{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} -------------------------------------------------------------------------------- module Accounts where -------------------------------------------------------------------------------- import Database.SQLite.Simple import qualified PendingAccounts import qualified Types as T -------------------------------------------------------------------------------- -- | 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 ) -- | 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 res <- query conn "SELECT (username,password,email,role,profilePicture) FROM Accounts WHERE username = ?" (Only username) 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 accounts <- query_ conn "SELECT (username,password,email,role,profilePicture) FROM Accounts" pure $ T.userFromAccount <$> accounts