Go to Qiita Advent Calendar 2024 Top
LoginSignup
2
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 3 years have passed since last update.

@sand(sand mypress)

【Servant】(7) Post Data

Last updated at Posted at 2020-02-23

【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

今回は以上です

2
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
2
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?