hspec-wai-json 0.6.1 → 0.12.0

raw patch · 4 files changed

Files

• LICENSE +1/−1
• hspec-wai-json.cabal +38/−30
• src/Test/Hspec/Wai/JSON.hs +38/−15
• test/Test/Hspec/Wai/JSONSpec.hs +45/−26

@@ -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

@@ -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 <me@fujimuradaisuke.com>,-                  Simon Hengel <sol@typeful.net>-maintainer:       Fujimura Daisuke <me@fujimuradaisuke.com>,-                  Simon Hengel <sol@typeful.net>-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 <me@fujimuradaisuke.com>,+                Simon Hengel <sol@typeful.net>+maintainer:     Fujimura Daisuke <me@fujimuradaisuke.com>,+                Simon Hengel <sol@typeful.net>+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

@@ -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

@@ -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"+          ]