モナド変換子 (その3: 課題の解答) ref: https://qiita.com/HirotoShioi/items/6faaf8babb23bb2f3485

file0.txt

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

file1.txt

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

file2.txt

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

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

file3.txt

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

file4.txt

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

file5.txt

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             -- 未使用アウトプットの金額を返す

file6.txt

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                           -- アウトプットの金額を返す

file7.txt

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

file8.txt

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

file9.txt

{-# 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