{-# LANGUAGE TypeSynonymInstances, OverloadedStrings #-}
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Yesod.Core.Json
(
defaultLayoutJson
, jsonToRepJson
, returnJson
, returnJsonEncoding
, provideJson
, parseCheckJsonBody
, parseInsecureJsonBody
, requireCheckJsonBody
, requireInsecureJsonBody
, parseJsonBody
, parseJsonBody_
, requireJsonBody
, J.Value (..)
, J.ToJSON (..)
, J.FromJSON (..)
, array
, object
, (.=)
, (J..:)
, jsonOrRedirect
, jsonEncodingOrRedirect
, acceptsJson
, 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)
defaultLayoutJson :: (Yesod site, J.ToJSON a)
=> WidgetFor site ()
-> HandlerFor site a
-> 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 = forall (m :: * -> *).
MonadHandler m =>
Writer (Endo [ProvidedRep m]) () -> m TypedContent
selectRep forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *) a.
(Monad m, HasContentType a) =>
m a -> Writer (Endo [ProvidedRep m]) ()
provideRep forall a b. (a -> b) -> a -> b
$ forall site.
Yesod site =>
WidgetFor site () -> HandlerFor site Html
defaultLayout WidgetFor site ()
w
forall (m :: * -> *) a.
(Monad m, HasContentType a) =>
m a -> Writer (Endo [ProvidedRep m]) ()
provideRep forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ToJSON a => a -> Encoding
J.toEncoding HandlerFor site a
json
jsonToRepJson :: (Monad m, J.ToJSON a) => a -> m J.Value
jsonToRepJson :: forall (m :: * -> *) a. (Monad m, ToJSON a) => a -> m Value
jsonToRepJson = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
J.toJSON
{-# DEPRECATED jsonToRepJson "Use returnJson instead" #-}
returnJson :: (Monad m, J.ToJSON a) => a -> m J.Value
returnJson :: forall (m :: * -> *) a. (Monad m, ToJSON a) => a -> m Value
returnJson = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
J.toJSON
returnJsonEncoding :: (Monad m, J.ToJSON a) => a -> m J.Encoding
returnJsonEncoding :: forall (m :: * -> *) a. (Monad m, ToJSON a) => a -> m Encoding
returnJsonEncoding = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Encoding
J.toEncoding
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 = forall (m :: * -> *) a.
(Monad m, HasContentType a) =>
m a -> Writer (Endo [ProvidedRep m]) ()
provideRep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Encoding
J.toEncoding
parseJsonBody :: (MonadHandler m, J.FromJSON a) => m (J.Result a)
parseJsonBody :: forall (m :: * -> *) a.
(MonadHandler m, FromJSON a) =>
m (Result a)
parseJsonBody = forall (m :: * -> *) a.
(MonadHandler m, FromJSON a) =>
m (Result a)
parseInsecureJsonBody
{-# DEPRECATED parseJsonBody "Use parseCheckJsonBody or parseInsecureJsonBody instead" #-}
parseInsecureJsonBody :: (MonadHandler m, J.FromJSON a) => m (J.Result a)
parseInsecureJsonBody :: forall (m :: * -> *) a.
(MonadHandler m, FromJSON a) =>
m (Result a)
parseInsecureJsonBody = do
Either SomeException Value
eValue <- forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) i.
MonadHandler m =>
ConduitT i ByteString m ()
rawRequestBody forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) i o r.
Monad m =>
ConduitT i o (CatchT m) r
-> ConduitT i o m (Either SomeException r)
runCatchC (forall a (m :: * -> *) b o.
(AttoparsecInput a, MonadThrow m) =>
Parser a b -> ConduitT a o m b
sinkParser Parser Value
JP.value')
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Either SomeException Value
eValue of
Left SomeException
e -> forall a. String -> Result a
J.Error forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show SomeException
e
Right Value
value -> forall a. FromJSON a => Value -> Result a
J.fromJSON Value
value
parseCheckJsonBody :: (MonadHandler m, J.FromJSON a) => m (J.Result a)
parseCheckJsonBody :: forall (m :: * -> *) a.
(MonadHandler m, FromJSON a) =>
m (Result a)
parseCheckJsonBody = do
Maybe ByteString
mct <- forall (m :: * -> *).
MonadHandler m =>
CI ByteString -> m (Maybe ByteString)
lookupHeader CI ByteString
"content-type"
case forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Bool
contentTypeHeaderIsJson Maybe ByteString
mct of
Just Bool
True -> forall (m :: * -> *) a.
(MonadHandler m, FromJSON a) =>
m (Result a)
parseInsecureJsonBody
Maybe Bool
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. String -> Result a
J.Error forall a b. (a -> b) -> a -> b
$ String
"Non-JSON content type: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Maybe ByteString
mct
parseJsonBody_ :: (MonadHandler m, J.FromJSON a) => m a
parseJsonBody_ :: forall (m :: * -> *) a. (MonadHandler m, FromJSON a) => m a
parseJsonBody_ = forall (m :: * -> *) a. (MonadHandler m, FromJSON a) => m a
requireInsecureJsonBody
{-# DEPRECATED parseJsonBody_ "Use requireCheckJsonBody or requireInsecureJsonBody instead" #-}
requireJsonBody :: (MonadHandler m, J.FromJSON a) => m a
requireJsonBody :: forall (m :: * -> *) a. (MonadHandler m, FromJSON a) => m a
requireJsonBody = forall (m :: * -> *) a. (MonadHandler m, FromJSON a) => m a
requireInsecureJsonBody
{-# DEPRECATED requireJsonBody "Use requireCheckJsonBody or requireInsecureJsonBody instead" #-}
requireInsecureJsonBody :: (MonadHandler m, J.FromJSON a) => m a
requireInsecureJsonBody :: forall (m :: * -> *) a. (MonadHandler m, FromJSON a) => m a
requireInsecureJsonBody = do
Result a
ra <- forall (m :: * -> *) a.
(MonadHandler m, FromJSON a) =>
m (Result a)
parseInsecureJsonBody
case Result a
ra of
J.Error String
s -> forall (m :: * -> *) a. MonadHandler m => [Text] -> m a
invalidArgs [String -> Text
pack String
s]
J.Success a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return a
a
requireCheckJsonBody :: (MonadHandler m, J.FromJSON a) => m a
requireCheckJsonBody :: forall (m :: * -> *) a. (MonadHandler m, FromJSON a) => m a
requireCheckJsonBody = do
Result a
ra <- forall (m :: * -> *) a.
(MonadHandler m, FromJSON a) =>
m (Result a)
parseCheckJsonBody
case Result a
ra of
J.Error String
s -> forall (m :: * -> *) a. MonadHandler m => [Text] -> m a
invalidArgs [String -> Text
pack String
s]
J.Success a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return a
a
array :: J.ToJSON a => [a] -> J.Value
array :: forall a. ToJSON a => [a] -> Value
array = Array -> Value
J.Array forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. ToJSON a => a -> Value
J.toJSON
jsonOrRedirect :: (MonadHandler m, J.ToJSON a)
=> Route (HandlerSite m)
-> a
-> m J.Value
jsonOrRedirect :: forall (m :: * -> *) a.
(MonadHandler m, ToJSON a) =>
Route (HandlerSite m) -> a -> m Value
jsonOrRedirect = forall (m :: * -> *) a b.
MonadHandler m =>
(a -> b) -> Route (HandlerSite m) -> a -> m b
jsonOrRedirect' forall a. ToJSON a => a -> Value
J.toJSON
jsonEncodingOrRedirect :: (MonadHandler m, J.ToJSON a)
=> Route (HandlerSite m)
-> a
-> m J.Encoding
jsonEncodingOrRedirect :: forall (m :: * -> *) a.
(MonadHandler m, ToJSON a) =>
Route (HandlerSite m) -> a -> m Encoding
jsonEncodingOrRedirect = forall (m :: * -> *) a b.
MonadHandler m =>
(a -> b) -> Route (HandlerSite m) -> a -> m b
jsonOrRedirect' forall a. ToJSON a => a -> Encoding
J.toEncoding
jsonOrRedirect' :: MonadHandler m
=> (a -> b)
-> Route (HandlerSite m)
-> a
-> 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
Bool
q <- forall (m :: * -> *). MonadHandler m => m Bool
acceptsJson
if Bool
q then forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
f a
j)
else forall (m :: * -> *) url a.
(MonadHandler m, RedirectUrl (HandlerSite m) url) =>
url -> m a
redirect Route (HandlerSite m)
r
acceptsJson :: MonadHandler m => m Bool
acceptsJson :: forall (m :: * -> *). MonadHandler m => m Bool
acceptsJson = (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((forall a. Eq a => a -> a -> Bool
== ByteString
"application/json") forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
B8.takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
';'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
listToMaybe
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YesodRequest -> [ByteString]
reqAccept)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (m :: * -> *). MonadHandler m => m YesodRequest
getRequest
contentTypeHeaderIsJson :: B8.ByteString -> Bool
ByteString
bs = (Char -> Bool) -> ByteString -> ByteString
B8.takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
';') ByteString
bs forall a. Eq a => a -> a -> Bool
== ByteString
"application/json"