【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
{-# 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
メイン
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
使用するパッケージ
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のクエリ関数が自動生成されます。
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@ 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 :: ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientMの値としては、ClientM a の実行結果（成功した場合）が IO (Right a)の形で得られることになります。
自動生成されたpostMsgとgetMsgは以下のように使われます。
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 (forkIO $ runApp dbfile) killThread $ \_ -> do
bracket で (forkIO $ runApp dbfile)を起動し、killThread でリソースの後始末をします。後始末のタイミングは 「$ _ -> do」 以下の本体（クライアントプログラム）が終了したタイミングです。
ちなみに以下のClientMモナド全体の値は、全部成功した場合ですけど、最後のgetMsgsの値となります。それはrunClientM で実行されたモナドの値 ms となります。
do
postMsg "hello"
postMsg "world"
getMsgs
最後にrunClientM の第2引数の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型データを作成します
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"]
今回は以上です