diff --git a/.travis.yml b/.travis.yml index 898e1e2..e9a94ff 100644 --- a/.travis.yml +++ b/.travis.yml @@ -16,6 +16,7 @@ cache: - $HOME/.cabal/store - $HOME/.ghc - $HOME/.stack + - $TRAVIS_BUILD_DIR/.stack-work before_cache: - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log diff --git a/applied-fp-course.cabal b/applied-fp-course.cabal index cb7cb04..b427895 100644 --- a/applied-fp-course.cabal +++ b/applied-fp-course.cabal @@ -145,15 +145,23 @@ test-suite app-fp-tests , Level06Tests , Level07Tests + , Helpers + build-depends: base >= 4.8 && <4.13 , applied-fp-course , wai == 3.2.* , wai-extra == 3.0.* + , http-types >= 0.9 && < 0.13 + , tasty >= 0.8 && < 1.2 + , tasty-hunit >= 0.9 && < 0.11 , hspec >= 2.2 && < 3.0 , hspec-wai >= 0.6 && < 0.10 , bytestring == 0.10.* , text == 1.2.* , mtl == 2.2.* + , semigroups == 0.18.* + , transformers >= 0.4 && < 0.6 + , mmorph test-suite doctests -- Base language which the package is written in. @@ -164,6 +172,7 @@ test-suite doctests , Level05Tests , Level06Tests , Level07Tests + , Helpers ghc-options: -threaded main-is: doctests.hs @@ -174,6 +183,15 @@ test-suite doctests , hspec >= 2.2 && < 3.0 , hspec-wai >= 0.6 && < 0.10 , doctest >= 0.11 && < 0.17 + , semigroups == 0.18.* + , tasty >= 0.8 && < 1.2 + , tasty-hunit >= 0.9 && < 0.11 + , bytestring == 0.10.* + , wai == 3.2.* + , wai-extra == 3.0.* + , http-types >= 0.9 && < 0.13 + , transformers >= 0.4 && < 0.6 + , mmorph -- Level Executables executable level01-exe diff --git a/applied-fp-course.nix b/applied-fp-course.nix index a44fb7e..2f7325a 100644 --- a/applied-fp-course.nix +++ b/applied-fp-course.nix @@ -1,7 +1,7 @@ { mkDerivation, aeson, base, bytestring, doctest, hspec, hspec-wai , http-types, mtl, optparse-applicative, semigroups, sqlite-simple -, sqlite-simple-errors, stdenv, text, time, transformers, wai -, wai-extra, warp +, sqlite-simple-errors, stdenv, tasty, tasty-hunit, text, time +, transformers, wai, wai-extra, warp, mmorph }: mkDerivation { pname = "applied-fp-course"; @@ -16,7 +16,8 @@ mkDerivation { ]; executableHaskellDepends = [ base ]; testHaskellDepends = [ - base bytestring doctest hspec hspec-wai mtl text wai wai-extra + base bytestring doctest hspec hspec-wai http-types mtl tasty + tasty-hunit text wai wai-extra mmorph ]; description = "Simplest of web apps for educational purposes"; license = stdenv.lib.licenses.bsd3; diff --git a/tests/Helpers.hs b/tests/Helpers.hs new file mode 100644 index 0000000..cdba0ee --- /dev/null +++ b/tests/Helpers.hs @@ -0,0 +1,118 @@ +module Helpers + ( -- * Test Monad + TestM + + -- * Test Runner + , runTestsFor + + -- * Request Builders + , get + , post + , put + + -- * Response Assertions + , assertBody + , assertStatus + , assertContentType + + -- * Internals + , RequestPath (..) + , rq + , rqWithBody + + ) where + +import qualified System.Exit as Exit + +import qualified Control.Exception as E + +import Control.Monad.Except (ExceptT (..), runExceptT) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Reader (ReaderT (..), ask, runReaderT) +import Control.Monad.State (StateT (..), evalStateT, lift, + runStateT) +import qualified Control.Monad.State as State + +import Data.Semigroup ((<>)) + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LBS + +import Network.HTTP.Types as HTTP + +import Network.Wai (Application, Request (..)) +import Network.Wai.Test (Session, WaiTestFailure (..)) +import qualified Network.Wai.Test as WT +import Network.Wai.Test.Internal (ClientState, initState) + +import Control.Concurrent.MVar (MVar) +import qualified Control.Concurrent.MVar as MVar + +import Control.Monad.Morph (hoist) + +-- | This terrifying beast is the combination of the 'Session' transformer stack +-- from Wai.Test and the transformer stack required to keep track of the test +-- name, along with catching the exceptions so we don't just die with an awful +-- failure and no information. +type TestM = ReaderT Application (StateT ClientState (ExceptT WaiTestFailure (StateT String IO))) + +-- | By leaning on some monad morphisms, we're able to insert a transformer +-- stack at an arbitrary point in a different transformer stack that we do not +-- control. This lets us extend it with new functionality that it may not have been +-- designed for. +manipulateTransStack :: WT.Session a -> TestM a +manipulateTransStack = hoist (hoist (hoist lift . ExceptT . E.try)) + +-- | Although not exported, this newtype helps us keep our strings in line. +newtype RequestPath = RequestPath + { unRequestPath :: BS.ByteString + } + +-- | Create an empty 'Request' using the given HTTP Method and route. +rq :: StdMethod -> RequestPath -> Request +rq mth rpath = flip WT.setPath (unRequestPath rpath) $ WT.defaultRequest + { requestMethod = HTTP.renderStdMethod mth + } + +-- | Create a 'Request' with a body. +rqWithBody + :: StdMethod + -> RequestPath + -> LBS.ByteString + -> WT.SRequest +rqWithBody mth rpath = + WT.SRequest (rq mth rpath) + +-- | Run a single instance of the 'Application' for all of the tests given in the 'TestM'. +runTestsFor :: Application -> String -> TestM a -> IO a +runTestsFor app nm m = do + (e, testName) <- runStateT (runExceptT (evalStateT (runReaderT m app) initState)) nm + either (sad testName) pure e + where + sad test (WT.WaiTestFailure msg) = do + putStrLn $ "\tTest Failure For: " <> "[" <> test <> "]" + putStrLn $ "\t" <> msg + Exit.exitFailure + +testRequest :: String -> WT.Session a -> TestM a +testRequest test r = do + lift . lift . State.put $ test + manipulateTransStack r + +get :: String -> BS.ByteString -> TestM WT.SResponse +get test = testRequest test . WT.request . rq HTTP.GET . RequestPath + +post :: String -> BS.ByteString -> LBS.ByteString -> TestM WT.SResponse +post test r = testRequest test . WT.srequest . rqWithBody HTTP.POST (RequestPath r) + +put :: String -> BS.ByteString -> LBS.ByteString -> TestM WT.SResponse +put test r = testRequest test . WT.srequest . rqWithBody HTTP.PUT (RequestPath r) + +assertBody :: LBS.ByteString -> WT.SResponse -> TestM () +assertBody b = manipulateTransStack . WT.assertBody b + +assertStatus :: HTTP.Status -> WT.SResponse -> TestM () +assertStatus c = manipulateTransStack . WT.assertStatus (HTTP.statusCode c) + +assertContentType :: BS.ByteString -> WT.SResponse -> TestM () +assertContentType b = manipulateTransStack . WT.assertContentType b diff --git a/tests/Level03Tests.hs b/tests/Level03Tests.hs index c8c8e89..09bd2ee 100644 --- a/tests/Level03Tests.hs +++ b/tests/Level03Tests.hs @@ -3,49 +3,32 @@ module Level03Tests ( unitTests ) where -import Test.Hspec -import Test.Hspec.Wai +import Test.Tasty (defaultMain, testGroup) +import Test.Tasty.HUnit (testCase) -import Data.String (fromString) +import Network.HTTP.Types as HTTP -import qualified System.Exit as Exit +import Helpers (assertBody, assertStatus, get, runTestsFor) -import qualified Data.ByteString.Lazy.Char8 as LBS8 - -import qualified Level03.Core as Core +import qualified Level03.Core as Core unitTests :: IO () -unitTests = do - -- We need to setup our Application. - let app' = pure Core.app +unitTests = runTestsFor Core.app "Level 03 Tests" $ do + -- Using the functions from ``Helpers`` this actions a GET request on the + -- "/list" route and compares the response body and status code to our + -- expectations + get "GET list route" "/list" >>= \resp -> do + assertBody "List Request not implemented" resp + assertStatus HTTP.status200 resp - -- This sets up HSpec to use our application as the thing it executes before the tests are run - hspec . with app' $ do - -- Here is an example test for the 'ListRq' route. - -- Start with a general description of what we're going to test. - describe "List Route" $ do - -- Individual test cases provide more precise information regarding - -- what they are going to test. - it "Should return a 'not implemented' message and 200 status" $ - -- Using the functions from ``Test.Hspec.Wai`` this actions a GET request - -- on the "/list" route, and using an infix function, compares the result of - -- that request to our expected result. + -- Write some more tests, below are some ideas to get you started: - -- There String literal here is being converted by the use of the - -- ``IsString`` typeclass into a response type that Hspec.Wai can - -- use. Check the documentation for more examples, but when given - -- a string literal, it will assume that is the expected body of - -- the request and also check for a 200 response code. - get "/list" `shouldRespondWith` "List Request not implemented" + -- Don't worry if you don't get all of these done. :) - -- Write some more tests, below are some ideas to get you started: + -- 1) The '/add' route will respond with an error when given an empty comment + -- 2) The '/view' route will respond correctly when given a topic + -- 3) The '/view' route will respond with an error when given an empty topic + -- 4) A gibberish route will return a 404 - -- Don't worry if you don't get all of these done. :) - - -- 1) The '/add' route will respond with an error when given an empty comment - -- 2) The '/view' route will respond correctly when given a topic - -- 3) The '/view' route will respond with an error when given an empty topic - -- 4) A gibberish route will return a 404 - --- After you're done here, you'll need to uncomment the use of these functions --- in the `test/Test.hs` otherwise the tests won't run! + -- After you're done here, you'll need to uncomment the use of these functions + -- in the `test/Test.hs` otherwise the tests won't run! diff --git a/tests/Level04Tests.hs b/tests/Level04Tests.hs index e927c91..9d31964 100644 --- a/tests/Level04Tests.hs +++ b/tests/Level04Tests.hs @@ -4,16 +4,22 @@ module Level04Tests , doctests ) where -import Control.Monad (join) +import Control.Monad (join) +import Control.Monad.IO.Class (liftIO) -import Test.Hspec -import Test.Hspec.Wai +import qualified System.Exit as Exit -import qualified System.Exit as Exit +import Data.Foldable (traverse_) +import Data.Semigroup ((<>)) -import qualified Level04.Core as Core -import qualified Level04.DB as DB -import qualified Level04.Types as Types +import Network.HTTP.Types as HTTP + +import Helpers (TestM, assertBody, assertStatus, get, + post, runTestsFor) + +import qualified Level04.Core as Core +import qualified Level04.DB as DB +import qualified Level04.Types as Types -- Don't forget to uncomment these functions in @tests/Test.hs@ otherwise your -- tests won't be run. @@ -26,47 +32,50 @@ doctests = , "src/Level04/Types.hs" ] +dieWith :: Show a => a -> IO () +dieWith err = print err >> Exit.exitFailure + unitTests :: IO () unitTests = do - let dieWith m = print m >> Exit.exitFailure - - reqsE <- Core.prepareAppReqs - case reqsE of - + reqE <- Core.prepareAppReqs + case reqE of Left err -> dieWith err + Right db -> runTestsFor (Core.app db) "Level 04 Tests" $ do - Right db -> do - let app' = pure ( Core.app db ) + let + flushTopic :: TestM () + flushTopic = liftIO . + -- Clean up and yell about our errors + (traverse_ (either dieWith pure) =<<) . + -- Purge all of the comments for this topic for our tests + traverse ( DB.deleteTopic db ) + -- We don't export the constructor so even for known values we have + -- to play by the rules. There is no - "Oh just this one time.", do it right. + $ Types.mkTopic "fudge" - flushTopic = - -- Clean up and yell about our errors - fmap ( either dieWith pure . join ) . - -- Purge all of the comments for this topic for our tests - traverse ( DB.deleteTopic db ) - -- We don't export the constructor so even for known values we have - -- to play by the rules. There is no - "Oh just this one time.", do it right. - $ Types.mkTopic "fudge" + -- Run a test and then flush the db + test t = t >> flushTopic - -- Run the tests with a DB topic flush between each spec - hspec . with ( flushTopic >> app' ) $ do + topicR = "/fudge/" - -- AddRq Spec - describe "POST /topic/add" $ do + addToTopic = + post "Add Topic" (topicR <> "add") "Fred" - it "Should return 200 with well formed request" $ do - post "/fudge/add" "Fred" `shouldRespondWith` "Success" + -- AddRq Spec + -- it should return 200 with well formed request + test $ addToTopic >>= assertBody "Success" - it "Should 400 on empty input" $ - post "/fudge/add" "" `shouldRespondWith` 400 + -- it should 400 on empty input + test $ post "Empty Input" (topicR <> "add") "" + >>= assertStatus HTTP.status400 - -- ViewRq Spec - describe "GET /topic/view" $ do - it "Should return 200 with content" $ do - post "/fudge/add" "Is super tasty." - get "/fudge/view" `shouldRespondWith` 200 + -- ViewRq Spec + -- it should return 200 with + test $ addToTopic + >> get "View topic" (topicR <> "view") + >>= assertStatus HTTP.status200 - -- ListRq Spec - describe "GET /list" $ do - it "Should return 200 with content" $ do - post "/fudge/add" "Is super tasty." - get "/list" `shouldRespondWith` "[\"fudge\"]" + -- ListRq Spec + test $ addToTopic + >> get "List topics" "/list" + >>= assertBody "[\"fudge\"]" diff --git a/tests/Level05Tests.hs b/tests/Level05Tests.hs index fd25117..7fcbdcd 100644 --- a/tests/Level05Tests.hs +++ b/tests/Level05Tests.hs @@ -4,22 +4,28 @@ module Level05Tests , doctests ) where -import Control.Monad.Reader (ask, reader) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Reader (ask, reader) -import Data.Monoid ((<>)) +import Data.Foldable (traverse_) +import Data.Monoid ((<>)) -import Data.String (IsString) +import Data.String (IsString) + +import Network.HTTP.Types as HTTP import Test.Hspec -import Test.Hspec.Wai -import qualified System.Exit as Exit +import Helpers (TestM, assertBody, assertStatus, get, + post, runTestsFor) -import qualified Level05.AppM as AppM +import qualified System.Exit as Exit -import qualified Level05.Core as Core -import qualified Level05.DB as DB -import qualified Level05.Types as Types +import qualified Level05.AppM as AppM + +import qualified Level05.Core as Core +import qualified Level05.DB as DB +import qualified Level05.Types as Types doctests :: [FilePath] doctests = @@ -43,43 +49,45 @@ unitTests = do reqsE <- Core.prepareAppReqs case reqsE of - Left err -> dieWith err + Right db -> runTestsFor (Core.app db) "Level 05 Tests" $ do - Right db -> do - let app' = pure (Core.app db) + let + flushTopic :: TestM () + flushTopic = liftIO . + -- Clean up and yell about our errors + (traverse_ (either dieWith pure) =<<) . + -- Include the runner to handle our new 'AppM' + AppM.runAppM . + -- Purge all of the comments for this topic for our tests + traverse ( DB.deleteTopic db ) + -- We don't export the constructor so even for known values we have + -- to play by the rules. There is no - "Oh just this one time.", do it right. + $ Types.mkTopic "fudge" - flushTopic = - -- Clean up and yell about our errors - either dieWith pure =<< AppM.runAppM ( - -- We don't export the constructor so even for known values we have - -- to play by the rules. There is no - "Oh just this one time.", do it right. - AppM.liftEither (Types.mkTopic testTopic) - -- Purge all of the comments for this topic for our tests - >>= DB.deleteTopic db - ) + -- Run a test and then flush the db + test t = t >> flushTopic - -- Run the tests with a DB topic flush between each spec - hspec . with ( flushTopic >> app' ) $ do - -- Save us a bit of repetition - let pOST = post ( "/" <> testTopic <> "/add" ) + topicR = "/fudge/" - -- AddRq Spec - describe "POST /topic/add" $ do - it "Should return 200 with well formed request" $ - pOST "Is super tasty." `shouldRespondWith` "Success" + addToTopic = + post "Add Topic" (topicR <> "add") "Fred" - it "Should 400 on empty input" $ - pOST "" `shouldRespondWith` 400 + -- AddRq Spec + -- it should return 200 with well formed request + test $ addToTopic >>= assertBody "Success" - -- ViewRq Spec - describe "GET /topic/view" $ - it "Should return 200 with content" $ do - _ <- pOST "Is super tasty." - get ( "/" <> testTopic <> "/view" ) `shouldRespondWith` 200 + -- it should 400 on empty input + test $ post "Empty Input" (topicR <> "add") "" + >>= assertStatus HTTP.status400 - -- ListRq Spec - describe "GET /list" $ - it "Should return 200 with content" $ do - _ <- pOST "Is super tasty." - get "/list" `shouldRespondWith` "[\"fudge\"]" + -- ViewRq Spec + -- it should return 200 with + test $ addToTopic + >> get "View topic" (topicR <> "view") + >>= assertStatus HTTP.status200 + + -- ListRq Spec + test $ addToTopic + >> get "List topics" "/list" + >>= assertBody "[\"fudge\"]" diff --git a/tests/Level06Tests.hs b/tests/Level06Tests.hs index 1a2c0f8..456a97c 100644 --- a/tests/Level06Tests.hs +++ b/tests/Level06Tests.hs @@ -4,20 +4,26 @@ module Level06Tests , unitTests ) where -import Control.Monad (join) +import Control.Monad (join) +import Control.Monad.IO.Class (liftIO) -import Data.Monoid ((<>)) -import Data.String (IsString) +import Data.Foldable (traverse_) +import Data.Monoid ((<>)) +import Data.String (IsString) + +import Network.HTTP.Types as HTTP import Test.Hspec -import Test.Hspec.Wai -import qualified System.Exit as Exit +import Helpers (TestM, assertBody, assertStatus, get, + post, runTestsFor) -import qualified Level06.AppM as AppM -import qualified Level06.Core as Core -import qualified Level06.DB as DB -import qualified Level06.Types as Types +import qualified System.Exit as Exit + +import qualified Level06.AppM as AppM +import qualified Level06.Core as Core +import qualified Level06.DB as DB +import qualified Level06.Types as Types doctests :: [FilePath] doctests = @@ -38,37 +44,45 @@ unitTests = do reqsE <- Core.prepareAppReqs case reqsE of - Left err -> dieWith err + Right (cfg, db) -> runTestsFor (Core.app cfg db) "Level 06 Tests" $ do - Right ( cfg, db ) -> do - let app' = pure (Core.app cfg db) + let + flushTopic :: TestM () + flushTopic = liftIO . + -- Clean up and yell about our errors + (traverse_ (either dieWith pure) =<<) . + -- Include the runner to handle our new 'AppM' + AppM.runAppM . + -- Purge all of the comments for this topic for our tests + traverse ( DB.deleteTopic db ) + -- We don't export the constructor so even for known values we have + -- to play by the rules. There is no - "Oh just this one time.", do it right. + $ Types.mkTopic "fudge" - flushTopic :: IO () - flushTopic = either dieWith pure =<< AppM.runAppM - (AppM.liftEither (Types.mkTopic testTopic) >>= DB.deleteTopic db) + -- Run a test and then flush the db + test t = t >> flushTopic - -- Run the tests with a DB topic flush between each spec - hspec . with ( flushTopic >> app' ) $ do - -- Save us a bit of repetition - let pOST = post ( "/" <> testTopic <> "/add" ) + topicR = "/fudge/" - -- AddRq Spec - describe "POST /topic/add" $ do - it "Should return 200 with well formed request" $ - pOST "Is super tasty." `shouldRespondWith` "Success" + addToTopic = + post "Add Topic" (topicR <> "add") "Fred" - it "Should 400 on empty input" $ - pOST "" `shouldRespondWith` 400 + -- AddRq Spec + -- it should return 200 with well formed request + test $ addToTopic >>= assertBody "Success" - -- ViewRq Spec - describe "GET /topic/view" $ - it "Should return 200 with content" $ do - _ <- pOST "Is super tasty." - get ( "/" <> testTopic <> "/view" ) `shouldRespondWith` 200 + -- it should 400 on empty input + test $ post "Empty Input" (topicR <> "add") "" + >>= assertStatus HTTP.status400 - -- ListRq Spec - describe "GET /list" $ - it "Should return 200 with content" $ do - _ <- pOST "Is super tasty." - get "/list" `shouldRespondWith` "[\"fudge\"]" + -- ViewRq Spec + -- it should return 200 with + test $ addToTopic + >> get "View topic" (topicR <> "view") + >>= assertStatus HTTP.status200 + + -- ListRq Spec + test $ addToTopic + >> get "List topics" "/list" + >>= assertBody "[\"fudge\"]" diff --git a/tests/Level07Tests.hs b/tests/Level07Tests.hs index baaa7bd..dd3cb2f 100644 --- a/tests/Level07Tests.hs +++ b/tests/Level07Tests.hs @@ -4,24 +4,30 @@ module Level07Tests , doctests ) where -import Control.Monad.Reader (ask, reader) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Reader (ask, reader) -import Control.Monad (join) +import Control.Monad (join) -import Data.Monoid ((<>)) -import Data.String (IsString) +import Data.Foldable (traverse_) +import Data.Monoid ((<>)) +import Data.String (IsString) import Test.Hspec -import Test.Hspec.Wai -import qualified System.Exit as Exit +import Network.HTTP.Types as HTTP -import Level07.AppM (Env) -import qualified Level07.AppM as AppM +import Helpers (TestM, assertBody, assertStatus, get, + post, runTestsFor) -import qualified Level07.Core as Core -import qualified Level07.DB as DB -import qualified Level07.Types as Types +import qualified System.Exit as Exit + +import Level07.AppM (Env) +import qualified Level07.AppM as AppM + +import qualified Level07.Core as Core +import qualified Level07.DB as DB +import qualified Level07.Types as Types doctests :: [FilePath] doctests = @@ -40,51 +46,50 @@ unitTests = do testTopic :: IsString s => s testTopic = "fudge" - -- Keeping everything in sync with out larger application changes. reqsE <- Core.prepareAppReqs case reqsE of - Left err -> dieWith err + Right e -> runTestsFor (Core.app e) "Level 07 API Tests" $ do - Right env -> do - let app' = pure ( Core.app env ) + let + flushTopic :: TestM () + flushTopic = liftIO . + -- Clean up and yell about our errors + (traverse_ (either dieWith pure) =<<) . + -- Include the runner to handle our new 'AppM' + flip AppM.runAppM e . + -- Purge all of the comments for this topic for our tests + traverse DB.deleteTopic + -- We don't export the constructor so even for known values we have + -- to play by the rules. There is no - "Oh just this one time.", do it right. + $ Types.mkTopic "fudge" - flushTopic :: IO () - flushTopic = either dieWith pure =<< AppM.runAppM - (AppM.liftEither =<< traverse DB.deleteTopic ( Types.mkTopic testTopic )) - env + -- Run a test and then flush the db + test t = t >> flushTopic - -- We can't run the tests for our AppM in the same stage as our - -- application, because of the use of the 'with' function. As it expects - -- to be able to execute our tests by applying it to our 'Application'. - hspec $ appMTests env + topicR = "/fudge/" - -- Run the tests with a DB topic flush between each spec - hspec . with ( flushTopic >> app' ) $ do + addToTopic = + post "Add Topic" (topicR <> "add") "Fred" - -- Save us a bit of repetition - let pOST = post ( "/" <> testTopic <> "/add" ) + -- AddRq Spec + -- it should return 200 with well formed request + test $ addToTopic >>= assertBody "Success" - -- AddRq Spec - describe "POST /topic/add" $ do - it "Should return 200 with well formed request" $ - pOST "Is super tasty." `shouldRespondWith` "Success" + -- it should 400 on empty input + test $ post "Empty Input" (topicR <> "add") "" + >>= assertStatus HTTP.status400 - it "Should 400 on empty input" $ - pOST "" `shouldRespondWith` 400 - - -- ViewRq Spec - describe "GET /topic/view" $ - it "Should return 200 with content" $ do - _ <- pOST "Is super tasty." - get ( "/" <> testTopic <> "/view" ) `shouldRespondWith` 200 - - -- ListRq Spec - describe "GET /list" $ - it "Should return 200 with content" $ do - _ <- pOST "Is super tasty." - get "/list" `shouldRespondWith` "[\"fudge\"]" + -- ViewRq Spec + -- it should return 200 with + test $ addToTopic + >> get "View topic" (topicR <> "view") + >>= assertStatus HTTP.status200 + -- ListRq Spec + test $ addToTopic + >> get "List topics" "/list" + >>= assertBody "[\"fudge\"]" -- These tests ensure that our AppM will do we want it to, with respect to the -- behaviour of 'ask', 'reader', and use in a Monad. @@ -93,13 +98,13 @@ appMTests env = describe "AppM Tests" $ do it "ask should retrieve the Env" $ do r <- AppM.runAppM ask env - ( (AppM.envConfig <$> r) == (Right $ AppM.envConfig env) ) `shouldBe` True + ( (AppM.envConfig <$> r) == Right (AppM.envConfig env) ) `shouldBe` True it "reader should run a function on the Env" $ do let getDBfilepath = Types.dbFilePath . AppM.envConfig r <- AppM.runAppM ( reader getDBfilepath ) env - r `shouldBe` (Right $ getDBfilepath env) + r `shouldBe` Right (getDBfilepath env) it "should let us run IO functions" $ do let fn = do