{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

{- |
 Copyright: © 2018-2022 IOHK
 License: Apache-2.0

Pure model for the transactions ('Tx') and metadata about them ('TxMeta')
in a collection of wallets.

-}
module Cardano.Wallet.DB.Store.Wallets.Model
    ( DeltaTxWalletsHistory (..)
    , TxWalletsHistory
    , walletsLinkedTransactions
    , mkTransactionInfo
    ) where

import Prelude

import Cardano.Wallet.DB.Sqlite.Schema
    ( TxCollateral (..)
    , TxCollateralOut (..)
    , TxCollateralOutToken (..)
    , TxIn (..)
    , TxMeta (..)
    , TxOut (..)
    , TxOutToken (..)
    , TxWithdrawal (..)
    )
import Cardano.Wallet.DB.Sqlite.Types
    ( TxId (getTxId) )
import Cardano.Wallet.DB.Store.Meta.Model
    ( DeltaTxMetaHistory (..)
    , ManipulateTxMetaHistory
    , TxMetaHistory (..)
    , mkTxMetaHistory
    )
import Cardano.Wallet.DB.Store.Transactions.Model
    ( Decoration (With)
    , TxHistory
    , TxHistory
    , TxHistoryF (..)
    , TxRelationF (..)
    , WithTxOut (..)
    , mkTxHistory
    )
import Cardano.Wallet.Primitive.Slotting
    ( TimeInterpreter, interpretQuery, slotToUTCTime )
import Cardano.Wallet.Primitive.Types.TokenMap
    ( AssetId (AssetId) )
import Cardano.Wallet.Primitive.Types.Tx
    ( TxMeta (..), TxOut (..) )
import Data.Delta
    ( Delta (..) )
import Data.DeltaMap
    ( DeltaMap (Adjust, Insert) )
import Data.Foldable
    ( toList )
import Data.Function
    ( (&) )
import Data.Functor
    ( (<&>) )
import Data.Generics.Internal.VL
    ( (^.) )
import Data.Map.Strict
    ( Map )
import Data.Quantity
    ( Quantity (..) )
import Data.Set
    ( Set )
import Fmt
    ( Buildable, build )

import qualified Cardano.Wallet.DB.Sqlite.Schema as DB
import qualified Cardano.Wallet.DB.Store.Meta.Model as TxMetaStore
import qualified Cardano.Wallet.DB.Store.Transactions.Model as TxStore
import qualified Cardano.Wallet.Primitive.Types as W
import qualified Cardano.Wallet.Primitive.Types.Coin as WC
import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
import qualified Cardano.Wallet.Primitive.Types.Tx as WT
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set

-- | Verbs to change transactions store and wallet-indexed meta stores.
data DeltaTxWalletsHistory
    = ExpandTxWalletsHistory W.WalletId [(WT.Tx, WT.TxMeta)]
    -- ^ Add transactions and meta for a wallet.
    | ChangeTxMetaWalletsHistory W.WalletId ManipulateTxMetaHistory
    -- ^ Change metas for a wallet.
    | GarbageCollectTxWalletsHistory
    -- ^ Delete all transactions that have no metas.
    | RemoveWallet W.WalletId
    -- ^ Remove all metas of a wallet.
    deriving ( Int -> DeltaTxWalletsHistory -> ShowS
[DeltaTxWalletsHistory] -> ShowS
DeltaTxWalletsHistory -> String
(Int -> DeltaTxWalletsHistory -> ShowS)
-> (DeltaTxWalletsHistory -> String)
-> ([DeltaTxWalletsHistory] -> ShowS)
-> Show DeltaTxWalletsHistory
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeltaTxWalletsHistory] -> ShowS
$cshowList :: [DeltaTxWalletsHistory] -> ShowS
show :: DeltaTxWalletsHistory -> String
$cshow :: DeltaTxWalletsHistory -> String
showsPrec :: Int -> DeltaTxWalletsHistory -> ShowS
$cshowsPrec :: Int -> DeltaTxWalletsHistory -> ShowS
Show, DeltaTxWalletsHistory -> DeltaTxWalletsHistory -> Bool
(DeltaTxWalletsHistory -> DeltaTxWalletsHistory -> Bool)
-> (DeltaTxWalletsHistory -> DeltaTxWalletsHistory -> Bool)
-> Eq DeltaTxWalletsHistory
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeltaTxWalletsHistory -> DeltaTxWalletsHistory -> Bool
$c/= :: DeltaTxWalletsHistory -> DeltaTxWalletsHistory -> Bool
== :: DeltaTxWalletsHistory -> DeltaTxWalletsHistory -> Bool
$c== :: DeltaTxWalletsHistory -> DeltaTxWalletsHistory -> Bool
Eq )

instance Buildable DeltaTxWalletsHistory where
    build :: DeltaTxWalletsHistory -> Builder
build = String -> Builder
forall p. Buildable p => p -> Builder
build (String -> Builder)
-> (DeltaTxWalletsHistory -> String)
-> DeltaTxWalletsHistory
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeltaTxWalletsHistory -> String
forall a. Show a => a -> String
show

-- | Transactions history is a shared transactions store together with
-- a set of meta-transactions stores indexed by wallet.
type TxWalletsHistory = (TxHistory, Map W.WalletId TxMetaHistory)

instance Delta DeltaTxWalletsHistory where
    type Base DeltaTxWalletsHistory = TxWalletsHistory
    apply :: DeltaTxWalletsHistory
-> Base DeltaTxWalletsHistory -> Base DeltaTxWalletsHistory
apply (ExpandTxWalletsHistory WalletId
wid [(Tx, TxMeta)]
cs) (txh,mtxmh) =
        ( DeltaTxHistory -> Base DeltaTxHistory -> Base DeltaTxHistory
forall delta. Delta delta => delta -> Base delta -> Base delta
apply (TxHistory -> DeltaTxHistory
TxStore.Append (TxHistory -> DeltaTxHistory) -> TxHistory -> DeltaTxHistory
forall a b. (a -> b) -> a -> b
$ [Tx] -> TxHistory
mkTxHistory ([Tx] -> TxHistory) -> [Tx] -> TxHistory
forall a b. (a -> b) -> a -> b
$ (Tx, TxMeta) -> Tx
forall a b. (a, b) -> a
fst ((Tx, TxMeta) -> Tx) -> [(Tx, TxMeta)] -> [Tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Tx, TxMeta)]
cs) Base DeltaTxHistory
TxHistory
txh
        , Map WalletId TxMetaHistory
mtxmh Map WalletId TxMetaHistory
-> (Map WalletId TxMetaHistory -> Map WalletId TxMetaHistory)
-> Map WalletId TxMetaHistory
forall a b. a -> (a -> b) -> b
& case WalletId -> Map WalletId TxMetaHistory -> Maybe TxMetaHistory
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup WalletId
wid Map WalletId TxMetaHistory
mtxmh of
              Maybe TxMetaHistory
Nothing -> Delta (DeltaMap WalletId DeltaTxMetaHistory) =>
DeltaMap WalletId DeltaTxMetaHistory
-> Base (DeltaMap WalletId DeltaTxMetaHistory)
-> Base (DeltaMap WalletId DeltaTxMetaHistory)
forall delta. Delta delta => delta -> Base delta -> Base delta
apply @(DeltaMap _ DeltaTxMetaHistory)
                  (DeltaMap WalletId DeltaTxMetaHistory
 -> Base (DeltaMap WalletId DeltaTxMetaHistory)
 -> Base (DeltaMap WalletId DeltaTxMetaHistory))
-> DeltaMap WalletId DeltaTxMetaHistory
-> Base (DeltaMap WalletId DeltaTxMetaHistory)
-> Base (DeltaMap WalletId DeltaTxMetaHistory)
forall a b. (a -> b) -> a -> b
$ WalletId
-> Base DeltaTxMetaHistory -> DeltaMap WalletId DeltaTxMetaHistory
forall key da. key -> Base da -> DeltaMap key da
Insert WalletId
wid
                  (Base DeltaTxMetaHistory -> DeltaMap WalletId DeltaTxMetaHistory)
-> Base DeltaTxMetaHistory -> DeltaMap WalletId DeltaTxMetaHistory
forall a b. (a -> b) -> a -> b
$ WalletId -> [(Tx, TxMeta)] -> TxMetaHistory
mkTxMetaHistory WalletId
wid [(Tx, TxMeta)]
cs
              Just TxMetaHistory
_ -> Delta (DeltaMap WalletId DeltaTxMetaHistory) =>
DeltaMap WalletId DeltaTxMetaHistory
-> Base (DeltaMap WalletId DeltaTxMetaHistory)
-> Base (DeltaMap WalletId DeltaTxMetaHistory)
forall delta. Delta delta => delta -> Base delta -> Base delta
apply @(DeltaMap _ DeltaTxMetaHistory)
                  (DeltaMap WalletId DeltaTxMetaHistory
 -> Base (DeltaMap WalletId DeltaTxMetaHistory)
 -> Base (DeltaMap WalletId DeltaTxMetaHistory))
-> DeltaMap WalletId DeltaTxMetaHistory
-> Base (DeltaMap WalletId DeltaTxMetaHistory)
-> Base (DeltaMap WalletId DeltaTxMetaHistory)
forall a b. (a -> b) -> a -> b
$ WalletId
-> DeltaTxMetaHistory -> DeltaMap WalletId DeltaTxMetaHistory
forall key da. key -> da -> DeltaMap key da
Adjust WalletId
wid
                  (DeltaTxMetaHistory -> DeltaMap WalletId DeltaTxMetaHistory)
-> DeltaTxMetaHistory -> DeltaMap WalletId DeltaTxMetaHistory
forall a b. (a -> b) -> a -> b
$ TxMetaHistory -> DeltaTxMetaHistory
TxMetaStore.Expand
                  (TxMetaHistory -> DeltaTxMetaHistory)
-> TxMetaHistory -> DeltaTxMetaHistory
forall a b. (a -> b) -> a -> b
$ WalletId -> [(Tx, TxMeta)] -> TxMetaHistory
mkTxMetaHistory WalletId
wid [(Tx, TxMeta)]
cs)
    apply (ChangeTxMetaWalletsHistory WalletId
wid ManipulateTxMetaHistory
change) (txh, mtxmh) =
        (TxHistory
txh, Map WalletId TxMetaHistory -> Map WalletId TxMetaHistory
forall k. Map k TxMetaHistory -> Map k TxMetaHistory
garbageCollectEmptyWallets
            (Map WalletId TxMetaHistory -> Map WalletId TxMetaHistory)
-> Map WalletId TxMetaHistory -> Map WalletId TxMetaHistory
forall a b. (a -> b) -> a -> b
$ Map WalletId TxMetaHistory
mtxmh Map WalletId TxMetaHistory
-> (Map WalletId TxMetaHistory -> Map WalletId TxMetaHistory)
-> Map WalletId TxMetaHistory
forall a b. a -> (a -> b) -> b
& DeltaMap WalletId DeltaTxMetaHistory
-> Base (DeltaMap WalletId DeltaTxMetaHistory)
-> Base (DeltaMap WalletId DeltaTxMetaHistory)
forall delta. Delta delta => delta -> Base delta -> Base delta
apply (WalletId
-> DeltaTxMetaHistory -> DeltaMap WalletId DeltaTxMetaHistory
forall key da. key -> da -> DeltaMap key da
Adjust WalletId
wid (DeltaTxMetaHistory -> DeltaMap WalletId DeltaTxMetaHistory)
-> DeltaTxMetaHistory -> DeltaMap WalletId DeltaTxMetaHistory
forall a b. (a -> b) -> a -> b
$ ManipulateTxMetaHistory -> DeltaTxMetaHistory
Manipulate ManipulateTxMetaHistory
change))
    apply DeltaTxWalletsHistory
GarbageCollectTxWalletsHistory (TxHistoryF txh, mtxmh) =
        ( 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)
-> Set TxId -> Map TxId (TxRelationF 'Without)
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map TxId (TxRelationF 'Without)
txh (Set TxId -> Map TxId (TxRelationF 'Without))
-> Set TxId -> Map TxId (TxRelationF 'Without)
forall a b. (a -> b) -> a -> b
$ Map WalletId TxMetaHistory -> Set TxId
walletsLinkedTransactions Map WalletId TxMetaHistory
mtxmh
        , Map WalletId TxMetaHistory
mtxmh)
    apply (RemoveWallet WalletId
wid) (TxHistoryF txh, mtxmh) =
        ( Map TxId (TxRelationF 'Without) -> TxHistory
forall (f :: Decoration). Map TxId (TxRelationF f) -> TxHistoryF f
TxHistoryF Map TxId (TxRelationF 'Without)
txh, WalletId
-> Map WalletId TxMetaHistory -> Map WalletId TxMetaHistory
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete WalletId
wid Map WalletId TxMetaHistory
mtxmh )

-- necessary because database will not distinuish between
-- a missing wallet in the map
-- and a wallet that has no meta-transactions
garbageCollectEmptyWallets :: Map k TxMetaHistory -> Map k TxMetaHistory
garbageCollectEmptyWallets :: Map k TxMetaHistory -> Map k TxMetaHistory
garbageCollectEmptyWallets = (TxMetaHistory -> Bool)
-> Map k TxMetaHistory -> Map k TxMetaHistory
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Bool -> Bool
not (Bool -> Bool) -> (TxMetaHistory -> Bool) -> TxMetaHistory -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TxId TxMeta -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Map TxId TxMeta -> Bool)
-> (TxMetaHistory -> Map TxId TxMeta) -> TxMetaHistory -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxMetaHistory -> Map TxId TxMeta
relations)

linkedTransactions :: TxMetaHistory -> Set TxId
linkedTransactions :: TxMetaHistory -> Set TxId
linkedTransactions (TxMetaHistory Map TxId TxMeta
m) = Map TxId TxMeta -> Set TxId
forall k a. Map k a -> Set k
Map.keysSet Map TxId TxMeta
m

walletsLinkedTransactions :: Map W.WalletId TxMetaHistory -> Set TxId
walletsLinkedTransactions :: Map WalletId TxMetaHistory -> Set TxId
walletsLinkedTransactions = [Set TxId] -> Set TxId
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set TxId] -> Set TxId)
-> (Map WalletId TxMetaHistory -> [Set TxId])
-> Map WalletId TxMetaHistory
-> Set TxId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map WalletId (Set TxId) -> [Set TxId]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Map WalletId (Set TxId) -> [Set TxId])
-> (Map WalletId TxMetaHistory -> Map WalletId (Set TxId))
-> Map WalletId TxMetaHistory
-> [Set TxId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  (TxMetaHistory -> Set TxId)
-> Map WalletId TxMetaHistory -> Map WalletId (Set TxId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TxMetaHistory -> Set TxId
linkedTransactions

-- | Compute a high level view of a transaction known as 'TransactionInfo'
-- from a 'TxMeta' and a 'TxRelationF'.
-- Assumes that these data refer to the same 'TxId', does /not/ check this.
mkTransactionInfo :: Monad m
    => TimeInterpreter m
    -> W.BlockHeader
    -> TxRelationF 'With
    -> DB.TxMeta
    -> m WT.TransactionInfo
mkTransactionInfo :: TimeInterpreter m
-> BlockHeader -> TxRelationF 'With -> TxMeta -> m TransactionInfo
mkTransactionInfo TimeInterpreter m
ti BlockHeader
tip TxRelationF{[(TxOut, [TxOutToken])]
[TxWithdrawal]
[DecorateWithTxOut 'With TxCollateral]
[DecorateWithTxOut 'With TxIn]
Maybe (TxCollateralOut, [TxCollateralOutToken])
$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]
withdrawals :: [TxWithdrawal]
collateralOuts :: Maybe (TxCollateralOut, [TxCollateralOutToken])
outs :: [(TxOut, [TxOutToken])]
collateralIns :: [DecorateWithTxOut 'With TxCollateral]
ins :: [DecorateWithTxOut 'With TxIn]
..} DB.TxMeta{Maybe Bool
Maybe Word64
Maybe TxMetadata
Maybe SlotNo
Word32
SlotNo
Coin
Direction
TxStatus
WalletId
TxId
txMetaScriptValidity :: TxMeta -> Maybe Bool
txMetaFee :: TxMeta -> Maybe Word64
txMetaSlotExpires :: TxMeta -> Maybe SlotNo
txMetadata :: TxMeta -> Maybe TxMetadata
txMetaAmount :: TxMeta -> Coin
txMetaBlockHeight :: TxMeta -> Word32
txMetaSlot :: TxMeta -> SlotNo
txMetaDirection :: TxMeta -> Direction
txMetaStatus :: TxMeta -> TxStatus
txMetaWalletId :: TxMeta -> WalletId
txMetaTxId :: TxMeta -> TxId
txMetaScriptValidity :: Maybe Bool
txMetaFee :: Maybe Word64
txMetaSlotExpires :: Maybe SlotNo
txMetadata :: Maybe TxMetadata
txMetaAmount :: Coin
txMetaBlockHeight :: Word32
txMetaSlot :: SlotNo
txMetaDirection :: Direction
txMetaStatus :: TxStatus
txMetaWalletId :: WalletId
txMetaTxId :: TxId
..} = do
    UTCTime
txTime <- TimeInterpreter m -> Qry UTCTime -> m UTCTime
forall (m :: * -> *) a.
(HasCallStack, Monad m) =>
TimeInterpreter m -> Qry a -> m a
interpretQuery TimeInterpreter m
ti (Qry UTCTime -> m UTCTime)
-> (SlotNo -> Qry UTCTime) -> SlotNo -> m UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotNo -> Qry UTCTime
slotToUTCTime (SlotNo -> m UTCTime) -> SlotNo -> m UTCTime
forall a b. (a -> b) -> a -> b
$ SlotNo
txMetaSlot
    TransactionInfo -> m TransactionInfo
forall (m :: * -> *) a. Monad m => a -> m a
return
        (TransactionInfo -> m TransactionInfo)
-> TransactionInfo -> m TransactionInfo
forall a b. (a -> b) -> a -> b
$ TransactionInfo :: Hash "Tx"
-> Maybe Coin
-> [(TxIn, Coin, Maybe TxOut)]
-> [(TxIn, Coin, Maybe TxOut)]
-> [TxOut]
-> Maybe TxOut
-> Map RewardAccount Coin
-> TxMeta
-> Quantity "block" Natural
-> UTCTime
-> Maybe TxMetadata
-> Maybe TxScriptValidity
-> TransactionInfo
WT.TransactionInfo
        { $sel:txInfoId:TransactionInfo :: Hash "Tx"
WT.txInfoId = TxId -> Hash "Tx"
getTxId TxId
txMetaTxId
        , $sel:txInfoFee:TransactionInfo :: Maybe Coin
WT.txInfoFee = Natural -> Coin
WC.Coin (Natural -> Coin) -> (Word64 -> Natural) -> Word64 -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Coin) -> Maybe Word64 -> Maybe Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Word64
txMetaFee
        , $sel:txInfoInputs:TransactionInfo :: [(TxIn, Coin, Maybe TxOut)]
WT.txInfoInputs = WithTxOut TxIn -> (TxIn, Coin, Maybe TxOut)
mkTxIn (WithTxOut TxIn -> (TxIn, Coin, Maybe TxOut))
-> [WithTxOut TxIn] -> [(TxIn, Coin, Maybe TxOut)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DecorateWithTxOut 'With TxIn]
[WithTxOut TxIn]
ins
        , $sel:txInfoCollateralInputs:TransactionInfo :: [(TxIn, Coin, Maybe TxOut)]
WT.txInfoCollateralInputs = WithTxOut TxCollateral -> (TxIn, Coin, Maybe TxOut)
mkTxCollateral (WithTxOut TxCollateral -> (TxIn, Coin, Maybe TxOut))
-> [WithTxOut TxCollateral] -> [(TxIn, Coin, Maybe TxOut)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DecorateWithTxOut 'With TxCollateral]
[WithTxOut TxCollateral]
collateralIns
        , $sel:txInfoOutputs:TransactionInfo :: [TxOut]
WT.txInfoOutputs = (TxOut, [TxOutToken]) -> TxOut
mkTxOut ((TxOut, [TxOutToken]) -> TxOut)
-> [(TxOut, [TxOutToken])] -> [TxOut]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(TxOut, [TxOutToken])]
outs
        , $sel:txInfoCollateralOutput:TransactionInfo :: Maybe TxOut
WT.txInfoCollateralOutput = (TxCollateralOut, [TxCollateralOutToken]) -> TxOut
mkTxCollateralOut ((TxCollateralOut, [TxCollateralOutToken]) -> TxOut)
-> Maybe (TxCollateralOut, [TxCollateralOutToken]) -> Maybe TxOut
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (TxCollateralOut, [TxCollateralOutToken])
collateralOuts
        , $sel:txInfoWithdrawals:TransactionInfo :: Map RewardAccount Coin
WT.txInfoWithdrawals = [(RewardAccount, Coin)] -> Map RewardAccount Coin
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(RewardAccount, Coin)] -> Map RewardAccount Coin)
-> [(RewardAccount, Coin)] -> Map RewardAccount Coin
forall a b. (a -> b) -> a -> b
$ (TxWithdrawal -> (RewardAccount, Coin))
-> [TxWithdrawal] -> [(RewardAccount, Coin)]
forall a b. (a -> b) -> [a] -> [b]
map TxWithdrawal -> (RewardAccount, Coin)
mkTxWithdrawal [TxWithdrawal]
withdrawals
        , $sel:txInfoMeta:TransactionInfo :: TxMeta
WT.txInfoMeta = TxMeta :: TxStatus
-> Direction
-> SlotNo
-> Quantity "block" Word32
-> Coin
-> Maybe SlotNo
-> TxMeta
WT.TxMeta
              { $sel:status:TxMeta :: TxStatus
WT.status = TxStatus
txMetaStatus
              , $sel:direction:TxMeta :: Direction
WT.direction = Direction
txMetaDirection
              , $sel:slotNo:TxMeta :: SlotNo
WT.slotNo = SlotNo
txMetaSlot
              , $sel:blockHeight:TxMeta :: Quantity "block" Word32
WT.blockHeight = Word32 -> Quantity "block" Word32
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity (Word32
txMetaBlockHeight)
              , $sel:amount:TxMeta :: Coin
amount = Coin
txMetaAmount
              , $sel:expiry:TxMeta :: Maybe SlotNo
WT.expiry = Maybe SlotNo
txMetaSlotExpires
              }
        , $sel:txInfoMetadata:TransactionInfo :: Maybe TxMetadata
WT.txInfoMetadata = Maybe TxMetadata
txMetadata
        , $sel:txInfoDepth:TransactionInfo :: Quantity "block" Natural
WT.txInfoDepth = Natural -> Quantity "block" Natural
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity
              (Natural -> Quantity "block" Natural)
-> Natural -> Quantity "block" Natural
forall a b. (a -> b) -> a -> b
$ Word32 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral
              (Word32 -> Natural) -> Word32 -> Natural
forall a b. (a -> b) -> a -> b
$ if Word32
tipH Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
txMetaBlockHeight
                  then Word32
tipH Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
txMetaBlockHeight
                  else Word32
0
        , $sel:txInfoTime:TransactionInfo :: UTCTime
WT.txInfoTime = UTCTime
txTime
        , $sel:txInfoScriptValidity:TransactionInfo :: Maybe TxScriptValidity
WT.txInfoScriptValidity = Maybe Bool
txMetaScriptValidity Maybe Bool -> (Bool -> TxScriptValidity) -> Maybe TxScriptValidity
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
              Bool
False -> TxScriptValidity
WT.TxScriptInvalid
              Bool
True -> TxScriptValidity
WT.TxScriptValid
        }
  where
    tipH :: Word32
tipH = Quantity "block" Word32 -> Word32
forall (unit :: Symbol) a. Quantity unit a -> a
getQuantity (Quantity "block" Word32 -> Word32)
-> Quantity "block" Word32 -> Word32
forall a b. (a -> b) -> a -> b
$ BlockHeader
tip BlockHeader
-> ((Quantity "block" Word32
     -> Const (Quantity "block" Word32) (Quantity "block" Word32))
    -> BlockHeader -> Const (Quantity "block" Word32) BlockHeader)
-> Quantity "block" Word32
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "blockHeight"
  ((Quantity "block" Word32
    -> Const (Quantity "block" Word32) (Quantity "block" Word32))
   -> BlockHeader -> Const (Quantity "block" Word32) BlockHeader)
(Quantity "block" Word32
 -> Const (Quantity "block" Word32) (Quantity "block" Word32))
-> BlockHeader -> Const (Quantity "block" Word32) BlockHeader
#blockHeight
    mkTxIn :: WithTxOut TxIn -> (TxIn, Coin, Maybe TxOut)
mkTxIn (WithTxOut TxIn
tx Maybe (TxOut, [TxOutToken])
out) =
        ( TxIn :: Hash "Tx" -> Word32 -> TxIn
WT.TxIn
          { $sel:inputId:TxIn :: Hash "Tx"
WT.inputId = TxId -> Hash "Tx"
getTxId (TxIn -> TxId
txInputSourceTxId TxIn
tx)
          , $sel:inputIx:TxIn :: Word32
WT.inputIx = TxIn -> Word32
txInputSourceIndex TxIn
tx
          }
        , TxIn -> Coin
txInputSourceAmount TxIn
tx
        , (TxOut, [TxOutToken]) -> TxOut
mkTxOut ((TxOut, [TxOutToken]) -> TxOut)
-> Maybe (TxOut, [TxOutToken]) -> Maybe TxOut
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (TxOut, [TxOutToken])
out)
    mkTxCollateral :: WithTxOut TxCollateral -> (TxIn, Coin, Maybe TxOut)
mkTxCollateral (WithTxOut TxCollateral
tx Maybe (TxOut, [TxOutToken])
out) =
        ( TxIn :: Hash "Tx" -> Word32 -> TxIn
WT.TxIn
          { $sel:inputId:TxIn :: Hash "Tx"
WT.inputId = TxId -> Hash "Tx"
getTxId (TxCollateral -> TxId
txCollateralSourceTxId TxCollateral
tx)
          , $sel:inputIx:TxIn :: Word32
WT.inputIx = TxCollateral -> Word32
txCollateralSourceIndex TxCollateral
tx
          }
        , TxCollateral -> Coin
txCollateralSourceAmount TxCollateral
tx
        , (TxOut, [TxOutToken]) -> TxOut
mkTxOut ((TxOut, [TxOutToken]) -> TxOut)
-> Maybe (TxOut, [TxOutToken]) -> Maybe TxOut
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (TxOut, [TxOutToken])
out)
    mkTxOut :: (TxOut, [TxOutToken]) -> TxOut
mkTxOut (TxOut
out,[TxOutToken]
tokens) =
        TxOut :: Address -> TokenBundle -> TxOut
WT.TxOut
        { $sel:address:TxOut :: Address
address = TxOut -> Address
txOutputAddress TxOut
out
        , $sel:tokens:TxOut :: TokenBundle
WT.tokens = Coin -> [(AssetId, TokenQuantity)] -> TokenBundle
TokenBundle.fromFlatList
              (TxOut -> Coin
txOutputAmount TxOut
out)
              (TxOutToken -> (AssetId, TokenQuantity)
mkTxOutToken (TxOutToken -> (AssetId, TokenQuantity))
-> [TxOutToken] -> [(AssetId, TokenQuantity)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxOutToken]
tokens)
        }
    mkTxOutToken :: TxOutToken -> (AssetId, TokenQuantity)
mkTxOutToken TxOutToken
token =
        ( TokenPolicyId -> TokenName -> AssetId
AssetId (TxOutToken -> TokenPolicyId
txOutTokenPolicyId TxOutToken
token) (TxOutToken -> TokenName
txOutTokenName TxOutToken
token)
        , TxOutToken -> TokenQuantity
txOutTokenQuantity TxOutToken
token)
    mkTxCollateralOut :: (TxCollateralOut, [TxCollateralOutToken]) -> TxOut
mkTxCollateralOut (TxCollateralOut
out,[TxCollateralOutToken]
tokens) =
        TxOut :: Address -> TokenBundle -> TxOut
WT.TxOut
        { $sel:address:TxOut :: Address
address = TxCollateralOut -> Address
txCollateralOutAddress TxCollateralOut
out
        , $sel:tokens:TxOut :: TokenBundle
WT.tokens = Coin -> [(AssetId, TokenQuantity)] -> TokenBundle
TokenBundle.fromFlatList
              (TxCollateralOut -> Coin
txCollateralOutAmount TxCollateralOut
out)
              (TxCollateralOutToken -> (AssetId, TokenQuantity)
mkTxCollateralOutToken (TxCollateralOutToken -> (AssetId, TokenQuantity))
-> [TxCollateralOutToken] -> [(AssetId, TokenQuantity)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxCollateralOutToken]
tokens)
        }
    mkTxCollateralOutToken :: TxCollateralOutToken -> (AssetId, TokenQuantity)
mkTxCollateralOutToken TxCollateralOutToken
token =
        ( TokenPolicyId -> TokenName -> AssetId
AssetId
              (TxCollateralOutToken -> TokenPolicyId
txCollateralOutTokenPolicyId TxCollateralOutToken
token)
              (TxCollateralOutToken -> TokenName
txCollateralOutTokenName TxCollateralOutToken
token)
        , TxCollateralOutToken -> TokenQuantity
txCollateralOutTokenQuantity TxCollateralOutToken
token)
    mkTxWithdrawal :: TxWithdrawal -> (RewardAccount, Coin)
mkTxWithdrawal TxWithdrawal
w = (TxWithdrawal -> RewardAccount
txWithdrawalAccount TxWithdrawal
w, TxWithdrawal -> Coin
txWithdrawalAmount TxWithdrawal
w)