diff --git a/yesod-core/ChangeLog.md b/yesod-core/ChangeLog.md index 9f35d9df..f4923073 100644 --- a/yesod-core/ChangeLog.md +++ b/yesod-core/ChangeLog.md @@ -1,5 +1,9 @@ # ChangeLog for yesod-core +## 1.6.17 + +Adds `contentTypeIsJson` [#1646](https://github.com/yesodweb/yesod/pull/1646) + ## 1.6.16.1 * Compiles with GHC 8.8.1 diff --git a/yesod-core/src/Yesod/Core/Json.hs b/yesod-core/src/Yesod/Core/Json.hs index 5fe75ccf..a51f5928 100644 --- a/yesod-core/src/Yesod/Core/Json.hs +++ b/yesod-core/src/Yesod/Core/Json.hs @@ -32,6 +32,9 @@ module Yesod.Core.Json , jsonOrRedirect , jsonEncodingOrRedirect , acceptsJson + + -- * Checking if data is JSON + , contentTypeHeaderIsJson ) where import Yesod.Core.Handler (HandlerFor, getRequest, invalidArgs, redirect, selectRep, provideRep, rawRequestBody, ProvidedRep, lookupHeader) @@ -134,8 +137,8 @@ parseInsecureJsonBody = do parseCheckJsonBody :: (MonadHandler m, J.FromJSON a) => m (J.Result a) parseCheckJsonBody = do mct <- lookupHeader "content-type" - case fmap (B8.takeWhile (/= ';')) mct of - Just "application/json" -> parseInsecureJsonBody + case fmap contentTypeHeaderIsJson mct of + Just True -> parseInsecureJsonBody _ -> return $ J.Error $ "Non-JSON content type: " ++ show mct -- | Same as 'parseInsecureJsonBody', but return an invalid args response on a parse @@ -219,3 +222,11 @@ acceptsJson = (maybe False ((== "application/json") . B8.takeWhile (/= ';')) . reqAccept) `liftM` getRequest +-- | Given the @Content-Type@ header, returns if it is JSON. +-- +-- This function is currently a simple check for @application/json@, but in the future may check for +-- alternative representations such as @@. +-- +-- @since 1.6.17 +contentTypeHeaderIsJson :: B8.ByteString -> Bool +contentTypeHeaderIsJson bs = B8.takeWhile (/= ';') bs == "application/json" diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index d0596efb..a5b6af51 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -1,5 +1,5 @@ name: yesod-core -version: 1.6.16.1 +version: 1.6.17 license: MIT license-file: LICENSE author: Michael Snoyman diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs index 1bd999e8..d7a704f4 100644 --- a/yesod-test/Yesod/Test.hs +++ b/yesod-test/Yesod/Test.hs @@ -171,6 +171,7 @@ import System.IO import Yesod.Core.Unsafe (runFakeHandler) import Yesod.Test.TransversingCSS import Yesod.Core +import Yesod.Core.Json (contentTypeHeaderIsJson) import qualified Data.Text.Lazy as TL import Data.Text.Lazy.Encoding (encodeUtf8, decodeUtf8, decodeUtf8With) import Text.XML.Cursor hiding (element) @@ -604,7 +605,7 @@ htmlCount query count = do -- | Parses the response body from JSON into a Haskell value, throwing an error if parsing fails. -- --- This function also checks that the @Content-Type@ of the response is @application/json@. +-- This function also checks that the @Content-Type@ of the response is @application\/json@. -- -- ==== __Examples__ -- @@ -619,7 +620,7 @@ requireJSONResponse :: (HasCallStack, FromJSON a) => YesodExample site a requireJSONResponse = do withResponse $ \(SResponse _status headers body) -> do let mContentType = lookup hContentType headers - isJSONContentType = maybe False (\contentType -> BS8.takeWhile (/= ';') contentType == "application/json") mContentType + isJSONContentType = maybe False contentTypeHeaderIsJson mContentType unless isJSONContentType (failure $ T.pack $ "Expected `Content-Type: application/json` in the headers, got: " ++ show headers)