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.

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

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,43 +40,34 @@ server dbFile = createAccountH
 
     -- TODO(wpcarro): Handle failed CONSTRAINTs instead of sending 500s
     createAccount :: T.CreateAccountRequest -> IO NoContent
-    createAccount request = withConnection dbFile $ \conn -> do
+    createAccount request = do
-      hashed <- T.hashPassword (T.createAccountRequestPassword request)
+      Accounts.create dbFile
-      execute conn "INSERT INTO Accounts (username,password,email,role) VALUES (?,?,?,?)"
+        (T.createAccountRequestUsername request)
-        ( T.createAccountRequestUsername request
+        (T.createAccountRequestPassword request)
-        , hashed
+        (T.createAccountRequestEmail request)
-        , T.createAccountRequestEmail request
+        (T.createAccountRequestRole request)
-        , T.createAccountRequestRole request
-        )
       pure NoContent
 
     deleteAccount :: Text -> IO NoContent
-    deleteAccount username = withConnection dbFile $ \conn -> do
+    deleteAccount username = do
-      execute conn "DELETE FROM Accounts WHERE username = ?"
+      Accounts.delete dbFile (T.Username username)
-        (Only (T.Username username))
       pure NoContent
 
     listAccounts :: IO [T.User]
-    listAccounts = withConnection dbFile $ \conn -> do
+    listAccounts = Accounts.list dbFile
-      accounts <- query_ conn "SELECT * FROM Accounts"
-      pure $ T.userFromAccount <$> accounts
 
     createTrip :: T.Trip -> IO NoContent
-    createTrip trip = withConnection dbFile $ \conn -> do
+    createTrip trip = do
-      execute conn "INSERT INTO Trips (username,destination,startDate,endDate,comment) VALUES (?,?,?,?,?)"
+      Trips.create dbFile trip
-        (trip & T.tripFields)
       pure NoContent
 
     listTrips :: IO [T.Trip]
-    listTrips = withConnection dbFile $ \conn ->
+    listTrips = Trips.list dbFile
-      query_ conn "SELECT * FROM Trips"
 
     -- TODO(wpcarro): Validate incoming data like startDate.
     deleteTrip :: T.TripPK -> IO NoContent
-    deleteTrip tripPK =
+    deleteTrip tripPK = do
-      withConnection dbFile $ \conn -> do
+      Trips.delete dbFile tripPK
-        execute conn "DELETE FROM Trips WHERE username = ? AND destination = ? and startDate = ?"
-          (tripPK & T.tripPKFields)
       pure NoContent
 
     -- TODO(wpcarro): Create and store a session token

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"