twain-2.1.0.0: test/TwainSpec.hs

module TwainSpec where

import Web.Twain
import Control.Monad (when)
import Control.Monad.IO.Class (liftIO)
import Data.String (fromString)
import Test.Hspec
import qualified Test.Hspec.Wai as Test

-- * Tests

spec :: Spec
spec = Test.with (pure app) $ do
  describe "GET" $ do
    describe "GET /" $ do
      it "responds with 200 & html 'hello world'" $
        Test.shouldRespondWith
          (Test.get "/")
          "Hello World!"
            { Test.matchStatus = 200
            , Test.matchHeaders = ["Content-Type" Test.<:> "text/html; charset=utf-8"]
            }

    describe "GET /json" $ do
      it "responds with Content-Type application/json" $
        Test.shouldRespondWith
          (Test.get "/json")
          "[true]"
            { Test.matchStatus = 200
            , Test.matchHeaders = ["Content-Type" Test.<:> "application/json; charset=utf-8"]
            }

    describe "GET /css" $ do
      it "responds with Content-Type text/css" $
        Test.shouldRespondWith
          (Test.get "/css")
          (fromString style)
            { Test.matchStatus = 200
            , Test.matchHeaders = ["Content-Type" Test.<:> "text/css; charset=utf-8"]
            }

    describe "GET /notfound" $ do
      it "responds with 404 / 'Not found...'" $
        Test.shouldRespondWith
          (Test.get "/notfound")
          "Not found..." { Test.matchStatus = 404 }

  describe "POST" $ do
    describe "POST /echo/James" $ do
      it "Without body - responds with 200 & 'Hello, James'" $
        Test.shouldRespondWith
          (Test.post "/echo/James" "")
          "Hello, James" { Test.matchStatus = 200 }

      it "With body - responds with 200 & 'Hello, Jameson'" $
        Test.shouldRespondWith
          (Test.postHtmlForm "/echo/James" [("bodyname", "Jameson")])
          "Hello, Jameson" { Test.matchStatus = 200 }

    describe "POST /echo/" $ do
      it "responds with 404 & 'Person not specified...' (next works correctly)" $
        Test.shouldRespondWith
          (Test.postHtmlForm "/echo/" [])
          "Person not specified..." { Test.matchStatus = 404 }

-- * App

app :: Application
app = foldr ($) (notFound missing) routes

routes :: [Middleware]
routes =
  [ get "/" index
  , get "/json" myjson
  , get "/css" (send $ css $ fromString style)
  , post "/echo/:name" echo
  , post "/echo/:name" missingPerson
  ]

index :: ResponderM a
index = send $ html "Hello World!"

myjson :: ResponderM a
myjson = send $ json [True]

style :: String
style = "body { width: 900px; margin: auto; }"

echo :: ResponderM a
echo = do
  name <- fmap (unwords . words) $ paramMaybe "bodyname" >>= maybe (param "name") pure
  when (null name) $ next
  send $ html $ "Hello, " <> fromString name

missing :: ResponderM a
missing = send $ html "Not found..."

missingPerson :: ResponderM a
missingPerson =
  send $
    raw status404 [("Content-Type", "text/html; charset=utf-8")] $
      "Person not specified..."