1. Post Dataを扱う

Post Dataを扱うAPIは以下のようになります。

API

type ServantType =  "name" :> ReqBody '[JSON] String :> Post '[PlainText] String
               :<|> "age" :> Get '[PlainText] String

ReqBodyを指定し、JSON文字列としてエンコードされたString値（リクエスト・ボディ）を受け取り、ハンドラでPOST処理してから、Content-TypeをPlainTextとしてString値をレスポンスとして返します。

ハンドラ handleNameではReqBodyで受け取ったString値を引数として処理します。ここではそのまま返しています。

Handler

handlerName :: String -> Handler String 
handlerName nameIn = return nameIn  -- Just output back the input string value

handlerAge :: Handler String
handlerAge = return "31"

server :: Server ServantType
server = handlerName :<|> handlerAge

APIとHandlerからApplicationを作ります。

Application

app :: Application
app = serve (Proxy :: Proxy ServantType) server

2. 全ソース

PostDataのソース本体

PostData.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}

module PostData
    ( runServant
    ) where

import Servant ( QueryParam
               , PlainText
               , JSON
               , FromHttpApiData(..)
               , Get
               , Post
               , ReqBody
               , Proxy(..)
               , type (:>)      -- Syntax for importing type operator
               , type (:<|>)
               , (:<|>)(..)
               )
import Servant.Server (Handler, Server, Application, serve)
import Network.Wai.Handler.Warp (run)

-- In this example, we see how we can accept
-- input in the request body, say a Json payload.

handlerName :: String -> Handler String 
handlerName nameIn = return nameIn  -- Just output back the input string value

handlerAge :: Handler String
handlerAge = return "31"

-- In the code below, look at the `ReqBody '[JSON] String` part.
-- This is what enables our endpoint to recieve a String encoded as JSON
-- in the body of the request.
--
type ServantType =  "name" :> ReqBody '[JSON] String :> Post '[PlainText] String
               :<|> "age" :> Get '[PlainText] String

server :: Server ServantType
server = handlerName :<|> handlerAge

app :: Application
app = serve (Proxy :: Proxy ServantType) server

runServant :: IO ()
runServant = run 4000 app

-- Output
-- curl -v -H "Content-Type:application/json" -d "\"John\"" http://127.0.0.1:4000/name
-- *   Trying 127.0.0.1...
-- * Connected to 127.0.0.1 (127.0.0.1) port 4000 (#0)
-- > POST /name HTTP/1.1
-- > Host: 127.0.0.1:4000
-- > User-Agent: curl/7.47.0
-- > Accept: */*
-- > Content-Type:application/json
-- > Content-Length: 6
-- >
-- * upload completely sent off: 6 out of 6 bytes
-- < HTTP/1.1 200 OK
-- < Transfer-Encoding: chunked
-- < Date: Tue, 10 Apr 2018 16:27:57 GMT
-- < Server: Warp/3.2.13
-- < Content-Type: text/plain;charset=utf-8
-- <
-- * Connection #0 to host 127.0.0.1 left intact
-- John

メイン

Main.hs

module Main where

import qualified HtmlContent as T1
import qualified PostData    as T2

main :: IO ()
main = T2.runServant

使用するパッケージ

package.yaml

dependencies:
- base >= 4.7 && < 5
- servant
- servant-server
- aeson
- time
- wai
- warp
- http-media
- bytestring

3. 実行結果

nameを叩く

$ curl -v -H "Content-Type:application/json" -d "\"John\"" http://127.0.0.1:4000/name
*   Trying 127.0.0.1:4000...
* TCP_NODELAY set
  % Total    % Received % Xferd  Average Speed   Time    Time     Time  Current
                                 Dload  Upload   Total   Spent    Left  Speed
  0     0    0     0    0     0      0      0 --:--:-- --:--:-- --:--:--     0* Connected to 127.0.0.1 (127.0.0.1) port 4000 (#0)
> POST /name HTTP/1.1
> Host: 127.0.0.1:4000
> User-Agent: curl/7.67.0
> Accept: */*
> Content-Type:application/json
> Content-Length: 6
>
} [6 bytes data]
* upload completely sent off: 6 out of 6 bytes
* Mark bundle as not supporting multiuse
< HTTP/1.1 200 OK
< Transfer-Encoding: chunked
< Date: Sun, 23 Feb 2020 12:35:09 GMT
< Server: Warp/3.3.5
< Content-Type: text/plain;charset=utf-8   ###コンテントタイプ
<
{ [17 bytes data]
100    10    0     4  100     6   2000   3000 --:--:-- --:--:-- --:--:-- 10000
John   ### 返り値

念のためageも叩く

$ curl -v  http://127.0.0.1:4000/age
*   Trying 127.0.0.1:4000...
* TCP_NODELAY set
  % Total    % Received % Xferd  Average Speed   Time    Time     Time  Current
                                 Dload  Upload   Total   Spent    Left  Speed
  0     0    0     0    0     0      0      0 --:--:-- --:--:-- --:--:--     0* Connected to 127.0.0.1 (127.0.0.1) port 4000 (#0)
> GET /age HTTP/1.1
> Host: 127.0.0.1:4000
> User-Agent: curl/7.67.0
> Accept: */*
>
* Mark bundle as not supporting multiuse
< HTTP/1.1 200 OK
< Transfer-Encoding: chunked
< Date: Sun, 23 Feb 2020 12:40:53 GMT
< Server: Warp/3.3.5
< Content-Type: text/plain;charset=utf-8   ### コンテントタイプ
<
{ [15 bytes data]
100     2    0     2    0     0   2000      0 --:--:-- --:--:-- --:--:--  2000
31   ### 返り値

4. CustomPostData

上ではReqBodyとして裸のString値を受け取りました。今回はNameWrapperというdata型を定義し、それに包んでString値を受け取り、HandlerにはNameWrapper値を渡すようにします。クライアントから渡されるJSON文字列は変わりませんが、Servantがそれを受け取るときにNameWrapper型へとデコードするだけです。

data NameWrapper = NameWrapper { getName :: String } -- This the type that our handler expects.
---
type ServantType =  "name" :> ReqBody '[JSON] NameWrapper :> Post '[PlainText] String

NameWrapper型へのデコード方法を定義します。

FromJSON

-- To make this work, NameWrapper should have an instance of FromJSON. This is becasuse the
-- built in 'Accept' and 'MimeUnrender' instances for 'JSON' type expects FromJSON and ToJSON
-- instances for the concerned types.
--
instance FromJSON NameWrapper where
  parseJSON v = NameWrapper <$> (parseJSON v)

以下に全ソースを示します。

CustomPostData

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}

module CustomPostData 
    ( runServant
    ) where

import Servant ( QueryParam
               , PlainText
               , JSON
               , FromHttpApiData(..)
               , Get
               , Post
               , ReqBody
               , Proxy(..)
               , type (:>)      -- Syntax for importing type operator
               , type (:<|>)
               , (:<|>)(..)
               )
import Servant.Server (Handler, Server, Application, serve)
import Network.Wai.Handler.Warp (run)
import Control.Monad.IO.Class (liftIO)
import Data.Aeson (FromJSON(..))

-- In this example, we see how we can recive data in the request
-- body in a custom format.

data NameWrapper = NameWrapper { getName :: String } -- This the type that our handler expects.

-- In the code below, look at the `ReqBody '[JSON] NameWrapper` part.
-- This (along with the FromJSON instance) is what enables our endpoint to recieve a value of type
-- `NameWrapper` encoded as JSON, in the body of the request.
--
type ServantType =  "name" :> ReqBody '[JSON] NameWrapper :> Post '[PlainText] String
               :<|> "age" :> Get '[PlainText] String

-- To make this work, NameWrapper should have an instance of FromJSON. This is becasuse the
-- built in 'Accept' and 'MimeUnrender' instances for 'JSON' type expects FromJSON and ToJSON
-- instances for the concerned types.
--
instance FromJSON NameWrapper where
  parseJSON v = NameWrapper <$> (parseJSON v)

handlerName :: NameWrapper -> Handler String
handlerName (NameWrapper nameIn) = return nameIn  -- Just output back the input string value

handlerAge :: Handler String
handlerAge = return "30"

server :: Server ServantType
server = handlerName :<|> handlerAge

app :: Application
app = serve (Proxy :: Proxy ServantType) server

runServant :: IO ()
runServant = run 4000 app

-- Output
-- curl -v -H "Content-Type:application/json" -d "\"John\"" http://127.0.0.1:4000/name
-- *   Trying 127.0.0.1...
-- * Connected to 127.0.0.1 (127.0.0.1) port 4000 (#0)
-- > POST /name HTTP/1.1
-- > Host: 127.0.0.1:4000
-- > User-Agent: curl/7.47.0
-- > Accept: */*
-- > Content-Type:application/json
-- > Content-Length: 6
-- >
-- * upload completely sent off: 6 out of 6 bytes
-- < HTTP/1.1 200 OK
-- < Transfer-Encoding: chunked
-- < Date: Tue, 10 Apr 2018 16:27:57 GMT
-- < Server: Warp/3.2.13
-- < Content-Type: text/plain;charset=utf-8
-- <
-- * Connection #0 to host 127.0.0.1 left intact
-- John

メイン