    {-# LANGUAGE OverloadedStrings #-}
    {-# OPTIONS_GHC -fno-warn-orphans #-}

    module Yesod.Core.Json
        ( -- * Convert from a JSON value
          defaultLayoutJson
        , jsonToRepJson
        , returnJson
        , returnJsonEncoding
        , provideJson

          -- * Convert to a JSON value
        , parseCheckJsonBody
        , parseInsecureJsonBody
        , requireCheckJsonBody
        , requireInsecureJsonBody
          -- ** Deprecated JSON conversion
        , parseJsonBody
        , parseJsonBody_
        , requireJsonBody

          -- * Produce JSON values
        , J.Value (..)
        , J.ToJSON (..)
        , J.FromJSON (..)
        , array
        , object
        , (.=)
        , (J..:)

          -- * Convenience functions
        , jsonOrRedirect
        , jsonEncodingOrRedirect
        , acceptsJson

          -- * Checking if data is JSON
        , contentTypeHeaderIsJson
        ) where

    import Yesod.Core.Handler (HandlerFor, getRequest, invalidArgs, redirect, selectRep, provideRep, rawRequestBody, ProvidedRep, lookupHeader)
    import Control.Monad.Trans.Writer (Writer)
    import Data.Monoid (Endo)
    import Yesod.Core.Content (TypedContent)
    import Yesod.Core.Types (reqAccept)
    import Yesod.Core.Class.Yesod (defaultLayout, Yesod)
    import Yesod.Core.Class.Handler
    import Yesod.Core.Widget (WidgetFor)
    import Yesod.Routes.Class
    import qualified Data.Aeson as J
    import qualified Data.Aeson.Parser as JP
    import Data.Aeson ((.=), object)
    import Data.Conduit.Attoparsec (sinkParser)
    import Data.Text (pack)
    import qualified Data.Vector as V
    import Data.Conduit
    import Data.Conduit.Lift
    import qualified Data.ByteString.Char8 as B8
    import Data.Maybe (listToMaybe)
    import Control.Monad (liftM)

    -- | Provide both an HTML and JSON representation for a piece of
    -- data, using the default layout for the HTML output
    -- ('defaultLayout').
    --
    -- @since 0.3.0
    defaultLayoutJson :: (Yesod site, J.ToJSON a)
                      => WidgetFor site ()  -- ^ HTML
                      -> HandlerFor site a  -- ^ JSON
                      -> HandlerFor site TypedContent
    defaultLayoutJson :: forall site a.
    (Yesod site, ToJSON a) =>
    WidgetFor site ()
    -> HandlerFor site a -> HandlerFor site TypedContent
    defaultLayoutJson WidgetFor site ()
    w HandlerFor site a
    json = Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    -> HandlerFor site TypedContent
    forall (m :: * -> *).
    MonadHandler m =>
    Writer (Endo [ProvidedRep m]) () -> m TypedContent
    selectRep (Writer (Endo [ProvidedRep (HandlerFor site)]) ()
     -> HandlerFor site TypedContent)
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    -> HandlerFor site TypedContent
    forall a b. (a -> b) -> a -> b
    $ do
        HandlerFor site Html
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall (m :: * -> *) a.
    (Monad m, HasContentType a) =>
    m a -> Writer (Endo [ProvidedRep m]) ()
    provideRep (HandlerFor site Html
     -> Writer (Endo [ProvidedRep (HandlerFor site)]) ())
    -> HandlerFor site Html
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall a b. (a -> b) -> a -> b
    $ WidgetFor site () -> HandlerFor site Html
    forall site.
    Yesod site =>
    WidgetFor site () -> HandlerFor site Html
    defaultLayout WidgetFor site ()
    w
        HandlerFor site Encoding
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall (m :: * -> *) a.
    (Monad m, HasContentType a) =>
    m a -> Writer (Endo [ProvidedRep m]) ()
    provideRep (HandlerFor site Encoding
     -> Writer (Endo [ProvidedRep (HandlerFor site)]) ())
    -> HandlerFor site Encoding
    -> Writer (Endo [ProvidedRep (HandlerFor site)]) ()
    forall a b. (a -> b) -> a -> b
    $ (a -> Encoding) -> HandlerFor site a -> HandlerFor site Encoding
    forall a b. (a -> b) -> HandlerFor site a -> HandlerFor site b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> Encoding
    forall a. ToJSON a => a -> Encoding
    J.toEncoding HandlerFor site a
    json

    -- | Wraps a data type in a 'RepJson'.  The data type must
    -- support conversion to JSON via 'J.ToJSON'.
    --
    -- @since 0.3.0
    jsonToRepJson :: (Monad m, J.ToJSON a) => a -> m J.Value
    jsonToRepJson :: forall (m :: * -> *) a. (Monad m, ToJSON a) => a -> m Value
    jsonToRepJson = Value -> m Value
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Value -> m Value) -> (a -> Value) -> a -> m Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Value
    forall a. ToJSON a => a -> Value
    J.toJSON
    {-# DEPRECATED jsonToRepJson "Use returnJson instead" #-}

    -- | Convert a value to a JSON representation via aeson\'s 'J.toJSON' function.
    --
    -- @since 1.2.1
    returnJson :: (Monad m, J.ToJSON a) => a -> m J.Value
    returnJson :: forall (m :: * -> *) a. (Monad m, ToJSON a) => a -> m Value
    returnJson = Value -> m Value
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Value -> m Value) -> (a -> Value) -> a -> m Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Value
    forall a. ToJSON a => a -> Value
    J.toJSON

    -- | Convert a value to a JSON representation via aeson\'s 'J.toEncoding' function.
    --
    -- @since 1.4.21
    returnJsonEncoding :: (Monad m, J.ToJSON a) => a -> m J.Encoding
    returnJsonEncoding :: forall (m :: * -> *) a. (Monad m, ToJSON a) => a -> m Encoding
    returnJsonEncoding = Encoding -> m Encoding
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Encoding -> m Encoding) -> (a -> Encoding) -> a -> m Encoding
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Encoding
    forall a. ToJSON a => a -> Encoding
    J.toEncoding

    -- | Provide a JSON representation for usage with 'selectReps', using aeson\'s
    -- 'J.toJSON' (aeson >= 0.11: 'J.toEncoding') function to perform the conversion.
    --
    -- @since 1.2.1
    provideJson :: (Monad m, J.ToJSON a) => a -> Writer (Endo [ProvidedRep m]) ()
    provideJson :: forall (m :: * -> *) a.
    (Monad m, ToJSON a) =>
    a -> Writer (Endo [ProvidedRep m]) ()
    provideJson = m Encoding -> Writer (Endo [ProvidedRep m]) ()
    forall (m :: * -> *) a.
    (Monad m, HasContentType a) =>
    m a -> Writer (Endo [ProvidedRep m]) ()
    provideRep (m Encoding -> Writer (Endo [ProvidedRep m]) ())
    -> (a -> m Encoding) -> a -> Writer (Endo [ProvidedRep m]) ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Encoding -> m Encoding
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Encoding -> m Encoding) -> (a -> Encoding) -> a -> m Encoding
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Encoding
    forall a. ToJSON a => a -> Encoding
    J.toEncoding

    -- | Same as 'parseInsecureJsonBody'
    --
    -- @since 0.3.0
    parseJsonBody :: (MonadHandler m, J.FromJSON a) => m (J.Result a)
    parseJsonBody :: forall (m :: * -> *) a.
    (MonadHandler m, FromJSON a) =>
    m (Result a)
    parseJsonBody = m (Result a)
    forall (m :: * -> *) a.
    (MonadHandler m, FromJSON a) =>
    m (Result a)
    parseInsecureJsonBody
    {-# DEPRECATED parseJsonBody "Use parseCheckJsonBody or parseInsecureJsonBody instead" #-}

    -- | Same as 'parseCheckJsonBody', but does not check that the mime type
    -- indicates JSON content.
    --
    -- Note: This function is vulnerable to CSRF attacks.
    --
    -- @since 1.6.11
    parseInsecureJsonBody :: (MonadHandler m, J.FromJSON a) => m (J.Result a)
    parseInsecureJsonBody :: forall (m :: * -> *) a.
    (MonadHandler m, FromJSON a) =>
    m (Result a)
    parseInsecureJsonBody = do
        eValue <- ConduitT () Void m (Either SomeException Value)
    -> m (Either SomeException Value)
    forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
    runConduit (ConduitT () Void m (Either SomeException Value)
     -> m (Either SomeException Value))
    -> ConduitT () Void m (Either SomeException Value)
    -> m (Either SomeException Value)
    forall a b. (a -> b) -> a -> b
    $ ConduitT () ByteString m ()
    forall (m :: * -> *) i.
    MonadHandler m =>
    ConduitT i ByteString m ()
    rawRequestBody ConduitT () ByteString m ()
    -> ConduitT ByteString Void m (Either SomeException Value)
    -> ConduitT () Void m (Either SomeException Value)
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| ConduitT ByteString Void (CatchT m) Value
    -> ConduitT ByteString Void m (Either SomeException Value)
    forall (m :: * -> *) i o r.
    Monad m =>
    ConduitT i o (CatchT m) r
    -> ConduitT i o m (Either SomeException r)
    runCatchC (Parser ByteString Value
    -> ConduitT ByteString Void (CatchT m) Value
    forall a (m :: * -> *) b o.
    (AttoparsecInput a, MonadThrow m) =>
    Parser a b -> ConduitT a o m b
    sinkParser Parser ByteString Value
    JP.value')
        return $ case eValue of
            Left SomeException
    e -> String -> Result a
    forall a. String -> Result a
    J.Error (String -> Result a) -> String -> Result a
    forall a b. (a -> b) -> a -> b
    $ SomeException -> String
    forall a. Show a => a -> String
    show SomeException
    e
            Right Value
    value -> Value -> Result a
    forall a. FromJSON a => Value -> Result a
    J.fromJSON Value
    value

    -- | Parse the request body to a data type as a JSON value.  The
    -- data type must support conversion from JSON via 'J.FromJSON'.
    -- If you want the raw JSON value, just ask for a @'J.Result'
    -- 'J.Value'@.
    --
    -- The MIME type must indicate JSON content. Requiring a JSON
    -- content-type helps secure your site against CSRF attacks
    -- (browsers will perform POST requests for form and text/plain
    -- content-types without doing a CORS check, and those content-types
    -- can easily contain valid JSON).
    --
    -- Note that this function will consume the request body. As such, calling it
    -- twice will result in a parse error on the second call, since the request
    -- body will no longer be available.
    --
    -- @since 0.3.0
    parseCheckJsonBody :: (MonadHandler m, J.FromJSON a) => m (J.Result a)
    parseCheckJsonBody :: forall (m :: * -> *) a.
    (MonadHandler m, FromJSON a) =>
    m (Result a)
    parseCheckJsonBody = do
        mct <- CI ByteString -> m (Maybe ByteString)
    forall (m :: * -> *).
    MonadHandler m =>
    CI ByteString -> m (Maybe ByteString)
    lookupHeader CI ByteString
    "content-type"
        case fmap contentTypeHeaderIsJson mct of
            Just Bool
    True -> m (Result a)
    forall (m :: * -> *) a.
    (MonadHandler m, FromJSON a) =>
    m (Result a)
    parseInsecureJsonBody
            Maybe Bool
    _ -> Result a -> m (Result a)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Result a -> m (Result a)) -> Result a -> m (Result a)
    forall a b. (a -> b) -> a -> b
    $ String -> Result a
    forall a. String -> Result a
    J.Error (String -> Result a) -> String -> Result a
    forall a b. (a -> b) -> a -> b
    $ String
    "Non-JSON content type: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Maybe ByteString -> String
    forall a. Show a => a -> String
    show Maybe ByteString
    mct

    -- | Same as 'parseInsecureJsonBody', but return an invalid args response on a parse
    -- error.
    parseJsonBody_ :: (MonadHandler m, J.FromJSON a) => m a
    parseJsonBody_ :: forall (m :: * -> *) a. (MonadHandler m, FromJSON a) => m a
    parseJsonBody_ = m a
    forall (m :: * -> *) a. (MonadHandler m, FromJSON a) => m a
    requireInsecureJsonBody
    {-# DEPRECATED parseJsonBody_ "Use requireCheckJsonBody or requireInsecureJsonBody instead" #-}

    -- | Same as 'parseInsecureJsonBody', but return an invalid args response on a parse
    -- error.
    requireJsonBody :: (MonadHandler m, J.FromJSON a) => m a
    requireJsonBody :: forall (m :: * -> *) a. (MonadHandler m, FromJSON a) => m a
    requireJsonBody = m a
    forall (m :: * -> *) a. (MonadHandler m, FromJSON a) => m a
    requireInsecureJsonBody
    {-# DEPRECATED requireJsonBody "Use requireCheckJsonBody or requireInsecureJsonBody instead" #-}

    -- | Same as 'parseInsecureJsonBody', but return an invalid args response on a parse
    -- error.
    --
    -- @since 1.6.11
    requireInsecureJsonBody :: (MonadHandler m, J.FromJSON a) => m a
    requireInsecureJsonBody :: forall (m :: * -> *) a. (MonadHandler m, FromJSON a) => m a
    requireInsecureJsonBody = do
        ra <- m (Result a)
    forall (m :: * -> *) a.
    (MonadHandler m, FromJSON a) =>
    m (Result a)
    parseInsecureJsonBody
        case ra of
            J.Error String
    s -> [Text] -> m a
    forall (m :: * -> *) a. MonadHandler m => [Text] -> m a
    invalidArgs [String -> Text
    pack String
    s]
            J.Success a
    a -> a -> m a
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    a

    -- | Same as 'parseCheckJsonBody', but return an invalid args response on a parse
    -- error.
    requireCheckJsonBody :: (MonadHandler m, J.FromJSON a) => m a
    requireCheckJsonBody :: forall (m :: * -> *) a. (MonadHandler m, FromJSON a) => m a
    requireCheckJsonBody = do
        ra <- m (Result a)
    forall (m :: * -> *) a.
    (MonadHandler m, FromJSON a) =>
    m (Result a)
    parseCheckJsonBody
        case ra of
            J.Error String
    s -> [Text] -> m a
    forall (m :: * -> *) a. MonadHandler m => [Text] -> m a
    invalidArgs [String -> Text
    pack String
    s]
            J.Success a
    a -> a -> m a
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    a

    -- | Convert a list of values to an 'J.Array'.
    array :: J.ToJSON a => [a] -> J.Value
    array :: forall a. ToJSON a => [a] -> Value
    array = Array -> Value
    J.Array (Array -> Value) -> ([a] -> Array) -> [a] -> Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Value] -> Array
    forall a. [a] -> Vector a
    V.fromList ([Value] -> Array) -> ([a] -> [Value]) -> [a] -> Array
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> Value) -> [a] -> [Value]
    forall a b. (a -> b) -> [a] -> [b]
    map a -> Value
    forall a. ToJSON a => a -> Value
    J.toJSON

    -- | jsonOrRedirect simplifies the scenario where a POST handler sends a different
    -- response based on Accept headers:
    --
    --     1. 200 with JSON data if the client prefers
    --     @application\/json@ (e.g. AJAX, see 'acceptsJSON').
    --
    --     2. 3xx otherwise, following the PRG pattern.
    jsonOrRedirect :: (MonadHandler m, J.ToJSON a)
                   => Route (HandlerSite m) -- ^ Redirect target
                   -> a            -- ^ Data to send via JSON
                   -> m J.Value
    jsonOrRedirect :: forall (m :: * -> *) a.
    (MonadHandler m, ToJSON a) =>
    Route (HandlerSite m) -> a -> m Value
    jsonOrRedirect = (a -> Value) -> Route (HandlerSite m) -> a -> m Value
    forall (m :: * -> *) a b.
    MonadHandler m =>
    (a -> b) -> Route (HandlerSite m) -> a -> m b
    jsonOrRedirect' a -> Value
    forall a. ToJSON a => a -> Value
    J.toJSON

    -- | jsonEncodingOrRedirect simplifies the scenario where a POST handler sends a different
    -- response based on Accept headers:
    --
    --     1. 200 with JSON data if the client prefers
    --     @application\/json@ (e.g. AJAX, see 'acceptsJSON').
    --
    --     2. 3xx otherwise, following the PRG pattern.
    -- @since 1.4.21
    jsonEncodingOrRedirect :: (MonadHandler m, J.ToJSON a)
                => Route (HandlerSite m) -- ^ Redirect target
                -> a            -- ^ Data to send via JSON
                -> m J.Encoding
    jsonEncodingOrRedirect :: forall (m :: * -> *) a.
    (MonadHandler m, ToJSON a) =>
    Route (HandlerSite m) -> a -> m Encoding
    jsonEncodingOrRedirect = (a -> Encoding) -> Route (HandlerSite m) -> a -> m Encoding
    forall (m :: * -> *) a b.
    MonadHandler m =>
    (a -> b) -> Route (HandlerSite m) -> a -> m b
    jsonOrRedirect' a -> Encoding
    forall a. ToJSON a => a -> Encoding
    J.toEncoding

    jsonOrRedirect' :: MonadHandler m
                => (a -> b)
                -> Route (HandlerSite m) -- ^ Redirect target
                -> a            -- ^ Data to send via JSON
                -> m b
    jsonOrRedirect' :: forall (m :: * -> *) a b.
    MonadHandler m =>
    (a -> b) -> Route (HandlerSite m) -> a -> m b
    jsonOrRedirect' a -> b
    f Route (HandlerSite m)
    r a
    j = do
        q <- m Bool
    forall (m :: * -> *). MonadHandler m => m Bool
    acceptsJson
        if q then return (f j)
             else redirect r

    -- | Returns @True@ if the client prefers @application\/json@ as
    -- indicated by the @Accept@ HTTP header.
    acceptsJson :: MonadHandler m => m Bool
    acceptsJson :: forall (m :: * -> *). MonadHandler m => m Bool
    acceptsJson =  (Bool -> (ByteString -> Bool) -> Maybe ByteString -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    False ((ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    "application/json") (ByteString -> Bool)
    -> (ByteString -> ByteString) -> ByteString -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> ByteString -> ByteString
    B8.takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    ';'))
                (Maybe ByteString -> Bool)
    -> (YesodRequest -> Maybe ByteString) -> YesodRequest -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .  [ByteString] -> Maybe ByteString
    forall a. [a] -> Maybe a
    listToMaybe
                ([ByteString] -> Maybe ByteString)
    -> (YesodRequest -> [ByteString])
    -> YesodRequest
    -> Maybe ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .  YesodRequest -> [ByteString]
    reqAccept)
               (YesodRequest -> Bool) -> m YesodRequest -> m Bool
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` m YesodRequest
    forall (m :: * -> *). MonadHandler m => m YesodRequest
    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 @<https://tools.ietf.org/html/rfc6839#section-3.1 xxx/yyy+json>@.
    --
    -- @since 1.6.17
    contentTypeHeaderIsJson :: B8.ByteString -> Bool
    contentTypeHeaderIsJson :: ByteString -> Bool
    contentTypeHeaderIsJson ByteString
    bs = (Char -> Bool) -> ByteString -> ByteString
    B8.takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    ';') ByteString
    bs ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    "application/json"