{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Cardano.Wallet.DB.Store.Transactions.Model
( DeltaTxHistory (..)
, TxHistory
, TxHistoryF (TxHistoryF)
, TxRelationF (..)
, tokenCollateralOrd
, tokenOutOrd
, mkTxHistory
, Decoration (..)
, WithTxOut (..)
, decorateWithTxOuts
, mkTxIn
, mkTxCollateral
, mkTxOut
, undecorateFromTxOuts
) where
import Prelude
import Cardano.Wallet.DB.Sqlite.Schema
( TxCollateral (..)
, TxCollateralOut (..)
, TxCollateralOutToken (..)
, TxIn (..)
, TxOut (..)
, TxOutToken (..)
, TxWithdrawal (..)
)
import Cardano.Wallet.DB.Sqlite.Types
( TxId (TxId) )
import Cardano.Wallet.Primitive.Types.RewardAccount
( RewardAccount )
import Cardano.Wallet.Primitive.Types.TokenMap
( AssetId (AssetId) )
import Cardano.Wallet.Primitive.Types.TokenPolicy
( TokenName, TokenPolicyId )
import Cardano.Wallet.Primitive.Types.TokenQuantity
( TokenQuantity )
import Control.Arrow
( (&&&) )
import Data.Delta
( Delta (..) )
import Data.Foldable
( fold, toList )
import Data.Generics.Internal.VL
( view, (^.) )
import Data.List
( sortOn )
import Data.Map.Strict
( Map )
import Data.Word
( Word32 )
import Fmt
( Buildable (build) )
import GHC.Generics
( Generic )
import qualified Cardano.Wallet.Primitive.Types.Coin as W
import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
import qualified Cardano.Wallet.Primitive.Types.Tx as W
import qualified Data.Map.Strict as Map
data WithTxOut txin = WithTxOut
{ WithTxOut txin -> txin
txIn :: txin, WithTxOut txin -> Maybe (TxOut, [TxOutToken])
context :: Maybe (TxOut, [TxOutToken]) }
deriving ( Int -> WithTxOut txin -> ShowS
[WithTxOut txin] -> ShowS
WithTxOut txin -> String
(Int -> WithTxOut txin -> ShowS)
-> (WithTxOut txin -> String)
-> ([WithTxOut txin] -> ShowS)
-> Show (WithTxOut txin)
forall txin. Show txin => Int -> WithTxOut txin -> ShowS
forall txin. Show txin => [WithTxOut txin] -> ShowS
forall txin. Show txin => WithTxOut txin -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WithTxOut txin] -> ShowS
$cshowList :: forall txin. Show txin => [WithTxOut txin] -> ShowS
show :: WithTxOut txin -> String
$cshow :: forall txin. Show txin => WithTxOut txin -> String
showsPrec :: Int -> WithTxOut txin -> ShowS
$cshowsPrec :: forall txin. Show txin => Int -> WithTxOut txin -> ShowS
Show, WithTxOut txin -> WithTxOut txin -> Bool
(WithTxOut txin -> WithTxOut txin -> Bool)
-> (WithTxOut txin -> WithTxOut txin -> Bool)
-> Eq (WithTxOut txin)
forall txin. Eq txin => WithTxOut txin -> WithTxOut txin -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WithTxOut txin -> WithTxOut txin -> Bool
$c/= :: forall txin. Eq txin => WithTxOut txin -> WithTxOut txin -> Bool
== :: WithTxOut txin -> WithTxOut txin -> Bool
$c== :: forall txin. Eq txin => WithTxOut txin -> WithTxOut txin -> Bool
Eq, a -> WithTxOut b -> WithTxOut a
(a -> b) -> WithTxOut a -> WithTxOut b
(forall a b. (a -> b) -> WithTxOut a -> WithTxOut b)
-> (forall a b. a -> WithTxOut b -> WithTxOut a)
-> Functor WithTxOut
forall a b. a -> WithTxOut b -> WithTxOut a
forall a b. (a -> b) -> WithTxOut a -> WithTxOut b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> WithTxOut b -> WithTxOut a
$c<$ :: forall a b. a -> WithTxOut b -> WithTxOut a
fmap :: (a -> b) -> WithTxOut a -> WithTxOut b
$cfmap :: forall a b. (a -> b) -> WithTxOut a -> WithTxOut b
Functor )
data Decoration
= Without
| With
type family DecorateWithTxOut f a where
DecorateWithTxOut 'Without a = a
DecorateWithTxOut 'With a = WithTxOut a
data TxRelationF (f :: Decoration) =
TxRelationF
{ TxRelationF f -> [DecorateWithTxOut f TxIn]
ins :: [DecorateWithTxOut f TxIn]
, TxRelationF f -> [DecorateWithTxOut f TxCollateral]
collateralIns :: [DecorateWithTxOut f TxCollateral]
, TxRelationF f -> [(TxOut, [TxOutToken])]
outs :: [(TxOut, [TxOutToken])]
, TxRelationF f -> Maybe (TxCollateralOut, [TxCollateralOutToken])
collateralOuts :: Maybe (TxCollateralOut, [TxCollateralOutToken])
, TxRelationF f -> [TxWithdrawal]
withdrawals :: [TxWithdrawal]
}
deriving ( (forall x. TxRelationF f -> Rep (TxRelationF f) x)
-> (forall x. Rep (TxRelationF f) x -> TxRelationF f)
-> Generic (TxRelationF f)
forall x. Rep (TxRelationF f) x -> TxRelationF f
forall x. TxRelationF f -> Rep (TxRelationF f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: Decoration) x. Rep (TxRelationF f) x -> TxRelationF f
forall (f :: Decoration) x. TxRelationF f -> Rep (TxRelationF f) x
$cto :: forall (f :: Decoration) x. Rep (TxRelationF f) x -> TxRelationF f
$cfrom :: forall (f :: Decoration) x. TxRelationF f -> Rep (TxRelationF f) x
Generic )
deriving instance ( Eq (DecorateWithTxOut f TxIn)
, Eq (DecorateWithTxOut f TxCollateral))
=> Eq (TxRelationF f)
deriving instance ( Show (DecorateWithTxOut f TxIn)
, Show (DecorateWithTxOut f TxCollateral))
=> Show (TxRelationF f)
newtype TxHistoryF f =
TxHistoryF { TxHistoryF f -> Map TxId (TxRelationF f)
relations :: Map TxId (TxRelationF f) }
deriving ( (forall x. TxHistoryF f -> Rep (TxHistoryF f) x)
-> (forall x. Rep (TxHistoryF f) x -> TxHistoryF f)
-> Generic (TxHistoryF f)
forall x. Rep (TxHistoryF f) x -> TxHistoryF f
forall x. TxHistoryF f -> Rep (TxHistoryF f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: Decoration) x. Rep (TxHistoryF f) x -> TxHistoryF f
forall (f :: Decoration) x. TxHistoryF f -> Rep (TxHistoryF f) x
$cto :: forall (f :: Decoration) x. Rep (TxHistoryF f) x -> TxHistoryF f
$cfrom :: forall (f :: Decoration) x. TxHistoryF f -> Rep (TxHistoryF f) x
Generic )
deriving instance ( Eq (DecorateWithTxOut f TxIn)
, Eq (DecorateWithTxOut f TxCollateral))
=> Eq (TxHistoryF f)
deriving instance ( Show (DecorateWithTxOut f TxIn)
, Show (DecorateWithTxOut f TxCollateral))
=> Show (TxHistoryF f)
instance Monoid (TxHistoryF f) where
mempty :: TxHistoryF f
mempty = Map TxId (TxRelationF f) -> TxHistoryF f
forall (f :: Decoration). Map TxId (TxRelationF f) -> TxHistoryF f
TxHistoryF Map TxId (TxRelationF f)
forall a. Monoid a => a
mempty
instance Semigroup (TxHistoryF f) where
TxHistoryF Map TxId (TxRelationF f)
h1 <> :: TxHistoryF f -> TxHistoryF f -> TxHistoryF f
<> TxHistoryF Map TxId (TxRelationF f)
h2 =
Map TxId (TxRelationF f) -> TxHistoryF f
forall (f :: Decoration). Map TxId (TxRelationF f) -> TxHistoryF f
TxHistoryF (Map TxId (TxRelationF f) -> TxHistoryF f)
-> Map TxId (TxRelationF f) -> TxHistoryF f
forall a b. (a -> b) -> a -> b
$ Map TxId (TxRelationF f)
h1 Map TxId (TxRelationF f)
-> Map TxId (TxRelationF f) -> Map TxId (TxRelationF f)
forall a. Semigroup a => a -> a -> a
<> Map TxId (TxRelationF f)
h2
instance ( Show (DecorateWithTxOut f TxIn)
, Show (DecorateWithTxOut f TxCollateral))
=> Buildable (TxHistoryF f) where
build :: TxHistoryF f -> Builder
build TxHistoryF f
txs = Builder
"TxHistory " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
forall p. Buildable p => p -> Builder
build (Map TxId (TxRelationF f) -> String
forall a. Show a => a -> String
show (Map TxId (TxRelationF f) -> String)
-> Map TxId (TxRelationF f) -> String
forall a b. (a -> b) -> a -> b
$ TxHistoryF f -> Map TxId (TxRelationF f)
forall (f :: Decoration). TxHistoryF f -> Map TxId (TxRelationF f)
relations TxHistoryF f
txs)
type TxHistory = TxHistoryF 'Without
data DeltaTxHistory
= Append TxHistory
| DeleteTx TxId
deriving ( Int -> DeltaTxHistory -> ShowS
[DeltaTxHistory] -> ShowS
DeltaTxHistory -> String
(Int -> DeltaTxHistory -> ShowS)
-> (DeltaTxHistory -> String)
-> ([DeltaTxHistory] -> ShowS)
-> Show DeltaTxHistory
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeltaTxHistory] -> ShowS
$cshowList :: [DeltaTxHistory] -> ShowS
show :: DeltaTxHistory -> String
$cshow :: DeltaTxHistory -> String
showsPrec :: Int -> DeltaTxHistory -> ShowS
$cshowsPrec :: Int -> DeltaTxHistory -> ShowS
Show, DeltaTxHistory -> DeltaTxHistory -> Bool
(DeltaTxHistory -> DeltaTxHistory -> Bool)
-> (DeltaTxHistory -> DeltaTxHistory -> Bool) -> Eq DeltaTxHistory
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeltaTxHistory -> DeltaTxHistory -> Bool
$c/= :: DeltaTxHistory -> DeltaTxHistory -> Bool
== :: DeltaTxHistory -> DeltaTxHistory -> Bool
$c== :: DeltaTxHistory -> DeltaTxHistory -> Bool
Eq, (forall x. DeltaTxHistory -> Rep DeltaTxHistory x)
-> (forall x. Rep DeltaTxHistory x -> DeltaTxHistory)
-> Generic DeltaTxHistory
forall x. Rep DeltaTxHistory x -> DeltaTxHistory
forall x. DeltaTxHistory -> Rep DeltaTxHistory x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeltaTxHistory x -> DeltaTxHistory
$cfrom :: forall x. DeltaTxHistory -> Rep DeltaTxHistory x
Generic )
instance Buildable DeltaTxHistory where
build :: DeltaTxHistory -> Builder
build DeltaTxHistory
action = String -> Builder
forall p. Buildable p => p -> Builder
build (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ DeltaTxHistory -> String
forall a. Show a => a -> String
show DeltaTxHistory
action
instance Delta DeltaTxHistory where
type Base DeltaTxHistory = TxHistory
apply :: DeltaTxHistory -> Base DeltaTxHistory -> Base DeltaTxHistory
apply (Append TxHistory
txs) Base DeltaTxHistory
h = TxHistory
txs TxHistory -> TxHistory -> TxHistory
forall a. Semigroup a => a -> a -> a
<> Base DeltaTxHistory
TxHistory
h
apply (DeleteTx TxId
tid) (TxHistoryF txs) =
Map TxId (TxRelationF 'Without) -> TxHistory
forall (f :: Decoration). Map TxId (TxRelationF f) -> TxHistoryF f
TxHistoryF (Map TxId (TxRelationF 'Without) -> TxHistory)
-> Map TxId (TxRelationF 'Without) -> TxHistory
forall a b. (a -> b) -> a -> b
$ TxId
-> Map TxId (TxRelationF 'Without)
-> Map TxId (TxRelationF 'Without)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete TxId
tid Map TxId (TxRelationF 'Without)
txs
mkTxIn :: TxId -> (Int, (W.TxIn, W.Coin)) -> TxIn
mkTxIn :: TxId -> (Int, (TxIn, Coin)) -> TxIn
mkTxIn TxId
tid (Int
ix,(TxIn
txIn,Coin
amt)) =
TxIn :: TxId -> Int -> TxId -> Word32 -> Coin -> TxIn
TxIn
{ txInputTxId :: TxId
txInputTxId = TxId
tid
, txInputOrder :: Int
txInputOrder = Int
ix
, txInputSourceTxId :: TxId
txInputSourceTxId = Hash "Tx" -> TxId
TxId (TxIn -> Hash "Tx"
W.inputId TxIn
txIn)
, txInputSourceIndex :: Word32
txInputSourceIndex = TxIn -> Word32
W.inputIx TxIn
txIn
, txInputSourceAmount :: Coin
txInputSourceAmount = Coin
amt
}
mkTxCollateral :: TxId
-> (Int, (W.TxIn, W.Coin))
-> TxCollateral
mkTxCollateral :: TxId -> (Int, (TxIn, Coin)) -> TxCollateral
mkTxCollateral TxId
tid (Int
ix,(TxIn
txCollateral,Coin
amt)) =
TxCollateral :: TxId -> Int -> TxId -> Word32 -> Coin -> TxCollateral
TxCollateral
{ txCollateralTxId :: TxId
txCollateralTxId = TxId
tid
, txCollateralOrder :: Int
txCollateralOrder = Int
ix
, txCollateralSourceTxId :: TxId
txCollateralSourceTxId = Hash "Tx" -> TxId
TxId (Hash "Tx" -> TxId) -> Hash "Tx" -> TxId
forall a b. (a -> b) -> a -> b
$ TxIn -> Hash "Tx"
W.inputId TxIn
txCollateral
, txCollateralSourceIndex :: Word32
txCollateralSourceIndex = TxIn -> Word32
W.inputIx TxIn
txCollateral
, txCollateralSourceAmount :: Coin
txCollateralSourceAmount = Coin
amt
}
tokenCollateralOrd :: TxCollateralOutToken -> (TokenPolicyId, TokenName)
tokenCollateralOrd :: TxCollateralOutToken -> (TokenPolicyId, TokenName)
tokenCollateralOrd = TxCollateralOutToken -> TokenPolicyId
txCollateralOutTokenPolicyId (TxCollateralOutToken -> TokenPolicyId)
-> (TxCollateralOutToken -> TokenName)
-> TxCollateralOutToken
-> (TokenPolicyId, TokenName)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& TxCollateralOutToken -> TokenName
txCollateralOutTokenName
tokenOutOrd :: TxOutToken -> (TokenPolicyId, TokenName)
tokenOutOrd :: TxOutToken -> (TokenPolicyId, TokenName)
tokenOutOrd = TxOutToken -> TokenPolicyId
txOutTokenPolicyId (TxOutToken -> TokenPolicyId)
-> (TxOutToken -> TokenName)
-> TxOutToken
-> (TokenPolicyId, TokenName)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& TxOutToken -> TokenName
txOutTokenName
mkTxOut
:: TxId
-> (Word32, W.TxOut)
-> (TxOut, [TxOutToken])
mkTxOut :: TxId -> (Word32, TxOut) -> (TxOut, [TxOutToken])
mkTxOut TxId
tid (Word32
ix,TxOut
txOut) = (TxOut
out, (TxOutToken -> (TokenPolicyId, TokenName))
-> [TxOutToken] -> [TxOutToken]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn TxOutToken -> (TokenPolicyId, TokenName)
tokenOutOrd [TxOutToken]
tokens)
where
out :: TxOut
out =
TxOut :: TxId -> Word32 -> Address -> Coin -> TxOut
TxOut
{ txOutputTxId :: TxId
txOutputTxId = TxId
tid
, txOutputIndex :: Word32
txOutputIndex = Word32
ix
, txOutputAddress :: Address
txOutputAddress = ((Address -> Const Address Address)
-> TxOut -> Const Address TxOut)
-> TxOut -> Address
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
"address"
((Address -> Const Address Address)
-> TxOut -> Const Address TxOut)
(Address -> Const Address Address) -> TxOut -> Const Address TxOut
#address TxOut
txOut
, txOutputAmount :: Coin
txOutputAmount = TxOut -> Coin
W.txOutCoin TxOut
txOut
}
tokens :: [TxOutToken]
tokens =
TxId -> Word32 -> (AssetId, TokenQuantity) -> TxOutToken
mkTxOutToken TxId
tid Word32
ix
((AssetId, TokenQuantity) -> TxOutToken)
-> [(AssetId, TokenQuantity)] -> [TxOutToken]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Coin, [(AssetId, TokenQuantity)]) -> [(AssetId, TokenQuantity)]
forall a b. (a, b) -> b
snd (TokenBundle -> (Coin, [(AssetId, TokenQuantity)])
TokenBundle.toFlatList (TokenBundle -> (Coin, [(AssetId, TokenQuantity)]))
-> TokenBundle -> (Coin, [(AssetId, TokenQuantity)])
forall a b. (a -> b) -> a -> b
$ ((TokenBundle -> Const TokenBundle TokenBundle)
-> TxOut -> Const TokenBundle TxOut)
-> TxOut -> TokenBundle
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
"tokens"
((TokenBundle -> Const TokenBundle TokenBundle)
-> TxOut -> Const TokenBundle TxOut)
(TokenBundle -> Const TokenBundle TokenBundle)
-> TxOut -> Const TokenBundle TxOut
#tokens TxOut
txOut)
mkTxOutToken
:: TxId
-> Word32
-> (AssetId, TokenQuantity)
-> TxOutToken
mkTxOutToken :: TxId -> Word32 -> (AssetId, TokenQuantity) -> TxOutToken
mkTxOutToken TxId
tid Word32
ix (AssetId TokenPolicyId
policy TokenName
token,TokenQuantity
quantity) =
TxOutToken :: TxId
-> Word32
-> TokenPolicyId
-> TokenName
-> TokenQuantity
-> TxOutToken
TxOutToken
{ txOutTokenTxId :: TxId
txOutTokenTxId = TxId
tid
, txOutTokenTxIndex :: Word32
txOutTokenTxIndex = Word32
ix
, txOutTokenPolicyId :: TokenPolicyId
txOutTokenPolicyId = TokenPolicyId
policy
, txOutTokenName :: TokenName
txOutTokenName = TokenName
token
, txOutTokenQuantity :: TokenQuantity
txOutTokenQuantity = TokenQuantity
quantity
}
mkTxCollateralOut
:: TxId
-> W.TxOut
-> (TxCollateralOut, [TxCollateralOutToken])
mkTxCollateralOut :: TxId -> TxOut -> (TxCollateralOut, [TxCollateralOutToken])
mkTxCollateralOut TxId
tid TxOut
txCollateralOut = (TxCollateralOut
out, (TxCollateralOutToken -> (TokenPolicyId, TokenName))
-> [TxCollateralOutToken] -> [TxCollateralOutToken]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn TxCollateralOutToken -> (TokenPolicyId, TokenName)
tokenCollateralOrd [TxCollateralOutToken]
tokens)
where
out :: TxCollateralOut
out =
TxCollateralOut :: TxId -> Address -> Coin -> TxCollateralOut
TxCollateralOut
{ txCollateralOutTxId :: TxId
txCollateralOutTxId = TxId
tid
, txCollateralOutAddress :: Address
txCollateralOutAddress = ((Address -> Const Address Address)
-> TxOut -> Const Address TxOut)
-> TxOut -> Address
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
"address"
((Address -> Const Address Address)
-> TxOut -> Const Address TxOut)
(Address -> Const Address Address) -> TxOut -> Const Address TxOut
#address TxOut
txCollateralOut
, txCollateralOutAmount :: Coin
txCollateralOutAmount = TxOut -> Coin
W.txOutCoin TxOut
txCollateralOut
}
tokens :: [TxCollateralOutToken]
tokens =
TxId -> (AssetId, TokenQuantity) -> TxCollateralOutToken
mkTxCollateralOutToken TxId
tid
((AssetId, TokenQuantity) -> TxCollateralOutToken)
-> [(AssetId, TokenQuantity)] -> [TxCollateralOutToken]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Coin, [(AssetId, TokenQuantity)]) -> [(AssetId, TokenQuantity)]
forall a b. (a, b) -> b
snd (TokenBundle -> (Coin, [(AssetId, TokenQuantity)])
TokenBundle.toFlatList (TokenBundle -> (Coin, [(AssetId, TokenQuantity)]))
-> TokenBundle -> (Coin, [(AssetId, TokenQuantity)])
forall a b. (a -> b) -> a -> b
$ ((TokenBundle -> Const TokenBundle TokenBundle)
-> TxOut -> Const TokenBundle TxOut)
-> TxOut -> TokenBundle
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
"tokens"
((TokenBundle -> Const TokenBundle TokenBundle)
-> TxOut -> Const TokenBundle TxOut)
(TokenBundle -> Const TokenBundle TokenBundle)
-> TxOut -> Const TokenBundle TxOut
#tokens TxOut
txCollateralOut)
mkTxCollateralOutToken
:: TxId -> (AssetId, TokenQuantity) -> TxCollateralOutToken
mkTxCollateralOutToken :: TxId -> (AssetId, TokenQuantity) -> TxCollateralOutToken
mkTxCollateralOutToken TxId
tid (AssetId TokenPolicyId
policy TokenName
token,TokenQuantity
quantity) =
TxCollateralOutToken :: TxId
-> TokenPolicyId
-> TokenName
-> TokenQuantity
-> TxCollateralOutToken
TxCollateralOutToken
{ txCollateralOutTokenTxId :: TxId
txCollateralOutTokenTxId = TxId
tid
, txCollateralOutTokenPolicyId :: TokenPolicyId
txCollateralOutTokenPolicyId = TokenPolicyId
policy
, txCollateralOutTokenName :: TokenName
txCollateralOutTokenName = TokenName
token
, txCollateralOutTokenQuantity :: TokenQuantity
txCollateralOutTokenQuantity = TokenQuantity
quantity
}
mkTxWithdrawal :: TxId -> (RewardAccount, W.Coin) -> TxWithdrawal
mkTxWithdrawal :: TxId -> (RewardAccount, Coin) -> TxWithdrawal
mkTxWithdrawal TxId
tid (RewardAccount
txWithdrawalAccount,Coin
txWithdrawalAmount) =
TxWithdrawal :: TxId -> Coin -> RewardAccount -> TxWithdrawal
TxWithdrawal { TxId
txWithdrawalTxId :: TxId
txWithdrawalTxId :: TxId
txWithdrawalTxId, RewardAccount
txWithdrawalAccount :: RewardAccount
txWithdrawalAccount :: RewardAccount
txWithdrawalAccount, Coin
txWithdrawalAmount :: Coin
txWithdrawalAmount :: Coin
txWithdrawalAmount }
where
txWithdrawalTxId :: TxId
txWithdrawalTxId = TxId
tid
mkTxRelation :: W.Tx -> TxRelationF 'Without
mkTxRelation :: Tx -> TxRelationF 'Without
mkTxRelation Tx
tx =
TxRelationF :: forall (f :: Decoration).
[DecorateWithTxOut f TxIn]
-> [DecorateWithTxOut f TxCollateral]
-> [(TxOut, [TxOutToken])]
-> Maybe (TxCollateralOut, [TxCollateralOutToken])
-> [TxWithdrawal]
-> TxRelationF f
TxRelationF
{ $sel:ins:TxRelationF :: [DecorateWithTxOut 'Without TxIn]
ins = ((Int, (TxIn, Coin)) -> TxIn) -> [(Int, (TxIn, Coin))] -> [TxIn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TxId -> (Int, (TxIn, Coin)) -> TxIn
mkTxIn TxId
tid) ([(Int, (TxIn, Coin))] -> [TxIn])
-> [(Int, (TxIn, Coin))] -> [TxIn]
forall a b. (a -> b) -> a -> b
$ [(TxIn, Coin)] -> [(Int, (TxIn, Coin))]
forall a b. (Enum a, Num a) => [b] -> [(a, b)]
indexed ([(TxIn, Coin)] -> [(Int, (TxIn, Coin))])
-> (Tx -> [(TxIn, Coin)]) -> Tx -> [(Int, (TxIn, Coin))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx -> [(TxIn, Coin)]
W.resolvedInputs (Tx -> [(Int, (TxIn, Coin))]) -> Tx -> [(Int, (TxIn, Coin))]
forall a b. (a -> b) -> a -> b
$ Tx
tx
, $sel:collateralIns:TxRelationF :: [DecorateWithTxOut 'Without TxCollateral]
collateralIns =
((Int, (TxIn, Coin)) -> TxCollateral)
-> [(Int, (TxIn, Coin))] -> [TxCollateral]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TxId -> (Int, (TxIn, Coin)) -> TxCollateral
mkTxCollateral TxId
tid) ([(Int, (TxIn, Coin))] -> [TxCollateral])
-> [(Int, (TxIn, Coin))] -> [TxCollateral]
forall a b. (a -> b) -> a -> b
$ [(TxIn, Coin)] -> [(Int, (TxIn, Coin))]
forall a b. (Enum a, Num a) => [b] -> [(a, b)]
indexed ([(TxIn, Coin)] -> [(Int, (TxIn, Coin))])
-> [(TxIn, Coin)] -> [(Int, (TxIn, Coin))]
forall a b. (a -> b) -> a -> b
$ Tx -> [(TxIn, Coin)]
W.resolvedCollateralInputs Tx
tx
, $sel:outs:TxRelationF :: [(TxOut, [TxOutToken])]
outs = ((Word32, TxOut) -> (TxOut, [TxOutToken]))
-> [(Word32, TxOut)] -> [(TxOut, [TxOutToken])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TxId -> (Word32, TxOut) -> (TxOut, [TxOutToken])
mkTxOut TxId
tid) ([(Word32, TxOut)] -> [(TxOut, [TxOutToken])])
-> [(Word32, TxOut)] -> [(TxOut, [TxOutToken])]
forall a b. (a -> b) -> a -> b
$ [TxOut] -> [(Word32, TxOut)]
forall a b. (Enum a, Num a) => [b] -> [(a, b)]
indexed ([TxOut] -> [(Word32, TxOut)]) -> [TxOut] -> [(Word32, TxOut)]
forall a b. (a -> b) -> a -> b
$ Tx -> [TxOut]
W.outputs Tx
tx
, $sel:collateralOuts:TxRelationF :: Maybe (TxCollateralOut, [TxCollateralOutToken])
collateralOuts = TxId -> TxOut -> (TxCollateralOut, [TxCollateralOutToken])
mkTxCollateralOut TxId
tid (TxOut -> (TxCollateralOut, [TxCollateralOutToken]))
-> Maybe TxOut -> Maybe (TxCollateralOut, [TxCollateralOutToken])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tx -> Maybe TxOut
W.collateralOutput Tx
tx
, $sel:withdrawals:TxRelationF :: [TxWithdrawal]
withdrawals =
((RewardAccount, Coin) -> TxWithdrawal)
-> [(RewardAccount, Coin)] -> [TxWithdrawal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TxId -> (RewardAccount, Coin) -> TxWithdrawal
mkTxWithdrawal TxId
tid) ([(RewardAccount, Coin)] -> [TxWithdrawal])
-> [(RewardAccount, Coin)] -> [TxWithdrawal]
forall a b. (a -> b) -> a -> b
$ Map RewardAccount Coin -> [(RewardAccount, Coin)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map RewardAccount Coin -> [(RewardAccount, Coin)])
-> Map RewardAccount Coin -> [(RewardAccount, Coin)]
forall a b. (a -> b) -> a -> b
$ Tx -> Map RewardAccount Coin
W.withdrawals Tx
tx
}
where
tid :: TxId
tid = Hash "Tx" -> TxId
TxId (Hash "Tx" -> TxId) -> Hash "Tx" -> TxId
forall a b. (a -> b) -> a -> b
$ Tx
tx Tx
-> ((Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
-> Tx -> Const (Hash "Tx") Tx)
-> Hash "Tx"
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
"txId"
((Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
-> Tx -> Const (Hash "Tx") Tx)
(Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
-> Tx -> Const (Hash "Tx") Tx
#txId
indexed :: (Enum a, Num a) => [b] -> [(a, b)]
indexed :: [b] -> [(a, b)]
indexed = [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a
0 .. ]
mkTxHistory :: [W.Tx] -> TxHistory
mkTxHistory :: [Tx] -> TxHistory
mkTxHistory [Tx]
txs = Map TxId (TxRelationF 'Without) -> TxHistory
forall (f :: Decoration). Map TxId (TxRelationF f) -> TxHistoryF f
TxHistoryF (Map TxId (TxRelationF 'Without) -> TxHistory)
-> Map TxId (TxRelationF 'Without) -> TxHistory
forall a b. (a -> b) -> a -> b
$ [Map TxId (TxRelationF 'Without)]
-> Map TxId (TxRelationF 'Without)
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([Map TxId (TxRelationF 'Without)]
-> Map TxId (TxRelationF 'Without))
-> [Map TxId (TxRelationF 'Without)]
-> Map TxId (TxRelationF 'Without)
forall a b. (a -> b) -> a -> b
$ do
Tx
tx <- [Tx]
txs
let relation :: TxRelationF 'Without
relation = Tx -> TxRelationF 'Without
mkTxRelation Tx
tx
Map TxId (TxRelationF 'Without)
-> [Map TxId (TxRelationF 'Without)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map TxId (TxRelationF 'Without)
-> [Map TxId (TxRelationF 'Without)])
-> Map TxId (TxRelationF 'Without)
-> [Map TxId (TxRelationF 'Without)]
forall a b. (a -> b) -> a -> b
$ TxId -> TxRelationF 'Without -> Map TxId (TxRelationF 'Without)
forall k a. k -> a -> Map k a
Map.singleton (Hash "Tx" -> TxId
TxId (Hash "Tx" -> TxId) -> Hash "Tx" -> TxId
forall a b. (a -> b) -> a -> b
$ Tx
tx Tx
-> ((Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
-> Tx -> Const (Hash "Tx") Tx)
-> Hash "Tx"
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
"txId"
((Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
-> Tx -> Const (Hash "Tx") Tx)
(Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
-> Tx -> Const (Hash "Tx") Tx
#txId) TxRelationF 'Without
relation
type TxOutKey = (TxId, Word32)
decorateWithTxOuts :: TxHistoryF 'Without -> TxHistoryF 'With
decorateWithTxOuts :: TxHistory -> TxHistoryF 'With
decorateWithTxOuts (TxHistoryF Map TxId (TxRelationF 'Without)
w) =
let
txouts :: Map TxOutKey (TxOut, [TxOutToken])
txouts :: Map TxOutKey (TxOut, [TxOutToken])
txouts = [(TxOutKey, (TxOut, [TxOutToken]))]
-> Map TxOutKey (TxOut, [TxOutToken])
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(TxOutKey, (TxOut, [TxOutToken]))]
-> Map TxOutKey (TxOut, [TxOutToken]))
-> [(TxOutKey, (TxOut, [TxOutToken]))]
-> Map TxOutKey (TxOut, [TxOutToken])
forall a b. (a -> b) -> a -> b
$ do
TxRelationF {[(TxOut, [TxOutToken])]
[TxWithdrawal]
[DecorateWithTxOut 'Without TxCollateral]
[DecorateWithTxOut 'Without TxIn]
Maybe (TxCollateralOut, [TxCollateralOutToken])
withdrawals :: [TxWithdrawal]
collateralOuts :: Maybe (TxCollateralOut, [TxCollateralOutToken])
outs :: [(TxOut, [TxOutToken])]
collateralIns :: [DecorateWithTxOut 'Without TxCollateral]
ins :: [DecorateWithTxOut 'Without TxIn]
$sel:withdrawals:TxRelationF :: forall (f :: Decoration). TxRelationF f -> [TxWithdrawal]
$sel:collateralOuts:TxRelationF :: forall (f :: Decoration).
TxRelationF f -> Maybe (TxCollateralOut, [TxCollateralOutToken])
$sel:outs:TxRelationF :: forall (f :: Decoration). TxRelationF f -> [(TxOut, [TxOutToken])]
$sel:collateralIns:TxRelationF :: forall (f :: Decoration).
TxRelationF f -> [DecorateWithTxOut f TxCollateral]
$sel:ins:TxRelationF :: forall (f :: Decoration).
TxRelationF f -> [DecorateWithTxOut f TxIn]
..} <- Map TxId (TxRelationF 'Without) -> [TxRelationF 'Without]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Map TxId (TxRelationF 'Without)
w
[(TxOut -> TxId
txOutputTxId (TxOut -> TxId) -> (TxOut -> Word32) -> TxOut -> TxOutKey
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& TxOut -> Word32
txOutputIndex (TxOut -> TxOutKey) -> TxOut -> TxOutKey
forall a b. (a -> b) -> a -> b
$ TxOut
txout, (TxOut, [TxOutToken])
x) | x :: (TxOut, [TxOutToken])
x@(TxOut
txout,[TxOutToken]
_ ) <- [(TxOut, [TxOutToken])]
outs]
in Map TxId (TxRelationF 'With) -> TxHistoryF 'With
forall (f :: Decoration). Map TxId (TxRelationF f) -> TxHistoryF f
TxHistoryF (Map TxId (TxRelationF 'With) -> TxHistoryF 'With)
-> Map TxId (TxRelationF 'With) -> TxHistoryF 'With
forall a b. (a -> b) -> a -> b
$ (TxRelationF 'Without -> TxRelationF 'With)
-> Map TxId (TxRelationF 'Without) -> Map TxId (TxRelationF 'With)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map TxOutKey (TxOut, [TxOutToken])
-> TxRelationF 'Without -> TxRelationF 'With
solveTxOut Map TxOutKey (TxOut, [TxOutToken])
txouts) Map TxId (TxRelationF 'Without)
w
decorateInputs
:: (t -> TxOutKey)
-> Map TxOutKey (TxOut, [TxOutToken])
-> [t]
-> [WithTxOut t]
decorateInputs :: (t -> TxOutKey)
-> Map TxOutKey (TxOut, [TxOutToken]) -> [t] -> [WithTxOut t]
decorateInputs t -> TxOutKey
keyOf Map TxOutKey (TxOut, [TxOutToken])
txOutMap [t]
ins = do
t
i <- [t]
ins
WithTxOut t -> [WithTxOut t]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WithTxOut t -> [WithTxOut t]) -> WithTxOut t -> [WithTxOut t]
forall a b. (a -> b) -> a -> b
$ t -> Maybe (TxOut, [TxOutToken]) -> WithTxOut t
forall txin. txin -> Maybe (TxOut, [TxOutToken]) -> WithTxOut txin
WithTxOut t
i (Maybe (TxOut, [TxOutToken]) -> WithTxOut t)
-> Maybe (TxOut, [TxOutToken]) -> WithTxOut t
forall a b. (a -> b) -> a -> b
$ TxOutKey
-> Map TxOutKey (TxOut, [TxOutToken])
-> Maybe (TxOut, [TxOutToken])
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (t -> TxOutKey
keyOf t
i) Map TxOutKey (TxOut, [TxOutToken])
txOutMap
solveTxOut
:: Map TxOutKey (TxOut, [TxOutToken])
-> TxRelationF 'Without
-> TxRelationF 'With
solveTxOut :: Map TxOutKey (TxOut, [TxOutToken])
-> TxRelationF 'Without -> TxRelationF 'With
solveTxOut Map TxOutKey (TxOut, [TxOutToken])
txOutMap TxRelationF {[(TxOut, [TxOutToken])]
[TxWithdrawal]
[DecorateWithTxOut 'Without TxCollateral]
[DecorateWithTxOut 'Without TxIn]
Maybe (TxCollateralOut, [TxCollateralOutToken])
withdrawals :: [TxWithdrawal]
collateralOuts :: Maybe (TxCollateralOut, [TxCollateralOutToken])
outs :: [(TxOut, [TxOutToken])]
collateralIns :: [DecorateWithTxOut 'Without TxCollateral]
ins :: [DecorateWithTxOut 'Without TxIn]
$sel:withdrawals:TxRelationF :: forall (f :: Decoration). TxRelationF f -> [TxWithdrawal]
$sel:collateralOuts:TxRelationF :: forall (f :: Decoration).
TxRelationF f -> Maybe (TxCollateralOut, [TxCollateralOutToken])
$sel:outs:TxRelationF :: forall (f :: Decoration). TxRelationF f -> [(TxOut, [TxOutToken])]
$sel:collateralIns:TxRelationF :: forall (f :: Decoration).
TxRelationF f -> [DecorateWithTxOut f TxCollateral]
$sel:ins:TxRelationF :: forall (f :: Decoration).
TxRelationF f -> [DecorateWithTxOut f TxIn]
..} = TxRelationF :: forall (f :: Decoration).
[DecorateWithTxOut f TxIn]
-> [DecorateWithTxOut f TxCollateral]
-> [(TxOut, [TxOutToken])]
-> Maybe (TxCollateralOut, [TxCollateralOutToken])
-> [TxWithdrawal]
-> TxRelationF f
TxRelationF
{ $sel:ins:TxRelationF :: [DecorateWithTxOut 'With TxIn]
ins =
(TxIn -> TxOutKey)
-> Map TxOutKey (TxOut, [TxOutToken]) -> [TxIn] -> [WithTxOut TxIn]
forall t.
(t -> TxOutKey)
-> Map TxOutKey (TxOut, [TxOutToken]) -> [t] -> [WithTxOut t]
decorateInputs
(TxIn -> TxId
txInputSourceTxId (TxIn -> TxId) -> (TxIn -> Word32) -> TxIn -> TxOutKey
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& TxIn -> Word32
txInputSourceIndex)
Map TxOutKey (TxOut, [TxOutToken])
txOutMap
[TxIn]
[DecorateWithTxOut 'Without TxIn]
ins
, $sel:collateralIns:TxRelationF :: [DecorateWithTxOut 'With TxCollateral]
collateralIns =
(TxCollateral -> TxOutKey)
-> Map TxOutKey (TxOut, [TxOutToken])
-> [TxCollateral]
-> [WithTxOut TxCollateral]
forall t.
(t -> TxOutKey)
-> Map TxOutKey (TxOut, [TxOutToken]) -> [t] -> [WithTxOut t]
decorateInputs
(TxCollateral -> TxId
txCollateralSourceTxId (TxCollateral -> TxId)
-> (TxCollateral -> Word32) -> TxCollateral -> TxOutKey
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& TxCollateral -> Word32
txCollateralSourceIndex)
Map TxOutKey (TxOut, [TxOutToken])
txOutMap
[TxCollateral]
[DecorateWithTxOut 'Without TxCollateral]
collateralIns
, $sel:outs:TxRelationF :: [(TxOut, [TxOutToken])]
outs = [(TxOut, [TxOutToken])]
outs
, $sel:collateralOuts:TxRelationF :: Maybe (TxCollateralOut, [TxCollateralOutToken])
collateralOuts = Maybe (TxCollateralOut, [TxCollateralOutToken])
collateralOuts
, $sel:withdrawals:TxRelationF :: [TxWithdrawal]
withdrawals = [TxWithdrawal]
withdrawals
}
undecorateFromTxOuts :: TxHistoryF 'With -> TxHistoryF 'Without
undecorateFromTxOuts :: TxHistoryF 'With -> TxHistory
undecorateFromTxOuts (TxHistoryF Map TxId (TxRelationF 'With)
w) = Map TxId (TxRelationF 'Without) -> TxHistory
forall (f :: Decoration). Map TxId (TxRelationF f) -> TxHistoryF f
TxHistoryF (Map TxId (TxRelationF 'Without) -> TxHistory)
-> Map TxId (TxRelationF 'Without) -> TxHistory
forall a b. (a -> b) -> a -> b
$ (TxRelationF 'With -> TxRelationF 'Without)
-> Map TxId (TxRelationF 'With) -> Map TxId (TxRelationF 'Without)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TxRelationF 'With -> TxRelationF 'Without
unsolveTxOut Map TxId (TxRelationF 'With)
w
unsolveTxOut :: TxRelationF 'With -> TxRelationF 'Without
unsolveTxOut :: TxRelationF 'With -> TxRelationF 'Without
unsolveTxOut TxRelationF {[(TxOut, [TxOutToken])]
[TxWithdrawal]
[DecorateWithTxOut 'With TxCollateral]
[DecorateWithTxOut 'With TxIn]
Maybe (TxCollateralOut, [TxCollateralOutToken])
withdrawals :: [TxWithdrawal]
collateralOuts :: Maybe (TxCollateralOut, [TxCollateralOutToken])
outs :: [(TxOut, [TxOutToken])]
collateralIns :: [DecorateWithTxOut 'With TxCollateral]
ins :: [DecorateWithTxOut 'With TxIn]
$sel:withdrawals:TxRelationF :: forall (f :: Decoration). TxRelationF f -> [TxWithdrawal]
$sel:collateralOuts:TxRelationF :: forall (f :: Decoration).
TxRelationF f -> Maybe (TxCollateralOut, [TxCollateralOutToken])
$sel:outs:TxRelationF :: forall (f :: Decoration). TxRelationF f -> [(TxOut, [TxOutToken])]
$sel:collateralIns:TxRelationF :: forall (f :: Decoration).
TxRelationF f -> [DecorateWithTxOut f TxCollateral]
$sel:ins:TxRelationF :: forall (f :: Decoration).
TxRelationF f -> [DecorateWithTxOut f TxIn]
..} = TxRelationF :: forall (f :: Decoration).
[DecorateWithTxOut f TxIn]
-> [DecorateWithTxOut f TxCollateral]
-> [(TxOut, [TxOutToken])]
-> Maybe (TxCollateralOut, [TxCollateralOutToken])
-> [TxWithdrawal]
-> TxRelationF f
TxRelationF
{ $sel:ins:TxRelationF :: [DecorateWithTxOut 'Without TxIn]
ins = (WithTxOut TxIn -> TxIn) -> [WithTxOut TxIn] -> [TxIn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithTxOut TxIn -> TxIn
forall txin. WithTxOut txin -> txin
txIn [DecorateWithTxOut 'With TxIn]
[WithTxOut TxIn]
ins
, $sel:collateralIns:TxRelationF :: [DecorateWithTxOut 'Without TxCollateral]
collateralIns = (WithTxOut TxCollateral -> TxCollateral)
-> [WithTxOut TxCollateral] -> [TxCollateral]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithTxOut TxCollateral -> TxCollateral
forall txin. WithTxOut txin -> txin
txIn [DecorateWithTxOut 'With TxCollateral]
[WithTxOut TxCollateral]
collateralIns
, $sel:outs:TxRelationF :: [(TxOut, [TxOutToken])]
outs = [(TxOut, [TxOutToken])]
outs
, $sel:collateralOuts:TxRelationF :: Maybe (TxCollateralOut, [TxCollateralOutToken])
collateralOuts = Maybe (TxCollateralOut, [TxCollateralOutToken])
collateralOuts
, $sel:withdrawals:TxRelationF :: [TxWithdrawal]
withdrawals = [TxWithdrawal]
withdrawals
}