【Servant】(11) Servant-Client

[【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)



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

[servant-client: Automatic derivation of querying functions for servant](https://hackage.haskell.org/package/servant-client)


# 1. 全ソース

前回のSqliteのプログラムを少し修正します。
[【Servant】(10) SQLite - Qiita](https://qiita.com/sand/items/091b0ea981152ad7d744)


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



メイン


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


使用するパッケージ

```yaml: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](https://hackage.haskell.org/package/servant-client)

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

```haskell: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モナドを積み重ねたものです。

```haskell: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の第一引数と第二引数を入れ替えていることに注意してください。

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

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


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


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

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

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

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



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

```haskell:ClientM
do
  postMsg "hello"
  postMsg "world"
  getMsgs
```




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

```haskell: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**型データを作成します


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


今回は以上です