hairy-0.1.0: test-suite/Main.hs

{-# LANGUAGE OverloadedStrings #-}

module Main
  ( main
  ) where

import Control.Monad.Reader (runReaderT)
import Hairy (Config (Config), Environment (Test), application, pool,
  environment, getPool, runConfigM)
import Hairy.Models (Task (Task), taskContent, taskCreated)
import Data.Time.Calendar (fromGregorian)
import Data.Time.Clock (UTCTime (UTCTime), utctDay, utctDayTime)
import Database.Persist.Sql (ConnectionPool, insert_, rawExecute, runSqlPool)
import Network.HTTP.Types.Status (created201, notFound404, ok200)
import Network.Wai.Internal (requestMethod)
import Network.Wai.Test (SRequest (SRequest), defaultRequest, request,
  runSession, setPath, simpleBody, simpleHeaders, simpleRequest,
  simpleRequestBody, simpleStatus, srequest)
import Test.Hspec (before, describe, hspec, it, shouldBe)
import Web.Scotty.Trans (scottyAppT)

main :: IO ()
main = do
  let e = Test
  p <- getPool e
  let c = Config
        { environment = e
        , pool = p
        }
      t m = runReaderT (runConfigM m) c
  a <- scottyAppT t t application

  hspec $ before (resetDB p) $ do
    describe "/" $ do
      describe "GET" $ do
        it "404s" $ do
          r <- runSession (request defaultRequest) a
          simpleStatus r `shouldBe` notFound404
          lookup "Content-Type" (simpleHeaders r) `shouldBe`
            Just "application/json; charset=utf-8"
          simpleBody r `shouldBe` "null"

    describe "/tasks" $ do
      describe "GET" $ do
        it "lists the tasks" $ do
          r <- runSession (request (defaultRequest `setPath` "/tasks")) a
          simpleStatus r `shouldBe` ok200
          lookup "Content-Type" (simpleHeaders r) `shouldBe`
            Just "application/json; charset=utf-8"
          simpleBody r `shouldBe` "[]"

      describe "POST" $ do
        it "creates a task" $ do
          let req = srequest SRequest
                { simpleRequest = defaultRequest
                  { requestMethod = "POST"
                  } `setPath` "/tasks"
                , simpleRequestBody = "{\"content\":\"\",\"created\":\"2001-02-03T04:05:06Z\"}"
                }
          r <- runSession req a
          simpleStatus r `shouldBe` created201
          lookup "Content-Type" (simpleHeaders r) `shouldBe`
            Just "application/json; charset=utf-8"
          simpleBody r `shouldBe`
            "{\"created\":\"2001-02-03T04:05:06.000Z\",\"content\":\"\"}"

    describe "/tasks/:id" $ before (createTask p) $ do
      describe "GET" $ do
        it "shows the task" $ do
          r <- runSession (request (setPath defaultRequest "/tasks/1")) a
          simpleStatus r `shouldBe` ok200
          lookup "Content-Type" (simpleHeaders r) `shouldBe`
            Just "application/json; charset=utf-8"
          simpleBody r `shouldBe`
            "{\"created\":\"2001-02-03T04:05:06.000Z\",\"content\":\"\"}"

      describe "PUT" $ do
        it "replaces the task" $ do
          let req = srequest SRequest
                { simpleRequest = defaultRequest
                  { requestMethod = "PUT"
                  } `setPath` "/tasks/1"
                , simpleRequestBody = "{\"content\":\"!\",\"created\":\"2001-02-03T04:05:06Z\"}"
                }
          r <- runSession req a
          simpleStatus r `shouldBe` ok200
          lookup "Content-Type" (simpleHeaders r) `shouldBe`
            Just "application/json; charset=utf-8"
          simpleBody r `shouldBe`
            "{\"created\":\"2001-02-03T04:05:06.000Z\",\"content\":\"!\"}"

      describe "DELETE" $ do
        it "deletes the task" $ do
          r <- runSession (request (defaultRequest { requestMethod = "DELETE" }`setPath` "/tasks/1")) a
          simpleStatus r `shouldBe` ok200
          lookup "Content-Type" (simpleHeaders r) `shouldBe`
            Just "application/json; charset=utf-8"
          simpleBody r `shouldBe` "null"

resetDB :: ConnectionPool -> IO ()
resetDB = runSqlPool (rawExecute "TRUNCATE TABLE task RESTART IDENTITY" [])

createTask :: ConnectionPool -> IO ()
createTask = runSqlPool (insert_ task) where
  task = Task
    { taskContent = ""
    , taskCreated = UTCTime
      { utctDay = fromGregorian 2001 2 3
      , utctDayTime = 14706
      }
    }