diff --git a/cardano-wallet.cabal b/cardano-wallet.cabal index e74d996dda2..8240750600f 100644 --- a/cardano-wallet.cabal +++ b/cardano-wallet.cabal @@ -32,6 +32,7 @@ library ghc-options: -Werror build-depends: base + , base58-bytestring , binary , bytestring , cborg @@ -39,6 +40,7 @@ library , cryptonite , deepseq , digest + , fmt , http-api-data , http-media , memory @@ -51,12 +53,13 @@ library src exposed-modules: Cardano.ChainProducer.RustHttpBridge.Api - , Cardano.ChainProducer.RustHttpBridge.Client - , Cardano.Wallet.Binary - , Cardano.Wallet.Binary.Packfile - , Cardano.Wallet.BlockSyncer - , Cardano.Wallet.Primitive - , Servant.Extra.ContentTypes + Cardano.ChainProducer.RustHttpBridge.Client + Cardano.Wallet.BlockSyncer + Servant.Extra.ContentTypes + Cardano.Wallet + Cardano.Wallet.Binary + Cardano.Wallet.Binary.Packfile + Cardano.Wallet.Primitive other-modules: Paths_cardano_wallet @@ -93,15 +96,17 @@ test-suite unit ghc-options: -Werror build-depends: base - , cardano-wallet , base58-bytestring , bytestring + , cardano-wallet , cborg , containers + , deepseq , hspec , memory , QuickCheck , time-units + , transformers type: exitcode-stdio-1.0 hs-source-dirs: @@ -109,7 +114,8 @@ test-suite unit main-is: Main.hs other-modules: + Cardano.WalletSpec Cardano.Wallet.BinarySpec - , Cardano.Wallet.Binary.PackfileSpec - , Cardano.Wallet.PrimitiveSpec - , Cardano.Wallet.BlockSyncerSpec + Cardano.Wallet.Binary.PackfileSpec + Cardano.Wallet.PrimitiveSpec + Cardano.Wallet.BlockSyncerSpec diff --git a/src/Cardano/Wallet.hs b/src/Cardano/Wallet.hs new file mode 100644 index 00000000000..71555af1e91 --- /dev/null +++ b/src/Cardano/Wallet.hs @@ -0,0 +1,240 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeOperators #-} + +-- | +-- Copyright: © 2018-2019 IOHK +-- License: MIT +-- +-- Here we find the "business logic" to manage a Cardano wallet. This is a +-- direct implementation of the model from the [Formal Specification for a Cardano Wallet](https://github.com/input-output-hk/cardano-wallet/blob/master/specifications/wallet/formal-specification-for-a-cardano-wallet.pdf) +-- Note that, this module is purposedly agnostic to how blocks are retrieved or +-- how various types are serialized. +-- +-- This is really about how the wallet keep track of its internal state, and its +-- UTxO (where the relationship is defined via the 'IsOurs' abstraction to allow +-- this core code to be used with any sort of derivation scheme). +-- +-- All those functions are pure and there's no reason to shove in any sort of +-- side-effects in here :) + +module Cardano.Wallet + ( + -- * Wallet + Wallet + , initWallet + , applyBlock + , availableBalance + , totalBalance + , totalUTxO + , availableUTxO + + -- * Helpers + , invariant + , txOutsOurs + , utxoFromTx + ) where + +import Prelude + +import Cardano.Wallet.Binary + ( txId ) +import Cardano.Wallet.Primitive + ( Block (..) + , Dom (..) + , IsOurs (..) + , Tx (..) + , TxIn (..) + , TxOut (..) + , UTxO (..) + , balance + , excluding + , restrictedBy + , restrictedTo + , txIns + , updatePending + ) +import Control.DeepSeq + ( NFData (..), deepseq ) +import Control.Monad.Trans.State.Strict + ( State, runState, state ) +import Data.List.NonEmpty + ( NonEmpty (..) ) +import Data.Maybe + ( catMaybes ) +import Data.Set + ( Set ) +import Data.Traversable + ( for ) + +import qualified Data.Map as Map +import qualified Data.Set as Set + + +-- * Wallet + +-- | An opaque wallet type, see @initWallet@ and @applyBlock@ to construct and +-- update wallets. +-- +-- Internally, this keeps track or a few things including: +-- +-- - UTxOs +-- - Pending transaction +-- - TODO: Transaction history +-- - TODO: Known & used addresses +data Wallet s where + Wallet + :: (IsOurs s, Semigroup s, NFData s, Show s) + => UTxO + -> Set Tx + -> s + -> Wallet s + +deriving instance Show (Wallet s) + +instance NFData (Wallet s) where + rnf (Wallet utxo pending s) = + rnf utxo `deepseq` (rnf pending `deepseq` (rnf s `deepseq` ())) + + +-- | Create an empty wallet from an initial state +initWallet + :: (IsOurs s, Semigroup s, NFData s, Show s) + => s + -> Wallet s +initWallet = Wallet mempty mempty + + +-- | Apply Block is the only way to make the wallet evolve. +applyBlock + :: Block + -> NonEmpty (Wallet s) + -> NonEmpty (Wallet s) +applyBlock !b (cp@(Wallet !utxo !pending _) :| checkpoints) = + let + (ourUtxo, ourIns, s') = prefilterBlock b cp + utxo' = (utxo <> ourUtxo) `excluding` ourIns + pending' = updatePending b pending + cp' = Wallet utxo' pending' s' + in + -- NOTE + -- k = 2160 is currently hard-coded here. In the short-long run, we do + -- want to get that as an argument or, leave that decision to the caller + -- though it is not trivial at all. If it shrinks, it's okay because we + -- have enough checkpoints, but if it does increase, then we have + -- problems in case of rollbacks. + (cp' :| cp : take 2160 checkpoints) + + +-- | Available balance = 'balance' . 'availableUTxO' +availableBalance :: Wallet s -> Integer +availableBalance = + balance . availableUTxO + + +-- | Total balance = 'balance' . 'totalUTxO' +totalBalance :: Wallet s -> Integer +totalBalance = + balance . totalUTxO + + +-- | Available UTxO = UTxO that aren't part of pending txs +availableUTxO :: Wallet s -> UTxO +availableUTxO (Wallet utxo pending _) = + utxo `excluding` txIns pending + + +-- | Total UTxO = 'availableUTxO' <> "pending UTxO" +totalUTxO :: Wallet s -> UTxO +totalUTxO wallet@(Wallet _ pending s) = + let + -- NOTE + -- We _safely_ discard the state here because we aren't intending to + -- discover any new addresses through this operation. In practice, we + -- can only discover new addresses when applying blocks. + discardState = fst + in + availableUTxO wallet <> discardState (changeUTxO pending s) + + +-- * Helpers + +-- | Check whether an invariants holds or not. +-- +-- >>> invariant "not empty" [1,2,3] (not . null) +-- [1, 2, 3] +-- +-- >>> invariant "not empty" [] (not . null) +-- *** Exception: not empty +invariant + :: String -- ^ A title / message to throw in case of violation + -> a + -> (a -> Bool) + -> a +invariant msg a predicate = + if predicate a then a else error msg + +-- | Return all transaction outputs that are ours. This plays well within a +-- 'State' monad. +-- +-- @ +-- myFunction :: Block -> State s Result +-- myFunction b = do +-- ours <- state $ txOutsOurs (transaction b) +-- return $ someComputation ours +-- @ +txOutsOurs + :: forall s. (IsOurs s) + => Set Tx + -> s + -> (Set TxOut, s) +txOutsOurs txs = + runState $ Set.fromList <$> forMaybe (foldMap outputs txs) pick + where + pick :: TxOut -> State s (Maybe TxOut) + pick out = do + predicate <- state $ isOurs (address out) + return $ if predicate then Just out else Nothing + + forMaybe :: Monad m => [a] -> (a -> m (Maybe b)) -> m [b] + forMaybe xs = fmap catMaybes . for xs + +-- | Construct a UTxO corresponding to a given transaction. It is important for +-- the transaction outputs to be ordered correctly, since they become available +-- inputs for the subsequent blocks. +utxoFromTx :: Tx -> UTxO +utxoFromTx tx@(Tx _ outs) = + UTxO $ Map.fromList $ zip (TxIn (txId tx) <$> [0..]) outs + + +-- * Internals + +prefilterBlock + :: Block + -> Wallet s + -> (UTxO, Set TxIn, s) +prefilterBlock b (Wallet !utxo _ !s) = + let + txs = transactions b + (ourOuts, s') = txOutsOurs txs s + ourUtxo = foldMap utxoFromTx txs `restrictedTo` ourOuts + ourIns = txIns txs `Set.intersection` dom (utxo <> ourUtxo) + in + invariant "applyBlock requires: dom ourUtxo ∩ dom utxo = ∅" + (ourUtxo, ourIns, s') + (const $ Set.null $ dom ourUtxo `Set.intersection` dom utxo) + +changeUTxO + :: IsOurs s + => Set Tx + -> s + -> (UTxO, s) +changeUTxO pending = runState $ do + ours <- state $ txOutsOurs pending + let utxo = foldMap utxoFromTx pending + let ins = txIns pending + return $ (utxo `restrictedTo` ours) `restrictedBy` ins diff --git a/src/Cardano/Wallet/Primitive.hs b/src/Cardano/Wallet/Primitive.hs index 9b22be09ccb..67ac0b8615f 100644 --- a/src/Cardano/Wallet/Primitive.hs +++ b/src/Cardano/Wallet/Primitive.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -34,7 +35,6 @@ module Cardano.Wallet.Primitive , TxIn(..) , TxOut(..) , txIns - , txOutsOurs , updatePending -- * Address @@ -56,26 +56,35 @@ module Cardano.Wallet.Primitive -- * Generic , Hash (..) + , ShowFmt (..) ) where import Prelude import Control.DeepSeq ( NFData (..) ) -import Control.Monad.Trans.State.Strict - ( State, runState, state ) +import Data.ByteArray.Encoding + ( Base (Base16), convertToBase ) import Data.ByteString ( ByteString ) +import Data.ByteString.Base58 + ( bitcoinAlphabet, encodeBase58 ) import Data.Map.Strict ( Map ) -import Data.Maybe - ( catMaybes ) import Data.Set ( Set ) -import Data.Traversable - ( for ) import Data.Word ( Word16, Word32, Word64 ) +import Fmt + ( Buildable (..) + , blockListF + , fmt + , nameF + , ordinalF + , padLeftF + , prefixF + , suffixF + ) import GHC.Generics ( Generic ) import GHC.TypeLits @@ -83,6 +92,7 @@ import GHC.TypeLits import qualified Data.Map.Strict as Map import qualified Data.Set as Set +import qualified Data.Text.Encoding as T -- * Epoch @@ -139,22 +149,6 @@ txIns :: Set Tx -> Set TxIn txIns = foldMap (Set.fromList . inputs) -txOutsOurs - :: forall s. (IsOurs s) - => Set Tx - -> s - -> (Set TxOut, s) -txOutsOurs txs = - runState $ Set.fromList <$> forMaybe (foldMap outputs txs) pick - where - pick :: TxOut -> State s (Maybe TxOut) - pick out = do - predicate <- state $ isOurs (address out) - return $ if predicate then Just out else Nothing - - forMaybe :: Monad m => [a] -> (a -> m (Maybe b)) -> m [b] - forMaybe xs = fmap catMaybes . for xs - updatePending :: Block -> Set Tx -> Set Tx updatePending b = let @@ -173,6 +167,16 @@ data TxIn = TxIn instance NFData TxIn +instance Buildable TxIn where + build txin = mempty + <> ordinalF (inputIx txin + 1) + <> " " + <> prefixF 8 txF + <> "..." + <> suffixF 8 txF + where + txF = build $ T.decodeUtf8 $ convertToBase Base16 $ getHash $ inputId txin + data TxOut = TxOut { address @@ -183,6 +187,20 @@ data TxOut = TxOut instance NFData TxOut +instance Buildable TxOut where + build txout = mempty + <> padLeftF 17 ' ' (build $ coin txout) -- NOTE 17 because max coin val + <> " @ " + <> prefixF 8 addrF + <> "..." + <> suffixF 8 addrF + where + addrF = build $ address txout + + +instance Buildable (TxIn, TxOut) where + build (txin, txout) = build txin <> " ==> " <> build txout + -- * Address @@ -192,6 +210,10 @@ newtype Address = Address instance NFData Address +instance Buildable Address where + build = build . T.decodeUtf8 . encodeBase58 bitcoinAlphabet . getAddress + + -- | This abstraction exists to give us the ability to keep the wallet business -- logic agnostic to the address derivation and discovery mechanisms. -- @@ -224,6 +246,9 @@ instance Bounded Coin where minBound = Coin 0 maxBound = Coin 45000000000000000 +instance Buildable Coin where + build = build . getCoin + isValidCoin :: Coin -> Bool isValidCoin c = c >= minBound && c <= maxBound @@ -240,6 +265,11 @@ instance Dom UTxO where type DomElem UTxO = TxIn dom (UTxO utxo) = Map.keysSet utxo +instance Buildable UTxO where + build (UTxO utxo) = + nameF "UTxO" $ blockListF (Map.toList utxo) + + balance :: UTxO -> Integer balance = Map.foldl' fn 0 . getUTxO @@ -268,7 +298,7 @@ restrictedTo (UTxO utxo) outs = UTxO $ Map.filter (`Set.member` outs) utxo --- * Generic +-- * Polymorphic class Dom a where type DomElem a :: * @@ -280,3 +310,12 @@ newtype Hash (tag :: Symbol) = Hash } deriving (Show, Generic, Eq, Ord) instance NFData (Hash tag) + + +-- | A polymorphic wrapper type with a custom show instance to display data +-- through 'Buildable' instances. +newtype ShowFmt a = ShowFmt a + deriving (Generic, Eq, Ord) + +instance Buildable a => Show (ShowFmt a) where + show (ShowFmt a) = fmt (build a) diff --git a/test/unit/Cardano/WalletSpec.hs b/test/unit/Cardano/WalletSpec.hs new file mode 100644 index 00000000000..9e6ff068ed6 --- /dev/null +++ b/test/unit/Cardano/WalletSpec.hs @@ -0,0 +1,598 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Cardano.WalletSpec + ( spec + ) where + +import Prelude + +import Cardano.Wallet + ( applyBlock + , availableBalance + , initWallet + , invariant + , totalBalance + , totalUTxO + , txOutsOurs + , utxoFromTx + ) +import Cardano.Wallet.Primitive + ( Address (..) + , Block (..) + , BlockHeader (..) + , Coin (..) + , Dom (..) + , Hash (..) + , IsOurs (..) + , ShowFmt (..) + , Tx (..) + , TxIn (..) + , TxOut (..) + , UTxO (..) + , balance + , excluding + , restrictedTo + , txIns + ) +import Control.DeepSeq + ( NFData (..) ) +import Control.Monad + ( foldM ) +import Control.Monad.Trans.State.Strict + ( State, evalState, state ) +import Data.List.NonEmpty + ( NonEmpty (..) ) +import Data.Set + ( Set, (\\) ) +import GHC.Generics + ( Generic ) +import Test.Hspec + ( Spec, describe, it ) +import Test.QuickCheck + ( Arbitrary (..) + , Property + , checkCoverage + , choose + , cover + , property + , shrinkList + , sublistOf + , (.&&.) + , (===) + ) + +import qualified Data.List.NonEmpty as NE +import qualified Data.Map.Strict as Map +import qualified Data.Set as Set + + +spec :: Spec +spec = do + describe "Buildable instances examples" $ do + let block = blockchain !! 1 + let utxo = utxoFromTx $ head $ Set.toList $ transactions block + it (show $ ShowFmt utxo) True + + describe "Compare Wallet impl. with Specification" $ do + it "Lemma 3.2 - dom u ⋪ updateUTxO b u = new b" + (checkCoverage prop_3_2) + + it "applyBlock matches the basic model from the specification" + (checkCoverage prop_applyBlockBasic) + + +{------------------------------------------------------------------------------- + Properties +-------------------------------------------------------------------------------} + +prop_3_2 + :: ApplyBlock + -> Property +prop_3_2 (ApplyBlock s utxo block) = + cover 75 cond "utxo ≠ ∅ " (property prop) + where + cond = utxo /= mempty + prop = + ShowFmt (updateUTxO' block utxo `excluding` dom utxo) + === + ShowFmt (new block) + new b = flip evalState s $ do + let txs = transactions b + utxo' <- (foldMap utxoFromTx txs `restrictedTo`) <$> state (txOutsOurs txs) + return $ utxo' `excluding` txIns txs + updateUTxO' b u = evalState (updateUTxO b u) s + + +prop_applyBlockBasic + :: WalletState + -> Property +prop_applyBlockBasic s = + cover 90 cond0 "ours ≠ ∅ " $ + cover 90 cond1 "addresses \\ ours ≠ ∅ " $ + property prop + where + cond0 = not $ null $ ourAddresses s + cond1 = not $ null $ (Set.fromList addresses) \\ (ourAddresses s) + prop = + let + checkpoints = initWallet s :| [] + (wallet :| _) = foldl (flip applyBlock) checkpoints blockchain + utxo = totalUTxO wallet + utxo' = evalState (foldM (flip updateUTxO) mempty blockchain) s + in + (ShowFmt utxo === ShowFmt utxo') .&&. + (availableBalance wallet === balance utxo') .&&. + (totalBalance wallet === balance utxo') + + +{------------------------------------------------------------------------------- + Basic Model - See Wallet Specification, section 3 + + Our implementation of 'applyBlock' is a bit more complex than the basic + model. In practice, we do not want to compute intersection and tx id of a + whole block of transactions, but we only do it for the one that are relevant + to us. + Plus, we are tracking more than just the UTxO. However, when it comes to UTxO + the basic model and our implementation should be "on-par" and therefore, + given a few blocks, we should be able to control that they are indeed. +-------------------------------------------------------------------------------} + +-- Update UTxO as described in the formal specification, Fig 3. The basic model +updateUTxO + :: IsOurs s + => Block + -> UTxO + -> State s UTxO +updateUTxO !b utxo = do + let txs = transactions b + utxo' <- (foldMap utxoFromTx txs `restrictedTo`) <$> state (txOutsOurs txs) + return $ (utxo <> utxo') `excluding` txIns txs + + +{------------------------------------------------------------------------------- + Test Data + + In practice, we may want to generate arbitrary valid sequences of block. + This isn't trivial though because we would need to generate _valid_ chains + for various invariants and preconditions to hold. Work have been done in + cardano-sl to generate such chains, and we may want to use that at some + point. For now, a valid chain coming from the testnet will do + +-------------------------------------------------------------------------------} + +-- | An arbitrary wallet state that can recognize some hard-coded addresses from +-- our chain. This allows us to control that the UTxO gets updated accordingly +-- for some arbitrary instances of that state. +data WalletState = WalletState + { ourAddresses :: Set Address + , discoveredAddresses :: Set Address + } deriving (Generic, Show) + +instance NFData WalletState + +instance Semigroup WalletState where + (WalletState ours a) <> (WalletState ours' b) = + invariant "Semigroup WalletState must be defined on same addresses" + (WalletState ours (a <> b)) + (\_ -> ours == ours') + +instance IsOurs WalletState where + isOurs addr s@(WalletState ours discovered) = + if addr `elem` ours then + (True, WalletState ours (Set.insert addr discovered)) + else + (False, s) + +instance Arbitrary WalletState where + shrink (WalletState ours _) = + [ WalletState (Set.fromList ours') mempty + | ours' <- shrinkList pure (Set.toList ours) + ] + arbitrary = do + knownAddresses <- Set.fromList <$> sublistOf addresses + return $ WalletState knownAddresses mempty + + +-- | Since it's quite tricky to generate a valid Arbitrary chain and +-- corresponding initial UTxO, instead, we take subset of our small valid +-- blockchain and, reconstruct a valid initial UTxO by applying all the given +-- blocks minus one. Then, we control the property when applying that very block +data ApplyBlock = ApplyBlock WalletState UTxO Block + deriving Show + +instance Arbitrary ApplyBlock where + shrink (ApplyBlock s (UTxO utxo) b) = + let utxos = UTxO . Map.fromList <$> shrinkList pure (Map.toList utxo) + in (\u -> ApplyBlock s u b) <$> utxos + arbitrary = do + n <- choose (1, length blockchain) + s <- arbitrary + let blocks = NE.fromList (take n blockchain) + let utxo = evalState (foldM (flip updateUTxO) mempty (NE.init blocks)) s + let block = NE.last blocks + return $ ApplyBlock s utxo block + + +addresses :: [Address] +addresses = map address + $ concatMap outputs + $ concatMap (Set.toList . transactions) + blockchain + +-- A excerpt of mainnet, epoch #14, first 20 blocks. +blockchain :: [Block] +blockchain = + [ Block + { header = BlockHeader + { epochIndex = 14 + , slotNumber = 0 + , prevBlockHash = Hash "39d89a1e837e968ba35370be47cdfcbfd193cd992fdeed557b77c49b77ee59cf" + } + , transactions = Set.fromList [] + } + , Block + { header = BlockHeader + { epochIndex = 14 + , slotNumber = 1 + , prevBlockHash = Hash "2d04732b41d07e45a2b87c05888f956805f94b108f59e1ff3177860a17c292db" + } + , transactions = Set.fromList + [ Tx + { inputs = + [ TxIn + { inputId = Hash "\187\199\161\240\222$\bZ\196\138R\238o\137\209\129QE\132Z\135\DC2TsP\167\228\146\&8Yt\171" + , inputIx = 0 + } + ] + , outputs = + [ TxOut + { address = Address "\130\216\CANXB\131X\FSUh\206'\198\237\161R3\214L\145\245P'\197\230\&6\206\152\173\EOTI:\152\vX&\161\SOHX\RSX\FS\202>U<\156c\197|\227M\202Cv\136\\\253\176\130\185b9G\188_\179\&4\253Y\NUL\SUB\176\EOT\165s" + , coin = Coin 3834435886614 + } + , TxOut + { address = Address "\130\216\CANXB\131X\FSq4\137\215\171\175Z\ENQ\242\216^\239\197\244^s\230\170}\183}\136\143\218\150\ENQ\137\255\161\SOHX\RSX\FS\173y\SI\234\169\ETB\\\251\238\175\128\178\191a\128\142?(\FSD\148\182\192\250\221\&5;7\NUL\SUB\241\244w\194" + , coin = Coin 9999800000 + } + ] + } + ] + } + , Block + { header = BlockHeader + { epochIndex = 14 + , slotNumber = 2 + , prevBlockHash = Hash "e95a6e7da3cd61e923e30b1998b135d40958419e4157a9f05d2f0f194e4d7bba" + } + , transactions = Set.fromList + [ Tx + { inputs = + [ TxIn + { inputId = Hash "s\165\210\a@\213\DC1\224\DLE\144$\DEL\138\202\144\225\229PVBD\ETB25\161\164u\137\NUL{\158v" + , inputIx = 0 + } + ] + , outputs = + [ TxOut + { address = Address "\130\216\CANXB\131X\FS\255-+\179k\202\194\212\206\224\248\243\158\b\188 \212\141$\189\194&\252\162\166\162jq\161\SOHX\RSX\FS\202>U<\156c\197QM\140\ACKCk=\238\239\134^w\CAN$\253\FSqL\198\128\200\NUL\SUB\f\219\163/" + , coin = Coin 3841151724910 + } + , TxOut + { address = Address "\130\216\CANXB\131X\FS\n\aGD6\206\202\&2K\n\203%\180\249\227\229\216n\130\218\&6\147\SYN/\SUBq\231\210\161\SOHX\RSX\FS?\DLE\204\131\217-\176\181^\169#?Jn~\137\153\ENQc0<\225\SOH)\DEL\150\163\136\NUL\SUB\b\215\236\238" + , coin = Coin 3273721339 + } + ] + } + ] + } + , Block + { header = BlockHeader + { epochIndex = 14 + , slotNumber = 3 + , prevBlockHash = Hash "b5d970285a2f8534e94119cd631888c20b3a4ec0707a821f6df5c96650fe01dd" + } + , transactions = Set.fromList + [ Tx + { inputs = + [ TxIn + { inputId = Hash "\177|\163\210\184\169\145\234F\128\209\235\217\148\n\ETXD\155\ESCba\251\230%\213\202\230Y\151&\234A" + , inputIx = 0 + } + ] + , outputs = + [ TxOut + { address = Address { getAddress = "\130\216\CANXB\131X\FS!\148\NULDcB\r\237\202\255)\DLEe`\159\a\\-IG\"P\218\136\219i\244\134\161\SOHX\RSX\FS\202>U<\156c\197;\236\EOT\STXC\209\173\138\205B\EOT.\ENQ\ACKG@\174\206\185\ESC\206\NUL\SUB\230\150\192\165" } + , coin = Coin 3824424245549 + } + , TxOut + { address = Address "\130\216\CANXB\131X\FS\ACK\218k\189\250\189\129\229A\128>`V\153\144EyN\187T\\\151 \171;\251(\t\161\SOHX\RSX\FS\197\217I\176.##'\217l\226i{\200'\176\&32I\150\166\SI+\143\138\GS\SOH+\NUL\SUB7\206\156`" + , coin = Coin 19999800000 + } + ] + } + ] + } + , Block + { header = BlockHeader + { epochIndex = 14 + , slotNumber = 4 + , prevBlockHash = Hash "cb96ff923728a67e52dfad54df01fc5a20c7aaf386226a0564a1185af9798cb1" + } + , transactions = Set.fromList [] + } + , Block + { header = BlockHeader + { epochIndex = 14 + , slotNumber = 5 + , prevBlockHash = Hash "63040af5ed7eb2948e2c09a43f946c91d5dd2efaa168bbc5c4f3e989cfc337e6" + } + , transactions = Set.fromList + [ Tx + { inputs = + [ TxIn + { inputId = Hash "\195\242\DEL-\232v(c\SI+\172\163\245\142\189\214aiB#4\139\172\166\237\167\ETB9\246\150\185\219" + , inputIx = 1 + } + , TxIn + { inputId = Hash "8O\137\193\224w\243\252s\198\250\201\&04\169\129E\155{\n\DC3H<\199\208\154\214\237\141\128<+" + , inputIx = 1 + } + ] + , outputs = + [ TxOut + { address = Address "\130\216\CANXB\131X\FS%\ENQ\163x'\DC3\DC1\222\157\197 4*\200v\219\f\201\215\197\136\188\128\243\216\NAKe\214\161\SOHX\RSX\FS\197\217I\176.##LD\224\179i\142\&3\220\162\250\221:F\227\NAK$\156|\EOTY\228\NUL\SUBr\a\134\146" + , coin = Coin 15908 + } + , TxOut + { address = Address "\130\216\CANXB\131X\FS\SI\DC4f\168\210\188\164\SUBF\239\212\201,\DLE\238\230U<\156c\197<\211\197>C_\207\225?\146\134\160\ETB\207!X\139\250N\220\ESC\NUL\SUB\186\217]\175" + , coin = Coin 3827577253906 + } + , TxOut + { address = Address { getAddress = "\130\216\CANXB\131X\FS\167\219!{\ETX\157lP>i~\158\225\DEL\141!.I\248\"\183(\DC13\231\185pU\161\SOHX\RSX\FS\SOH\131\136&\ESC\236\240\200\rw\255.\153\252\&6'\174\159vs\CAN\255\153\USf\155\173\223\NUL\SUB\214\237\RS\248" } + , coin = Coin 16837395907 + } + ] + } + , Tx + { inputs = + [ TxIn + { inputId = Hash "\151\146\133\SYN\187\ENQ\252\226\&4\210n\153\178+.h\200\CANAs\SI\181\189\GS\131[g7O\GS\232\215" + , inputIx = 1 + } + ] + , outputs = + [ TxOut + { address = Address "\130\216\CANXB\131X\FS!f\151\SYN\189\218\167\236\206\253\&9UW%\CAN\238\139\205<\246\132\&1\SOH\164\SUBR\237\DC4\161\SOHX\RSX\FS\202>U<\156c\197T\188\198\219C5_\246\194@\227\217\151\235\139\216(2p\173\236\NUL\SUB0\147sX" + , coin = Coin 3843675297120 + } + , TxOut + { address = Address "\130\216\CANXB\131X\FS\ETBb\215X\172)\244\139Tp\DC4b\194\DC3\SUB\157\STXqr\172/\175q\244\153\140\214`\161\SOHX\RSX\FSCGQbc\253u+\vF\192XT\185\233e\150}\173\139\199\CAN\215\134\159\166\GS\216\NUL\SUBA}\137A" + , coin = Coin 748331810 + } + ] + } + ] + } + , Block + { header = BlockHeader + { epochIndex = 14 + , slotNumber = 11 + , prevBlockHash = Hash "4fdff9f1d751dba5a48bc2a14d6dfb21709882a13dad495b856bf76d5adf4bd1" + } + , transactions = Set.fromList + [ Tx + { inputs = + [ TxIn + { inputId = Hash "_>\240.\159\145\US\NUL1\158r\231\&8\214\241\134\&2\DC4\ETB\160\134\237z\143D\229d\DC4\245\208\DC3?" + , inputIx = 0 + } + ] + , outputs = + [ TxOut + { address = Address "\130\216\CANXB\131X\FS\233\219\220^Zp\135\EOT\205&#\226S\232\&0\160\252\164\&9\224\&2\152\RS\197F\191\193\223\161\SOHX\RSX\FS\202>U<\156c\197\&5\201\210\140C\v\216\253\150\235\177\189*\211E\241\201;L;t\NUL\SUB||\158\&1" + , coin = Coin 3842710635646 + } + , TxOut + { address = Address "\130\216\CANXB\131X\FS\197\251\223.\192>\179\168\236}\242\180\188$\173\161\229\165\157#\190\USo{]BO\191\161\SOHX\RSX\FSA\162\195Z4\CANj\174\148\160\&34\USo\ETB\179\a\133Te\ACK\131\182y\248\236\211c\NUL\SUB\225\153\247\212" + , coin = Coin 1499800000 + } + ] + } + , Tx + { inputs = + [ TxIn + { inputId = Hash "\187\177J\189\132K\n\175\130\148\&3[\150\193zL\153\191Qjcl\n\162B\241G)>\151\DC4\225" + , inputIx = 0 + } + ] + , outputs = + [ TxOut + { address = Address "\130\216\CANXB\131X\FS\203\242{\247\221*[\182a\171/`\151,\130\&4\246\219\245I\t\240\&6\ACK\159wg\186\161\SOHX\RSX\FS\202>U<\156c\197\CAN\250\154\238C \170\214\202\244y\140!\189\SYN]\157\132\ETXt\245\NUL\SUB\155\210\\\173" + , coin = Coin 3842940911894 + } + , TxOut + { address = Address "\130\216\CANXB\131X\FS~\133V\SYN\DEL\211\165\ACK\239\a\182\131\143'\253On\210d\169kc\145\179\156\142\230\140\161\SOHX\RSX\FS\179@nvQ\155\209\149n\214\226y\166\133\170\207\134\131t\219\&7&\246m_Jv\DC2\NUL\SUB\218\132l\235" + , coin = Coin 1345293520 + } + ] + } + ] + } + , Block + { header = BlockHeader + { epochIndex = 14 + , slotNumber = 12 + , prevBlockHash = Hash "96a31a7cdb410aeb5756ddb43ee2ddb4c682f6308db38310ab54bf38b89d6b0d" + } + , transactions = Set.fromList [] + } + , Block + { header = BlockHeader + { epochIndex = 14 + , slotNumber = 13 + , prevBlockHash = Hash "47c08c0a11f66aeab915e5cd19362e8da50dc2523e629b230b73ec7b6cdbeef8" + } + , transactions = Set.fromList [] + } + , Block + { header = BlockHeader + { epochIndex = 14 + , slotNumber = 14 + , prevBlockHash = Hash "d6d7e79e2a25f53e6fb771eebd1be05274861004dc62c03bf94df03ff7b87198" + } + , transactions = Set.fromList [] + } + , Block + { header = BlockHeader + { epochIndex = 14 + , slotNumber = 15 + , prevBlockHash = Hash "647e62b29ebcb0ecfa0b4deb4152913d1a669611d646072d2f5898835b88d938" + } + , transactions = Set.fromList [] + } + , Block + { header = BlockHeader + { epochIndex = 14 + , slotNumber = 16 + , prevBlockHash = Hash "02f38ce50c9499f2526dd9c5f9e8899e65c0c40344e14ff01dc6c31137978efb" + } + , transactions = Set.fromList [] + } + , Block + { header = BlockHeader + { epochIndex = 14 + , slotNumber = 17 + , prevBlockHash = Hash "528492ded729ca77a72b1d85654742db85dfd3b68e6c4117ce3c253e3e86616d" + } + , transactions = Set.fromList [] + } + , Block + { header = BlockHeader + { epochIndex = 14 + , slotNumber = 18 + , prevBlockHash = Hash "f4283844eb78ca6f6333b007f5a735d71499d6ce7cc816846a033a36784bd299" + } + , transactions = Set.fromList + [ Tx + { inputs = + [ TxIn + { inputId = Hash "\150\225pI\SUB\251n\189W\159\213|v\198\132\242$6\248\204:\145#\151\221\177\201\197\ESC\134\251S" + , inputIx = 0 + } + ] + , outputs = + [ TxOut + { address = Address "\130\216\CANXB\131X\FS\197\CAN\DELP\160W\144\&8\GSW\189\&7m\b\233Y\216I\176\159\250\144\EM\155|\219\n\231\161\SOHX\RSX\FS\202>U<\156c\197\&6\149=XC\217L\SOH\255\166\228\138\221\157\&0\ACK&]`z\DC2\NUL\SUB\149\157\191\162" + , coin = Coin 3832107959251 + } + , TxOut + { address = Address { getAddress = "\130\216\CANXB\131X\FSI\SI\165\f\DLE\223\214\209\206\187y\128F\SUB\248.\203\186/\244\143m1]\n\132\234\"\161\SOHX\RSX\FSv\SI\240\133L\130\194\DC2\191}\189;5\141\252t]\132}[\244\ESC&\SI\EOT[{\238\NUL\SUB\159\236eZ" } + , coin = Coin 11823271860 + } + ] + } + , Tx + { inputs = + [ TxIn + { inputId = Hash "\249\DC2\146\&0\GSK\177\182\224@\206\205\255@0\149\155I\201^}\174\bw\130\221U\139\235\182f\138" + , inputIx = 0 + } + ] + , outputs = + [ TxOut + { address = Address "\130\216\CANXB\131X\FSe$;\SO\178g\161\226>1w\159M\NAK\141d\173\210\202\192Bn\250\176C(\DC2\ENQ\161\SOHX\RSX\FS\202>U<\156c\197\SUB\225\157\&1C\209\253\183\USuz\163\193\209\196\217:\155!\167!\NUL\SUB\137\240\187\159" + , coin = Coin 3841254542346 + } + , TxOut + { address = Address "\130\216\CANXB\131X\FS\161\243^\nQ`\DLE\151\147n\153j\STX\215]\SOr7\136\211\222y\US*\157%\DEL\ETB\161\SOHX\RSX\FS\201\SUB\170\156Oe\155)D\US\143\CAN\237\193\244vKM\160\SOH\166&\161\213\188KD\142\NUL\SUB\144\192\240\146" + , coin = Coin 2700667457 + } + ] + } + ] + } + , Block + { header = BlockHeader + { epochIndex = 14 + , slotNumber = 19 + , prevBlockHash = Hash "dffc3506d381361468376227e1c9323a2ffc76011103e3225124f08e6969a73b" + } + , transactions = Set.fromList + [ Tx + { inputs = + [ TxIn + { inputId = Hash "\194\157>\160\221\163\&4\218\149\215\178\161]p\185\246\208\198\ENQ \188\216\242\160\190\236\137\151\DC3\134\"\DC4" + , inputIx = 0 + } + ] + , outputs = + [ TxOut + { address = Address "\130\216\CANXB\131X\FS\147\ACKn\246.n\DLE\233Y\166)\207c\v\248\183\235\212\EOTV\243h\192\190T\150'\196\161\SOHX\RSX\FS\202>U<\156c\197&\DC3S\235C\198\245\163\204=\214fa\201\t\205\248\204\226r%\NUL\SUB\174\187\&7\t" + , coin = Coin 3823755953610 + } + , TxOut + { address = Address "\130\216\CANXB\131X\FS\ACK\218k\189\250\189\129\229A\128>`V\153\144EyN\187T\\\151 \171;\251(\t\161\SOHX\RSX\FS\197\217I\176.##'\217l\226i{\200'\176\&32I\150\166\SI+\143\138\GS\SOH+\NUL\SUB7\206\156`" + , coin = Coin 19999800000 + } + ] + } + ] + } + ]