diff options
| -rw-r--r-- | src/Accounts.hs | 36 | ||||
| -rw-r--r-- | src/App.hs | 42 | ||||
| -rw-r--r-- | src/Trips.hs | 27 |
3 files changed, 80 insertions, 25 deletions
diff --git a/src/Accounts.hs b/src/Accounts.hs new file mode 100644 index 000000000000..bdc0bf64d432 --- /dev/null +++ b/src/Accounts.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE OverloadedStrings #-} +-------------------------------------------------------------------------------- +module Accounts where +-------------------------------------------------------------------------------- +import Data.Function ((&)) +import Database.SQLite.Simple + +import qualified Types as T +-------------------------------------------------------------------------------- + +-- | 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 * 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 * FROM Accounts" + pure $ T.userFromAccount <$> accounts diff --git a/src/App.hs b/src/App.hs index f8b81ed98672..5160f3627560 100644 --- a/src/App.hs +++ b/src/App.hs @@ -10,7 +10,6 @@ import Control.Monad.IO.Class (liftIO) import Data.Function ((&)) import Data.String.Conversions (cs) import Data.Text (Text) -import Database.SQLite.Simple import Network.Wai.Handler.Warp as Warp import Servant import API @@ -18,6 +17,8 @@ import API import qualified Crypto.KDF.BCrypt as BC import qualified Data.Text.Encoding as TE import qualified Types as T +import qualified Accounts as Accounts +import qualified Trips as Trips -------------------------------------------------------------------------------- server :: FilePath -> Server API @@ -39,44 +40,35 @@ server dbFile = createAccountH -- TODO(wpcarro): Handle failed CONSTRAINTs instead of sending 500s createAccount :: T.CreateAccountRequest -> IO NoContent - createAccount request = withConnection dbFile $ \conn -> do - hashed <- T.hashPassword (T.createAccountRequestPassword request) - execute conn "INSERT INTO Accounts (username,password,email,role) VALUES (?,?,?,?)" - ( T.createAccountRequestUsername request - , hashed - , T.createAccountRequestEmail request - , T.createAccountRequestRole request - ) + createAccount request = do + Accounts.create dbFile + (T.createAccountRequestUsername request) + (T.createAccountRequestPassword request) + (T.createAccountRequestEmail request) + (T.createAccountRequestRole request) pure NoContent deleteAccount :: Text -> IO NoContent - deleteAccount username = withConnection dbFile $ \conn -> do - execute conn "DELETE FROM Accounts WHERE username = ?" - (Only (T.Username username)) + deleteAccount username = do + Accounts.delete dbFile (T.Username username) pure NoContent listAccounts :: IO [T.User] - listAccounts = withConnection dbFile $ \conn -> do - accounts <- query_ conn "SELECT * FROM Accounts" - pure $ T.userFromAccount <$> accounts + listAccounts = Accounts.list dbFile createTrip :: T.Trip -> IO NoContent - createTrip trip = withConnection dbFile $ \conn -> do - execute conn "INSERT INTO Trips (username,destination,startDate,endDate,comment) VALUES (?,?,?,?,?)" - (trip & T.tripFields) + createTrip trip = do + Trips.create dbFile trip pure NoContent listTrips :: IO [T.Trip] - listTrips = withConnection dbFile $ \conn -> - query_ conn "SELECT * FROM Trips" + listTrips = Trips.list dbFile -- TODO(wpcarro): Validate incoming data like startDate. deleteTrip :: T.TripPK -> IO NoContent - deleteTrip tripPK = - withConnection dbFile $ \conn -> do - execute conn "DELETE FROM Trips WHERE username = ? AND destination = ? and startDate = ?" - (tripPK & T.tripPKFields) - pure NoContent + deleteTrip tripPK = do + Trips.delete dbFile tripPK + pure NoContent -- TODO(wpcarro): Create and store a session token login :: T.AccountCredentials -> IO (Maybe T.Session) diff --git a/src/Trips.hs b/src/Trips.hs new file mode 100644 index 000000000000..0b395f8bcfe8 --- /dev/null +++ b/src/Trips.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE OverloadedStrings #-} +-------------------------------------------------------------------------------- +module Trips where +-------------------------------------------------------------------------------- +import Data.Function ((&)) +import Database.SQLite.Simple + +import qualified Types as T +-------------------------------------------------------------------------------- + +-- | Create a new `trip` in `dbFile`. +create :: FilePath -> T.Trip -> IO () +create dbFile trip = withConnection dbFile $ \conn -> + execute conn "INSERT INTO Trips (username,destination,startDate,endDate,comment) VALUES (?,?,?,?,?)" + (trip & T.tripFields) + +-- | Delete a trip from `dbFile` using its `tripPK` Primary Key. +delete :: FilePath -> T.TripPK -> IO () +delete dbFile tripPK = + withConnection dbFile $ \conn -> do + execute conn "DELETE FROM Trips WHERE username = ? AND destination = ? and startDate = ?" + (tripPK & T.tripPKFields) + +-- | Return a list of all of the trips in `dbFile`. +list :: FilePath -> IO [T.Trip] +list dbFile = withConnection dbFile $ \conn -> + query_ conn "SELECT * FROM Trips" |