test/Hspec/Server/Error.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 {-# OPTIONS_GHC -Wno-missing-signatures #-}
   3 module Hspec.Server.Error where
   4
   5 import Control.Monad (when)
   6 import Data.Bool
   7 import Data.Either (Either(..))
   8 import Data.Eq (Eq(..))
   9 import Data.Int (Int)
  10 import Data.Maybe (Maybe(..))
  11 import Data.String (String)
  12 import Prelude ((+))
  13 import System.IO (IO)
  14 import Test.Hspec.Wai (liftIO)
  15 import Text.Read (readMaybe)
  16 import Text.Show (Show(..))
  17 import qualified Data.ByteString.Base64 as BS64
  18 import qualified Data.ByteString.Lazy as BSL
  19 import qualified Data.Text as Text
  20 import qualified Data.Text.Encoding as Text
  21 import qualified Data.Text.Lazy as TL
  22 import qualified Data.Text.Lazy.Encoding as TL
  23 import qualified Network.HTTP.Types as HTTP
  24 import qualified Network.Wai.Handler.Warp as Warp
  25 import qualified Test.Hspec.Wai as Wai
  26
  27 import Symantic.HTTP
  28 import Hspec.Utils
  29
  30 api = "good" </> "path" </> capture @Int "i"
  31                         <.> queryParams @Int "param"
  32                         <.> basicAuth @User "realm"
  33                         <.> body @Int @'[PlainText]
  34                         <.> post @Int @'[PlainText]
  35     <!> "unauthorized"  </> basicAuth @UnauthorizedUser "realm"
  36                         <.> post @Int @'[PlainText]
  37
  38 data User = User
  39 instance ServerBasicAuth User where
  40         serverBasicAuth user pass =
  41                 return $
  42                         if user=="user"
  43                         then if pass=="pass"
  44                                 then BasicAuth_Authorized User
  45                                 else BasicAuth_BadPassword
  46                         else BasicAuth_NoSuchUser
  47 data UnauthorizedUser = UnauthorizedUser
  48 instance ServerBasicAuth UnauthorizedUser where
  49         serverBasicAuth user pass =
  50                 return $
  51                         if user=="user"
  52                         then if pass=="pass"
  53                                 then BasicAuth_Unauthorized
  54                                 else BasicAuth_BadPassword
  55                         else BasicAuth_NoSuchUser
  56
  57 srv = server api $ route_good :!: route_unauthorized
  58         where
  59         route_good i params User (ServerBodyArg b) = return (i+b)
  60         route_unauthorized UnauthorizedUser = return 0
  61
  62 warp :: IO ()
  63 warp = Warp.run 8080 srv
  64
  65 hspec = testSpecs $ describe "Error" $ Wai.with (return srv) $ do
  66         describe "Path" $ do
  67                 it "checks shorter path" $ do
  68                         Wai.get "/good"
  69                          `Wai.shouldRespondWith` 404
  70                 it "checks longer path" $ do
  71                         Wai.get "/good/path/bad"
  72                          `Wai.shouldRespondWith` 404
  73         describe "BasicAuth" $ do
  74                 it "can decode username and password" $ do
  75                         Wai.request goodMethod goodURI goodHeaders goodBody
  76                          `Wai.shouldRespondWith` 200
  77                 it "checks username" $ do
  78                         Wai.request goodMethod goodURI
  79                          [ (HTTP.hAuthorization, "Basic "<>BS64.encode "no-such-user:pass")
  80                          , goodAccept
  81                          , goodContentType
  82                          ] goodBody
  83                          `Wai.shouldRespondWith` 401
  84                 it "checks password" $ do
  85                         Wai.request goodMethod goodURI
  86                          [ (HTTP.hAuthorization, "Basic "<>BS64.encode "user:wrong-pass")
  87                          , goodAccept
  88                          , goodContentType
  89                          ] goodBody
  90                          `Wai.shouldRespondWith` 401
  91                 it "can deny access" $ do
  92                         Wai.request goodMethod "/unauthorized" goodHeaders goodBody
  93                          `Wai.shouldRespondWith` 403
  94         describe "Priorities" $ do
  95                 it "has 404 as its highest priority error (path)" $ do
  96                         Wai.request badMethod badURI [badAuth, badAccept, badContentType] badBody
  97                         `Wai.shouldRespondWith` 404
  98                 it "has 405 as its second highest priority error (method)" $ do
  99                         Wai.request badMethod badParam [badAuth, badAccept, badContentType] badBody
 100                         `Wai.shouldRespondWith` 405
 101                 it "has 401 as its third highest priority error (auth)" $ do
 102                         Wai.request goodMethod badParam [badAuth, badAccept, badContentType] badBody
 103                         `Wai.shouldRespondWith` 401
 104                 it "has 406 as its fourth highest priority error (accept)" $ do
 105                         Wai.request goodMethod badParam [goodAuth, badAccept, badContentType] badBody
 106                         `Wai.shouldRespondWith` 406
 107                 it "has 415 as its fifth highest priority error (content type)" $ do
 108                         Wai.request goodMethod badParam [goodAuth, goodAccept, badContentType] badBody
 109                         `Wai.shouldRespondWith` 415
 110                 it "has 400 as its sixth highest priority error (query and body)" $ do
 111                         badParamsRes <- Wai.request goodMethod badParam goodHeaders goodBody
 112                         badBodyRes   <- Wai.request goodMethod goodURI  goodHeaders badBody
 113
 114                         -- Both bad body and bad params result in 400
 115                         return badParamsRes `Wai.shouldRespondWith` 400
 116                         return badBodyRes   `Wai.shouldRespondWith` 400
 117
 118                         -- Param check should occur before body checks
 119                         badBothRes <- Wai.request goodMethod badParam
 120                          [goodAuth, goodAccept, goodContentType] badBody
 121                         when (badBothRes /= badParamsRes) $ liftIO $
 122                                 expectationFailure $ "badParam + badBody /= badParam: "
 123                                  <> show badBothRes <> ", " <> show badParamsRes
 124                         when (badBothRes == badBodyRes) $ liftIO $
 125                                 expectationFailure $ "badParam + badBody == badBody: "
 126                                  <> show badBothRes
 127
 128
 129 badContentType  = (HTTP.hContentType, "application/json")
 130 badAccept       = (HTTP.hAccept, "application/json")
 131 badMethod       = HTTP.methodGet
 132 badURI          = "bad"
 133 badBody         = "bad"
 134 badAuth         = (HTTP.hAuthorization, "Basic foofoofoo")
 135 goodContentType = (HTTP.hContentType, "text/plain;charset=utf-8")
 136 goodAccept      = (HTTP.hAccept, "text/plain")
 137 goodMethod      = HTTP.methodPost
 138 goodPath        = "good/path/4"
 139 goodURI         = goodPath<>"?param=2"
 140 badParam        = goodPath<>"?param=foo"
 141 goodBody        = "42" -- {-encode-} (42::Int)
 142 goodAuth        = (HTTP.hAuthorization, "Basic "<>BS64.encode "user:pass")
 143 goodHeaders     = [goodAuth, goodAccept, goodContentType]