【Servant】(9) Handlerモナド

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




遅くなりましたが、今回はHandlerモナドについてシッカリと見ていきます。


# 1.Handlerモナド


これまで使ってきた **Server** 型は、実は **ServerT** によって以下のように定義されたものです。
[Servant.Server - Hackage](https://hackage.haskell.org/package/servant-server-0.17/docs/Servant-Server.html)

```haskell:Server
type Server api = ServerT api Handler
```


HandlerでHandlerモナド以外のモナドを使いたい時はどうするのか、次の記事で紹介しました・
[【Servant】(8) Another Monad - Qiita](https://qiita.com/sand/items/9c8fa50815b00daead24)


しかしHandlerモナドがそもそもどんなモナドなのかはまだ説明していませんでした。Handlerモナドは、[**mtl**](https://hackage.haskell.org/package/mtl) を利用して**IOモナドの上にExceptモナドを積み重ねた**シンプルなものです。


[servant-server: A family of combinators for defining webservices APIs and serving them](https://hackage.haskell.org/package/servant-server)

```haskell:Handler
newtype Handler a = Handler { runHandler' :: ExceptT ServerError IO a }
  deriving
    ( Functor, Applicative, Monad, MonadIO, Generic
    , MonadError ServerError
    , MonadThrow, MonadCatch, MonadMask
    )
```



mtlではありませんが、Monad transformersとIOモナドについては以下の一連の過去記事にまとめてありますので、**モナドの積み重ね**に不慣れな方はご一読ください。ExceptTやIOを含め、4つのモナドを重ねたシンプルなモナドを説明しています。
[【Control.Monad.Trans】(1) Identityモナド - Qiita](https://qiita.com/sand/items/e88b798d8783606071c5)


つまりHandlerモナドでは、ExceptTモナドとIOモナドの両方を使うことができます。


## 1-1. ExceptTモナド
[Control.Monad.Except](https://hackage.haskell.org/package/mtl-2.2.2/docs/Control-Monad-Except.html)

ExceptTモナドでは成功と失敗を表現することができます。

* 成功 - return で結果を返します。
* 失敗 - throwError でエラーを投げます


## 1-2. IOモナド
HandlerモナドはIOモナドをbaseモナドにしており、MonadIOのインスタンスです。つまりHandlerで好きなIOモナドを書き、それをliftIO でHandlerモナドに持ち上げることができます。

```haskell:MonadIO
class (Monad m) => MonadIO m where
    liftIO :: IO a -> m a
```



# 2. 全ソース

今回は以下の記事のソースコードに、IOモナドとExceptTモナドを追加してみます。
[【Servant】(7) Post Data - Qiita](https://qiita.com/sand/items/d21aed7c24521e20f1cb)


まず以下のimport文を追加します。

```haskell:new-import
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Error.Class
import Servant.Server.Internal.ServerError
```

IOモナドとしてprintを追加しliftIOで持ち上げます。

```haskell:liftIO
handlerName :: String -> Handler String 
handlerName nameIn = do
    liftIO $ print $ "input name = " ++ nameIn  -- IO monad
    return nameIn  -- Just output back the input string value
```



次はExceptTモナドの追加です。Handlerを追加します。

```haskell:handlerWithError
handlerWithError :: Handler String
handlerWithError = if True -- If there was an error ?
  then throwError $ err500 { errBody = "Exception in module A.B.C:55.  Have a great day!" }  -- We throw error here. Read more about it below.
  else return "sras" -- else return result.
```

throwErrorでerr500を投げています。throwErrorはExceptT所属で、err500はServant.Server.Internal.ServerError所属です。

このHandlerに対応するAPIを追加します。3番目です。

```haskell:ServantType
type ServantType =  "name" :> ReqBody '[JSON] String :> Post '[PlainText] String
               :<|> "age" :> Get '[PlainText] String
               :<|>  "errname" :> Get '[PlainText] String
```

serverについても3番目に追加します。

```haskell:
server :: Server ServantType
server = handlerName
    :<|> handlerAge
    :<|> handlerWithError
```


変更点は以上です。以下に全ソースを示します。


```haskell:PostData.he
{-# 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)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Error.Class
import Servant.Server.Internal.ServerError

-- ^^ This is the module from which the errors that we can throw are imported.
-- For some reason this is a not really mentioned in the documentation and is marked an Internal module.
-- To see all the possible types of errors we can throw or how to make our custom errors, refer the following.
-- https://hackage.haskell.org/package/servant-server-0.17/docs/Servant-Server-Internal-ServerError.html


-- In this example, we see how we can accept
-- input in the request body, say a Json payload.

handlerName :: String -> Handler String 
handlerName nameIn = do
    liftIO $ print $ "input name = " ++ nameIn  -- IO monad
    return nameIn  -- Just output back the input string value

handlerAge :: Handler String
handlerAge = return "31"


handlerWithError :: Handler String
handlerWithError = if True -- If there was an error ?
  then throwError $ err500 { errBody = "Exception in module A.B.C:55.  Have a great day!" }  -- We throw error here. Read more about it below.
  else return "sras" -- else return result.


-- The function err500 is part of Servant and returns a value of type 'ServantErr'.
-- The throwError function is not part of Servant library.
-- We can use it to throw errors of type `ServantErr` in the `Handler` monad
-- only because of the typeclass instance `MonadError ServantErr Handler`.
-- You can see it in the documentation page.
-- https://hackage.haskell.org/package/servant-server-0.17/docs/Servant-Server-Internal-ServerError.html


-- 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
               :<|>  "errname" :> Get '[PlainText] String

server :: Server ServantType
server = handlerName
    :<|> handlerAge
    :<|> handlerWithError

app :: Application
app = serve (Proxy :: Proxy ServantType) server

runServant :: IO ()
runServant = run 4000 app
```



メイン


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

main :: IO ()
main = T2.runServant
```

使用するパッケージ

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



# 3. 実行結果


```
stack build && stack exec first-project-exe
```

まずIOモナドの確認です


```
$ 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: Sat, 29 Feb 2020 01:33:24 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   ### 実行結果
* Connection #0 to host 127.0.0.1 left intact
```

プリント出力が、サーバ側のコンソールに出力されています。OKですね。

```
"input name = John"
```


次にExceptTモナドの確認です。


```
$ curl -v http://127.0.0.1:4000/errname                                         *   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 /errname 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 500 Internal Server Error     ### サーバエラー
< Transfer-Encoding: chunked
< Date: Sat, 29 Feb 2020 01:33:54 GMT
< Server: Warp/3.3.5
<
{ [61 bytes data]
100    48    0    48    0     0  48000      0 --:--:-- --:--:-- --:--:-- 48000
Exception in module A.B.C:55.  Have a great day!     ### エラーメッセージ
* Connection #0 to host 127.0.0.1 left intact
```


サーバエラーとなり、エラーメッセージも返ってきています。OKですね。


今回は以上となります。