【Servant】(7) Post Data

[【Servant】(1) Wai - Qiita](https://qiita.com/sand/items/16a6ef431a8376e7cbaa)
[【Servant】(2) Servantチュートリアル - Qiita](https://qiita.com/sand/items/fea7c294dd7835692ff7)
[【Servant】(3) エンドポイントを増やす - Qiita](https://qiita.com/sand/items/3af359b1830453d1d0ed)
[【Servant】(4) URLパラメータをハンドラの引数とする - Qiita](https://qiita.com/sand/items/d1c0bfb84487a1dfa9bb)
[【Servant】(5) JSON - Qiita](https://qiita.com/sand/items/fd2ea8acdc56998d5c5e)
[【Servant】(6) HTML - Qiita](https://qiita.com/sand/items/0e9f3c80b5103b966be4)
[【Servant】(7) Post Data - Qiita](https://qiita.com/sand/items/d21aed7c24521e20f1cb)
[【Servant】(8) Another Monad - Qiita](https://qiita.com/sand/items/9c8fa50815b00daead24)
[【Servant】(9) Handlerモナド - Qiita](https://qiita.com/sand/items/ae649f14f1b598d636c3)
[【Servant】(10) SQLite - Qiita](https://qiita.com/sand/items/091b0ea981152ad7d744)
[【Servant】(11) Servant-Client - Qiita](https://qiita.com/sand/items/a0e7758da7274a119849)
[【Servant】(12) Basic 認証 - Qiita](https://qiita.com/sand/items/dba678cef365fbd23ae3)



今回は、以下のexample集からPost Dataのexampleを取り上げます。
[Example Projects - haskell-servant/servant@github](https://github.com/haskell-servant/servant/blob/master/doc/examples.md)

今回の記事は、前回の記事「[【Servant】(4) URLパラメータをハンドラの引数とする](https://qiita.com/sand/items/d1c0bfb84487a1dfa9bb) 」でも取り上げたReqBodyに焦点を合わせています。


# 1. Post Dataを扱う

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

```haskell: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値を引数として処理します。ここではそのまま返しています。

```haskell: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を作ります。

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


# 2. 全ソース

PostDataのソース本体

```haskell: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
```




メイン


```haskell:Main.hs
module Main where

import qualified HtmlContent as T1
import qualified PostData    as T2

main :: IO ()
main = T2.runServant
```

使用するパッケージ

```yaml: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型へのデコード方法を定義します。


```haskell: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)
```

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

```haskell: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

```

メイン


```haskell:Main.hs
module Main where

import qualified HtmlContent       as T1
import qualified PostData          as T2
import qualified CustomPostData    as T3

main :: IO ()
main = T3.runServant
```

使用するパッケージ

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



実行結果

```
$ 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 14:02:12 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
```


今回は以上です