diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2012-2014 Fujimura Daisuke, Simon Hengel +Copyright (c) 2012-2018 Fujimura Daisuke, Simon Hengel Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal diff --git a/hspec-wai-json.cabal b/hspec-wai-json.cabal --- a/hspec-wai-json.cabal +++ b/hspec-wai-json.cabal @@ -1,54 +1,62 @@ --- This file has been generated from package.yml by hpack version 0.2.0. +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.38.3. -- -- see: https://github.com/sol/hpack -name: hspec-wai-json -version: 0.6.1 -homepage: https://github.com/hspec/hspec-wai#readme -bug-reports: https://github.com/hspec/hspec-wai/issues -license: MIT -license-file: LICENSE -copyright: (c) 2012-2014 Fujimura Daisuke, - (c) 2014 Simon Hengel -author: Fujimura Daisuke , - Simon Hengel -maintainer: Fujimura Daisuke , - Simon Hengel -build-type: Simple -cabal-version: >= 1.10 -category: Testing -synopsis: Testing JSON APIs with hspec-wai -description: Testing JSON APIs with hspec-wai +name: hspec-wai-json +version: 0.12.0 +synopsis: Testing JSON APIs with hspec-wai +description: Testing JSON APIs with hspec-wai +category: Testing +homepage: https://github.com/hspec/hspec-wai#readme +bug-reports: https://github.com/hspec/hspec-wai/issues +author: Fujimura Daisuke , + Simon Hengel +maintainer: Fujimura Daisuke , + Simon Hengel +copyright: (c) 2012-2014 Fujimura Daisuke, + (c) 2014-2018 Simon Hengel +license: MIT +license-file: LICENSE +build-type: Simple source-repository head type: git location: https://github.com/hspec/hspec-wai library - hs-source-dirs: src exposed-modules: Test.Hspec.Wai.JSON + other-modules: + Paths_hspec_wai_json + hs-source-dirs: + src + ghc-options: -Wall build-depends: - base == 4.* - , hspec-wai == 0.6.* + aeson + , aeson-qq >=0.7.3 + , base ==4.* , bytestring - , template-haskell - , aeson - , aeson-qq >= 0.7.3 , case-insensitive - ghc-options: -Wall + , hspec-wai ==0.12.0 + , template-haskell default-language: Haskell2010 test-suite spec type: exitcode-stdio-1.0 - hs-source-dirs: test main-is: Spec.hs other-modules: Test.Hspec.Wai.JSONSpec + Paths_hspec_wai_json + hs-source-dirs: + test + ghc-options: -Wall + build-tool-depends: + hspec-discover:hspec-discover build-depends: - base == 4.* - , hspec-wai-json - , hspec-wai + base ==4.* , hspec - ghc-options: -Wall + , hspec-wai + , hspec-wai-json default-language: Haskell2010 diff --git a/src/Test/Hspec/Wai/JSON.hs b/src/Test/Hspec/Wai/JSON.hs --- a/src/Test/Hspec/Wai/JSON.hs +++ b/src/Test/Hspec/Wai/JSON.hs @@ -5,17 +5,15 @@ , FromValue(..) ) where -import Control.Arrow (second) -import Data.List import Data.ByteString.Lazy (ByteString) -import qualified Data.ByteString.Lazy as BL -import Data.Aeson (Value, encode) +import qualified Data.ByteString.Char8 as B +import Data.Char +import Data.Aeson (Value, decode, encode) import Data.Aeson.QQ -import qualified Data.CaseInsensitive as CI import Language.Haskell.TH.Quote import Test.Hspec.Wai -import Test.Hspec.Wai.Internal (formatHeader) +import Test.Hspec.Wai.Matcher -- $setup -- The examples in this module assume that you have the @QuasiQuotes@ language @@ -56,19 +54,44 @@ fromValue :: Value -> a instance FromValue ResponseMatcher where - fromValue v = ResponseMatcher 200 [MatchHeader p] (Just body) + fromValue = ResponseMatcher 200 [matchHeader] . equalsJSON where - body = fromValue v - - permissibleHeaders = addIfASCII ("Content-Type", "application/json") [("Content-Type", "application/json; charset=utf-8")] + matchHeader = MatchHeader $ \headers _body -> + case lookup "Content-Type" headers of + Just h | isJSON h -> Nothing + _ -> Just $ unlines [ + "missing header:" + , formatHeader ("Content-Type", "application/json") + ] + isJSON c = media == "application/json" && parameters `elem` ignoredParameters + where + (media, parameters) = let (m, p) = breakAt ';' c in (strip m, strip p) - addIfASCII h = if BL.all (< 128) body then (h :) else id + -- Technically, no parameters are required nor optional for + -- application/json. However, as charset=utf-8 is widely added by + -- other software and compliant recipients should ignore any charset + -- (as per http://www.iana.org/assignments/media-types/application/json) + -- we ignore charset=utf-8 here. + -- + -- This is a decision made for pragmatism! + -- + -- I'm still pretty much against ignoring any other charsets. Adding + -- a charset parameter is non-standard and hspec-wai is not just a + -- compliant recipients but a testing software. Hence I take the + -- stance that the job of a testing software is not just to accept + -- what a compliant client would accept but also to enforce standard + -- conformance. + ignoredParameters = ["", "charset=utf-8"] - mkCI = map (second CI.mk) + breakAt c = fmap (B.drop 1) . B.break (== c) + strip = B.reverse . B.dropWhile isSpace . B.reverse . B.dropWhile isSpace - p headers = if any (`elem` mkCI permissibleHeaders) (mkCI headers) - then Nothing - else (Just . unlines) ("missing header:" : (intersperse " OR" $ map formatHeader permissibleHeaders)) +equalsJSON :: Value -> MatchBody +equalsJSON expected = MatchBody matcher + where + matcher headers actualBody = case decode actualBody of + Just actual | actual == expected -> Nothing + _ -> let MatchBody m = bodyEquals (encode expected) in m headers actualBody instance FromValue ByteString where fromValue = encode diff --git a/test/Test/Hspec/Wai/JSONSpec.hs b/test/Test/Hspec/Wai/JSONSpec.hs --- a/test/Test/Hspec/Wai/JSONSpec.hs +++ b/test/Test/Hspec/Wai/JSONSpec.hs @@ -1,9 +1,13 @@ -{-# LANGUAGE OverloadedStrings, QuasiQuotes #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} module Test.Hspec.Wai.JSONSpec (main, spec) where import Test.Hspec +import Data.String -import Test.Hspec.Wai +import Test.Hspec.Wai hiding (pending) import Test.Hspec.Wai.JSON main :: IO () @@ -12,33 +16,48 @@ spec :: Spec spec = do describe "json" $ do + context "when matching body" $ do + let MatchBody matcher = matchBody [json|{foo: 23}|] + + it "ignores whitespace" $ do + let + actual = fromString $ unlines [ + "{" + , show ("foo" :: String) ++ " : 23" + , "}" + ] + matcher [] actual `shouldBe` Nothing + + it "rejects bodies that are not equal" $ do + matcher [] [json|{foo: 42}|] `shouldBe` Just (unlines [ + "body mismatch:" + , " expected: {\"foo\":23}" + , " but got: {\"foo\":42}" + ]) + context "when matching Content-Type header" $ do - context "when JSON is ASCII" $ do - let [MatchHeader matcher] = matchHeaders [json|{foo: 23}|] - it "accepts 'application/json'" $ do - matcher [("Content-Type", "application/json")] `shouldBe` Nothing + let + body = [json|{foo: 23}|] + [MatchHeader matcher] = matchHeaders body + match = (`matcher` body) - it "accepts 'application/json; charset=utf-8'" $ do - matcher [("Content-Type", "application/json; charset=utf-8")] `shouldBe` Nothing + it "accepts 'application/json'" $ do + match [("Content-Type", "application/json")] `shouldBe` Nothing - it "ignores case" $ do - matcher [("Content-Type", "application/JSON; charset=UTF-8")] `shouldBe` Nothing + it "ignores 'charset=utf-8'" $ do + match [("Content-Type", "application/json;charset=utf-8")] `shouldBe` Nothing - it "rejects other headers" $ do - matcher [("Content-Type", "foobar")] `shouldBe` (Just . unlines) [ - "missing header:" - , " Content-Type: application/json" - , " OR" - , " Content-Type: application/json; charset=utf-8" - ] + it "ignores whitespace" $ do + match [("Content-Type", "application/json ; charset=utf-8")] `shouldBe` Nothing - context "when JSON contains Unicode" $ do - let [MatchHeader matcher] = matchHeaders [json|{foo: #{"\955" :: String}}|] - it "rejects 'application/json'" $ do - matcher [("Content-Type", "application/json")] `shouldBe` (Just . unlines) [ - "missing header:" - , " Content-Type: application/json; charset=utf-8" - ] + it "requires a Content-Type header" $ do + match [] `shouldBe` (Just. unlines) [ + "missing header:" + , " Content-Type: application/json" + ] - it "accepts 'application/json; charset=utf-8'" $ do - matcher [("Content-Type", "application/json; charset=utf-8")] `shouldBe` Nothing + it "rejects other values for Content-Type" $ do + match [("Content-Type", "foobar")] `shouldBe` (Just . unlines) [ + "missing header:" + , " Content-Type: application/json" + ]