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

##はじめに
この記事は以前出した課題の解答例を紹介したいと思います。
まだ課題に取り組んでいる、解答を見たくないという方はこの記事を読まないでください。

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

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

それでは始めましょう。

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

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

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

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

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

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

##実装

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

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

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

runApp :: App () -> UTXOs -> Either String UTXOs
runApp (App a) utxo = runIdentity (runExceptT (execStateT a utxo))

以前との違いはevalStateTをexecStateTにしたことです。これでモナドスタックの部分は完了です。

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

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

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

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

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

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

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

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を適用すればいいので以下のようになります。

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

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

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

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

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関数を適用するという方法を取りました。
(実はこの方法で実装するとインプットが重複しているトランザクションを無効にすることができます。なにげにすごいです。）

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

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関数を実装します

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

それでは実行してみます

λ: 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"}

完璧です。

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

{-# 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コメントを識別できないために普通のコメントに書き換えました。 ↩