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

【Servant】(11) Servant-Client

【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

今回はServant-Clientについてです。Servant-Clientを使えば、ServantのAPIに対応したクライアント用のクエリ関数を自動生成してくれます。

servant-client: Automatic derivation of querying functions for servant

1. 全ソース

前回のSqliteのプログラムを少し修正します。
【Servant】(10) SQLite - Qiita

Client.hs
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}

module Client
    ( runServant
    ) where

import Control.Concurrent
import Control.Exception (bracket)
import Control.Monad.IO.Class
import Database.SQLite.Simple
import Network.HTTP.Client (newManager, defaultManagerSettings)
import Network.Wai.Handler.Warp
import Servant
import Servant.Client



type Message = String

type API = ReqBody '[PlainText] Message :> Post '[JSON] NoContent
      :<|> Get '[JSON] [Message]

api :: Proxy API
api = Proxy


initDB :: FilePath -> IO ()
initDB dbfile = withConnection dbfile $ \conn ->
  execute_ conn
    "CREATE TABLE IF NOT EXISTS messages (msg text not null)"



server :: FilePath -> Server API
server dbfile = postMessage :<|> getMessages

  where postMessage :: Message -> Handler NoContent
        postMessage msg = do
          liftIO . withConnection dbfile $ \conn ->
            execute conn
                    "INSERT INTO messages VALUES (?)"
                    (Only msg)
          return NoContent

        getMessages :: Handler [Message]
        getMessages = fmap (map fromOnly) . liftIO $
         withConnection dbfile $ \conn ->
            query_ conn "SELECT msg FROM messages"

runApp :: FilePath -> IO ()
runApp dbfile = run 8080 (serve api $ server dbfile)


postMsg :: Message -> ClientM NoContent
getMsgs :: ClientM [Message]
postMsg :<|> getMsgs = client api


runServant :: IO ()
runServant = do
  -- you could read this from some configuration file,
  -- environment variable or somewhere else instead.
  let dbfile = "test.db"
  initDB dbfile
  mgr <- newManager defaultManagerSettings
  bracket (forkIO $ runApp dbfile) killThread $ \_ -> do
    ms <- flip runClientM (mkClientEnv mgr (BaseUrl Http "localhost" 8080 "")) $ do
      postMsg "hello"
      postMsg "world"
      getMsgs
    print ms

メイン

Main.hs
module Main where

import qualified HtmlContent       as T1
import qualified PostData          as T2
import qualified CustomPostData    as T3
import qualified AnotherMonad      as T4
import qualified Sqlite            as T5
import qualified Client            as T6

main :: IO ()
main = T6.runServant

使用するパッケージ

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

2.説明

servant-client: Automatic derivation of querying functions for servant

client はServantで定義されたAPIのそれぞれのエンドポイントに対するクエリ関数を自動生成します。今回の以下の定義では、postMsgとgetMsgのクエリ関数が自動生成されます。

client
type API = ReqBody '[PlainText] Message :> Post '[JSON] NoContent
      :<|> Get '[JSON] [Message]

api :: Proxy API
api = Proxy
--
postMsg :: Message -> ClientM NoContent
getMsgs :: ClientM [Message]
postMsg :<|> getMsgs = client api

postMsgとgetMsgsはClientMモナドの文脈で実行されます。
ちなみにClientMモナドは,IOモナドをベースに、ExceptTモナドを積み、更にReaderTモナドを積み重ねたものです。

ClientM
-- | @ClientM@ is the monad in which client functions run. Contains the
-- 'Client.Manager' and 'BaseUrl' used for requests in the reader environment.
newtype ClientM a = ClientM
  { unClientM :: ReaderT ClientEnv (ExceptT ClientError IO) a }
  deriving ( Functor, Applicative, Monad, MonadIO, Generic
           , MonadReader ClientEnv, MonadError ClientError, MonadThrow
           , MonadCatch)

ClientMモナドはrunClientMで実行されます。今回の例ではflipで、runClientMの第一引数と第二引数を入れ替えていることに注意してください。

runClientM
runClientM :: ClientM a -> ClientEnv -> IO (Either ClientError a)

runClientMの値としては、ClientM a の実行結果(成功した場合)が IO (Right a)の形で得られることになります。

自動生成されたpostMsgとgetMsgは以下のように使われます。

runServant
runServant :: IO ()
runServant = do
  -- you could read this from some configuration file,
  -- environment variable or somewhere else instead.
  let dbfile = "test.db"
  initDB dbfile
  mgr <- newManager defaultManagerSettings
  bracket (forkIO $ runApp dbfile) killThread $ \_ -> do
    ms <- flip runClientM (mkClientEnv mgr (BaseUrl Http "localhost" 8080 "")) $ do
      postMsg "hello"
      postMsg "world"
      getMsgs
    print ms

以下の一行で、サーバとクライアントを起動しています。

bracket
  bracket (forkIO $ runApp dbfile) killThread $ \_ -> do

bracket で (forkIO \$ runApp dbfile)を起動し、killThread でリソースの後始末をします。後始末のタイミングは 「$ _ -> do」 以下の本体(クライアントプログラム)が終了したタイミングです。

ちなみに以下のClientMモナド全体の値は、全部成功した場合ですけど、最後のgetMsgsの値となります。それはrunClientM で実行されたモナドの値 ms となります。

ClientM
do
  postMsg "hello"
  postMsg "world"
  getMsgs

最後にrunClientM の第2引数のClientEnv型の定義をみてみます。

ClientEnv
-- | The environment in which a request is run.
--   The 'baseUrl' and 'makeClientRequest' function are used to create a @http-client@ request.
--   Cookies are then added to that request if a 'CookieJar' is set on the environment.
--   Finally the request is executed with the 'manager'.
--   The 'makeClientRequest' function can be used to modify the request to execute 
--   and set values which
--   are not specified on a @servant@ 'Request' like 'responseTimeout' or 'redirectCount'
data ClientEnv
  = ClientEnv
  { manager :: Client.Manager
  , baseUrl :: BaseUrl
  , cookieJar :: Maybe (TVar Client.CookieJar)
  , makeClientRequest :: BaseUrl -> Request -> Client.Request
  -- ^ this function can be used to customize the creation of @http-client@ requests
  -- from @servant@ requests. Default value: 'defaultMakeClientRequest'
  --   Note that:
  --      1. 'makeClientRequest' exists to allow overriding operational semantics
  --          e.g. 'responseTimeout' per request,
  --          If you need global modifications, you should use 'managerModifyRequest'
  --      2. the 'cookieJar', if defined, is being applied after 'makeClientRequest' is called.
  }

mkClientEnv関数でClientEnv型データを作成します

mkClientEnv
import qualified Network.HTTP.Client         as Client
---
-- | 'ClientEnv' smart constructor.
mkClientEnv :: Client.Manager -> BaseUrl -> ClientEnv
mkClientEnv mgr burl = ClientEnv mgr burl Nothing defaultMakeClientRequest

3. 実行結果

実行します。

stack build && stack exec first-project-exe

以下のような結果が出力されます。

Right ["hello","world"]

今回は以上です

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
ユーザーは見つかりませんでした