Prefer SQLite.Simple to Persistent

In the spirit of walking crawling before I walk, I'm preferring the less
powerful SQLite.Simple library to the more powerful (but mystifying) Persistent
library.

1 files changed, 19 insertions, 28 deletions

diff --git a/src/App.hs b/src/App.hs
index 4381882d192a..b80a3ba4f619 100644
--- a/src/App.hs
+++ b/src/App.hs
@@ -5,12 +5,10 @@ module App where
 --------------------------------------------------------------------------------
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Logger (runStderrLoggingT)
-import Database.Persist.Sqlite ( ConnectionPool, createSqlitePool
-                               , runSqlPool, runSqlPersistMPool
-                               , runMigration, selectFirst, (==.)
-                               , insert, entityVal)
+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
 
@@ -18,40 +16,33 @@ import API
 import qualified Types as T
 --------------------------------------------------------------------------------
 
-server :: ConnectionPool -> Server API
-server pool =
+server :: FilePath -> Server API
+server dbFile =
   userAddH :<|> userGetH
   where
     userAddH newUser = liftIO $ userAdd newUser
     userGetH name    = liftIO $ userGet name
 
+    -- TODO(wpcarro): Handle failed CONSTRAINTs instead of sending 500s
     userAdd :: T.Account -> IO (Maybe T.Session)
-    userAdd newUser = flip runSqlPersistMPool pool $ do
-      exists <- selectFirst [T.AccountUsername ==. (T.accountUsername newUser)] []
-      case exists of
-        Nothing -> do
-          insert newUser
-          pure $ Just (T.Session { T.username = T.Username "wpcarro"
-                                 , T.password = T.Password "testing"
-                                 , T.role = T.RegularUser
-                                 })
-        Just _ -> pure Nothing
+    userAdd account = withConnection dbFile $ \conn -> do
+      execute conn "INSERT INTO Accounts (username,password,email,role,profilePicture) VALUES (?,?,?,?,?)"
+        (account & T.accountFields)
+      T.Session{ T.username = T.accountUsername account
+               , T.password = T.accountPassword account
+               , T.role = T.accountRole account
+               } & Just & pure
 
     userGet :: Text -> IO (Maybe T.Account)
-    userGet name = flip runSqlPersistMPool pool $ do
-      mUser <- selectFirst [T.AccountUsername ==. name] []
-      pure $ entityVal <$> mUser
-
-app :: ConnectionPool -> Application
-app pool = serve (Proxy @ API) $ server pool
+    userGet name = withConnection dbFile $ \conn -> do
+      res <- query conn "SELECT * FROM Accounts WHERE username = ?" (Only name)
+      case res of
+        [x] -> pure (Just x)
+        _   -> pure Nothing
 
 mkApp :: FilePath -> IO Application
-mkApp sqliteFile = do
-  pool <- runStderrLoggingT $ do
-    createSqlitePool (cs sqliteFile) 5
-
-  runSqlPool (runMigration T.migrateAll) pool
-  pure $ app pool
+mkApp dbFile = do
+  pure $ serve (Proxy @ API) $ server dbFile
 
 run :: FilePath -> IO ()
 run sqliteFile =