Edited at

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

More than 1 year has passed since last update.


はじめに

この記事は以前出した課題の解答例を紹介したいと思います。

まだ課題に取り組んでいる、解答を見たくないという方はこの記事を読まないでください。

解答もGithubにて公開しました。

https://github.com/HirotoShioi/utxo-based-transaction-solution


解答

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

それでは始めましょう。


トランザクション処理の流れを確認

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


  1. インプットリストにあるインプットが全てUTXOsにて参照可能であるか確認し、合計金額を求める

  2. アウトプットの合計金額を求める

  3. インプットとアウトプットの差額を求め、それに応じて処理する。

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


  1. 利用した全てのインプットをUTXOsから削除する

  2. アウトプットをUTXOsに書き込む。書き込む際にはトランザクションID及びそのアウトプットのインデックスをInputとする。


実装方法の検討

ここではprocessTransactionを原子性のある関数として実装することで1425の処理を1つの関数にまとめることができます。つまり以下のようになります:


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

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


トランザクション処理

まず全体像を捉えるために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 aStateモナド、Eitherモナドのモナドスタックです。

よってUTXOsの参照及び変更はgetmodify関数で可能となります。またエラーが出た際には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"}

完璧です。

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

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