Servant Echo PlainText to JSON

curl-test

$ curl --verbose localhost:5051/echo -X POST -H "Content-Type:text/plain;charset-utf8" --data '{"name":"Mocking Bird","author":"Lee"}'
*   Trying ::1...
* connect to ::1 port 5051 failed: Connection refused
*   Trying 127.0.0.1...
* Connected to localhost (127.0.0.1) port 5051 (#0)
> POST /echo HTTP/1.1
> Host: localhost:5051
> User-Agent: curl/7.43.0
> Accept: */*
> Content-Type:text/plain;charset-utf8
> Content-Length: 38
>
* upload completely sent off: 38 out of 38 bytes
< HTTP/1.1 415 Unsupported Media Type
< Transfer-Encoding: chunked
< Date: Tue, 30 Aug 2016 16:53:07 GMT
< Server: Warp/3.2.8
<
* Connection #0 to host localhost left intact

Main.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}

module Main where

import Data.Proxy
import Data.Text (Text)
import GHC.Generics
import Network.Wai.Handler.Warp (run)
import Network.Wai.Middleware.RequestLogger
import Servant.API
import Servant.Server
import qualified Data.Aeson as A

data Book = Book {
  name :: Text
, author :: Text
} deriving (Show, Generic)

instance A.ToJSON Book
instance A.FromJSON Book
instance MimeUnrender PlainText Book where
  mimeUnrender _ = A.eitherDecode
--instance MimeRender PlainText Book where
--  mimeRender _ = A.encode

--instance A.FromJSON a => MimeUnrender PlainText a where
--  mimeUnrender _ = A.eitherDecode
-- ^^ or use `eitherDecodeLenient` from the servant tutorial [1]
-- [1] https://haskell-servant.readthedocs.io/en/stable/tutorial/Server.html#the-truth-behind-json
--instance A.ToJSON a => MimeRender PlainText a where
--  mimeRender _ = A.encode

type BookAPI =
  "echo" :> ReqBody '[PlainText] Book :> Post '[JSON] Book

handleAdd :: Book -> Handler Book
handleAdd b = return b

bookServer :: Server BookAPI
bookServer = handleAdd

main :: IO ()
main = run 5051 (logStdoutDev $ serve (Proxy :: Proxy BookAPI) bookServer)

ServantExtraJSONTypes.hs

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE DeriveDataTypeable #-}
module ServantExtraJSONTypes (ReqBodyJSON) where

import Data.Aeson
import Data.Typeable
import Servant.API
import qualified Network.HTTP.Media as M
import Servant.API.ContentTypes (eitherDecodeLenient)

data JSONAsOctetStream deriving Typeable
data JSONAsPlainText deriving Typeable

instance Accept JSONAsPlainText where
  contentType _ = "text" M.// "plain" M./: ("charset", "utf-8")

instance Accept JSONAsOctetStream where
  contentType _ = "application" M.// "octet-stream"

instance ToJSON a => MimeRender JSONAsPlainText a where
  mimeRender _ = encode
instance FromJSON a => MimeUnrender JSONAsPlainText a where
  mimeUnrender _ = eitherDecodeLenient

instance ToJSON a => MimeRender JSONAsOctetStream a where
  mimeRender _ = encode
instance FromJSON a => MimeUnrender JSONAsOctetStream a where
  mimeUnrender _ = eitherDecodeLenient

type PermissiveJSON = '[JSON, JSONAsPlainText, JSONAsOctetStream]
type ReqBodyJSON a = ReqBody PermissiveJSON a