モナド変換子 (その3: 課題の解答)

##はじめに
この記事は[以前出した課題](https://qiita.com/HirotoShioi/items/ac75b97aa52f9db9c472)の解答例を紹介したいと思います。
まだ課題に取り組んでいる、解答を見たくないという方はこの記事を読まないでください。

解答もGithubにて公開しました。
https://github.com/HirotoShioi/utxo-based-transaction-solution

##解答
まずはトランザクション処理の流れをまとめ、そこから如何に実装するのかを考察し、その上で実装を行います。

それでは始めましょう。

##トランザクション処理の流れを確認
まずはトランザクション処理の流れをまとめてみましょう。

1. インプットリストにあるインプットが全て`UTXOs`にて参照可能であるか確認し、合計金額を求める
2. アウトプットの合計金額を求める
3.  インプットとアウトプットの差額を求め、それに応じて処理する。

インプットの合計金額がアウトプットより多い場合には以下の処理をする：

4. 利用した全てのインプットを`UTXOs`から削除する
5. アウトプットを`UTXOs`に書き込む。書き込む際にはトランザクションID及びそのアウトプットのインデックスを`Input`とする。

##実装方法の検討
ここでは`processTransaction`を原子性のある関数として実装することで**1**と**4**、**2**と**5**の処理を１つの関数にまとめることができます。つまり以下のようになります:

1. インプットを`UTXOs`にて参照し、もしあれば削除する、なければエラーとなり、トランザクションは無効とみなされる。
2. アウトプットの合計金額を求めるとともに、`UTXOs`に書き込む。
3. インプットとアウトプットの差額を求める。もしアウトプットの金額のほうが多ければトランザクションを無効とし、それまでの処理を無効にする。

##実装

###モナドスタック
ヒントでも述べていましたが、この問題には状態の参照及び変更、そしてエラー処理をする必要があります。よってモナドスタックは以下のようになります。

```haskell
newtype App a = App (StateT UTXOs (ExcepT String Identity) a)
  deriving (Functor, 
          , Applicative,
          , Monad,
          , MonadState UTXOs
          , MonadError String)
```

次に走査関数が必要となります。

```haskell
runApp :: App () -> UTXOs -> Either String UTXOs
runApp (App a) utxo = runIdentity (runExceptT (execStateT a utxo))
```
以前との違いは`evalStateT`を`execStateT`にしたことです。これでモナドスタックの部分は完了です。

###トランザクション処理

まず全体像を捉えるために`processTransaction`を実装しましょう。
その上で念頭に置かなければいけないのがインプットとアウトプットの処理方法です。これに関しては以下の方法で処理できると考えています。

> インプット、アウトプットはそれぞれリストなので何らかの`map`関数を利用すれば処理できる、そして返り値に合計金額を返せばいい。

よって以下の関数で処理できそうです。

```haskell
processInputs :: Id -> [Input] -> App Int
processInputs = undefined

processOutputs :: Id -> [Output] -> App Int
processOUtputs = undefined
```

これを踏まえた上で`processTransaction`を実装してみましょう。

```haskell
processTransaction :: Transaction -> App ()
processTransaction Transaction{..} = do
    inputValue <- processInputs tId tInput      --1
    outputValue <- processOutputs tId tOutput   --2
    when (inputValue < outputValue) $
      throwError $ "Infuccient amount, tId: " <> show tId
        <> "\n Input is less than output by: "
        <> show (outputValue - inputValue)      --3
```
1,2,3の処理を適切に行っているのでこれで完璧です。

次に`processTransactions`関数の実装です。これはそれぞれの`Transaction`に対して`processTransaction`を適用すればいいので以下のようになります。

```haskell
processTransactions :: [Transaction] -> App ()
processTransactions = mapM_ processTransaction
```

###インプット、アウトプット処理
ここで一度モナドスタック`App a`のおさらいをします。

`App a`は`State`モナド、`Either`モナドのモナドスタックです。
よって`UTXOs`の参照及び変更は`get`、`modify`関数で可能となります。またエラーが出た際には`throwError`関数を利用できます。

これらを踏まえた上でまずをインプット処理を実装しましょう。

```haskell
processInputs :: Id -> [Input] -> App Int
processInputs tid inputs = sum <$> mapM (processInput tid) inputs

processInput :: Id -> Input -> App Int
processInput tid input = do
  utxos <- get
  case M.lookup input utxos of  -- 検証処理
    Nothing         -> throwError $ "Invalid input at: " <> show tid
    Just Output{..} -> do
      modify $ M.delete input   -- UTXOの更新
      return oValue             -- 未使用アウトプットの金額を返す
```
より容易に実装するために、それぞれのインプットに対して`processInput`関数を適用するという方法を取りました。
(実はこの方法で実装するとインプットが重複しているトランザクションを無効にすることができます。なにげにすごいです。）

同様にアウトプット処理も実装します。

```haskell
processOutputs :: Id -> [Output] -> App Int
processOutputs tid outputs = sum <$> zipWithM (processOutput tid) [0..] outputs

processOutput :: Id -> Index -> Output -> App Int
processOutput tid i output@Output{..} = do
  modify $ M.insert (Input tid i) output  -- UTXOの更新
  return oValue                           -- アウトプットの金額を返す
```

いい感じです。

これで全ての関数が実装されました。
実際に動かす前に、わかりやすく出力されるように`prettyPrint`関数を実装します

```haskell
prettyPrint :: Either String UTXOs -> IO ()
prettyPrint (Left e) = putStrLn $ "Warning: " <> e
prettyPrint (Right utxo) = putStrLn $ M.foldrWithKey 
  (\k v acc -> show k <> " " <>  show v <> "\n" <> acc ) "" utxo
```

ダミーデータは以下のものを利用します。
https://github.com/HirotoShioi/utxo-based-transaction-solution/blob/master/src/Dummy.hs

それでは実行してみます

```terminal
λ: prettyPrint $ runApp (processTransactions [transaction1, transaction2]) utxos
Input {iPrevious = 1, iIndex = 0} Output {oValue = 2000, oAddress = "Lars"}
Input {iPrevious = 2, iIndex = 0} Output {oValue = 5000, oAddress = "Charles"}
Input {iPrevious = 2, iIndex = 1} Output {oValue = 5000, oAddress = "Jeremy"}
Input {iPrevious = 2, iIndex = 2} Output {oValue = 1000, oAddress = "Hiroto"}
```
**完璧です。**

以下にトランザクション処理部分の実装コードを掲載します。[^1]

```haskell
{-# LANGUAGE RecordWildCards #-}

module Transaction (
  processTransactions
) where

import Control.Monad.Except
import Control.Monad.State

import qualified Data.Map as M

import App
import Types

import Data.Semigroup ((<>))

-- Process transaction
processTransaction :: Transaction -> App ()
processTransaction Transaction{..} = do
    inputValue <- processInputs tId tInput
    outputValue <- processOutputs tId tOutput
    when (inputValue < outputValue) $
      throwError $ "Infuccient amount, tId: " <> show tId
        <> "\n Input is less than output by: " <> show (outputValue - inputValue)

-- Process list of tranactions
processTransactions :: [Transaction] -> App ()
processTransactions = mapM_ processTransaction

-- Process list of inputs
processInputs :: Id -> [Input] -> App Int
processInputs tid inputs = sum <$> mapM (processInput tid) inputs

-- Process inputs i.e. check it is valid, update utxos, and return unspent value
processInput :: Id -> Input -> App Int
processInput tid input = do
  utxos <- get
  case M.lookup input utxos of  -- Check if the input is valid
    Nothing         -> throwError $ "Invalid input at: " <> show tid
    Just Output{..} -> do
      modify $ M.delete input   -- Delete the input from utxos
      return oValue             -- Return output value

-- Process list of outputs
processOutputs :: Id -> [Output] -> App Int
processOutputs tid outputs = sum <$> zipWithM (processOutput tid) [0..] outputs

-- Process outputs i.e. Update utxos accordingly then return output value
processOutput :: Id -> Index -> Output -> App Int
processOutput tid i output@Output{..} = do
  modify $ M.insert (Input tid i) output  -- Update utxos accordingly
  return oValue                           -- Return a value
```

## まとめ
次回は効果的なモナドスタックとは何なのか、スタックを構築する上でのガイドラインなどが述べられた記事を紹介していきたいと思います。

####小言
僕がHaskellを用いてコーディングを行ってる際には

- あそこはああすればなんとかなる
- 出来上がったものがなにをするのか
- 使っているライブラリがどう実装されていて、なにをするのか

を意識しています。細かいことは全てコンパイラがなんとかしてくれるのでユーザーは自分の作りたいものを意識し続けることができるのがHaskellの強みではないでしょうか。

[^1]: 実際のコードではHaddockコメントを残してるのですが、QiitaのマークダウンではHaddockコメントを識別できないために普通のコメントに書き換えました。