{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DeriveDataTypeable    #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE PolyKinds             #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TupleSections         #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# OPTIONS_HADDOCK not-home       #-}

-- | A collection of basic Content-Types (also known as Internet Media
-- Types, or MIME types). Additionally, this module provides classes that
-- encapsulate how to serialize or deserialize values to or from
-- a particular Content-Type.
--
-- Content-Types are used in `ReqBody` and the method combinators:
--
-- >>> type MyEndpoint = ReqBody '[JSON, PlainText] Book :> Put '[JSON, PlainText] Book
--
-- Meaning the endpoint accepts requests of Content-Type @application/json@
-- or @text/plain;charset-utf8@, and returns data in either one of those
-- formats (depending on the @Accept@ header).
--
-- If you would like to support Content-Types beyond those provided here,
-- then:
--
--      (1) Declare a new data type with no constructors (e.g. @data HTML@).
--      (2) Make an instance of it for `Accept`.
--      (3) If you want to be able to serialize data *into* that
--      Content-Type, make an instance of it for `MimeRender`.
--      (4) If you want to be able to deserialize data *from* that
--      Content-Type, make an instance of it for `MimeUnrender`.
--
-- Note that roles are reversed in @servant-server@ and @servant-client@:
-- to be able to serve (or even typecheck) a @Get '[JSON, XML] MyData@,
-- you'll need to have the appropriate `MimeRender` instances in scope,
-- whereas to query that endpoint with @servant-client@, you'll need
-- a `MimeUnrender` instance in scope.
module Servant.API.ContentTypes
    (
    -- * Provided Content-Types
      JSON
    , PlainText
    , FormUrlEncoded
    , OctetStream

    -- * Building your own Content-Type
    , Accept(..)
    , MimeRender(..)
    , MimeUnrender(..)

    -- * NoContent
    , NoContent(..)

    -- * Internal
    , AcceptHeader(..)
    , AllCTRender(..)
    , AllCTUnrender(..)
    , AllMime(..)
    , AllMimeRender(..)
    , AllMimeUnrender(..)
    , eitherDecodeLenient
    , canHandleAcceptH
    ) where

import           Control.Arrow
                 (left)
import           Control.Monad.Compat
import           Control.DeepSeq
                 (NFData)
import           Data.Aeson
                 (FromJSON (..), ToJSON (..), encode)
import           Data.Aeson.Parser
                 (value)
import           Data.Aeson.Types
                 (parseEither)
import           Data.Attoparsec.ByteString.Char8
                 (endOfInput, parseOnly, skipSpace, (<?>))
import qualified Data.ByteString                  as BS
import           Data.ByteString.Lazy
                 (ByteString, fromStrict, toStrict)
import qualified Data.ByteString.Lazy.Char8       as BC
import qualified Data.List.NonEmpty               as NE
import           Data.Maybe
                 (isJust)
import           Data.String.Conversions
                 (cs)
import qualified Data.Text                        as TextS
import qualified Data.Text.Encoding               as TextS
import qualified Data.Text.Lazy                   as TextL
import qualified Data.Text.Lazy.Encoding          as TextL
import           Data.Typeable
import           GHC.Generics
                 (Generic)
import qualified GHC.TypeLits                     as TL
import qualified Network.HTTP.Media               as M
import           Prelude ()
import           Prelude.Compat
import           Web.FormUrlEncoded
                 (FromForm, ToForm, urlDecodeAsForm, urlEncodeAsForm)

-- * Provided content types
data JSON deriving Typeable
data PlainText deriving Typeable
data FormUrlEncoded deriving Typeable
data OctetStream deriving Typeable

-- * Accept class

-- | Instances of 'Accept' represent mimetypes. They are used for matching
-- against the @Accept@ HTTP header of the request, and for setting the
-- @Content-Type@ header of the response
--
-- Example:
--
-- >>> import Network.HTTP.Media ((//), (/:))
-- >>> data HTML
-- >>> :{
--instance Accept HTML where
--    contentType _ = "text" // "html" /: ("charset", "utf-8")
-- :}
--
class Accept ctype where
    contentType   :: Proxy ctype -> M.MediaType
    contentType = forall a. NonEmpty a -> a
NE.head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (ctype :: k).
Accept ctype =>
Proxy ctype -> NonEmpty MediaType
contentTypes

    contentTypes  :: Proxy ctype -> NE.NonEmpty M.MediaType
    contentTypes  =  (forall a. a -> [a] -> NonEmpty a
NE.:| []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (ctype :: k). Accept ctype => Proxy ctype -> MediaType
contentType

    {-# MINIMAL contentType | contentTypes #-}

-- | @application/json@
instance Accept JSON where
    contentTypes :: Proxy JSON -> NonEmpty MediaType
contentTypes Proxy JSON
_ =
      ByteString
"application" ByteString -> ByteString -> MediaType
M.// ByteString
"json" MediaType -> (ByteString, ByteString) -> MediaType
M./: (ByteString
"charset", ByteString
"utf-8") forall a. a -> [a] -> NonEmpty a
NE.:|
      [ ByteString
"application" ByteString -> ByteString -> MediaType
M.// ByteString
"json" ]

-- | @application/x-www-form-urlencoded@
instance Accept FormUrlEncoded where
    contentType :: Proxy FormUrlEncoded -> MediaType
contentType Proxy FormUrlEncoded
_ = ByteString
"application" ByteString -> ByteString -> MediaType
M.// ByteString
"x-www-form-urlencoded"

-- | @text/plain;charset=utf-8@
instance Accept PlainText where
    contentType :: Proxy PlainText -> MediaType
contentType Proxy PlainText
_ = ByteString
"text" ByteString -> ByteString -> MediaType
M.// ByteString
"plain" MediaType -> (ByteString, ByteString) -> MediaType
M./: (ByteString
"charset", ByteString
"utf-8")

-- | @application/octet-stream@
instance Accept OctetStream where
    contentType :: Proxy OctetStream -> MediaType
contentType Proxy OctetStream
_ = ByteString
"application" ByteString -> ByteString -> MediaType
M.// ByteString
"octet-stream"

newtype AcceptHeader = AcceptHeader BS.ByteString
    deriving (AcceptHeader -> AcceptHeader -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AcceptHeader -> AcceptHeader -> Bool
$c/= :: AcceptHeader -> AcceptHeader -> Bool
== :: AcceptHeader -> AcceptHeader -> Bool
$c== :: AcceptHeader -> AcceptHeader -> Bool
Eq, Int -> AcceptHeader -> ShowS
[AcceptHeader] -> ShowS
AcceptHeader -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AcceptHeader] -> ShowS
$cshowList :: [AcceptHeader] -> ShowS
show :: AcceptHeader -> String
$cshow :: AcceptHeader -> String
showsPrec :: Int -> AcceptHeader -> ShowS
$cshowsPrec :: Int -> AcceptHeader -> ShowS
Show, ReadPrec [AcceptHeader]
ReadPrec AcceptHeader
Int -> ReadS AcceptHeader
ReadS [AcceptHeader]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AcceptHeader]
$creadListPrec :: ReadPrec [AcceptHeader]
readPrec :: ReadPrec AcceptHeader
$creadPrec :: ReadPrec AcceptHeader
readList :: ReadS [AcceptHeader]
$creadList :: ReadS [AcceptHeader]
readsPrec :: Int -> ReadS AcceptHeader
$creadsPrec :: Int -> ReadS AcceptHeader
Read, Typeable, forall x. Rep AcceptHeader x -> AcceptHeader
forall x. AcceptHeader -> Rep AcceptHeader x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AcceptHeader x -> AcceptHeader
$cfrom :: forall x. AcceptHeader -> Rep AcceptHeader x
Generic)

-- * Render (serializing)

-- | Instantiate this class to register a way of serializing a type based
-- on the @Accept@ header.
--
-- Example:
--
-- > data MyContentType
-- >
-- > instance Accept MyContentType where
-- >    contentType _ = "example" // "prs.me.mine" /: ("charset", "utf-8")
-- >
-- > instance Show a => MimeRender MyContentType a where
-- >    mimeRender _ val = pack ("This is MINE! " ++ show val)
-- >
-- > type MyAPI = "path" :> Get '[MyContentType] Int
--
class Accept ctype => MimeRender ctype a where
    mimeRender  :: Proxy ctype -> a -> ByteString

class (AllMime list) => AllCTRender (list :: [*]) a where
    -- If the Accept header can be matched, returns (Just) a tuple of the
    -- Content-Type and response (serialization of @a@ into the appropriate
    -- mimetype).
    handleAcceptH :: Proxy list -> AcceptHeader -> a -> Maybe (ByteString, ByteString)

instance {-# OVERLAPPABLE #-}
         (Accept ct, AllMime cts, AllMimeRender (ct ': cts) a) => AllCTRender (ct ': cts) a where
    handleAcceptH :: Proxy (ct : cts)
-> AcceptHeader -> a -> Maybe (ByteString, ByteString)
handleAcceptH Proxy (ct : cts)
_ (AcceptHeader ByteString
accept) a
val = forall b. [(MediaType, b)] -> ByteString -> Maybe b
M.mapAcceptMedia [(MediaType, (ByteString, ByteString))]
lkup ByteString
accept
      where pctyps :: Proxy (ct : cts)
pctyps = forall {k} (t :: k). Proxy t
Proxy :: Proxy (ct ': cts)
            amrs :: [(MediaType, ByteString)]
amrs = forall (list :: [*]) a.
AllMimeRender list a =>
Proxy list -> a -> [(MediaType, ByteString)]
allMimeRender Proxy (ct : cts)
pctyps a
val
            lkup :: [(MediaType, (ByteString, ByteString))]
lkup = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(MediaType
a,ByteString
b) -> (MediaType
a, (ByteString -> ByteString
fromStrict forall a b. (a -> b) -> a -> b
$ forall h. RenderHeader h => h -> ByteString
M.renderHeader MediaType
a, ByteString
b))) [(MediaType, ByteString)]
amrs

instance TL.TypeError ('TL.Text "No instance for (), use NoContent instead.")
  => AllCTRender '[] () where
  handleAcceptH :: Proxy '[] -> AcceptHeader -> () -> Maybe (ByteString, ByteString)
handleAcceptH Proxy '[]
_ AcceptHeader
_ ()
_ = forall a. HasCallStack => String -> a
error String
"unreachable"

--------------------------------------------------------------------------
-- * Unrender

-- | Instantiate this class to register a way of deserializing a type based
-- on the request's @Content-Type@ header.
--
-- >>> import Network.HTTP.Media hiding (Accept)
-- >>> import qualified Data.ByteString.Lazy.Char8 as BSC
-- >>> data MyContentType = MyContentType String
--
-- >>> :{
--instance Accept MyContentType where
--    contentType _ = "example" // "prs.me.mine" /: ("charset", "utf-8")
-- :}
--
-- >>> :{
--instance Read a => MimeUnrender MyContentType a where
--    mimeUnrender _ bs = case BSC.take 12 bs of
--      "MyContentType" -> return . read . BSC.unpack $ BSC.drop 12 bs
--      _ -> Left "didn't start with the magic incantation"
-- :}
--
-- >>> type MyAPI = "path" :> ReqBody '[MyContentType] Int :> Get '[JSON] Int
--
class Accept ctype => MimeUnrender ctype a where
    mimeUnrender :: Proxy ctype -> ByteString -> Either String a
    mimeUnrender Proxy ctype
p = forall {k} (ctype :: k) a.
MimeUnrender ctype a =>
Proxy ctype -> MediaType -> ByteString -> Either String a
mimeUnrenderWithType Proxy ctype
p (forall {k} (ctype :: k). Accept ctype => Proxy ctype -> MediaType
contentType Proxy ctype
p)

    -- | Variant which is given the actual 'M.MediaType' provided by the other party.
    --
    -- In the most cases you don't want to branch based on the 'M.MediaType'.
    -- See <https://github.com/haskell-servant/servant/pull/552 pr552> for a motivating example.
    mimeUnrenderWithType :: Proxy ctype -> M.MediaType -> ByteString -> Either String a
    mimeUnrenderWithType Proxy ctype
p MediaType
_ = forall {k} (ctype :: k) a.
MimeUnrender ctype a =>
Proxy ctype -> ByteString -> Either String a
mimeUnrender Proxy ctype
p

    {-# MINIMAL mimeUnrender | mimeUnrenderWithType #-}

class AllCTUnrender (list :: [*]) a where
    canHandleCTypeH
        :: Proxy list
        -> ByteString  -- Content-Type header
        -> Maybe (ByteString -> Either String a)

    handleCTypeH :: Proxy list
                 -> ByteString     -- Content-Type header
                 -> ByteString     -- Request body
                 -> Maybe (Either String a)
    handleCTypeH Proxy list
p ByteString
ctypeH ByteString
body = (forall a b. (a -> b) -> a -> b
$ ByteString
body) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (list :: [*]) a.
AllCTUnrender list a =>
Proxy list -> ByteString -> Maybe (ByteString -> Either String a)
canHandleCTypeH Proxy list
p ByteString
ctypeH

instance ( AllMimeUnrender ctyps a ) => AllCTUnrender ctyps a where
    canHandleCTypeH :: Proxy ctyps -> ByteString -> Maybe (ByteString -> Either String a)
canHandleCTypeH Proxy ctyps
p ByteString
ctypeH =
        forall b. [(MediaType, b)] -> ByteString -> Maybe b
M.mapContentMedia (forall (list :: [*]) a.
AllMimeUnrender list a =>
Proxy list -> [(MediaType, ByteString -> Either String a)]
allMimeUnrender Proxy ctyps
p) (forall a b. ConvertibleStrings a b => a -> b
cs ByteString
ctypeH)

--------------------------------------------------------------------------
-- * Utils (Internal)

class AllMime (list :: [*]) where
    allMime :: Proxy list -> [M.MediaType]

instance AllMime '[] where
    allMime :: Proxy '[] -> [MediaType]
allMime Proxy '[]
_ = []

instance (Accept ctyp, AllMime ctyps) => AllMime (ctyp ': ctyps) where
    allMime :: Proxy (ctyp : ctyps) -> [MediaType]
allMime Proxy (ctyp : ctyps)
_ = forall a. NonEmpty a -> [a]
NE.toList (forall {k} (ctype :: k).
Accept ctype =>
Proxy ctype -> NonEmpty MediaType
contentTypes Proxy ctyp
pctyp) forall a. [a] -> [a] -> [a]
++ forall (list :: [*]). AllMime list => Proxy list -> [MediaType]
allMime Proxy ctyps
pctyps
      where
        pctyp :: Proxy ctyp
pctyp  = forall {k} (t :: k). Proxy t
Proxy :: Proxy ctyp
        pctyps :: Proxy ctyps
pctyps = forall {k} (t :: k). Proxy t
Proxy :: Proxy ctyps

canHandleAcceptH :: AllMime list => Proxy list -> AcceptHeader -> Bool
canHandleAcceptH :: forall (list :: [*]).
AllMime list =>
Proxy list -> AcceptHeader -> Bool
canHandleAcceptH Proxy list
p (AcceptHeader ByteString
h ) = forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ forall a. Accept a => [a] -> ByteString -> Maybe a
M.matchAccept (forall (list :: [*]). AllMime list => Proxy list -> [MediaType]
allMime Proxy list
p) ByteString
h

--------------------------------------------------------------------------
-- Check that all elements of list are instances of MimeRender
--------------------------------------------------------------------------
class (AllMime list) => AllMimeRender (list :: [*]) a where
    allMimeRender :: Proxy list
                  -> a                              -- value to serialize
                  -> [(M.MediaType, ByteString)]    -- content-types/response pairs

instance {-# OVERLAPPABLE #-} ( MimeRender ctyp a ) => AllMimeRender '[ctyp] a where
    allMimeRender :: Proxy '[ctyp] -> a -> [(MediaType, ByteString)]
allMimeRender Proxy '[ctyp]
_ a
a = forall a b. (a -> b) -> [a] -> [b]
map (, ByteString
bs) forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NE.toList forall a b. (a -> b) -> a -> b
$ forall {k} (ctype :: k).
Accept ctype =>
Proxy ctype -> NonEmpty MediaType
contentTypes Proxy ctyp
pctyp
      where
        bs :: ByteString
bs    = forall {k} (ctype :: k) a.
MimeRender ctype a =>
Proxy ctype -> a -> ByteString
mimeRender Proxy ctyp
pctyp a
a
        pctyp :: Proxy ctyp
pctyp = forall {k} (t :: k). Proxy t
Proxy :: Proxy ctyp

instance {-# OVERLAPPABLE #-}
         ( MimeRender ctyp a
         , AllMimeRender (ctyp' ': ctyps) a
         ) => AllMimeRender (ctyp ': ctyp' ': ctyps) a where
    allMimeRender :: Proxy (ctyp : ctyp' : ctyps) -> a -> [(MediaType, ByteString)]
allMimeRender Proxy (ctyp : ctyp' : ctyps)
_ a
a =
        forall a b. (a -> b) -> [a] -> [b]
map (, ByteString
bs) (forall a. NonEmpty a -> [a]
NE.toList forall a b. (a -> b) -> a -> b
$ forall {k} (ctype :: k).
Accept ctype =>
Proxy ctype -> NonEmpty MediaType
contentTypes Proxy ctyp
pctyp)
        forall a. [a] -> [a] -> [a]
++ forall (list :: [*]) a.
AllMimeRender list a =>
Proxy list -> a -> [(MediaType, ByteString)]
allMimeRender Proxy (ctyp' : ctyps)
pctyps a
a
      where
        bs :: ByteString
bs     = forall {k} (ctype :: k) a.
MimeRender ctype a =>
Proxy ctype -> a -> ByteString
mimeRender Proxy ctyp
pctyp a
a
        pctyp :: Proxy ctyp
pctyp  = forall {k} (t :: k). Proxy t
Proxy :: Proxy ctyp
        pctyps :: Proxy (ctyp' : ctyps)
pctyps = forall {k} (t :: k). Proxy t
Proxy :: Proxy (ctyp' ': ctyps)


-- Ideally we would like to declare a 'MimeRender a NoContent' instance, and
-- then this would be taken care of. However there is no more specific instance
-- between that and 'MimeRender JSON a', so we do this instead
instance {-# OVERLAPPING #-} ( Accept ctyp ) => AllMimeRender '[ctyp] NoContent where
    allMimeRender :: Proxy '[ctyp] -> NoContent -> [(MediaType, ByteString)]
allMimeRender Proxy '[ctyp]
_ NoContent
NoContent = forall a b. (a -> b) -> [a] -> [b]
map (, ByteString
"") forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NE.toList forall a b. (a -> b) -> a -> b
$ forall {k} (ctype :: k).
Accept ctype =>
Proxy ctype -> NonEmpty MediaType
contentTypes Proxy ctyp
pctyp
      where
        pctyp :: Proxy ctyp
pctyp = forall {k} (t :: k). Proxy t
Proxy :: Proxy ctyp

instance {-# OVERLAPPING #-}
         ( AllMime (ctyp ': ctyp' ': ctyps)
         ) => AllMimeRender (ctyp ': ctyp' ': ctyps) NoContent where
    allMimeRender :: Proxy (ctyp : ctyp' : ctyps)
-> NoContent -> [(MediaType, ByteString)]
allMimeRender Proxy (ctyp : ctyp' : ctyps)
p NoContent
_ = forall a b. [a] -> [b] -> [(a, b)]
zip (forall (list :: [*]). AllMime list => Proxy list -> [MediaType]
allMime Proxy (ctyp : ctyp' : ctyps)
p) (forall a. a -> [a]
repeat ByteString
"")

--------------------------------------------------------------------------
-- Check that all elements of list are instances of MimeUnrender
--------------------------------------------------------------------------
class (AllMime list) => AllMimeUnrender (list :: [*]) a where
    allMimeUnrender :: Proxy list
                    -> [(M.MediaType, ByteString -> Either String a)]

instance AllMimeUnrender '[] a where
    allMimeUnrender :: Proxy '[] -> [(MediaType, ByteString -> Either String a)]
allMimeUnrender Proxy '[]
_ = []

instance ( MimeUnrender ctyp a
         , AllMimeUnrender ctyps a
         ) => AllMimeUnrender (ctyp ': ctyps) a where
    allMimeUnrender :: Proxy (ctyp : ctyps)
-> [(MediaType, ByteString -> Either String a)]
allMimeUnrender Proxy (ctyp : ctyps)
_ =
        forall a b. (a -> b) -> [a] -> [b]
map MediaType -> (MediaType, ByteString -> Either String a)
mk (forall a. NonEmpty a -> [a]
NE.toList forall a b. (a -> b) -> a -> b
$ forall {k} (ctype :: k).
Accept ctype =>
Proxy ctype -> NonEmpty MediaType
contentTypes Proxy ctyp
pctyp)
        forall a. [a] -> [a] -> [a]
++ forall (list :: [*]) a.
AllMimeUnrender list a =>
Proxy list -> [(MediaType, ByteString -> Either String a)]
allMimeUnrender Proxy ctyps
pctyps
      where
        mk :: MediaType -> (MediaType, ByteString -> Either String a)
mk MediaType
ct   = (MediaType
ct, forall {k} (ctype :: k) a.
MimeUnrender ctype a =>
Proxy ctype -> MediaType -> ByteString -> Either String a
mimeUnrenderWithType Proxy ctyp
pctyp MediaType
ct)
        pctyp :: Proxy ctyp
pctyp  = forall {k} (t :: k). Proxy t
Proxy :: Proxy ctyp
        pctyps :: Proxy ctyps
pctyps = forall {k} (t :: k). Proxy t
Proxy :: Proxy ctyps

--------------------------------------------------------------------------
-- * MimeRender Instances

-- | `encode`
instance {-# OVERLAPPABLE #-}
         ToJSON a => MimeRender JSON a where
    mimeRender :: Proxy JSON -> a -> ByteString
mimeRender Proxy JSON
_ = forall a. ToJSON a => a -> ByteString
encode

-- | @urlEncodeAsForm@
-- Note that the @mimeUnrender p (mimeRender p x) == Right x@ law only
-- holds if every element of x is non-null (i.e., not @("", "")@)
instance {-# OVERLAPPABLE #-}
         ToForm a => MimeRender FormUrlEncoded a where
    mimeRender :: Proxy FormUrlEncoded -> a -> ByteString
mimeRender Proxy FormUrlEncoded
_ = forall a. ToForm a => a -> ByteString
urlEncodeAsForm

-- | `TextL.encodeUtf8`
instance MimeRender PlainText TextL.Text where
    mimeRender :: Proxy PlainText -> Text -> ByteString
mimeRender Proxy PlainText
_ = Text -> ByteString
TextL.encodeUtf8

-- | @fromStrict . TextS.encodeUtf8@
instance MimeRender PlainText TextS.Text where
    mimeRender :: Proxy PlainText -> Text -> ByteString
mimeRender Proxy PlainText
_ = ByteString -> ByteString
fromStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TextS.encodeUtf8

-- | @BC.pack@
instance MimeRender PlainText String where
    mimeRender :: Proxy PlainText -> String -> ByteString
mimeRender Proxy PlainText
_ = String -> ByteString
BC.pack

-- | @id@
instance MimeRender OctetStream ByteString where
    mimeRender :: Proxy OctetStream -> ByteString -> ByteString
mimeRender Proxy OctetStream
_ = forall a. a -> a
id

-- | `fromStrict`
instance MimeRender OctetStream BS.ByteString where
    mimeRender :: Proxy OctetStream -> ByteString -> ByteString
mimeRender Proxy OctetStream
_ = ByteString -> ByteString
fromStrict

-- | A type for responses without content-body.
data NoContent = NoContent
  deriving (Int -> NoContent -> ShowS
[NoContent] -> ShowS
NoContent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NoContent] -> ShowS
$cshowList :: [NoContent] -> ShowS
show :: NoContent -> String
$cshow :: NoContent -> String
showsPrec :: Int -> NoContent -> ShowS
$cshowsPrec :: Int -> NoContent -> ShowS
Show, NoContent -> NoContent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NoContent -> NoContent -> Bool
$c/= :: NoContent -> NoContent -> Bool
== :: NoContent -> NoContent -> Bool
$c== :: NoContent -> NoContent -> Bool
Eq, ReadPrec [NoContent]
ReadPrec NoContent
Int -> ReadS NoContent
ReadS [NoContent]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NoContent]
$creadListPrec :: ReadPrec [NoContent]
readPrec :: ReadPrec NoContent
$creadPrec :: ReadPrec NoContent
readList :: ReadS [NoContent]
$creadList :: ReadS [NoContent]
readsPrec :: Int -> ReadS NoContent
$creadsPrec :: Int -> ReadS NoContent
Read, forall x. Rep NoContent x -> NoContent
forall x. NoContent -> Rep NoContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NoContent x -> NoContent
$cfrom :: forall x. NoContent -> Rep NoContent x
Generic)

instance NFData NoContent


--------------------------------------------------------------------------
-- * MimeUnrender Instances

-- | Like 'Data.Aeson.eitherDecode' but allows all JSON values instead of just
-- objects and arrays.
--
-- Will handle trailing whitespace, but not trailing junk. ie.
--
-- >>> eitherDecodeLenient "1 " :: Either String Int
-- Right 1
--
-- >>> eitherDecodeLenient "1 junk" :: Either String Int
-- Left "trailing junk after valid JSON: endOfInput"
eitherDecodeLenient :: FromJSON a => ByteString -> Either String a
eitherDecodeLenient :: forall a. FromJSON a => ByteString -> Either String a
eitherDecodeLenient ByteString
input =
    forall a. Parser a -> ByteString -> Either String a
parseOnly Parser ByteString Value
parser (forall a b. ConvertibleStrings a b => a -> b
cs ByteString
input) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. (a -> Parser b) -> a -> Either String b
parseEither forall a. FromJSON a => Value -> Parser a
parseJSON
  where
    parser :: Parser ByteString Value
parser = Parser ()
skipSpace
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Value
Data.Aeson.Parser.value
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (forall t. Chunk t => Parser t ()
endOfInput forall i a. Parser i a -> String -> Parser i a
<?> String
"trailing junk after valid JSON")

-- | `eitherDecode`
instance FromJSON a => MimeUnrender JSON a where
    mimeUnrender :: Proxy JSON -> ByteString -> Either String a
mimeUnrender Proxy JSON
_ = forall a. FromJSON a => ByteString -> Either String a
eitherDecodeLenient

-- | @urlDecodeAsForm@
-- Note that the @mimeUnrender p (mimeRender p x) == Right x@ law only
-- holds if every element of x is non-null (i.e., not @("", "")@)
instance FromForm a => MimeUnrender FormUrlEncoded a where
    mimeUnrender :: Proxy FormUrlEncoded -> ByteString -> Either String a
mimeUnrender Proxy FormUrlEncoded
_ = forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left Text -> String
TextS.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromForm a => ByteString -> Either Text a
urlDecodeAsForm

-- | @left show . TextL.decodeUtf8'@
instance MimeUnrender PlainText TextL.Text where
    mimeUnrender :: Proxy PlainText -> ByteString -> Either String Text
mimeUnrender Proxy PlainText
_ = forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
TextL.decodeUtf8'

-- | @left show . TextS.decodeUtf8' . toStrict@
instance MimeUnrender PlainText TextS.Text where
    mimeUnrender :: Proxy PlainText -> ByteString -> Either String Text
mimeUnrender Proxy PlainText
_ = forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
TextS.decodeUtf8' forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict

-- | @Right . BC.unpack@
instance MimeUnrender PlainText String where
    mimeUnrender :: Proxy PlainText -> ByteString -> Either String String
mimeUnrender Proxy PlainText
_ = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BC.unpack

-- | @Right . id@
instance MimeUnrender OctetStream ByteString where
    mimeUnrender :: Proxy OctetStream -> ByteString -> Either String ByteString
mimeUnrender Proxy OctetStream
_ = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> a
id

-- | @Right . toStrict@
instance MimeUnrender OctetStream BS.ByteString where
    mimeUnrender :: Proxy OctetStream -> ByteString -> Either String ByteString
mimeUnrender Proxy OctetStream
_ = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict


-- $setup
-- >>> :set -XFlexibleInstances
-- >>> :set -XMultiParamTypeClasses
-- >>> :set -XOverloadedStrings
-- >>> import Servant.API
-- >>> import Data.Aeson
-- >>> import Data.Text
-- >>> data Book
-- >>> instance ToJSON Book where { toJSON = undefined }