more robust testing

test/Handler/AppSpec.hs

@@ -4,6 +4,8 @@ module Handler.AppSpec (spec) where
 
 import Startlude
 import TestImport
+import Database.Persist.Sql
+import Model
 
 spec :: Spec
 spec = do
@@ -15,15 +17,29 @@ spec = do
             bodyContains "bitcoind"
             bodyContains "version: 0.18.1"
             statusIs 200
-    describe "GET /apps/:appId" $
+    describe "GET /apps/:appId with unknown version spec for bitcoin" $
         withApp $ it "fails to get unknown app" $ do
             request $ do
                 setMethod "GET"
-                setUrl ("/apps/bitcoind.s9pk?spec=0.18.2" :: Text)
+                setUrl ("/apps/bitcoind.s9pk?spec=0.18.3" :: Text)
             statusIs 404
-    describe "GET /apps/:appId" $
-        withApp $ it "makes da records" $ do
+    describe "GET /apps/:appId with existing version spec for bitcoin" $
+        withApp $ it "creates app and metric records" $ do
             request $ do
                 setMethod "GET"
                 setUrl ("/apps/bitcoind.s9pk?spec=0.18.1" :: Text)
-            statusIs 200
+            statusIs 200
+            apps <- runDBtest $ selectList [SAppAppId ==. "bitcoind"] []
+            metrics <- runDBtest $ selectList [MetricEvent ==. "bitcoind"] []
+            assertEq "app should exist" (length apps) 1
+            assertEq "metric should exist" (length metrics) 1
+    describe "GET /apps/:appId with existing version spec for cups" $
+        withApp $ it "creates app and metric records" $ do
+            request $ do
+                setMethod "GET"
+                setUrl ("/apps/cups.s9pk?spec=0.2.1" :: Text)
+            statusIs 200
+            apps <- runDBtest $ selectList [SAppAppId ==. "cups"] []
+            metrics <- runDBtest $ selectList [MetricEvent ==. "cups"] []
+            assertEq "app should exist" (length apps) 1
+            assertEq "metric should exist" (length metrics) 1

test/TestImport.hs

@@ -1,4 +1,6 @@
 {-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE KindSignatures #-}
 
 module TestImport
     ( module TestImport
@@ -12,6 +14,10 @@ import Test.Hspec            as X
 import Yesod.Default.Config2 (useEnv, loadYamlSettings)
 import Yesod.Test            as X
 import Yesod.Core.Unsafe     (fakeHandlerGetLogger)
+import Database.Persist.Sql
+import Text.Shakespeare.Text (st)
+import Yesod.Core
+import qualified Data.Text as T
 
 runHandler :: Handler a -> YesodExample AgentCtx a
 runHandler handler = do
@@ -25,5 +31,38 @@ withApp = before $ do
         []
         useEnv
     foundation <- makeFoundation settings
+    wipeDB foundation
     logWare <- liftIO $ makeLogWare foundation
-    return (foundation, logWare)
+    return (foundation, logWare)
+
+getTables :: DB [Text]
+getTables = do
+    tables <- rawSql [st|
+        SELECT table_name
+        FROM information_schema.tables
+        WHERE table_schema = 'public'
+        AND table_type = 'BASE TABLE';
+    |] []
+
+    return $ map unSingle tables
+
+wipeDB :: AgentCtx -> IO ()
+wipeDB app = runDBWithApp app $ do
+    tables <- getTables
+    sqlBackend <- ask
+
+    let escapedTables = map (T.unpack . connEscapeName sqlBackend . DBName) tables
+        query = "TRUNCATE TABLE " ++ (intercalate ", " $ escapedTables)
+    rawExecute (T.pack query) []
+
+runDBtest :: SqlPersistM a -> YesodExample AgentCtx a
+runDBtest query = do
+    app <- getTestYesod
+    liftIO $ runDBWithApp app query
+
+runDBWithApp :: AgentCtx -> SqlPersistM a -> IO a
+runDBWithApp app query = runSqlPersistMPool query (appConnPool app)
+
+-- A convenient synonym for database access functions.
+type DB a = forall (m :: * -> *).
+    (MonadUnliftIO m) => ReaderT SqlBackend m a