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
-      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)
+    deleteTrip tripPK = do
+      Trips.delete dbFile tripPK
       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"