Help us understand the problem. What is going on with this article?

【Servant】(7) Post Data

【Servant】(1) Wai - Qiita
【Servant】(2) Servantチュートリアル - Qiita
【Servant】(3) エンドポイントを増やす - Qiita
【Servant】(4) URLパラメータをハンドラの引数とする - Qiita
【Servant】(5) JSON - Qiita
【Servant】(6) HTML - Qiita
【Servant】(7) Post Data - Qiita
【Servant】(8) Another Monad - Qiita
【Servant】(9) Handlerモナド - Qiita
【Servant】(10) SQLite - Qiita
【Servant】(11) Servant-Client - Qiita
【Servant】(12) Basic 認証 - Qiita

今回は、以下のexample集からPost Dataのexampleを取り上げます。
Example Projects - haskell-servant/servant@github

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

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

メイン

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

使用するパッケージ

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

今回は以上です

sand
Haskell、Elm、Elixir、Phoenixなどが好きな言語です
http://www.mypress.jp/
Why not register and get more from Qiita?
  1. We will deliver articles that match you
    By following users and tags, you can catch up information on technical fields that you are interested in as a whole
  2. you can read useful information later efficiently
    By "stocking" the articles you like, you can search right away
Comments
No comments
Sign up for free and join this conversation.
If you already have a Qiita account
Why do not you register as a user and use Qiita more conveniently?
You need to log in to use this function. Qiita can be used more conveniently after logging in.
You seem to be reading articles frequently this month. Qiita can be used more conveniently after logging in.
  1. We will deliver articles that match you
    By following users and tags, you can catch up information on technical fields that you are interested in as a whole
  2. you can read useful information later efficiently
    By "stocking" the articles you like, you can search right away
ユーザーは見つかりませんでした