{-# LANGUAGE DeriveGeneric   #-}
{-# LANGUAGE DerivingVia     #-}
{-# LANGUAGE NamedFieldPuns  #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections   #-}
{-# LANGUAGE TypeFamilies    #-}
{-# LANGUAGE ViewPatterns    #-}
{-| The disk state is the part of the chain index that is kept on disk. This
module defines an in-memory implementation of the disk state which can be
used in the emulator.
-}
module Plutus.ChainIndex.Emulator.DiskState(
    DiskState
    , dataMap
    , scriptMap
    , redeemerMap
    , txMap
    , addressMap
    , assetClassMap
    , fromTx
    , CredentialMap
    , unCredentialMap
    , AssetClassMap
    , unAssetClassMap
    , diagnostics
) where

import Cardano.Api qualified as C
import Control.Lens (At (..), Index, IxValue, Ixed (..), lens, makeLenses, view, (&), (.~), (^.))
import Data.Bifunctor (Bifunctor (..))
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Semigroup.Generic (GenericSemigroupMonoid (..))
import Data.Set (Set)
import Data.Set qualified as Set
import GHC.Generics (Generic)
import Ledger (Datum, DatumHash, Redeemer, RedeemerHash, Script, ScriptHash, TxOutRef, cardanoAddressCredential)
import Ledger.Credential (Credential)
import Ledger.Tx (Versioned)
import Plutus.ChainIndex.Tx (ChainIndexTx, ChainIndexTxOut (..), citxData, citxScripts, citxTxId, txOutsWithRef,
                             txRedeemersWithHash)
import Plutus.ChainIndex.Types (Diagnostics (..))
import Plutus.V1.Ledger.Api (TxId)

-- | Set of transaction output references for each address.
newtype CredentialMap = CredentialMap { CredentialMap -> Map Credential (Set TxOutRef)
_unCredentialMap :: Map Credential (Set TxOutRef) }
    deriving stock (CredentialMap -> CredentialMap -> Bool
(CredentialMap -> CredentialMap -> Bool)
-> (CredentialMap -> CredentialMap -> Bool) -> Eq CredentialMap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CredentialMap -> CredentialMap -> Bool
$c/= :: CredentialMap -> CredentialMap -> Bool
== :: CredentialMap -> CredentialMap -> Bool
$c== :: CredentialMap -> CredentialMap -> Bool
Eq, Int -> CredentialMap -> ShowS
[CredentialMap] -> ShowS
CredentialMap -> String
(Int -> CredentialMap -> ShowS)
-> (CredentialMap -> String)
-> ([CredentialMap] -> ShowS)
-> Show CredentialMap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CredentialMap] -> ShowS
$cshowList :: [CredentialMap] -> ShowS
show :: CredentialMap -> String
$cshow :: CredentialMap -> String
showsPrec :: Int -> CredentialMap -> ShowS
$cshowsPrec :: Int -> CredentialMap -> ShowS
Show, (forall x. CredentialMap -> Rep CredentialMap x)
-> (forall x. Rep CredentialMap x -> CredentialMap)
-> Generic CredentialMap
forall x. Rep CredentialMap x -> CredentialMap
forall x. CredentialMap -> Rep CredentialMap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CredentialMap x -> CredentialMap
$cfrom :: forall x. CredentialMap -> Rep CredentialMap x
Generic)

makeLenses ''CredentialMap

type instance IxValue CredentialMap = Set TxOutRef
type instance Index CredentialMap = Credential

instance Ixed CredentialMap where
    ix :: Index CredentialMap
-> Traversal' CredentialMap (IxValue CredentialMap)
ix Index CredentialMap
cred IxValue CredentialMap -> f (IxValue CredentialMap)
f (CredentialMap Map Credential (Set TxOutRef)
mp) = Map Credential (Set TxOutRef) -> CredentialMap
CredentialMap (Map Credential (Set TxOutRef) -> CredentialMap)
-> f (Map Credential (Set TxOutRef)) -> f CredentialMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index (Map Credential (Set TxOutRef))
-> (IxValue (Map Credential (Set TxOutRef))
    -> f (IxValue (Map Credential (Set TxOutRef))))
-> Map Credential (Set TxOutRef)
-> f (Map Credential (Set TxOutRef))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map Credential (Set TxOutRef))
Index CredentialMap
cred IxValue (Map Credential (Set TxOutRef))
-> f (IxValue (Map Credential (Set TxOutRef)))
IxValue CredentialMap -> f (IxValue CredentialMap)
f Map Credential (Set TxOutRef)
mp

instance At CredentialMap where
    at :: Index CredentialMap
-> Lens' CredentialMap (Maybe (IxValue CredentialMap))
at Index CredentialMap
idx = (CredentialMap -> Maybe (Set TxOutRef))
-> (CredentialMap -> Maybe (Set TxOutRef) -> CredentialMap)
-> Lens
     CredentialMap
     CredentialMap
     (Maybe (Set TxOutRef))
     (Maybe (Set TxOutRef))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CredentialMap -> Maybe (Set TxOutRef)
g CredentialMap -> Maybe (Set TxOutRef) -> CredentialMap
s where
        g :: CredentialMap -> Maybe (Set TxOutRef)
g (CredentialMap Map Credential (Set TxOutRef)
mp) = Map Credential (Set TxOutRef)
mp Map Credential (Set TxOutRef)
-> Getting
     (Maybe (Set TxOutRef))
     (Map Credential (Set TxOutRef))
     (Maybe (Set TxOutRef))
-> Maybe (Set TxOutRef)
forall s a. s -> Getting a s a -> a
^. Index (Map Credential (Set TxOutRef))
-> Lens'
     (Map Credential (Set TxOutRef))
     (Maybe (IxValue (Map Credential (Set TxOutRef))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Credential (Set TxOutRef))
Index CredentialMap
idx
        s :: CredentialMap -> Maybe (Set TxOutRef) -> CredentialMap
s (CredentialMap Map Credential (Set TxOutRef)
mp) Maybe (Set TxOutRef)
refs = Map Credential (Set TxOutRef) -> CredentialMap
CredentialMap (Map Credential (Set TxOutRef) -> CredentialMap)
-> Map Credential (Set TxOutRef) -> CredentialMap
forall a b. (a -> b) -> a -> b
$ Map Credential (Set TxOutRef)
mp Map Credential (Set TxOutRef)
-> (Map Credential (Set TxOutRef) -> Map Credential (Set TxOutRef))
-> Map Credential (Set TxOutRef)
forall a b. a -> (a -> b) -> b
& Index (Map Credential (Set TxOutRef))
-> Lens'
     (Map Credential (Set TxOutRef))
     (Maybe (IxValue (Map Credential (Set TxOutRef))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Credential (Set TxOutRef))
Index CredentialMap
idx ((Maybe (Set TxOutRef) -> Identity (Maybe (Set TxOutRef)))
 -> Map Credential (Set TxOutRef)
 -> Identity (Map Credential (Set TxOutRef)))
-> Maybe (Set TxOutRef)
-> Map Credential (Set TxOutRef)
-> Map Credential (Set TxOutRef)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe (Set TxOutRef)
refs

instance Semigroup CredentialMap where
    (CredentialMap Map Credential (Set TxOutRef)
l) <> :: CredentialMap -> CredentialMap -> CredentialMap
<> (CredentialMap Map Credential (Set TxOutRef)
r) = Map Credential (Set TxOutRef) -> CredentialMap
CredentialMap (Map Credential (Set TxOutRef) -> CredentialMap)
-> Map Credential (Set TxOutRef) -> CredentialMap
forall a b. (a -> b) -> a -> b
$ (Set TxOutRef -> Set TxOutRef -> Set TxOutRef)
-> Map Credential (Set TxOutRef)
-> Map Credential (Set TxOutRef)
-> Map Credential (Set TxOutRef)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Set TxOutRef -> Set TxOutRef -> Set TxOutRef
forall a. Semigroup a => a -> a -> a
(<>) Map Credential (Set TxOutRef)
l Map Credential (Set TxOutRef)
r

instance Monoid CredentialMap where
    mappend :: CredentialMap -> CredentialMap -> CredentialMap
mappend = CredentialMap -> CredentialMap -> CredentialMap
forall a. Semigroup a => a -> a -> a
(<>)
    mempty :: CredentialMap
mempty  = Map Credential (Set TxOutRef) -> CredentialMap
CredentialMap Map Credential (Set TxOutRef)
forall a. Monoid a => a
mempty

-- | Convert the outputs of the transaction into a 'CredentialMap'.
txCredentialMap :: ChainIndexTx -> CredentialMap
txCredentialMap :: ChainIndexTx -> CredentialMap
txCredentialMap  =
    let credential :: ChainIndexTxOut -> Credential
credential ChainIndexTxOut{CardanoAddress
citoAddress :: ChainIndexTxOut -> CardanoAddress
citoAddress :: CardanoAddress
citoAddress} = CardanoAddress -> Credential
forall era. AddressInEra era -> Credential
cardanoAddressCredential CardanoAddress
citoAddress
    in Map Credential (Set TxOutRef) -> CredentialMap
CredentialMap
       (Map Credential (Set TxOutRef) -> CredentialMap)
-> (ChainIndexTx -> Map Credential (Set TxOutRef))
-> ChainIndexTx
-> CredentialMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set TxOutRef -> Set TxOutRef -> Set TxOutRef)
-> [(Credential, Set TxOutRef)] -> Map Credential (Set TxOutRef)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Set TxOutRef -> Set TxOutRef -> Set TxOutRef
forall a. Semigroup a => a -> a -> a
(<>)
       ([(Credential, Set TxOutRef)] -> Map Credential (Set TxOutRef))
-> (ChainIndexTx -> [(Credential, Set TxOutRef)])
-> ChainIndexTx
-> Map Credential (Set TxOutRef)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ChainIndexTxOut, TxOutRef) -> (Credential, Set TxOutRef))
-> [(ChainIndexTxOut, TxOutRef)] -> [(Credential, Set TxOutRef)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ChainIndexTxOut -> Credential)
-> (TxOutRef -> Set TxOutRef)
-> (ChainIndexTxOut, TxOutRef)
-> (Credential, Set TxOutRef)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ChainIndexTxOut -> Credential
credential TxOutRef -> Set TxOutRef
forall a. a -> Set a
Set.singleton)
       ([(ChainIndexTxOut, TxOutRef)] -> [(Credential, Set TxOutRef)])
-> (ChainIndexTx -> [(ChainIndexTxOut, TxOutRef)])
-> ChainIndexTx
-> [(Credential, Set TxOutRef)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainIndexTx -> [(ChainIndexTxOut, TxOutRef)]
txOutsWithRef

-- | Set of transaction output references for each asset class.
newtype AssetClassMap = AssetClassMap { AssetClassMap -> Map AssetId (Set TxOutRef)
_unAssetClassMap :: Map C.AssetId (Set TxOutRef) }
    deriving stock (AssetClassMap -> AssetClassMap -> Bool
(AssetClassMap -> AssetClassMap -> Bool)
-> (AssetClassMap -> AssetClassMap -> Bool) -> Eq AssetClassMap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssetClassMap -> AssetClassMap -> Bool
$c/= :: AssetClassMap -> AssetClassMap -> Bool
== :: AssetClassMap -> AssetClassMap -> Bool
$c== :: AssetClassMap -> AssetClassMap -> Bool
Eq, Int -> AssetClassMap -> ShowS
[AssetClassMap] -> ShowS
AssetClassMap -> String
(Int -> AssetClassMap -> ShowS)
-> (AssetClassMap -> String)
-> ([AssetClassMap] -> ShowS)
-> Show AssetClassMap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssetClassMap] -> ShowS
$cshowList :: [AssetClassMap] -> ShowS
show :: AssetClassMap -> String
$cshow :: AssetClassMap -> String
showsPrec :: Int -> AssetClassMap -> ShowS
$cshowsPrec :: Int -> AssetClassMap -> ShowS
Show, (forall x. AssetClassMap -> Rep AssetClassMap x)
-> (forall x. Rep AssetClassMap x -> AssetClassMap)
-> Generic AssetClassMap
forall x. Rep AssetClassMap x -> AssetClassMap
forall x. AssetClassMap -> Rep AssetClassMap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AssetClassMap x -> AssetClassMap
$cfrom :: forall x. AssetClassMap -> Rep AssetClassMap x
Generic)

makeLenses ''AssetClassMap

type instance IxValue AssetClassMap = Set TxOutRef
type instance Index AssetClassMap = C.AssetId

instance Ixed AssetClassMap where
    ix :: Index AssetClassMap
-> Traversal' AssetClassMap (IxValue AssetClassMap)
ix Index AssetClassMap
ac IxValue AssetClassMap -> f (IxValue AssetClassMap)
f (AssetClassMap Map AssetId (Set TxOutRef)
mp) = Map AssetId (Set TxOutRef) -> AssetClassMap
AssetClassMap (Map AssetId (Set TxOutRef) -> AssetClassMap)
-> f (Map AssetId (Set TxOutRef)) -> f AssetClassMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index (Map AssetId (Set TxOutRef))
-> (IxValue (Map AssetId (Set TxOutRef))
    -> f (IxValue (Map AssetId (Set TxOutRef))))
-> Map AssetId (Set TxOutRef)
-> f (Map AssetId (Set TxOutRef))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map AssetId (Set TxOutRef))
Index AssetClassMap
ac IxValue (Map AssetId (Set TxOutRef))
-> f (IxValue (Map AssetId (Set TxOutRef)))
IxValue AssetClassMap -> f (IxValue AssetClassMap)
f Map AssetId (Set TxOutRef)
mp

instance At AssetClassMap where
    at :: Index AssetClassMap
-> Lens' AssetClassMap (Maybe (IxValue AssetClassMap))
at Index AssetClassMap
idx = (AssetClassMap -> Maybe (Set TxOutRef))
-> (AssetClassMap -> Maybe (Set TxOutRef) -> AssetClassMap)
-> Lens
     AssetClassMap
     AssetClassMap
     (Maybe (Set TxOutRef))
     (Maybe (Set TxOutRef))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens AssetClassMap -> Maybe (Set TxOutRef)
g AssetClassMap -> Maybe (Set TxOutRef) -> AssetClassMap
s where
        g :: AssetClassMap -> Maybe (Set TxOutRef)
g (AssetClassMap Map AssetId (Set TxOutRef)
mp) = Map AssetId (Set TxOutRef)
mp Map AssetId (Set TxOutRef)
-> Getting
     (Maybe (Set TxOutRef))
     (Map AssetId (Set TxOutRef))
     (Maybe (Set TxOutRef))
-> Maybe (Set TxOutRef)
forall s a. s -> Getting a s a -> a
^. Index (Map AssetId (Set TxOutRef))
-> Lens'
     (Map AssetId (Set TxOutRef))
     (Maybe (IxValue (Map AssetId (Set TxOutRef))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map AssetId (Set TxOutRef))
Index AssetClassMap
idx
        s :: AssetClassMap -> Maybe (Set TxOutRef) -> AssetClassMap
s (AssetClassMap Map AssetId (Set TxOutRef)
mp) Maybe (Set TxOutRef)
refs = Map AssetId (Set TxOutRef) -> AssetClassMap
AssetClassMap (Map AssetId (Set TxOutRef) -> AssetClassMap)
-> Map AssetId (Set TxOutRef) -> AssetClassMap
forall a b. (a -> b) -> a -> b
$ Map AssetId (Set TxOutRef)
mp Map AssetId (Set TxOutRef)
-> (Map AssetId (Set TxOutRef) -> Map AssetId (Set TxOutRef))
-> Map AssetId (Set TxOutRef)
forall a b. a -> (a -> b) -> b
& Index (Map AssetId (Set TxOutRef))
-> Lens'
     (Map AssetId (Set TxOutRef))
     (Maybe (IxValue (Map AssetId (Set TxOutRef))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map AssetId (Set TxOutRef))
Index AssetClassMap
idx ((Maybe (Set TxOutRef) -> Identity (Maybe (Set TxOutRef)))
 -> Map AssetId (Set TxOutRef)
 -> Identity (Map AssetId (Set TxOutRef)))
-> Maybe (Set TxOutRef)
-> Map AssetId (Set TxOutRef)
-> Map AssetId (Set TxOutRef)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe (Set TxOutRef)
refs

instance Semigroup AssetClassMap where
    (AssetClassMap Map AssetId (Set TxOutRef)
l) <> :: AssetClassMap -> AssetClassMap -> AssetClassMap
<> (AssetClassMap Map AssetId (Set TxOutRef)
r) = Map AssetId (Set TxOutRef) -> AssetClassMap
AssetClassMap (Map AssetId (Set TxOutRef) -> AssetClassMap)
-> Map AssetId (Set TxOutRef) -> AssetClassMap
forall a b. (a -> b) -> a -> b
$ (Set TxOutRef -> Set TxOutRef -> Set TxOutRef)
-> Map AssetId (Set TxOutRef)
-> Map AssetId (Set TxOutRef)
-> Map AssetId (Set TxOutRef)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Set TxOutRef -> Set TxOutRef -> Set TxOutRef
forall a. Semigroup a => a -> a -> a
(<>) Map AssetId (Set TxOutRef)
l Map AssetId (Set TxOutRef)
r

instance Monoid AssetClassMap where
    mappend :: AssetClassMap -> AssetClassMap -> AssetClassMap
mappend = AssetClassMap -> AssetClassMap -> AssetClassMap
forall a. Semigroup a => a -> a -> a
(<>)
    mempty :: AssetClassMap
mempty  = Map AssetId (Set TxOutRef) -> AssetClassMap
AssetClassMap Map AssetId (Set TxOutRef)
forall a. Monoid a => a
mempty

-- | Convert the outputs of the transaction into a 'AssetClassMap'.
--
-- Note that we don't store the Ada currency, as all 'TxOutRef' contain Ada.
txAssetClassMap :: ChainIndexTx -> AssetClassMap
txAssetClassMap :: ChainIndexTx -> AssetClassMap
txAssetClassMap =
    Map AssetId (Set TxOutRef) -> AssetClassMap
AssetClassMap
      (Map AssetId (Set TxOutRef) -> AssetClassMap)
-> (ChainIndexTx -> Map AssetId (Set TxOutRef))
-> ChainIndexTx
-> AssetClassMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set TxOutRef -> Set TxOutRef -> Set TxOutRef)
-> [(AssetId, Set TxOutRef)] -> Map AssetId (Set TxOutRef)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Set TxOutRef -> Set TxOutRef -> Set TxOutRef
forall a. Semigroup a => a -> a -> a
(<>)
      ([(AssetId, Set TxOutRef)] -> Map AssetId (Set TxOutRef))
-> (ChainIndexTx -> [(AssetId, Set TxOutRef)])
-> ChainIndexTx
-> Map AssetId (Set TxOutRef)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ChainIndexTxOut, TxOutRef) -> [(AssetId, Set TxOutRef)])
-> [(ChainIndexTxOut, TxOutRef)] -> [(AssetId, Set TxOutRef)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(ChainIndexTxOut
txOut, TxOutRef
txOutRef) ->
          (AssetId -> (AssetId, Set TxOutRef))
-> [AssetId] -> [(AssetId, Set TxOutRef)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, TxOutRef -> Set TxOutRef
forall a. a -> Set a
Set.singleton TxOutRef
txOutRef) ([AssetId] -> [(AssetId, Set TxOutRef)])
-> [AssetId] -> [(AssetId, Set TxOutRef)]
forall a b. (a -> b) -> a -> b
$ ChainIndexTxOut -> [AssetId]
assetClassesOfTxOut ChainIndexTxOut
txOut)
      ([(ChainIndexTxOut, TxOutRef)] -> [(AssetId, Set TxOutRef)])
-> (ChainIndexTx -> [(ChainIndexTxOut, TxOutRef)])
-> ChainIndexTx
-> [(AssetId, Set TxOutRef)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainIndexTx -> [(ChainIndexTxOut, TxOutRef)]
txOutsWithRef
  where
    assetClassesOfTxOut :: ChainIndexTxOut -> [C.AssetId]
    assetClassesOfTxOut :: ChainIndexTxOut -> [AssetId]
assetClassesOfTxOut ChainIndexTxOut{Value
citoValue :: ChainIndexTxOut -> Value
citoValue :: Value
citoValue} =
        (AssetId -> Bool) -> [AssetId] -> [AssetId]
forall a. (a -> Bool) -> [a] -> [a]
filter (AssetId -> AssetId -> Bool
forall a. Eq a => a -> a -> Bool
/= AssetId
C.AdaAssetId)
           ([AssetId] -> [AssetId]) -> [AssetId] -> [AssetId]
forall a b. (a -> b) -> a -> b
$ ((AssetId, Quantity) -> AssetId)
-> [(AssetId, Quantity)] -> [AssetId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AssetId, Quantity) -> AssetId
forall a b. (a, b) -> a
fst
           ([(AssetId, Quantity)] -> [AssetId])
-> [(AssetId, Quantity)] -> [AssetId]
forall a b. (a -> b) -> a -> b
$ Value -> [(AssetId, Quantity)]
C.valueToList Value
citoValue

-- | Data that we keep on disk. (This type is used for testing only - we need
--   other structures for the disk-backed storage)
data DiskState =
    DiskState
        { DiskState -> Map DatumHash Datum
_DataMap       :: Map DatumHash Datum
        , DiskState -> Map ScriptHash (Versioned Script)
_ScriptMap     :: Map ScriptHash (Versioned Script)
        , DiskState -> Map RedeemerHash Redeemer
_RedeemerMap   :: Map RedeemerHash Redeemer
        , DiskState -> Map TxId ChainIndexTx
_TxMap         :: Map TxId ChainIndexTx
        , DiskState -> CredentialMap
_AddressMap    :: CredentialMap
        , DiskState -> AssetClassMap
_AssetClassMap :: AssetClassMap
        }
        deriving stock (DiskState -> DiskState -> Bool
(DiskState -> DiskState -> Bool)
-> (DiskState -> DiskState -> Bool) -> Eq DiskState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DiskState -> DiskState -> Bool
$c/= :: DiskState -> DiskState -> Bool
== :: DiskState -> DiskState -> Bool
$c== :: DiskState -> DiskState -> Bool
Eq, Int -> DiskState -> ShowS
[DiskState] -> ShowS
DiskState -> String
(Int -> DiskState -> ShowS)
-> (DiskState -> String)
-> ([DiskState] -> ShowS)
-> Show DiskState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DiskState] -> ShowS
$cshowList :: [DiskState] -> ShowS
show :: DiskState -> String
$cshow :: DiskState -> String
showsPrec :: Int -> DiskState -> ShowS
$cshowsPrec :: Int -> DiskState -> ShowS
Show, (forall x. DiskState -> Rep DiskState x)
-> (forall x. Rep DiskState x -> DiskState) -> Generic DiskState
forall x. Rep DiskState x -> DiskState
forall x. DiskState -> Rep DiskState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DiskState x -> DiskState
$cfrom :: forall x. DiskState -> Rep DiskState x
Generic)
        deriving (b -> DiskState -> DiskState
NonEmpty DiskState -> DiskState
DiskState -> DiskState -> DiskState
(DiskState -> DiskState -> DiskState)
-> (NonEmpty DiskState -> DiskState)
-> (forall b. Integral b => b -> DiskState -> DiskState)
-> Semigroup DiskState
forall b. Integral b => b -> DiskState -> DiskState
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> DiskState -> DiskState
$cstimes :: forall b. Integral b => b -> DiskState -> DiskState
sconcat :: NonEmpty DiskState -> DiskState
$csconcat :: NonEmpty DiskState -> DiskState
<> :: DiskState -> DiskState -> DiskState
$c<> :: DiskState -> DiskState -> DiskState
Semigroup, Semigroup DiskState
DiskState
Semigroup DiskState
-> DiskState
-> (DiskState -> DiskState -> DiskState)
-> ([DiskState] -> DiskState)
-> Monoid DiskState
[DiskState] -> DiskState
DiskState -> DiskState -> DiskState
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [DiskState] -> DiskState
$cmconcat :: [DiskState] -> DiskState
mappend :: DiskState -> DiskState -> DiskState
$cmappend :: DiskState -> DiskState -> DiskState
mempty :: DiskState
$cmempty :: DiskState
$cp1Monoid :: Semigroup DiskState
Monoid) via (GenericSemigroupMonoid DiskState)

makeLenses ''DiskState

-- | The data we store on disk for a given 'ChainIndexTx'
fromTx :: ChainIndexTx -> DiskState
fromTx :: ChainIndexTx -> DiskState
fromTx ChainIndexTx
tx =
    DiskState :: Map DatumHash Datum
-> Map ScriptHash (Versioned Script)
-> Map RedeemerHash Redeemer
-> Map TxId ChainIndexTx
-> CredentialMap
-> AssetClassMap
-> DiskState
DiskState
        { _DataMap :: Map DatumHash Datum
_DataMap = Getting (Map DatumHash Datum) ChainIndexTx (Map DatumHash Datum)
-> ChainIndexTx -> Map DatumHash Datum
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Map DatumHash Datum) ChainIndexTx (Map DatumHash Datum)
Lens' ChainIndexTx (Map DatumHash Datum)
citxData ChainIndexTx
tx
        , _ScriptMap :: Map ScriptHash (Versioned Script)
_ScriptMap = Getting
  (Map ScriptHash (Versioned Script))
  ChainIndexTx
  (Map ScriptHash (Versioned Script))
-> ChainIndexTx -> Map ScriptHash (Versioned Script)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Map ScriptHash (Versioned Script))
  ChainIndexTx
  (Map ScriptHash (Versioned Script))
Lens' ChainIndexTx (Map ScriptHash (Versioned Script))
citxScripts ChainIndexTx
tx
        , _TxMap :: Map TxId ChainIndexTx
_TxMap = TxId -> ChainIndexTx -> Map TxId ChainIndexTx
forall k a. k -> a -> Map k a
Map.singleton (Getting TxId ChainIndexTx TxId -> ChainIndexTx -> TxId
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting TxId ChainIndexTx TxId
Lens' ChainIndexTx TxId
citxTxId ChainIndexTx
tx) ChainIndexTx
tx
        , _RedeemerMap :: Map RedeemerHash Redeemer
_RedeemerMap = ChainIndexTx -> Map RedeemerHash Redeemer
txRedeemersWithHash ChainIndexTx
tx
        , _AddressMap :: CredentialMap
_AddressMap = ChainIndexTx -> CredentialMap
txCredentialMap ChainIndexTx
tx
        , _AssetClassMap :: AssetClassMap
_AssetClassMap = ChainIndexTx -> AssetClassMap
txAssetClassMap ChainIndexTx
tx
        }

diagnostics :: DiskState -> Diagnostics
diagnostics :: DiskState -> Diagnostics
diagnostics DiskState{Map DatumHash Datum
_DataMap :: Map DatumHash Datum
_DataMap :: DiskState -> Map DatumHash Datum
_DataMap, Map ScriptHash (Versioned Script)
_ScriptMap :: Map ScriptHash (Versioned Script)
_ScriptMap :: DiskState -> Map ScriptHash (Versioned Script)
_ScriptMap, Map TxId ChainIndexTx
_TxMap :: Map TxId ChainIndexTx
_TxMap :: DiskState -> Map TxId ChainIndexTx
_TxMap, Map RedeemerHash Redeemer
_RedeemerMap :: Map RedeemerHash Redeemer
_RedeemerMap :: DiskState -> Map RedeemerHash Redeemer
_RedeemerMap, CredentialMap
_AddressMap :: CredentialMap
_AddressMap :: DiskState -> CredentialMap
_AddressMap, AssetClassMap
_AssetClassMap :: AssetClassMap
_AssetClassMap :: DiskState -> AssetClassMap
_AssetClassMap} =
    Diagnostics :: Integer
-> Integer
-> Integer
-> Integer
-> Int
-> Int
-> [TxId]
-> [ChainIndexTxOut]
-> Diagnostics
Diagnostics
        { numTransactions :: Integer
numTransactions = Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Map TxId ChainIndexTx -> Int
forall k a. Map k a -> Int
Map.size Map TxId ChainIndexTx
_TxMap
        , numScripts :: Integer
numScripts = Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Map ScriptHash (Versioned Script) -> Int
forall k a. Map k a -> Int
Map.size Map ScriptHash (Versioned Script)
_ScriptMap
        , numAddresses :: Integer
numAddresses = Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Map Credential (Set TxOutRef) -> Int
forall k a. Map k a -> Int
Map.size (Map Credential (Set TxOutRef) -> Int)
-> Map Credential (Set TxOutRef) -> Int
forall a b. (a -> b) -> a -> b
$ CredentialMap -> Map Credential (Set TxOutRef)
_unCredentialMap CredentialMap
_AddressMap
        , numAssetClasses :: Integer
numAssetClasses = Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Map AssetId (Set TxOutRef) -> Int
forall k a. Map k a -> Int
Map.size (Map AssetId (Set TxOutRef) -> Int)
-> Map AssetId (Set TxOutRef) -> Int
forall a b. (a -> b) -> a -> b
$ AssetClassMap -> Map AssetId (Set TxOutRef)
_unAssetClassMap AssetClassMap
_AssetClassMap
        , someTransactions :: [TxId]
someTransactions = Int -> [TxId] -> [TxId]
forall a. Int -> [a] -> [a]
take Int
10 ([TxId] -> [TxId]) -> [TxId] -> [TxId]
forall a b. (a -> b) -> a -> b
$ ((TxId, ChainIndexTx) -> TxId) -> [(TxId, ChainIndexTx)] -> [TxId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TxId, ChainIndexTx) -> TxId
forall a b. (a, b) -> a
fst ([(TxId, ChainIndexTx)] -> [TxId])
-> [(TxId, ChainIndexTx)] -> [TxId]
forall a b. (a -> b) -> a -> b
$ Map TxId ChainIndexTx -> [(TxId, ChainIndexTx)]
forall k a. Map k a -> [(k, a)]
Map.toList Map TxId ChainIndexTx
_TxMap
        , unspentTxOuts :: [ChainIndexTxOut]
unspentTxOuts = []
        -- These 2 are filled in Handlers.hs
        , numUnmatchedInputs :: Int
numUnmatchedInputs = Int
0
        , numUnspentOutputs :: Int
numUnspentOutputs = Int
0
        }