symantic-http-test/Hspec/Server/Raw.hs

   1 {-# LANGUAGE NoMonomorphismRestriction #-}
   2 {-# LANGUAGE OverloadedStrings #-}
   3 {-# OPTIONS -Wno-missing-signatures #-}
   4 module Hspec.Server.Raw where
   5
   6 import Data.Int (Int)
   7 import Data.String (String, IsString(..))
   8 import System.IO (IO)
   9 import Text.Show (Show(..))
  10 import qualified Control.Monad.Classes as MC
  11 import qualified Network.HTTP.Types as HTTP
  12 import qualified Network.Wai as Wai
  13 import qualified Network.Wai.Test as Wai
  14 import qualified Network.Wai.Test
  15 import Data.Function (const)
  16
  17 import Symantic.HTTP
  18 import Symantic.HTTP.Server
  19 import Hspec.Utils
  20
  21 api = "foo" </> raw
  22
  23 rawApplication :: Show a => (Wai.Request -> a) -> Wai.Application
  24 rawApplication f req res =
  25         res $ Wai.responseLBS HTTP.ok200 [] (fromString $ show $ f req)
  26
  27 hspec = testSpecs $ describe "Raw" $ do
  28         it "runs applications" $ do
  29                 (`Wai.runSession` server api (rawApplication (const (42 :: Int)))) $ do
  30                         res <- Network.Wai.Test.request Wai.defaultRequest
  31                          { Wai.pathInfo = ["foo"] }
  32                         MC.exec @IO $ do
  33                                 Wai.simpleBody res `shouldBe` "42"
  34         it "gets the pathInfo modified" $ do
  35                 (`Wai.runSession` server api (rawApplication Wai.pathInfo)) $ do
  36                         res <- Network.Wai.Test.request Wai.defaultRequest
  37                          { Wai.pathInfo = ["foo", "bar"] }
  38                         MC.exec @IO $ do
  39                                 Wai.simpleBody res `shouldBe` fromString (show ["bar" :: String])