about summary refs log tree commit diff
diff options
context:
space:
mode:
authorWilliam Carroll <wpcarro@gmail.com>2020-07-28T17·38+0100
committerWilliam Carroll <wpcarro@gmail.com>2020-07-28T17·38+0100
commit012296f156f59fe8581a01f2ddfd2a1067c09108 (patch)
treef95ef3a62db11060e658909836788230c8ede52a
parentb3556648582c02fb5a9a10a6a4525e212397f945 (diff)
Move SQL out of API and into separate modules
Create modules for each Table in our SQL database. This cleans up the handler
bodies at the expense of introducing more files and indirection.
-rw-r--r--src/Accounts.hs36
-rw-r--r--src/App.hs42
-rw-r--r--src/Trips.hs27
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"