{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

module Cardano.Ledger.State.Query where

import Cardano.Ledger.Babbage.TxOut (internBabbageTxOut)
import Cardano.Ledger.Binary
import Cardano.Ledger.Core (TxOut, emptyPParams)
import qualified Cardano.Ledger.Credential as Credential
import qualified Cardano.Ledger.EpochBoundary as EpochBoundary
import qualified Cardano.Ledger.Keys as Keys
import Cardano.Ledger.Shelley.LedgerState (curPParamsEpochStateL, prevPParamsEpochStateL)
import qualified Cardano.Ledger.Shelley.LedgerState as Shelley
import Cardano.Ledger.State.Orphans
import Cardano.Ledger.State.Schema
import Cardano.Ledger.State.Transform
import Cardano.Ledger.State.UTxO
import Cardano.Ledger.State.Vector
import qualified Cardano.Ledger.TxIn as TxIn
import Cardano.Ledger.UMap (ptrMap, rewardMap, sPoolMap, unify)
import qualified Cardano.Ledger.UMap as UM
import qualified Cardano.Ledger.UTxO as Shelley
import Conduit
import Control.Foldl (Fold (..))
import Control.Monad
import Control.Monad.Trans.Reader
import Data.Conduit.Internal (zipSources)
import Data.Conduit.List (sourceList)
import Data.Default (def)
import Data.Functor
import qualified Data.IntMap.Strict as IntMap
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import qualified Data.VMap as VMap
import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Generic.Mutable as VGM
import Database.Persist.Sqlite
import Lens.Micro ((&), (.~), (^.))

-- Populate database

insertGetKey ::
  ( MonadIO m
  , PersistUniqueWrite backend
  , PersistRecordBackend record backend
  , AtLeastOneUniqueKey record
  , SafeToInsert record
  ) =>
  record ->
  ReaderT backend m (Key record)
insertGetKey :: forall (m :: * -> *) backend record.
(MonadIO m, PersistUniqueWrite backend,
 PersistRecordBackend record backend, AtLeastOneUniqueKey record,
 SafeToInsert record) =>
record -> ReaderT backend m (Key record)
insertGetKey = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall record. Entity record -> Key record
entityKey forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall record backend (m :: * -> *).
(MonadIO m, PersistUniqueWrite backend,
 PersistRecordBackend record backend, AtLeastOneUniqueKey record,
 SafeToInsert record) =>
record -> ReaderT backend m (Either (Entity record) (Key record))
insertBy

insertUTxOState ::
  MonadIO m =>
  Shelley.UTxOState CurrentEra ->
  ReaderT SqlBackend m (Key UtxoState)
insertUTxOState :: forall (m :: * -> *).
MonadIO m =>
UTxOState CurrentEra -> ReaderT SqlBackend m (Key UtxoState)
insertUTxOState Shelley.UTxOState {GovState CurrentEra
UTxO CurrentEra
Coin
IncrementalStake
utxosUtxo :: forall era. UTxOState era -> UTxO era
utxosDeposited :: forall era. UTxOState era -> Coin
utxosFees :: forall era. UTxOState era -> Coin
utxosGovState :: forall era. UTxOState era -> GovState era
utxosStakeDistr :: forall era. UTxOState era -> IncrementalStake
utxosDonation :: forall era. UTxOState era -> Coin
utxosDonation :: Coin
utxosStakeDistr :: IncrementalStake
utxosGovState :: GovState CurrentEra
utxosFees :: Coin
utxosDeposited :: Coin
utxosUtxo :: UTxO CurrentEra
..} = do
  forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m (Key record)
insert forall a b. (a -> b) -> a -> b
$
    UtxoState
      { utxoStateDeposited :: Coin
utxoStateDeposited = Coin
utxosDeposited
      , utxoStateFees :: Coin
utxoStateFees = Coin
utxosFees
      , utxoStatePpups :: ShelleyGovState CurrentEra
utxoStatePpups = GovState CurrentEra
utxosGovState
      , utxoStateDonation :: Coin
utxoStateDonation = Coin
utxosDonation
      }

insertUTxO ::
  MonadIO m =>
  Shelley.UTxO CurrentEra ->
  Key UtxoState ->
  ReaderT SqlBackend m ()
insertUTxO :: forall (m :: * -> *).
MonadIO m =>
UTxO CurrentEra -> Key UtxoState -> ReaderT SqlBackend m ()
insertUTxO UTxO CurrentEra
utxo Key UtxoState
stateKey = do
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (TxIn, BabbageTxOut CurrentEra) -> ReaderT SqlBackend m ()
insertTxOut forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toList (forall era. UTxO era -> Map TxIn (TxOut era)
Shelley.unUTxO UTxO CurrentEra
utxo)
  where
    insertTxOut :: (TxIn, BabbageTxOut CurrentEra) -> ReaderT SqlBackend m ()
insertTxOut (TxIn.TxIn TxId
txId TxIx
txIx, BabbageTxOut CurrentEra
out) = do
      Key Tx
txKey <-
        forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m (Key record)
insert forall a b. (a -> b) -> a -> b
$ Tx {txInIx :: TxIx
txInIx = TxIx
txIx, txInId :: TxId
txInId = TxId
txId, txOut :: BabbageTxOut CurrentEra
txOut = BabbageTxOut CurrentEra
out}
      Key Txs
txsKey <-
        forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m (Key record)
insert forall a b. (a -> b) -> a -> b
$
          Txs
            { txsInIx :: TxIx
txsInIx = TxIx
txIx
            , txsInId :: TxId
txsInId = TxId
txId
            , txsOut :: BabbageTxOut CurrentEra
txsOut = BabbageTxOut CurrentEra
out
            , txsStakeCredential :: Maybe CredentialId
txsStakeCredential = forall a. Maybe a
Nothing
            }
      forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m ()
insert_ forall a b. (a -> b) -> a -> b
$
        UtxoEntry
          { utxoEntryTxId :: Key Tx
utxoEntryTxId = Key Tx
txKey
          , utxoEntryTxsId :: Key Txs
utxoEntryTxsId = Key Txs
txsKey
          , utxoEntryStateId :: Key UtxoState
utxoEntryStateId = Key UtxoState
stateKey
          }

insertDState :: MonadIO m => Shelley.DState CurrentEra -> ReaderT SqlBackend m DStateId
insertDState :: forall (m :: * -> *).
MonadIO m =>
DState CurrentEra -> ReaderT SqlBackend m DStateId
insertDState Shelley.DState {Map FutureGenDeleg GenDelegPair
InstantaneousRewards
UMap
GenDelegs
dsUnified :: forall era. DState era -> UMap
dsFutureGenDelegs :: forall era. DState era -> Map FutureGenDeleg GenDelegPair
dsGenDelegs :: forall era. DState era -> GenDelegs
dsIRewards :: forall era. DState era -> InstantaneousRewards
dsIRewards :: InstantaneousRewards
dsGenDelegs :: GenDelegs
dsFutureGenDelegs :: Map FutureGenDeleg GenDelegPair
dsUnified :: UMap
..} = do
  let irDeltaReserves :: DeltaCoin
irDeltaReserves = InstantaneousRewards -> DeltaCoin
Shelley.deltaReserves InstantaneousRewards
dsIRewards
  let irDeltaTreasury :: DeltaCoin
irDeltaTreasury = InstantaneousRewards -> DeltaCoin
Shelley.deltaTreasury InstantaneousRewards
dsIRewards
  DStateId
dstateId <- forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m (Key record)
insert forall a b. (a -> b) -> a -> b
$ FGenDelegs -> GenDelegs -> DeltaCoin -> DeltaCoin -> DState
DState (forall a. a -> Enc a
Enc Map FutureGenDeleg GenDelegPair
dsFutureGenDelegs) GenDelegs
dsGenDelegs DeltaCoin
irDeltaReserves DeltaCoin
irDeltaTreasury
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k a. Map k a -> [(k, a)]
Map.toList (UMap -> Map (Credential 'Staking) Coin
rewardMap UMap
dsUnified)) forall a b. (a -> b) -> a -> b
$ \(Credential 'Staking
cred, Coin
c) -> do
    CredentialId
credId <- forall (m :: * -> *) backend record.
(MonadIO m, PersistUniqueWrite backend,
 PersistRecordBackend record backend, AtLeastOneUniqueKey record,
 SafeToInsert record) =>
record -> ReaderT backend m (Key record)
insertGetKey (CredentialWitness -> Credential
Credential (forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
Keys.asWitness Credential 'Staking
cred))
    forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m ()
insert_ (DStateId -> CredentialId -> Coin -> Reward
Reward DStateId
dstateId CredentialId
credId Coin
c)
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k a. Map k a -> [(k, a)]
Map.toList (UMap -> Map (Credential 'Staking) (KeyHash 'StakePool)
sPoolMap UMap
dsUnified)) forall a b. (a -> b) -> a -> b
$ \(Credential 'Staking
cred, KeyHash 'StakePool
spKeyHash) -> do
    CredentialId
credId <- forall (m :: * -> *) backend record.
(MonadIO m, PersistUniqueWrite backend,
 PersistRecordBackend record backend, AtLeastOneUniqueKey record,
 SafeToInsert record) =>
record -> ReaderT backend m (Key record)
insertGetKey (CredentialWitness -> Credential
Credential (forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
Keys.asWitness Credential 'Staking
cred))
    Key KeyHash
keyHashId <- forall (m :: * -> *) backend record.
(MonadIO m, PersistUniqueWrite backend,
 PersistRecordBackend record backend, AtLeastOneUniqueKey record,
 SafeToInsert record) =>
record -> ReaderT backend m (Key record)
insertGetKey (KeyHashWitness -> KeyHash
KeyHash (forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
Keys.asWitness KeyHash 'StakePool
spKeyHash))
    forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m ()
insert_ (DStateId -> CredentialId -> Key KeyHash -> Delegation
Delegation DStateId
dstateId CredentialId
credId Key KeyHash
keyHashId)
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k a. Map k a -> [(k, a)]
Map.toList (UMap -> Map Ptr (Credential 'Staking)
ptrMap UMap
dsUnified)) forall a b. (a -> b) -> a -> b
$ \(Ptr
ptr, Credential 'Staking
cred) -> do
    CredentialId
credId <- forall (m :: * -> *) backend record.
(MonadIO m, PersistUniqueWrite backend,
 PersistRecordBackend record backend, AtLeastOneUniqueKey record,
 SafeToInsert record) =>
record -> ReaderT backend m (Key record)
insertGetKey (CredentialWitness -> Credential
Credential (forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
Keys.asWitness Credential 'Staking
cred))
    forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m ()
insert_ (DStateId -> CredentialId -> Ptr -> Ptr
Ptr DStateId
dstateId CredentialId
credId Ptr
ptr)
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k a. Map k a -> [(k, a)]
Map.toList (InstantaneousRewards -> Map (Credential 'Staking) Coin
Shelley.iRReserves InstantaneousRewards
dsIRewards)) forall a b. (a -> b) -> a -> b
$ \(Credential 'Staking
cred, Coin
c) -> do
    CredentialId
credId <- forall (m :: * -> *) backend record.
(MonadIO m, PersistUniqueWrite backend,
 PersistRecordBackend record backend, AtLeastOneUniqueKey record,
 SafeToInsert record) =>
record -> ReaderT backend m (Key record)
insertGetKey (CredentialWitness -> Credential
Credential (forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
Keys.asWitness Credential 'Staking
cred))
    forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m ()
insert_ (DStateId -> CredentialId -> Coin -> IRReserves
IRReserves DStateId
dstateId CredentialId
credId Coin
c)
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k a. Map k a -> [(k, a)]
Map.toList (InstantaneousRewards -> Map (Credential 'Staking) Coin
Shelley.iRTreasury InstantaneousRewards
dsIRewards)) forall a b. (a -> b) -> a -> b
$ \(Credential 'Staking
cred, Coin
c) -> do
    CredentialId
credId <- forall (m :: * -> *) backend record.
(MonadIO m, PersistUniqueWrite backend,
 PersistRecordBackend record backend, AtLeastOneUniqueKey record,
 SafeToInsert record) =>
record -> ReaderT backend m (Key record)
insertGetKey (CredentialWitness -> Credential
Credential (forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
Keys.asWitness Credential 'Staking
cred))
    forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m ()
insert_ (DStateId -> CredentialId -> Coin -> IRTreasury
IRTreasury DStateId
dstateId CredentialId
credId Coin
c)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure DStateId
dstateId

insertLedgerState ::
  MonadIO m => EpochStateId -> Shelley.LedgerState CurrentEra -> ReaderT SqlBackend m ()
insertLedgerState :: forall (m :: * -> *).
MonadIO m =>
EpochStateId -> LedgerState CurrentEra -> ReaderT SqlBackend m ()
insertLedgerState EpochStateId
epochStateKey Shelley.LedgerState {CertState CurrentEra
UTxOState CurrentEra
lsUTxOState :: forall era. LedgerState era -> UTxOState era
lsCertState :: forall era. LedgerState era -> CertState era
lsCertState :: CertState CurrentEra
lsUTxOState :: UTxOState CurrentEra
..} = do
  Key UtxoState
stateKey <- forall (m :: * -> *).
MonadIO m =>
UTxOState CurrentEra -> ReaderT SqlBackend m (Key UtxoState)
insertUTxOState UTxOState CurrentEra
lsUTxOState
  forall (m :: * -> *).
MonadIO m =>
UTxO CurrentEra -> Key UtxoState -> ReaderT SqlBackend m ()
insertUTxO (forall era. UTxOState era -> UTxO era
Shelley.utxosUtxo UTxOState CurrentEra
lsUTxOState) Key UtxoState
stateKey
  DStateId
dstateKey <- forall (m :: * -> *).
MonadIO m =>
DState CurrentEra -> ReaderT SqlBackend m DStateId
insertDState forall a b. (a -> b) -> a -> b
$ forall era. CertState era -> DState era
Shelley.certDState CertState CurrentEra
lsCertState
  forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m ()
insert_
    LedgerState
      { ledgerStateUtxoId :: Key UtxoState
ledgerStateUtxoId = Key UtxoState
stateKey
      , ledgerStateDstateId :: DStateId
ledgerStateDstateId = DStateId
dstateKey
      , ledgerStatePstateBin :: PState CurrentEra
ledgerStatePstateBin = forall era. CertState era -> PState era
Shelley.certPState CertState CurrentEra
lsCertState
      , ledgerStateEpochStateId :: EpochStateId
ledgerStateEpochStateId = EpochStateId
epochStateKey
      }

insertSnapShot ::
  MonadIO m =>
  Key EpochState ->
  SnapShotType ->
  EpochBoundary.SnapShot ->
  ReaderT SqlBackend m ()
insertSnapShot :: forall (m :: * -> *).
MonadIO m =>
EpochStateId -> SnapShotType -> SnapShot -> ReaderT SqlBackend m ()
insertSnapShot EpochStateId
snapShotEpochStateId SnapShotType
snapShotType EpochBoundary.SnapShot {Stake
VMap VB VB (KeyHash 'StakePool) PoolParams
VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
$sel:ssStake:SnapShot :: SnapShot -> Stake
$sel:ssDelegations:SnapShot :: SnapShot -> VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
$sel:ssPoolParams:SnapShot :: SnapShot -> VMap VB VB (KeyHash 'StakePool) PoolParams
ssPoolParams :: VMap VB VB (KeyHash 'StakePool) PoolParams
ssDelegations :: VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
ssStake :: Stake
..} = do
  Key SnapShot
snapShotId <- forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m (Key record)
insert forall a b. (a -> b) -> a -> b
$ SnapShot {SnapShotType
snapShotType :: SnapShotType
snapShotType :: SnapShotType
snapShotType, EpochStateId
snapShotEpochStateId :: EpochStateId
snapShotEpochStateId :: EpochStateId
snapShotEpochStateId}
  forall (m :: * -> *) (v :: * -> *) a b.
(Monad m, Vector v a) =>
v a -> (a -> m b) -> m ()
VG.forM_ (forall (kv :: * -> *) (vv :: * -> *) k v.
VMap kv vv k v -> KVVector kv vv (k, v)
VMap.unVMap (Stake -> VMap VB VP (Credential 'Staking) (CompactForm Coin)
EpochBoundary.unStake Stake
ssStake)) forall a b. (a -> b) -> a -> b
$ \(Credential 'Staking
cred, CompactForm Coin
c) -> do
    CredentialId
credId <- forall (m :: * -> *) backend record.
(MonadIO m, PersistUniqueWrite backend,
 PersistRecordBackend record backend, AtLeastOneUniqueKey record,
 SafeToInsert record) =>
record -> ReaderT backend m (Key record)
insertGetKey (CredentialWitness -> Credential
Credential (forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
Keys.asWitness Credential 'Staking
cred))
    forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m ()
insert_ (Key SnapShot -> CredentialId -> CompactForm Coin -> SnapShotStake
SnapShotStake Key SnapShot
snapShotId CredentialId
credId CompactForm Coin
c)
  forall (m :: * -> *) (v :: * -> *) a b.
(Monad m, Vector v a) =>
v a -> (a -> m b) -> m ()
VG.forM_ (forall (kv :: * -> *) (vv :: * -> *) k v.
VMap kv vv k v -> KVVector kv vv (k, v)
VMap.unVMap VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
ssDelegations) forall a b. (a -> b) -> a -> b
$ \(Credential 'Staking
cred, KeyHash 'StakePool
spKeyHash) -> do
    CredentialId
credId <- forall (m :: * -> *) backend record.
(MonadIO m, PersistUniqueWrite backend,
 PersistRecordBackend record backend, AtLeastOneUniqueKey record,
 SafeToInsert record) =>
record -> ReaderT backend m (Key record)
insertGetKey (CredentialWitness -> Credential
Credential (forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
Keys.asWitness Credential 'Staking
cred))
    Key KeyHash
keyHashId <- forall (m :: * -> *) backend record.
(MonadIO m, PersistUniqueWrite backend,
 PersistRecordBackend record backend, AtLeastOneUniqueKey record,
 SafeToInsert record) =>
record -> ReaderT backend m (Key record)
insertGetKey (KeyHashWitness -> KeyHash
KeyHash (forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
Keys.asWitness KeyHash 'StakePool
spKeyHash))
    forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m ()
insert_ (Key SnapShot -> CredentialId -> Key KeyHash -> SnapShotDelegation
SnapShotDelegation Key SnapShot
snapShotId CredentialId
credId Key KeyHash
keyHashId)
  forall (m :: * -> *) (v :: * -> *) a b.
(Monad m, Vector v a) =>
v a -> (a -> m b) -> m ()
VG.forM_ (forall (kv :: * -> *) (vv :: * -> *) k v.
VMap kv vv k v -> KVVector kv vv (k, v)
VMap.unVMap VMap VB VB (KeyHash 'StakePool) PoolParams
ssPoolParams) forall a b. (a -> b) -> a -> b
$ \(KeyHash 'StakePool
keyHash, PoolParams
pps) -> do
    Key KeyHash
keyHashId <- forall (m :: * -> *) backend record.
(MonadIO m, PersistUniqueWrite backend,
 PersistRecordBackend record backend, AtLeastOneUniqueKey record,
 SafeToInsert record) =>
record -> ReaderT backend m (Key record)
insertGetKey (KeyHashWitness -> KeyHash
KeyHash (forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
Keys.asWitness KeyHash 'StakePool
keyHash))
    forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m ()
insert_ (Key SnapShot -> Key KeyHash -> PoolParams -> SnapShotPool
SnapShotPool Key SnapShot
snapShotId Key KeyHash
keyHashId PoolParams
pps)

insertSnapShots ::
  MonadIO m =>
  Key EpochState ->
  EpochBoundary.SnapShots ->
  ReaderT SqlBackend m ()
insertSnapShots :: forall (m :: * -> *).
MonadIO m =>
EpochStateId -> SnapShots -> ReaderT SqlBackend m ()
insertSnapShots EpochStateId
epochStateKey EpochBoundary.SnapShots {SnapShot
PoolDistr
Coin
$sel:ssStakeMark:SnapShots :: SnapShots -> SnapShot
$sel:ssStakeMarkPoolDistr:SnapShots :: SnapShots -> PoolDistr
$sel:ssStakeSet:SnapShots :: SnapShots -> SnapShot
$sel:ssStakeGo:SnapShots :: SnapShots -> SnapShot
$sel:ssFee:SnapShots :: SnapShots -> Coin
ssFee :: Coin
ssStakeGo :: SnapShot
ssStakeSet :: SnapShot
ssStakeMarkPoolDistr :: PoolDistr
ssStakeMark :: SnapShot
..} = do
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
    (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall (m :: * -> *).
MonadIO m =>
EpochStateId -> SnapShotType -> SnapShot -> ReaderT SqlBackend m ()
insertSnapShot EpochStateId
epochStateKey))
    [ (SnapShotType
SnapShotMark, SnapShot
ssStakeMark)
    , (SnapShotType
SnapShotSet, SnapShot
ssStakeSet)
    , (SnapShotType
SnapShotGo, SnapShot
ssStakeGo)
    ]

insertEpochState ::
  MonadIO m => Shelley.EpochState CurrentEra -> ReaderT SqlBackend m ()
insertEpochState :: forall (m :: * -> *).
MonadIO m =>
EpochState CurrentEra -> ReaderT SqlBackend m ()
insertEpochState es :: EpochState CurrentEra
es@Shelley.EpochState {SnapShots
AccountState
LedgerState CurrentEra
NonMyopic
esAccountState :: forall era. EpochState era -> AccountState
esLState :: forall era. EpochState era -> LedgerState era
esSnapshots :: forall era. EpochState era -> SnapShots
esNonMyopic :: forall era. EpochState era -> NonMyopic
esNonMyopic :: NonMyopic
esSnapshots :: SnapShots
esLState :: LedgerState CurrentEra
esAccountState :: AccountState
..} = do
  EpochStateId
epochStateKey <-
    forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m (Key record)
insert
      EpochState
        { epochStateTreasury :: Coin
epochStateTreasury = AccountState -> Coin
Shelley.asTreasury AccountState
esAccountState
        , epochStateReserves :: Coin
epochStateReserves = AccountState -> Coin
Shelley.asReserves AccountState
esAccountState
        , epochStatePrevPp :: PParams CurrentEra
epochStatePrevPp = EpochState CurrentEra
es forall s a. s -> Getting a s a -> a
^. forall era. EraGov era => Lens' (EpochState era) (PParams era)
prevPParamsEpochStateL
        , epochStatePp :: PParams CurrentEra
epochStatePp = EpochState CurrentEra
es forall s a. s -> Getting a s a -> a
^. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL
        , epochStateNonMyopic :: NonMyopic
epochStateNonMyopic = NonMyopic
esNonMyopic
        , epochStateSnapShotsFee :: Coin
epochStateSnapShotsFee = SnapShots -> Coin
EpochBoundary.ssFee SnapShots
esSnapshots
        }
  forall (m :: * -> *).
MonadIO m =>
EpochStateId -> SnapShots -> ReaderT SqlBackend m ()
insertSnapShots EpochStateId
epochStateKey SnapShots
esSnapshots
  forall (m :: * -> *).
MonadIO m =>
EpochStateId -> LedgerState CurrentEra -> ReaderT SqlBackend m ()
insertLedgerState EpochStateId
epochStateKey LedgerState CurrentEra
esLState

-- Query database

-- Into vector

selectVMap ::
  ( Ord k
  , PersistEntity record
  , PersistEntityBackend record ~ SqlBackend
  , VMap.Vector kv k
  , VMap.Vector vv v
  , MonadResource m
  ) =>
  [Filter record] ->
  (record -> ReaderT SqlBackend m (k, v)) ->
  ReaderT SqlBackend m (VMap.VMap kv vv k v)
selectVMap :: forall k record (kv :: * -> *) (vv :: * -> *) v (m :: * -> *).
(Ord k, PersistEntity record,
 PersistEntityBackend record ~ SqlBackend, Vector kv k, Vector vv v,
 MonadResource m) =>
[Filter record]
-> (record -> ReaderT SqlBackend m (k, v))
-> ReaderT SqlBackend m (VMap kv vv k v)
selectVMap [Filter record]
fs record -> ReaderT SqlBackend m (k, v)
f = do
  Int
n <- forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m Int
count [Filter record]
fs
  KVMVector (Mutable kv) (Mutable vv) RealWorld (k, v)
mv <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
Int -> m (v (PrimState m) a)
VGM.unsafeNew Int
n
  forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) a b.
Monad m =>
ConduitT () a m () -> ConduitT () b m () -> ConduitT () (a, b) m ()
zipSources (forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
sourceList [Int
0 ..]) (forall record backend (m :: * -> *).
(PersistQueryRead backend, MonadResource m,
 PersistRecordBackend record backend, MonadReader backend m) =>
[Filter record]
-> [SelectOpt record] -> ConduitM () (Entity record) m ()
selectSource [Filter record]
fs [])
      forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a o.
Monad m =>
(a -> m ()) -> ConduitT a o m ()
mapM_C (\(Int
i, Entity Key record
_ record
a) -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (v :: * -> * -> *) a.
(HasCallStack, PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
VGM.write KVMVector (Mutable kv) (Mutable vv) RealWorld (k, v)
mv Int
i forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< record -> ReaderT SqlBackend m (k, v)
f record
a)
  forall (kv :: * -> *) (vv :: * -> *) k v.
KVVector kv vv (k, v) -> VMap kv vv k v
VMap.VMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
VG.unsafeFreeze forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall k (m :: * -> *) (kv :: * -> *) (vv :: * -> *) v.
(Ord k, PrimMonad m, Vector kv k, Vector vv v) =>
KVMVector (Mutable kv) (Mutable vv) (PrimState m) (k, v)
-> m (KVMVector (Mutable kv) (Mutable vv) (PrimState m) (k, v))
VMap.normalizeM KVMVector (Mutable kv) (Mutable vv) RealWorld (k, v)
mv)
{-# INLINEABLE selectVMap #-}

getSnapShotNoSharingM ::
  MonadResource m =>
  Key EpochState ->
  SnapShotType ->
  ReaderT SqlBackend m SnapShotM
getSnapShotNoSharingM :: forall (m :: * -> *).
MonadResource m =>
EpochStateId -> SnapShotType -> ReaderT SqlBackend m SnapShotM
getSnapShotNoSharingM EpochStateId
epochStateId SnapShotType
snapShotType = do
  Key SnapShot
snapShotId <-
    forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m (Maybe (Entity record))
selectFirst
      [forall typ. (typ ~ SnapShotType) => EntityField SnapShot typ
SnapShotType forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. SnapShotType
snapShotType, forall typ. (typ ~ EpochStateId) => EntityField SnapShot typ
SnapShotEpochStateId forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. EpochStateId
epochStateId]
      []
      forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
        Maybe (Entity SnapShot)
Nothing -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Missing a snapshot: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show SnapShotType
snapShotType
        Just (Entity Key SnapShot
snapShotId SnapShot
_) -> Key SnapShot
snapShotId
  Map (Credential 'Staking) (CompactForm Coin)
stake <-
    forall (m :: * -> *) k record a.
(MonadResource m, Ord k, PersistEntity record,
 PersistEntityBackend record ~ SqlBackend) =>
[Filter record]
-> (record -> ReaderT SqlBackend m (k, a))
-> ReaderT SqlBackend m (Map k a)
selectMap [forall typ. (typ ~ Key SnapShot) => EntityField SnapShotStake typ
SnapShotStakeSnapShotId forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key SnapShot
snapShotId] forall a b. (a -> b) -> a -> b
$ \SnapShotStake {CompactForm Coin
CredentialId
Key SnapShot
snapShotStakeCoin :: SnapShotStake -> CompactForm Coin
snapShotStakeCredentialId :: SnapShotStake -> CredentialId
snapShotStakeSnapShotId :: SnapShotStake -> Key SnapShot
snapShotStakeCoin :: CompactForm Coin
snapShotStakeCredentialId :: CredentialId
snapShotStakeSnapShotId :: Key SnapShot
..} -> do
      Credential CredentialWitness
credential <- forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
getJust CredentialId
snapShotStakeCredentialId
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
Keys.coerceKeyRole CredentialWitness
credential, CompactForm Coin
snapShotStakeCoin)
  Map (Credential 'Staking) (KeyHash 'StakePool)
delegations <-
    forall (m :: * -> *) k record a.
(MonadResource m, Ord k, PersistEntity record,
 PersistEntityBackend record ~ SqlBackend) =>
[Filter record]
-> (record -> ReaderT SqlBackend m (k, a))
-> ReaderT SqlBackend m (Map k a)
selectMap [forall typ.
(typ ~ Key SnapShot) =>
EntityField SnapShotDelegation typ
SnapShotDelegationSnapShotId forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key SnapShot
snapShotId] forall a b. (a -> b) -> a -> b
$ \SnapShotDelegation {Key KeyHash
CredentialId
Key SnapShot
snapShotDelegationKeyHash :: SnapShotDelegation -> Key KeyHash
snapShotDelegationCredentialId :: SnapShotDelegation -> CredentialId
snapShotDelegationSnapShotId :: SnapShotDelegation -> Key SnapShot
snapShotDelegationKeyHash :: Key KeyHash
snapShotDelegationCredentialId :: CredentialId
snapShotDelegationSnapShotId :: Key SnapShot
..} -> do
      Credential CredentialWitness
credential <- forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
getJust CredentialId
snapShotDelegationCredentialId
      KeyHash KeyHashWitness
keyHash <- forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
getJust Key KeyHash
snapShotDelegationKeyHash
      -- TODO ^ rename snapShotDelegationKeyHashId
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
Keys.coerceKeyRole CredentialWitness
credential, forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
Keys.coerceKeyRole KeyHashWitness
keyHash)
  Map (KeyHash 'StakePool) PoolParams
poolParams <-
    forall (m :: * -> *) k record a.
(MonadResource m, Ord k, PersistEntity record,
 PersistEntityBackend record ~ SqlBackend) =>
[Filter record]
-> (record -> ReaderT SqlBackend m (k, a))
-> ReaderT SqlBackend m (Map k a)
selectMap [forall typ. (typ ~ Key SnapShot) => EntityField SnapShotPool typ
SnapShotPoolSnapShotId forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key SnapShot
snapShotId] forall a b. (a -> b) -> a -> b
$ \SnapShotPool {PoolParams
Key KeyHash
Key SnapShot
snapShotPoolParams :: SnapShotPool -> PoolParams
snapShotPoolKeyHashId :: SnapShotPool -> Key KeyHash
snapShotPoolSnapShotId :: SnapShotPool -> Key SnapShot
snapShotPoolParams :: PoolParams
snapShotPoolKeyHashId :: Key KeyHash
snapShotPoolSnapShotId :: Key SnapShot
..} -> do
      KeyHash KeyHashWitness
keyHash <- forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
getJust Key KeyHash
snapShotPoolKeyHashId
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
Keys.coerceKeyRole KeyHashWitness
keyHash, PoolParams
snapShotPoolParams)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    SnapShotM
      { ssStake :: Map (Credential 'Staking) (CompactForm Coin)
ssStake = Map (Credential 'Staking) (CompactForm Coin)
stake
      , ssDelegations :: Map (Credential 'Staking) (KeyHash 'StakePool)
ssDelegations = Map (Credential 'Staking) (KeyHash 'StakePool)
delegations
      , ssPoolParams :: Map (KeyHash 'StakePool) PoolParams
ssPoolParams = Map (KeyHash 'StakePool) PoolParams
poolParams
      }
{-# INLINEABLE getSnapShotNoSharingM #-}

getSnapShotWithSharingM ::
  MonadResource m =>
  [SnapShotM] ->
  Key EpochState ->
  SnapShotType ->
  ReaderT SqlBackend m SnapShotM
getSnapShotWithSharingM :: forall (m :: * -> *).
MonadResource m =>
[SnapShotM]
-> EpochStateId -> SnapShotType -> ReaderT SqlBackend m SnapShotM
getSnapShotWithSharingM [SnapShotM]
otherSnapShots EpochStateId
epochStateId SnapShotType
snapShotType = do
  let internOtherStakes :: CredentialWitness -> Credential 'Staking
internOtherStakes =
        forall k. Interns k -> k -> k
interns
          (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall k a. Ord k => Map k a -> Interns k
internsFromMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. SnapShotM -> Map (Credential 'Staking) (CompactForm Coin)
ssStake) [SnapShotM]
otherSnapShots)
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
Keys.coerceKeyRole
  let internOtherPoolParams :: KeyHashWitness -> KeyHash 'StakePool
internOtherPoolParams =
        forall k. Interns k -> k -> k
interns (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall k a. Ord k => Map k a -> Interns k
internsFromMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. SnapShotM -> Map (KeyHash 'StakePool) PoolParams
ssPoolParams) [SnapShotM]
otherSnapShots)
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
Keys.coerceKeyRole
  let internOtherDelegations :: CredentialWitness -> Credential 'Staking
internOtherDelegations =
        forall k. Interns k -> k -> k
interns (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall k a. Ord k => Map k a -> Interns k
internsFromMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. SnapShotM -> Map (Credential 'Staking) (KeyHash 'StakePool)
ssDelegations) [SnapShotM]
otherSnapShots)
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
Keys.coerceKeyRole
  Key SnapShot
snapShotId <-
    forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m (Maybe (Entity record))
selectFirst
      [forall typ. (typ ~ SnapShotType) => EntityField SnapShot typ
SnapShotType forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. SnapShotType
snapShotType, forall typ. (typ ~ EpochStateId) => EntityField SnapShot typ
SnapShotEpochStateId forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. EpochStateId
epochStateId]
      []
      forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
        Maybe (Entity SnapShot)
Nothing -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Missing a snapshot: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show SnapShotType
snapShotType
        Just (Entity Key SnapShot
snapShotId SnapShot
_) -> Key SnapShot
snapShotId
  Map (Credential 'Staking) (CompactForm Coin)
stake <-
    forall (m :: * -> *) k record a.
(MonadResource m, Ord k, PersistEntity record,
 PersistEntityBackend record ~ SqlBackend) =>
[Filter record]
-> (record -> ReaderT SqlBackend m (k, a))
-> ReaderT SqlBackend m (Map k a)
selectMap [forall typ. (typ ~ Key SnapShot) => EntityField SnapShotStake typ
SnapShotStakeSnapShotId forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key SnapShot
snapShotId] forall a b. (a -> b) -> a -> b
$ \SnapShotStake {CompactForm Coin
CredentialId
Key SnapShot
snapShotStakeCoin :: CompactForm Coin
snapShotStakeCredentialId :: CredentialId
snapShotStakeSnapShotId :: Key SnapShot
snapShotStakeCoin :: SnapShotStake -> CompactForm Coin
snapShotStakeCredentialId :: SnapShotStake -> CredentialId
snapShotStakeSnapShotId :: SnapShotStake -> Key SnapShot
..} -> do
      Credential CredentialWitness
credential <- forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
getJust CredentialId
snapShotStakeCredentialId
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (CredentialWitness -> Credential 'Staking
internOtherStakes CredentialWitness
credential, CompactForm Coin
snapShotStakeCoin)
  Map (KeyHash 'StakePool) PoolParams
poolParams <-
    forall (m :: * -> *) k record a.
(MonadResource m, Ord k, PersistEntity record,
 PersistEntityBackend record ~ SqlBackend) =>
[Filter record]
-> (record -> ReaderT SqlBackend m (k, a))
-> ReaderT SqlBackend m (Map k a)
selectMap [forall typ. (typ ~ Key SnapShot) => EntityField SnapShotPool typ
SnapShotPoolSnapShotId forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key SnapShot
snapShotId] forall a b. (a -> b) -> a -> b
$ \SnapShotPool {PoolParams
Key KeyHash
Key SnapShot
snapShotPoolParams :: PoolParams
snapShotPoolKeyHashId :: Key KeyHash
snapShotPoolSnapShotId :: Key SnapShot
snapShotPoolParams :: SnapShotPool -> PoolParams
snapShotPoolKeyHashId :: SnapShotPool -> Key KeyHash
snapShotPoolSnapShotId :: SnapShotPool -> Key SnapShot
..} -> do
      KeyHash KeyHashWitness
keyHash <- forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
getJust Key KeyHash
snapShotPoolKeyHashId
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (KeyHashWitness -> KeyHash 'StakePool
internOtherPoolParams KeyHashWitness
keyHash, PoolParams
snapShotPoolParams)
  let internPoolParams :: KeyHashWitness -> KeyHash 'StakePool
internPoolParams = forall k. Interns k -> k -> k
interns (forall k a. Ord k => Map k a -> Interns k
internsFromMap Map (KeyHash 'StakePool) PoolParams
poolParams) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
Keys.coerceKeyRole
  Map (Credential 'Staking) (KeyHash 'StakePool)
delegations <-
    forall (m :: * -> *) k record a.
(MonadResource m, Ord k, PersistEntity record,
 PersistEntityBackend record ~ SqlBackend) =>
[Filter record]
-> (record -> ReaderT SqlBackend m (k, a))
-> ReaderT SqlBackend m (Map k a)
selectMap [forall typ.
(typ ~ Key SnapShot) =>
EntityField SnapShotDelegation typ
SnapShotDelegationSnapShotId forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key SnapShot
snapShotId] forall a b. (a -> b) -> a -> b
$ \SnapShotDelegation {Key KeyHash
CredentialId
Key SnapShot
snapShotDelegationKeyHash :: Key KeyHash
snapShotDelegationCredentialId :: CredentialId
snapShotDelegationSnapShotId :: Key SnapShot
snapShotDelegationKeyHash :: SnapShotDelegation -> Key KeyHash
snapShotDelegationCredentialId :: SnapShotDelegation -> CredentialId
snapShotDelegationSnapShotId :: SnapShotDelegation -> Key SnapShot
..} -> do
      Credential CredentialWitness
credential <- forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
getJust CredentialId
snapShotDelegationCredentialId
      KeyHash KeyHashWitness
keyHash <- forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
getJust Key KeyHash
snapShotDelegationKeyHash
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (CredentialWitness -> Credential 'Staking
internOtherDelegations CredentialWitness
credential, KeyHashWitness -> KeyHash 'StakePool
internPoolParams KeyHashWitness
keyHash)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    SnapShotM
      { ssStake :: Map (Credential 'Staking) (CompactForm Coin)
ssStake = Map (Credential 'Staking) (CompactForm Coin)
stake
      , ssDelegations :: Map (Credential 'Staking) (KeyHash 'StakePool)
ssDelegations = Map (Credential 'Staking) (KeyHash 'StakePool)
delegations
      , ssPoolParams :: Map (KeyHash 'StakePool) PoolParams
ssPoolParams = Map (KeyHash 'StakePool) PoolParams
poolParams
      }
{-# INLINEABLE getSnapShotWithSharingM #-}

getSnapShotsWithSharingM ::
  MonadResource m =>
  Entity EpochState ->
  ReaderT SqlBackend m SnapShotsM
getSnapShotsWithSharingM :: forall (m :: * -> *).
MonadResource m =>
Entity EpochState -> ReaderT SqlBackend m SnapShotsM
getSnapShotsWithSharingM (Entity EpochStateId
epochStateId EpochState {Coin
epochStateSnapShotsFee :: Coin
epochStateSnapShotsFee :: EpochState -> Coin
epochStateSnapShotsFee}) = do
  SnapShotM
mark <- forall (m :: * -> *).
MonadResource m =>
[SnapShotM]
-> EpochStateId -> SnapShotType -> ReaderT SqlBackend m SnapShotM
getSnapShotWithSharingM [] EpochStateId
epochStateId SnapShotType
SnapShotMark
  SnapShotM
set <- forall (m :: * -> *).
MonadResource m =>
[SnapShotM]
-> EpochStateId -> SnapShotType -> ReaderT SqlBackend m SnapShotM
getSnapShotWithSharingM [SnapShotM
mark] EpochStateId
epochStateId SnapShotType
SnapShotSet
  SnapShotM
go <- forall (m :: * -> *).
MonadResource m =>
[SnapShotM]
-> EpochStateId -> SnapShotType -> ReaderT SqlBackend m SnapShotM
getSnapShotWithSharingM [SnapShotM
mark, SnapShotM
set] EpochStateId
epochStateId SnapShotType
SnapShotGo
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    SnapShotsM
      { ssPstakeMark :: SnapShotM
ssPstakeMark = SnapShotM
mark
      , ssPstakeSet :: SnapShotM
ssPstakeSet = SnapShotM
set
      , ssPstakeGo :: SnapShotM
ssPstakeGo = SnapShotM
go
      , ssFeeSS :: Coin
ssFeeSS = Coin
epochStateSnapShotsFee
      }
{-# INLINEABLE getSnapShotsWithSharingM #-}

-- Into a Map structure

selectMap ::
  ( MonadResource m
  , Ord k
  , PersistEntity record
  , PersistEntityBackend record ~ SqlBackend
  ) =>
  [Filter record] ->
  (record -> ReaderT SqlBackend m (k, a)) ->
  ReaderT SqlBackend m (Map.Map k a)
selectMap :: forall (m :: * -> *) k record a.
(MonadResource m, Ord k, PersistEntity record,
 PersistEntityBackend record ~ SqlBackend) =>
[Filter record]
-> (record -> ReaderT SqlBackend m (k, a))
-> ReaderT SqlBackend m (Map k a)
selectMap [Filter record]
fs record -> ReaderT SqlBackend m (k, a)
f = do
  forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit forall a b. (a -> b) -> a -> b
$
    forall record backend (m :: * -> *).
(PersistQueryRead backend, MonadResource m,
 PersistRecordBackend record backend, MonadReader backend m) =>
[Filter record]
-> [SelectOpt record] -> ConduitM () (Entity record) m ()
selectSource [Filter record]
fs []
      forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ConduitT a b m ()
mapMC (\(Entity Key record
_ record
a) -> record -> ReaderT SqlBackend m (k, a)
f record
a)
      forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a b o.
Monad m =>
(a -> b -> a) -> a -> ConduitT b o m a
foldlC (\Map k a
m (k
k, a
v) -> forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
k a
v Map k a
m) forall a. Monoid a => a
mempty
{-# INLINEABLE selectMap #-}

getSnapShotNoSharing ::
  MonadResource m =>
  Key EpochState ->
  SnapShotType ->
  ReaderT SqlBackend m EpochBoundary.SnapShot
getSnapShotNoSharing :: forall (m :: * -> *).
MonadResource m =>
EpochStateId -> SnapShotType -> ReaderT SqlBackend m SnapShot
getSnapShotNoSharing EpochStateId
epochStateId SnapShotType
snapShotType = do
  Key SnapShot
snapShotId <-
    forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m (Maybe (Entity record))
selectFirst
      [forall typ. (typ ~ SnapShotType) => EntityField SnapShot typ
SnapShotType forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. SnapShotType
snapShotType, forall typ. (typ ~ EpochStateId) => EntityField SnapShot typ
SnapShotEpochStateId forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. EpochStateId
epochStateId]
      []
      forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
        Maybe (Entity SnapShot)
Nothing -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Missing a snapshot: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show SnapShotType
snapShotType
        Just (Entity Key SnapShot
snapShotId SnapShot
_) -> Key SnapShot
snapShotId
  VMap VB VP (Credential 'Staking) (CompactForm Coin)
stake <-
    forall k record (kv :: * -> *) (vv :: * -> *) v (m :: * -> *).
(Ord k, PersistEntity record,
 PersistEntityBackend record ~ SqlBackend, Vector kv k, Vector vv v,
 MonadResource m) =>
[Filter record]
-> (record -> ReaderT SqlBackend m (k, v))
-> ReaderT SqlBackend m (VMap kv vv k v)
selectVMap [forall typ. (typ ~ Key SnapShot) => EntityField SnapShotStake typ
SnapShotStakeSnapShotId forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key SnapShot
snapShotId] forall a b. (a -> b) -> a -> b
$ \SnapShotStake {CompactForm Coin
CredentialId
Key SnapShot
snapShotStakeCoin :: CompactForm Coin
snapShotStakeCredentialId :: CredentialId
snapShotStakeSnapShotId :: Key SnapShot
snapShotStakeCoin :: SnapShotStake -> CompactForm Coin
snapShotStakeCredentialId :: SnapShotStake -> CredentialId
snapShotStakeSnapShotId :: SnapShotStake -> Key SnapShot
..} -> do
      Credential CredentialWitness
credential <- forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
getJust CredentialId
snapShotStakeCredentialId
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
Keys.coerceKeyRole CredentialWitness
credential, CompactForm Coin
snapShotStakeCoin)
  VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
delegations <-
    forall k record (kv :: * -> *) (vv :: * -> *) v (m :: * -> *).
(Ord k, PersistEntity record,
 PersistEntityBackend record ~ SqlBackend, Vector kv k, Vector vv v,
 MonadResource m) =>
[Filter record]
-> (record -> ReaderT SqlBackend m (k, v))
-> ReaderT SqlBackend m (VMap kv vv k v)
selectVMap [forall typ.
(typ ~ Key SnapShot) =>
EntityField SnapShotDelegation typ
SnapShotDelegationSnapShotId forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key SnapShot
snapShotId] forall a b. (a -> b) -> a -> b
$ \SnapShotDelegation {Key KeyHash
CredentialId
Key SnapShot
snapShotDelegationKeyHash :: Key KeyHash
snapShotDelegationCredentialId :: CredentialId
snapShotDelegationSnapShotId :: Key SnapShot
snapShotDelegationKeyHash :: SnapShotDelegation -> Key KeyHash
snapShotDelegationCredentialId :: SnapShotDelegation -> CredentialId
snapShotDelegationSnapShotId :: SnapShotDelegation -> Key SnapShot
..} -> do
      Credential CredentialWitness
credential <- forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
getJust CredentialId
snapShotDelegationCredentialId
      KeyHash KeyHashWitness
keyHash <- forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
getJust Key KeyHash
snapShotDelegationKeyHash
      -- TODO ^ rename snapShotDelegationKeyHashId
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
Keys.coerceKeyRole CredentialWitness
credential, forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
Keys.coerceKeyRole KeyHashWitness
keyHash)
  VMap VB VB (KeyHash 'StakePool) PoolParams
poolParams <-
    forall k record (kv :: * -> *) (vv :: * -> *) v (m :: * -> *).
(Ord k, PersistEntity record,
 PersistEntityBackend record ~ SqlBackend, Vector kv k, Vector vv v,
 MonadResource m) =>
[Filter record]
-> (record -> ReaderT SqlBackend m (k, v))
-> ReaderT SqlBackend m (VMap kv vv k v)
selectVMap [forall typ. (typ ~ Key SnapShot) => EntityField SnapShotPool typ
SnapShotPoolSnapShotId forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key SnapShot
snapShotId] forall a b. (a -> b) -> a -> b
$ \SnapShotPool {PoolParams
Key KeyHash
Key SnapShot
snapShotPoolParams :: PoolParams
snapShotPoolKeyHashId :: Key KeyHash
snapShotPoolSnapShotId :: Key SnapShot
snapShotPoolParams :: SnapShotPool -> PoolParams
snapShotPoolKeyHashId :: SnapShotPool -> Key KeyHash
snapShotPoolSnapShotId :: SnapShotPool -> Key SnapShot
..} -> do
      KeyHash KeyHashWitness
keyHash <- forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
getJust Key KeyHash
snapShotPoolKeyHashId
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
Keys.coerceKeyRole KeyHashWitness
keyHash, PoolParams
snapShotPoolParams)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    EpochBoundary.SnapShot
      { $sel:ssStake:SnapShot :: Stake
ssStake = VMap VB VP (Credential 'Staking) (CompactForm Coin) -> Stake
EpochBoundary.Stake VMap VB VP (Credential 'Staking) (CompactForm Coin)
stake
      , $sel:ssDelegations:SnapShot :: VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
ssDelegations = VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
delegations
      , $sel:ssPoolParams:SnapShot :: VMap VB VB (KeyHash 'StakePool) PoolParams
ssPoolParams = VMap VB VB (KeyHash 'StakePool) PoolParams
poolParams
      }
{-# INLINEABLE getSnapShotNoSharing #-}

getSnapShotsNoSharing ::
  MonadResource m =>
  Entity EpochState ->
  ReaderT SqlBackend m EpochBoundary.SnapShots
getSnapShotsNoSharing :: forall (m :: * -> *).
MonadResource m =>
Entity EpochState -> ReaderT SqlBackend m SnapShots
getSnapShotsNoSharing (Entity EpochStateId
epochStateId EpochState {Coin
epochStateSnapShotsFee :: Coin
epochStateSnapShotsFee :: EpochState -> Coin
epochStateSnapShotsFee}) = do
  SnapShot
mark <- forall (m :: * -> *).
MonadResource m =>
EpochStateId -> SnapShotType -> ReaderT SqlBackend m SnapShot
getSnapShotNoSharing EpochStateId
epochStateId SnapShotType
SnapShotMark
  SnapShot
set <- forall (m :: * -> *).
MonadResource m =>
EpochStateId -> SnapShotType -> ReaderT SqlBackend m SnapShot
getSnapShotNoSharing EpochStateId
epochStateId SnapShotType
SnapShotSet
  SnapShot
go <- forall (m :: * -> *).
MonadResource m =>
EpochStateId -> SnapShotType -> ReaderT SqlBackend m SnapShot
getSnapShotNoSharing EpochStateId
epochStateId SnapShotType
SnapShotGo
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    EpochBoundary.SnapShots
      { $sel:ssStakeMark:SnapShots :: SnapShot
ssStakeMark = SnapShot
mark
      , $sel:ssStakeMarkPoolDistr:SnapShots :: PoolDistr
ssStakeMarkPoolDistr = SnapShot -> PoolDistr
EpochBoundary.calculatePoolDistr SnapShot
mark
      , $sel:ssStakeSet:SnapShots :: SnapShot
ssStakeSet = SnapShot
set
      , $sel:ssStakeGo:SnapShots :: SnapShot
ssStakeGo = SnapShot
go
      , $sel:ssFee:SnapShots :: Coin
ssFee = Coin
epochStateSnapShotsFee
      }
{-# INLINEABLE getSnapShotsNoSharing #-}

getSnapShotsNoSharingM ::
  MonadResource m =>
  Entity EpochState ->
  ReaderT SqlBackend m SnapShotsM
getSnapShotsNoSharingM :: forall (m :: * -> *).
MonadResource m =>
Entity EpochState -> ReaderT SqlBackend m SnapShotsM
getSnapShotsNoSharingM (Entity EpochStateId
epochStateId EpochState {Coin
epochStateSnapShotsFee :: Coin
epochStateSnapShotsFee :: EpochState -> Coin
epochStateSnapShotsFee}) = do
  SnapShotM
mark <- forall (m :: * -> *).
MonadResource m =>
EpochStateId -> SnapShotType -> ReaderT SqlBackend m SnapShotM
getSnapShotNoSharingM EpochStateId
epochStateId SnapShotType
SnapShotMark
  SnapShotM
set <- forall (m :: * -> *).
MonadResource m =>
EpochStateId -> SnapShotType -> ReaderT SqlBackend m SnapShotM
getSnapShotNoSharingM EpochStateId
epochStateId SnapShotType
SnapShotSet
  SnapShotM
go <- forall (m :: * -> *).
MonadResource m =>
EpochStateId -> SnapShotType -> ReaderT SqlBackend m SnapShotM
getSnapShotNoSharingM EpochStateId
epochStateId SnapShotType
SnapShotGo
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    SnapShotsM
      { ssPstakeMark :: SnapShotM
ssPstakeMark = SnapShotM
mark
      , ssPstakeSet :: SnapShotM
ssPstakeSet = SnapShotM
set
      , ssPstakeGo :: SnapShotM
ssPstakeGo = SnapShotM
go
      , ssFeeSS :: Coin
ssFeeSS = Coin
epochStateSnapShotsFee
      }
{-# INLINEABLE getSnapShotsNoSharingM #-}

getSnapShotWithSharing ::
  MonadResource m =>
  [EpochBoundary.SnapShot] ->
  Key EpochState ->
  SnapShotType ->
  ReaderT SqlBackend m EpochBoundary.SnapShot
getSnapShotWithSharing :: forall (m :: * -> *).
MonadResource m =>
[SnapShot]
-> EpochStateId -> SnapShotType -> ReaderT SqlBackend m SnapShot
getSnapShotWithSharing [SnapShot]
otherSnapShots EpochStateId
epochStateId SnapShotType
snapShotType = do
  let internOtherStakes :: CredentialWitness -> Credential 'Staking
internOtherStakes =
        forall k. Interns k -> k -> k
interns
          (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall k (kv :: * -> *) a. Ord k => VMap VB kv k a -> Interns k
internsFromVMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stake -> VMap VB VP (Credential 'Staking) (CompactForm Coin)
EpochBoundary.unStake forall b c a. (b -> c) -> (a -> b) -> a -> c
. SnapShot -> Stake
EpochBoundary.ssStake) [SnapShot]
otherSnapShots)
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
Keys.coerceKeyRole
  let internOtherPoolParams :: KeyHashWitness -> KeyHash 'StakePool
internOtherPoolParams =
        forall k. Interns k -> k -> k
interns (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall k (kv :: * -> *) a. Ord k => VMap VB kv k a -> Interns k
internsFromVMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. SnapShot -> VMap VB VB (KeyHash 'StakePool) PoolParams
EpochBoundary.ssPoolParams) [SnapShot]
otherSnapShots)
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
Keys.coerceKeyRole
  let internOtherDelegations :: CredentialWitness -> Credential 'Staking
internOtherDelegations =
        forall k. Interns k -> k -> k
interns (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall k (kv :: * -> *) a. Ord k => VMap VB kv k a -> Interns k
internsFromVMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. SnapShot -> VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
EpochBoundary.ssDelegations) [SnapShot]
otherSnapShots)
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
Keys.coerceKeyRole
  Key SnapShot
snapShotId <-
    forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m (Maybe (Entity record))
selectFirst
      [forall typ. (typ ~ SnapShotType) => EntityField SnapShot typ
SnapShotType forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. SnapShotType
snapShotType, forall typ. (typ ~ EpochStateId) => EntityField SnapShot typ
SnapShotEpochStateId forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. EpochStateId
epochStateId]
      []
      forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
        Maybe (Entity SnapShot)
Nothing -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Missing a snapshot: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show SnapShotType
snapShotType
        Just (Entity Key SnapShot
snapShotId SnapShot
_) -> Key SnapShot
snapShotId
  VMap VB VP (Credential 'Staking) (CompactForm Coin)
stake <-
    forall k record (kv :: * -> *) (vv :: * -> *) v (m :: * -> *).
(Ord k, PersistEntity record,
 PersistEntityBackend record ~ SqlBackend, Vector kv k, Vector vv v,
 MonadResource m) =>
[Filter record]
-> (record -> ReaderT SqlBackend m (k, v))
-> ReaderT SqlBackend m (VMap kv vv k v)
selectVMap [forall typ. (typ ~ Key SnapShot) => EntityField SnapShotStake typ
SnapShotStakeSnapShotId forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key SnapShot
snapShotId] forall a b. (a -> b) -> a -> b
$ \SnapShotStake {CompactForm Coin
CredentialId
Key SnapShot
snapShotStakeCoin :: CompactForm Coin
snapShotStakeCredentialId :: CredentialId
snapShotStakeSnapShotId :: Key SnapShot
snapShotStakeCoin :: SnapShotStake -> CompactForm Coin
snapShotStakeCredentialId :: SnapShotStake -> CredentialId
snapShotStakeSnapShotId :: SnapShotStake -> Key SnapShot
..} -> do
      Credential CredentialWitness
credential <- forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
getJust CredentialId
snapShotStakeCredentialId
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (CredentialWitness -> Credential 'Staking
internOtherStakes CredentialWitness
credential, CompactForm Coin
snapShotStakeCoin)
  VMap VB VB (KeyHash 'StakePool) PoolParams
poolParams <-
    forall k record (kv :: * -> *) (vv :: * -> *) v (m :: * -> *).
(Ord k, PersistEntity record,
 PersistEntityBackend record ~ SqlBackend, Vector kv k, Vector vv v,
 MonadResource m) =>
[Filter record]
-> (record -> ReaderT SqlBackend m (k, v))
-> ReaderT SqlBackend m (VMap kv vv k v)
selectVMap [forall typ. (typ ~ Key SnapShot) => EntityField SnapShotPool typ
SnapShotPoolSnapShotId forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key SnapShot
snapShotId] forall a b. (a -> b) -> a -> b
$ \SnapShotPool {PoolParams
Key KeyHash
Key SnapShot
snapShotPoolParams :: PoolParams
snapShotPoolKeyHashId :: Key KeyHash
snapShotPoolSnapShotId :: Key SnapShot
snapShotPoolParams :: SnapShotPool -> PoolParams
snapShotPoolKeyHashId :: SnapShotPool -> Key KeyHash
snapShotPoolSnapShotId :: SnapShotPool -> Key SnapShot
..} -> do
      KeyHash KeyHashWitness
keyHash <- forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
getJust Key KeyHash
snapShotPoolKeyHashId
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (KeyHashWitness -> KeyHash 'StakePool
internOtherPoolParams KeyHashWitness
keyHash, PoolParams
snapShotPoolParams)
  let internPoolParams :: KeyHashWitness -> KeyHash 'StakePool
internPoolParams = forall k. Interns k -> k -> k
interns (forall k (kv :: * -> *) a. Ord k => VMap VB kv k a -> Interns k
internsFromVMap VMap VB VB (KeyHash 'StakePool) PoolParams
poolParams) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
Keys.coerceKeyRole
  VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
delegations <-
    forall k record (kv :: * -> *) (vv :: * -> *) v (m :: * -> *).
(Ord k, PersistEntity record,
 PersistEntityBackend record ~ SqlBackend, Vector kv k, Vector vv v,
 MonadResource m) =>
[Filter record]
-> (record -> ReaderT SqlBackend m (k, v))
-> ReaderT SqlBackend m (VMap kv vv k v)
selectVMap [forall typ.
(typ ~ Key SnapShot) =>
EntityField SnapShotDelegation typ
SnapShotDelegationSnapShotId forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key SnapShot
snapShotId] forall a b. (a -> b) -> a -> b
$ \SnapShotDelegation {Key KeyHash
CredentialId
Key SnapShot
snapShotDelegationKeyHash :: Key KeyHash
snapShotDelegationCredentialId :: CredentialId
snapShotDelegationSnapShotId :: Key SnapShot
snapShotDelegationKeyHash :: SnapShotDelegation -> Key KeyHash
snapShotDelegationCredentialId :: SnapShotDelegation -> CredentialId
snapShotDelegationSnapShotId :: SnapShotDelegation -> Key SnapShot
..} -> do
      Credential CredentialWitness
credential <- forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
getJust CredentialId
snapShotDelegationCredentialId
      KeyHash KeyHashWitness
keyHash <- forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
getJust Key KeyHash
snapShotDelegationKeyHash
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (CredentialWitness -> Credential 'Staking
internOtherDelegations CredentialWitness
credential, KeyHashWitness -> KeyHash 'StakePool
internPoolParams KeyHashWitness
keyHash)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    EpochBoundary.SnapShot
      { $sel:ssStake:SnapShot :: Stake
ssStake = VMap VB VP (Credential 'Staking) (CompactForm Coin) -> Stake
EpochBoundary.Stake VMap VB VP (Credential 'Staking) (CompactForm Coin)
stake
      , $sel:ssDelegations:SnapShot :: VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
ssDelegations = VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
delegations
      , $sel:ssPoolParams:SnapShot :: VMap VB VB (KeyHash 'StakePool) PoolParams
ssPoolParams = VMap VB VB (KeyHash 'StakePool) PoolParams
poolParams
      }
{-# INLINEABLE getSnapShotWithSharing #-}

getSnapShotsWithSharing ::
  MonadResource m =>
  Entity EpochState ->
  ReaderT SqlBackend m EpochBoundary.SnapShots
getSnapShotsWithSharing :: forall (m :: * -> *).
MonadResource m =>
Entity EpochState -> ReaderT SqlBackend m SnapShots
getSnapShotsWithSharing (Entity EpochStateId
epochStateId EpochState {Coin
epochStateSnapShotsFee :: Coin
epochStateSnapShotsFee :: EpochState -> Coin
epochStateSnapShotsFee}) = do
  SnapShot
mark <- forall (m :: * -> *).
MonadResource m =>
[SnapShot]
-> EpochStateId -> SnapShotType -> ReaderT SqlBackend m SnapShot
getSnapShotWithSharing [] EpochStateId
epochStateId SnapShotType
SnapShotMark
  SnapShot
set <- forall (m :: * -> *).
MonadResource m =>
[SnapShot]
-> EpochStateId -> SnapShotType -> ReaderT SqlBackend m SnapShot
getSnapShotWithSharing [SnapShot
mark] EpochStateId
epochStateId SnapShotType
SnapShotSet
  SnapShot
go <- forall (m :: * -> *).
MonadResource m =>
[SnapShot]
-> EpochStateId -> SnapShotType -> ReaderT SqlBackend m SnapShot
getSnapShotWithSharing [SnapShot
mark, SnapShot
set] EpochStateId
epochStateId SnapShotType
SnapShotGo
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    EpochBoundary.SnapShots
      { $sel:ssStakeMark:SnapShots :: SnapShot
ssStakeMark = SnapShot
mark
      , $sel:ssStakeMarkPoolDistr:SnapShots :: PoolDistr
ssStakeMarkPoolDistr = SnapShot -> PoolDistr
EpochBoundary.calculatePoolDistr SnapShot
mark
      , $sel:ssStakeSet:SnapShots :: SnapShot
ssStakeSet = SnapShot
set
      , $sel:ssStakeGo:SnapShots :: SnapShot
ssStakeGo = SnapShot
go
      , $sel:ssFee:SnapShots :: Coin
ssFee = Coin
epochStateSnapShotsFee
      }
{-# INLINEABLE getSnapShotsWithSharing #-}

sourceUTxO ::
  MonadResource m =>
  ConduitM () (TxIn.TxIn, TxOut CurrentEra) (ReaderT SqlBackend m) ()
sourceUTxO :: forall (m :: * -> *).
MonadResource m =>
ConduitM () (TxIn, TxOut CurrentEra) (ReaderT SqlBackend m) ()
sourceUTxO =
  forall record backend (m :: * -> *).
(PersistQueryRead backend, MonadResource m,
 PersistRecordBackend record backend, MonadReader backend m) =>
[Filter record]
-> [SelectOpt record] -> ConduitM () (Entity record) m ()
selectSource [] []
    forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC (\(Entity Key Tx
_ Tx {BabbageTxOut CurrentEra
TxId
TxIx
txOut :: BabbageTxOut CurrentEra
txInId :: TxId
txInIx :: TxIx
txOut :: Tx -> BabbageTxOut CurrentEra
txInId :: Tx -> TxId
txInIx :: Tx -> TxIx
..}) -> (TxId -> TxIx -> TxIn
TxIn.TxIn TxId
txInId TxIx
txInIx, BabbageTxOut CurrentEra
txOut))

sourceWithSharingUTxO ::
  MonadResource m =>
  Map.Map Credential.StakeCredential a ->
  ConduitM () (TxIn.TxIn, TxOut CurrentEra) (ReaderT SqlBackend m) ()
sourceWithSharingUTxO :: forall (m :: * -> *) a.
MonadResource m =>
Map (Credential 'Staking) a
-> ConduitM () (TxIn, TxOut CurrentEra) (ReaderT SqlBackend m) ()
sourceWithSharingUTxO Map (Credential 'Staking) a
stakeCredentials =
  forall (m :: * -> *).
MonadResource m =>
ConduitM () (TxIn, TxOut CurrentEra) (ReaderT SqlBackend m) ()
sourceUTxO forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall era.
(Credential 'Staking -> Credential 'Staking)
-> BabbageTxOut era -> BabbageTxOut era
internBabbageTxOut (forall k a. Ord k => k -> Map k a -> k
`intern` Map (Credential 'Staking) a
stakeCredentials)))

foldDbUTxO ::
  MonadUnliftIO m =>
  -- | Folding function
  (a -> (TxIn.TxIn, TxOut CurrentEra) -> a) ->
  -- | Empty acc
  a ->
  -- | Path to Sqlite db
  T.Text ->
  m a
foldDbUTxO :: forall (m :: * -> *) a.
MonadUnliftIO m =>
(a -> (TxIn, TxOut CurrentEra) -> a) -> a -> Text -> m a
foldDbUTxO a -> (TxIn, TxOut CurrentEra) -> a
f a
m Text
fp = forall (m :: * -> *) a.
MonadUnliftIO m =>
Text -> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a -> m a
runSqlite Text
fp (forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (forall (m :: * -> *).
MonadResource m =>
ConduitM () (TxIn, TxOut CurrentEra) (ReaderT SqlBackend m) ()
sourceUTxO forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a b o.
Monad m =>
(a -> b -> a) -> a -> ConduitT b o m a
foldlC a -> (TxIn, TxOut CurrentEra) -> a
f a
m))

-- sourceUTxOr ::
--      MonadResource m
--   => Int64 -> Int64 -> ConduitM () (TxIn.TxIn C, TxOut CurrentEra) (ReaderT SqlBackend m) ()
-- sourceUTxOr b t =
--   selectSource [TxId >. TxKey (SqlBackendKey b) , TxId <. TxKey (SqlBackendKey t)] [] .|
--   mapC (\(Entity _ Tx {..}) -> (TxIn.TxIn txInId (fromIntegral txInIx), txOut))

-- foldDbUTxOr ::
--      MonadUnliftIO m
--   => Int64
--   -> Int64
--   -> (a -> (TxIn.TxIn C, TxOut CurrentEra) -> a) -- ^ Folding function
--   -> a -- ^ Empty acc
--   -> T.Text -- ^ Path to Sqlite db
--   -> m a
-- foldDbUTxOr b t f m fp = runSqlite fp (runConduit (sourceUTxOr b t .| foldlC f m))

lsId :: Key LedgerState
lsId :: Key LedgerState
lsId = BackendKey SqlBackend -> Key LedgerState
LedgerStateKey (Int64 -> BackendKey SqlBackend
SqlBackendKey Int64
1)

getLedgerState ::
  MonadIO m =>
  Shelley.UTxO CurrentEra ->
  LedgerState ->
  Shelley.DState CurrentEra ->
  ReaderT SqlBackend m (Shelley.LedgerState CurrentEra)
getLedgerState :: forall (m :: * -> *).
MonadIO m =>
UTxO CurrentEra
-> LedgerState
-> DState CurrentEra
-> ReaderT SqlBackend m (LedgerState CurrentEra)
getLedgerState UTxO CurrentEra
utxo LedgerState {PState CurrentEra
DStateId
Key UtxoState
EpochStateId
ledgerStatePstateBin :: PState CurrentEra
ledgerStateEpochStateId :: EpochStateId
ledgerStateDstateId :: DStateId
ledgerStateUtxoId :: Key UtxoState
ledgerStateEpochStateId :: LedgerState -> EpochStateId
ledgerStatePstateBin :: LedgerState -> PState CurrentEra
ledgerStateDstateId :: LedgerState -> DStateId
ledgerStateUtxoId :: LedgerState -> Key UtxoState
..} DState CurrentEra
dstate = do
  UtxoState {ShelleyGovState CurrentEra
Coin
utxoStateDonation :: Coin
utxoStatePpups :: ShelleyGovState CurrentEra
utxoStateFees :: Coin
utxoStateDeposited :: Coin
utxoStateDonation :: UtxoState -> Coin
utxoStatePpups :: UtxoState -> ShelleyGovState CurrentEra
utxoStateFees :: UtxoState -> Coin
utxoStateDeposited :: UtxoState -> Coin
..} <- forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
getJust Key UtxoState
ledgerStateUtxoId
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Shelley.LedgerState
      { lsUTxOState :: UTxOState CurrentEra
Shelley.lsUTxOState =
          forall era.
EraTxOut era =>
PParams era
-> UTxO era
-> Coin
-> Coin
-> GovState era
-> Coin
-> UTxOState era
Shelley.smartUTxOState
            forall era. EraPParams era => PParams era
emptyPParams
            UTxO CurrentEra
utxo
            Coin
utxoStateDeposited
            Coin
utxoStateFees
            ShelleyGovState CurrentEra
utxoStatePpups -- Maintain invariant
            Coin
utxoStateDonation
      , lsCertState :: CertState CurrentEra
Shelley.lsCertState =
          Shelley.CertState
            { certDState :: DState CurrentEra
Shelley.certDState = DState CurrentEra
dstate
            , certPState :: PState CurrentEra
Shelley.certPState = PState CurrentEra
ledgerStatePstateBin
            , certVState :: VState CurrentEra
Shelley.certVState = forall a. Default a => a
def
            }
      }

getDStateNoSharing ::
  MonadIO m => Key DState -> ReaderT SqlBackend m (Shelley.DState CurrentEra)
getDStateNoSharing :: forall (m :: * -> *).
MonadIO m =>
DStateId -> ReaderT SqlBackend m (DState CurrentEra)
getDStateNoSharing DStateId
dstateId = do
  DState {DeltaCoin
GenDelegs
FGenDelegs
dStateIrDeltaTreasury :: DState -> DeltaCoin
dStateIrDeltaReserves :: DState -> DeltaCoin
dStateGenDelegs :: DState -> GenDelegs
dStateFGenDelegs :: DState -> FGenDelegs
dStateIrDeltaTreasury :: DeltaCoin
dStateIrDeltaReserves :: DeltaCoin
dStateGenDelegs :: GenDelegs
dStateFGenDelegs :: FGenDelegs
..} <- forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
getJust DStateId
dstateId
  Map (Credential 'Staking) RDPair
rewards <-
    forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
      [Entity Reward]
rws <- forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [forall typ. (typ ~ DStateId) => EntityField Reward typ
RewardDstateId forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. DStateId
dstateId] []
      forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Entity Reward]
rws forall a b. (a -> b) -> a -> b
$ \(Entity Key Reward
_ Reward {Coin
CredentialId
DStateId
rewardCoin :: Reward -> Coin
rewardCredentialId :: Reward -> CredentialId
rewardDstateId :: Reward -> DStateId
rewardCoin :: Coin
rewardCredentialId :: CredentialId
rewardDstateId :: DStateId
..}) -> do
        Credential CredentialWitness
credential <- forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
getJust CredentialId
rewardCredentialId
        forall (f :: * -> *) a. Applicative f => a -> f a
pure
          (forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
Keys.coerceKeyRole CredentialWitness
credential, CompactForm Coin -> CompactForm Coin -> RDPair
UM.RDPair (HasCallStack => Coin -> CompactForm Coin
UM.compactCoinOrError Coin
rewardCoin) (Word64 -> CompactForm Coin
UM.CompactCoin Word64
0))
  -- FIXME the deposit is not accounted for ^
  -- The PR ts-keydeposit-intoUMap breaks this tool since it changes the CertState data type.
  -- https://github.com/intersectmbo/cardano-ledger/pull/3217
  -- All the FIXME-s in this file will have to be addressed in a follow on PR
  Map (Credential 'Staking) (KeyHash 'StakePool)
delegations <-
    forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
      [Entity Delegation]
ds <- forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [forall typ. (typ ~ DStateId) => EntityField Delegation typ
DelegationDstateId forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. DStateId
dstateId] []
      forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Entity Delegation]
ds forall a b. (a -> b) -> a -> b
$ \(Entity Key Delegation
_ Delegation {Key KeyHash
CredentialId
DStateId
delegationStakePoolId :: Delegation -> Key KeyHash
delegationCredentialId :: Delegation -> CredentialId
delegationDstateId :: Delegation -> DStateId
delegationStakePoolId :: Key KeyHash
delegationCredentialId :: CredentialId
delegationDstateId :: DStateId
..}) -> do
        Credential CredentialWitness
credential <- forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
getJust CredentialId
delegationCredentialId
        KeyHash KeyHashWitness
keyHash <- forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
getJust Key KeyHash
delegationStakePoolId
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
Keys.coerceKeyRole CredentialWitness
credential, forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
Keys.coerceKeyRole KeyHashWitness
keyHash)
  Map (Credential 'Staking) DRep
dreps <- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
  -- Map.fromList <$> do
  --  ds <- selectList [DRepDstateId ==. dstateId] []
  --  forM ds $ \(Entity _ DRep {..}) -> do
  --    Credential credential <- getJust dRepCredentialId
  --    Credential dRepCredential <- getJust dRepDRepCredentialId
  --    pure (Keys.coerceKeyRole credential, Keys.coerceKeyRole dRepCredential)
  Map Ptr (Credential 'Staking)
ptrs <-
    forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
      [Entity Ptr]
ps <- forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [forall typ. (typ ~ DStateId) => EntityField Ptr typ
PtrDstateId forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. DStateId
dstateId] []
      forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Entity Ptr]
ps forall a b. (a -> b) -> a -> b
$ \(Entity Key Ptr
_ Ptr {Ptr
CredentialId
DStateId
ptrPtr :: Ptr -> Ptr
ptrCredentialId :: Ptr -> CredentialId
ptrDstateId :: Ptr -> DStateId
ptrPtr :: Ptr
ptrCredentialId :: CredentialId
ptrDstateId :: DStateId
..}) -> do
        Credential CredentialWitness
credential <- forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
getJust CredentialId
ptrCredentialId
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr
ptrPtr, forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
Keys.coerceKeyRole CredentialWitness
credential)
  Map (Credential 'Staking) Coin
iRReserves <-
    forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
      [Entity IRReserves]
ds <- forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [forall typ. (typ ~ DStateId) => EntityField IRReserves typ
IRReservesDstateId forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. DStateId
dstateId] []
      forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Entity IRReserves]
ds forall a b. (a -> b) -> a -> b
$ \(Entity Key IRReserves
_ IRReserves {Coin
CredentialId
DStateId
iRReservesCoin :: IRReserves -> Coin
iRReservesCredentialId :: IRReserves -> CredentialId
iRReservesDstateId :: IRReserves -> DStateId
iRReservesCoin :: Coin
iRReservesCredentialId :: CredentialId
iRReservesDstateId :: DStateId
..}) -> do
        Credential CredentialWitness
credential <- forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
getJust CredentialId
iRReservesCredentialId
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
Keys.coerceKeyRole CredentialWitness
credential, Coin
iRReservesCoin)
  Map (Credential 'Staking) Coin
iRTreasury <-
    forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
      [Entity IRTreasury]
ds <- forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [forall typ. (typ ~ DStateId) => EntityField IRTreasury typ
IRTreasuryDstateId forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. DStateId
dstateId] []
      forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Entity IRTreasury]
ds forall a b. (a -> b) -> a -> b
$ \(Entity Key IRTreasury
_ IRTreasury {Coin
CredentialId
DStateId
iRTreasuryCoin :: IRTreasury -> Coin
iRTreasuryCredentialId :: IRTreasury -> CredentialId
iRTreasuryDstateId :: IRTreasury -> DStateId
iRTreasuryCoin :: Coin
iRTreasuryCredentialId :: CredentialId
iRTreasuryDstateId :: DStateId
..}) -> do
        Credential CredentialWitness
credential <- forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
getJust CredentialId
iRTreasuryCredentialId
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
Keys.coerceKeyRole CredentialWitness
credential, Coin
iRTreasuryCoin)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Shelley.DState
      { dsUnified :: UMap
dsUnified = Map (Credential 'Staking) RDPair
-> Map Ptr (Credential 'Staking)
-> Map (Credential 'Staking) (KeyHash 'StakePool)
-> Map (Credential 'Staking) DRep
-> UMap
unify Map (Credential 'Staking) RDPair
rewards Map Ptr (Credential 'Staking)
ptrs Map (Credential 'Staking) (KeyHash 'StakePool)
delegations Map (Credential 'Staking) DRep
dreps
      , dsFutureGenDelegs :: Map FutureGenDeleg GenDelegPair
dsFutureGenDelegs = forall a. Enc a -> a
unEnc FGenDelegs
dStateFGenDelegs
      , dsGenDelegs :: GenDelegs
dsGenDelegs = GenDelegs
dStateGenDelegs
      , dsIRewards :: InstantaneousRewards
dsIRewards =
          Shelley.InstantaneousRewards
            { iRReserves :: Map (Credential 'Staking) Coin
iRReserves = Map (Credential 'Staking) Coin
iRReserves
            , iRTreasury :: Map (Credential 'Staking) Coin
iRTreasury = Map (Credential 'Staking) Coin
iRTreasury
            , deltaReserves :: DeltaCoin
deltaReserves = DeltaCoin
dStateIrDeltaReserves
            , deltaTreasury :: DeltaCoin
deltaTreasury = DeltaCoin
dStateIrDeltaTreasury
            }
      }

getDStateWithSharing ::
  MonadIO m => Key DState -> ReaderT SqlBackend m (Shelley.DState CurrentEra)
getDStateWithSharing :: forall (m :: * -> *).
MonadIO m =>
DStateId -> ReaderT SqlBackend m (DState CurrentEra)
getDStateWithSharing DStateId
dstateId = do
  DState {DeltaCoin
GenDelegs
FGenDelegs
dStateIrDeltaTreasury :: DeltaCoin
dStateIrDeltaReserves :: DeltaCoin
dStateGenDelegs :: GenDelegs
dStateFGenDelegs :: FGenDelegs
dStateIrDeltaTreasury :: DState -> DeltaCoin
dStateIrDeltaReserves :: DState -> DeltaCoin
dStateGenDelegs :: DState -> GenDelegs
dStateFGenDelegs :: DState -> FGenDelegs
..} <- forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
getJust DStateId
dstateId
  Map (Credential 'Staking) RDPair
rewards <-
    forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
      [Entity Reward]
rws <- forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [forall typ. (typ ~ DStateId) => EntityField Reward typ
RewardDstateId forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. DStateId
dstateId] []
      forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Entity Reward]
rws forall a b. (a -> b) -> a -> b
$ \(Entity Key Reward
_ Reward {Coin
CredentialId
DStateId
rewardCoin :: Coin
rewardCredentialId :: CredentialId
rewardDstateId :: DStateId
rewardCoin :: Reward -> Coin
rewardCredentialId :: Reward -> CredentialId
rewardDstateId :: Reward -> DStateId
..}) -> do
        Credential CredentialWitness
credential <- forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
getJust CredentialId
rewardCredentialId
        forall (f :: * -> *) a. Applicative f => a -> f a
pure
          (forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
Keys.coerceKeyRole CredentialWitness
credential, CompactForm Coin -> CompactForm Coin -> RDPair
UM.RDPair (HasCallStack => Coin -> CompactForm Coin
UM.compactCoinOrError Coin
rewardCoin) (Word64 -> CompactForm Coin
UM.CompactCoin Word64
0))
  -- FIXME the deposit is not accounted for ^
  Map (Credential 'Staking) (KeyHash 'StakePool)
delegations <-
    forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
      [Entity Delegation]
ds <- forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [forall typ. (typ ~ DStateId) => EntityField Delegation typ
DelegationDstateId forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. DStateId
dstateId] []
      forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Entity Delegation]
ds forall a b. (a -> b) -> a -> b
$ \(Entity Key Delegation
_ Delegation {Key KeyHash
CredentialId
DStateId
delegationStakePoolId :: Key KeyHash
delegationCredentialId :: CredentialId
delegationDstateId :: DStateId
delegationStakePoolId :: Delegation -> Key KeyHash
delegationCredentialId :: Delegation -> CredentialId
delegationDstateId :: Delegation -> DStateId
..}) -> do
        Credential CredentialWitness
credential <- forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
getJust CredentialId
delegationCredentialId
        let !cred :: Credential 'Staking
cred = forall k a. Ord k => k -> Map k a -> k
intern (forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
Keys.coerceKeyRole CredentialWitness
credential) Map (Credential 'Staking) RDPair
rewards
        KeyHash KeyHashWitness
keyHash <- forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
getJust Key KeyHash
delegationStakePoolId
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Credential 'Staking
cred, forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
Keys.coerceKeyRole KeyHashWitness
keyHash)
  Map (Credential 'Staking) DRep
dreps <- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
  -- Map.fromList <$> do
  --  ds <- selectList [DRepDstateId ==. dstateId] []
  --  forM ds $ \(Entity _ DRep {..}) -> do
  --    Credential credential <- getJust dRepCredentialId
  --    let !cred = intern (Keys.coerceKeyRole credential) rewards
  --    Credential dRepCredential <- getJust dRepDRepCredentialId
  --    pure (cred, Keys.coerceKeyRole dRepCredential)
  Map Ptr (Credential 'Staking)
ptrs <-
    forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
      [Entity Ptr]
ps <- forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [forall typ. (typ ~ DStateId) => EntityField Ptr typ
PtrDstateId forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. DStateId
dstateId] []
      forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Entity Ptr]
ps forall a b. (a -> b) -> a -> b
$ \(Entity Key Ptr
_ Ptr {Ptr
CredentialId
DStateId
ptrPtr :: Ptr
ptrCredentialId :: CredentialId
ptrDstateId :: DStateId
ptrPtr :: Ptr -> Ptr
ptrCredentialId :: Ptr -> CredentialId
ptrDstateId :: Ptr -> DStateId
..}) -> do
        Credential CredentialWitness
credential <- forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
getJust CredentialId
ptrCredentialId
        let !cred :: Credential 'Staking
cred = forall k a. Ord k => k -> Map k a -> k
intern (forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
Keys.coerceKeyRole CredentialWitness
credential) Map (Credential 'Staking) RDPair
rewards
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr
ptrPtr, Credential 'Staking
cred)
  Map (Credential 'Staking) Coin
iRReserves <-
    forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
      [Entity IRReserves]
ds <- forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [forall typ. (typ ~ DStateId) => EntityField IRReserves typ
IRReservesDstateId forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. DStateId
dstateId] []
      forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Entity IRReserves]
ds forall a b. (a -> b) -> a -> b
$ \(Entity Key IRReserves
_ IRReserves {Coin
CredentialId
DStateId
iRReservesCoin :: Coin
iRReservesCredentialId :: CredentialId
iRReservesDstateId :: DStateId
iRReservesCoin :: IRReserves -> Coin
iRReservesCredentialId :: IRReserves -> CredentialId
iRReservesDstateId :: IRReserves -> DStateId
..}) -> do
        Credential CredentialWitness
credential <- forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
getJust CredentialId
iRReservesCredentialId
        let !cred :: Credential 'Staking
cred = forall k a. Ord k => k -> Map k a -> k
intern (forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
Keys.coerceKeyRole CredentialWitness
credential) Map (Credential 'Staking) RDPair
rewards
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Credential 'Staking
cred, Coin
iRReservesCoin)
  Map (Credential 'Staking) Coin
iRTreasury <-
    forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
      [Entity IRTreasury]
ds <- forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [forall typ. (typ ~ DStateId) => EntityField IRTreasury typ
IRTreasuryDstateId forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. DStateId
dstateId] []
      forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Entity IRTreasury]
ds forall a b. (a -> b) -> a -> b
$ \(Entity Key IRTreasury
_ IRTreasury {Coin
CredentialId
DStateId
iRTreasuryCoin :: Coin
iRTreasuryCredentialId :: CredentialId
iRTreasuryDstateId :: DStateId
iRTreasuryCoin :: IRTreasury -> Coin
iRTreasuryCredentialId :: IRTreasury -> CredentialId
iRTreasuryDstateId :: IRTreasury -> DStateId
..}) -> do
        Credential CredentialWitness
credential <- forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
getJust CredentialId
iRTreasuryCredentialId
        let !cred :: Credential 'Staking
cred = forall k a. Ord k => k -> Map k a -> k
intern (forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
Keys.coerceKeyRole CredentialWitness
credential) Map (Credential 'Staking) RDPair
rewards
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Credential 'Staking
cred, Coin
iRTreasuryCoin)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Shelley.DState
      { dsUnified :: UMap
dsUnified = Map (Credential 'Staking) RDPair
-> Map Ptr (Credential 'Staking)
-> Map (Credential 'Staking) (KeyHash 'StakePool)
-> Map (Credential 'Staking) DRep
-> UMap
unify Map (Credential 'Staking) RDPair
rewards Map Ptr (Credential 'Staking)
ptrs Map (Credential 'Staking) (KeyHash 'StakePool)
delegations Map (Credential 'Staking) DRep
dreps
      , dsFutureGenDelegs :: Map FutureGenDeleg GenDelegPair
dsFutureGenDelegs = forall a. Enc a -> a
unEnc FGenDelegs
dStateFGenDelegs
      , dsGenDelegs :: GenDelegs
dsGenDelegs = GenDelegs
dStateGenDelegs
      , dsIRewards :: InstantaneousRewards
dsIRewards =
          Shelley.InstantaneousRewards
            { iRReserves :: Map (Credential 'Staking) Coin
iRReserves = Map (Credential 'Staking) Coin
iRReserves
            , iRTreasury :: Map (Credential 'Staking) Coin
iRTreasury = Map (Credential 'Staking) Coin
iRTreasury
            , deltaReserves :: DeltaCoin
deltaReserves = DeltaCoin
dStateIrDeltaReserves
            , deltaTreasury :: DeltaCoin
deltaTreasury = DeltaCoin
dStateIrDeltaTreasury
            }
      }

loadDStateNoSharing :: MonadUnliftIO m => T.Text -> m (Shelley.DState CurrentEra)
loadDStateNoSharing :: forall (m :: * -> *).
MonadUnliftIO m =>
Text -> m (DState CurrentEra)
loadDStateNoSharing Text
fp =
  forall (m :: * -> *) a.
MonadUnliftIO m =>
Text -> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a -> m a
runSqlite Text
fp forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
DStateId -> ReaderT SqlBackend m (DState CurrentEra)
getDStateNoSharing (BackendKey SqlBackend -> DStateId
DStateKey (Int64 -> BackendKey SqlBackend
SqlBackendKey Int64
1))

loadUTxONoSharing ::
  MonadUnliftIO m => T.Text -> m (Shelley.UTxO CurrentEra)
loadUTxONoSharing :: forall (m :: * -> *).
MonadUnliftIO m =>
Text -> m (UTxO CurrentEra)
loadUTxONoSharing Text
fp =
  forall (m :: * -> *) a.
MonadUnliftIO m =>
Text -> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a -> m a
runSqlite Text
fp (forall era. Map TxIn (TxOut era) -> UTxO era
Shelley.UTxO forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b.
Monad m =>
ConduitT () a m () -> Fold a b -> m b
runConduitFold forall (m :: * -> *).
MonadResource m =>
ConduitM () (TxIn, TxOut CurrentEra) (ReaderT SqlBackend m) ()
sourceUTxO forall a. Fold (TxIn, a) (Map TxIn a)
noSharingMap)

loadLedgerStateNoSharing ::
  MonadUnliftIO m => T.Text -> m (Shelley.LedgerState CurrentEra)
loadLedgerStateNoSharing :: forall (m :: * -> *).
MonadUnliftIO m =>
Text -> m (LedgerState CurrentEra)
loadLedgerStateNoSharing Text
fp =
  forall (m :: * -> *) a.
MonadUnliftIO m =>
Text -> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a -> m a
runSqlite Text
fp forall a b. (a -> b) -> a -> b
$ do
    ledgerState :: LedgerState
ledgerState@LedgerState {PState CurrentEra
DStateId
Key UtxoState
EpochStateId
ledgerStatePstateBin :: PState CurrentEra
ledgerStateEpochStateId :: EpochStateId
ledgerStateDstateId :: DStateId
ledgerStateUtxoId :: Key UtxoState
ledgerStateEpochStateId :: LedgerState -> EpochStateId
ledgerStatePstateBin :: LedgerState -> PState CurrentEra
ledgerStateDstateId :: LedgerState -> DStateId
ledgerStateUtxoId :: LedgerState -> Key UtxoState
..} <- forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
getJust Key LedgerState
lsId
    DState CurrentEra
dstate <- forall (m :: * -> *).
MonadIO m =>
DStateId -> ReaderT SqlBackend m (DState CurrentEra)
getDStateNoSharing DStateId
ledgerStateDstateId
    Map TxIn (BabbageTxOut CurrentEra)
m <- forall (m :: * -> *) a b.
Monad m =>
ConduitT () a m () -> Fold a b -> m b
runConduitFold forall (m :: * -> *).
MonadResource m =>
ConduitM () (TxIn, TxOut CurrentEra) (ReaderT SqlBackend m) ()
sourceUTxO forall a. Fold (TxIn, a) (Map TxIn a)
noSharingMap
    forall (m :: * -> *).
MonadIO m =>
UTxO CurrentEra
-> LedgerState
-> DState CurrentEra
-> ReaderT SqlBackend m (LedgerState CurrentEra)
getLedgerState (forall era. Map TxIn (TxOut era) -> UTxO era
Shelley.UTxO Map TxIn (BabbageTxOut CurrentEra)
m) LedgerState
ledgerState DState CurrentEra
dstate

loadLedgerStateDStateSharing ::
  MonadUnliftIO m => T.Text -> m (Shelley.LedgerState CurrentEra)
loadLedgerStateDStateSharing :: forall (m :: * -> *).
MonadUnliftIO m =>
Text -> m (LedgerState CurrentEra)
loadLedgerStateDStateSharing Text
fp =
  forall (m :: * -> *) a.
MonadUnliftIO m =>
Text -> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a -> m a
runSqlite Text
fp forall a b. (a -> b) -> a -> b
$ do
    Entity EpochState
ese <- forall record backend (m :: * -> *).
(PersistEntityBackend record ~ BaseBackend backend, MonadIO m,
 PersistEntity record, PersistStoreRead backend) =>
Key record -> ReaderT backend m (Entity record)
getJustEntity EpochStateId
esId
    forall (m :: * -> *).
(MonadUnliftIO m, MonadResource m) =>
Entity EpochState -> ReaderT SqlBackend m (LedgerState CurrentEra)
getLedgerStateWithSharing Entity EpochState
ese

loadLedgerStateDStateTxIxSharing ::
  MonadUnliftIO m =>
  T.Text ->
  m
    ( Shelley.LedgerState CurrentEra
    , IntMap.IntMap (Map.Map TxIn.TxId (TxOut CurrentEra))
    )
loadLedgerStateDStateTxIxSharing :: forall (m :: * -> *).
MonadUnliftIO m =>
Text
-> m (LedgerState CurrentEra, IntMap (Map TxId (TxOut CurrentEra)))
loadLedgerStateDStateTxIxSharing Text
fp =
  forall (m :: * -> *) a.
MonadUnliftIO m =>
Text -> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a -> m a
runSqlite Text
fp forall a b. (a -> b) -> a -> b
$ do
    ledgerState :: LedgerState
ledgerState@LedgerState {PState CurrentEra
DStateId
Key UtxoState
EpochStateId
ledgerStatePstateBin :: PState CurrentEra
ledgerStateEpochStateId :: EpochStateId
ledgerStateDstateId :: DStateId
ledgerStateUtxoId :: Key UtxoState
ledgerStateEpochStateId :: LedgerState -> EpochStateId
ledgerStatePstateBin :: LedgerState -> PState CurrentEra
ledgerStateDstateId :: LedgerState -> DStateId
ledgerStateUtxoId :: LedgerState -> Key UtxoState
..} <- forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
getJust Key LedgerState
lsId
    DState CurrentEra
dstate <- forall (m :: * -> *).
MonadIO m =>
DStateId -> ReaderT SqlBackend m (DState CurrentEra)
getDStateWithSharing DStateId
ledgerStateDstateId
    LedgerState CurrentEra
ls <- forall (m :: * -> *).
MonadIO m =>
UTxO CurrentEra
-> LedgerState
-> DState CurrentEra
-> ReaderT SqlBackend m (LedgerState CurrentEra)
getLedgerState (forall era. Map TxIn (TxOut era) -> UTxO era
Shelley.UTxO forall a. Monoid a => a
mempty) LedgerState
ledgerState DState CurrentEra
dstate
    IntMap (Map TxId (BabbageTxOut CurrentEra))
m <- forall (m :: * -> *) a b.
Monad m =>
ConduitT () a m () -> Fold a b -> m b
runConduitFold forall (m :: * -> *).
MonadResource m =>
ConduitM () (TxIn, TxOut CurrentEra) (ReaderT SqlBackend m) ()
sourceUTxO forall a. Fold (TxIn, a) (IntMap (Map TxId a))
txIxSharing
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (LedgerState CurrentEra
ls, IntMap (Map TxId (BabbageTxOut CurrentEra))
m)

storeEpochState ::
  MonadUnliftIO m => T.Text -> Shelley.EpochState CurrentEra -> m ()
storeEpochState :: forall (m :: * -> *).
MonadUnliftIO m =>
Text -> EpochState CurrentEra -> m ()
storeEpochState Text
fp EpochState CurrentEra
es =
  forall (m :: * -> *) a.
MonadUnliftIO m =>
Text -> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a -> m a
runSqlite Text
fp forall a b. (a -> b) -> a -> b
$ do
    forall (m :: * -> *).
MonadIO m =>
Migration -> ReaderT SqlBackend m ()
runMigration Migration
migrateAll
    forall (m :: * -> *).
MonadIO m =>
EpochState CurrentEra -> ReaderT SqlBackend m ()
insertEpochState EpochState CurrentEra
es

loadDbUTxO :: UTxOFold a -> T.Text -> IO a
loadDbUTxO :: forall a. UTxOFold a -> Text -> IO a
loadDbUTxO (Fold x -> (TxIn, TxOut CurrentEra) -> x
f x
e x -> a
g) Text
fp = forall (m :: * -> *) a.
MonadUnliftIO m =>
Text -> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a -> m a
runSqlite Text
fp (x -> a
g forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (forall (m :: * -> *).
MonadResource m =>
ConduitM () (TxIn, TxOut CurrentEra) (ReaderT SqlBackend m) ()
sourceUTxO forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a b o.
Monad m =>
(a -> b -> a) -> a -> ConduitT b o m a
foldlC x -> (TxIn, TxOut CurrentEra) -> x
f x
e))

esId :: Key EpochState
esId :: EpochStateId
esId = BackendKey SqlBackend -> EpochStateId
EpochStateKey (Int64 -> BackendKey SqlBackend
SqlBackendKey Int64
1)

loadEpochStateEntity :: MonadUnliftIO m => T.Text -> m (Entity EpochState)
loadEpochStateEntity :: forall (m :: * -> *).
MonadUnliftIO m =>
Text -> m (Entity EpochState)
loadEpochStateEntity Text
fp = forall (m :: * -> *) a.
MonadUnliftIO m =>
Text -> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a -> m a
runSqlite Text
fp (forall record backend (m :: * -> *).
(PersistEntityBackend record ~ BaseBackend backend, MonadIO m,
 PersistEntity record, PersistStoreRead backend) =>
Key record -> ReaderT backend m (Entity record)
getJustEntity EpochStateId
esId)

getLedgerStateWithSharing ::
  (MonadUnliftIO m, MonadResource m) =>
  Entity EpochState ->
  ReaderT SqlBackend m (Shelley.LedgerState CurrentEra)
getLedgerStateWithSharing :: forall (m :: * -> *).
(MonadUnliftIO m, MonadResource m) =>
Entity EpochState -> ReaderT SqlBackend m (LedgerState CurrentEra)
getLedgerStateWithSharing Entity EpochState
ese = do
  ledgerState :: LedgerState
ledgerState@LedgerState {PState CurrentEra
DStateId
Key UtxoState
EpochStateId
ledgerStatePstateBin :: PState CurrentEra
ledgerStateEpochStateId :: EpochStateId
ledgerStateDstateId :: DStateId
ledgerStateUtxoId :: Key UtxoState
ledgerStateEpochStateId :: LedgerState -> EpochStateId
ledgerStatePstateBin :: LedgerState -> PState CurrentEra
ledgerStateDstateId :: LedgerState -> DStateId
ledgerStateUtxoId :: LedgerState -> Key UtxoState
..} <-
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => [Char] -> a
error [Char]
"Impossible") (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall record. Entity record -> record
entityVal)
      forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m (Maybe (Entity record))
selectFirst [forall typ. (typ ~ EpochStateId) => EntityField LedgerState typ
LedgerStateEpochStateId forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. forall record. Entity record -> Key record
entityKey Entity EpochState
ese] []
  DState CurrentEra
dstate <- forall (m :: * -> *).
MonadIO m =>
DStateId -> ReaderT SqlBackend m (DState CurrentEra)
getDStateWithSharing DStateId
ledgerStateDstateId
  Map TxIn (BabbageTxOut CurrentEra)
m <- forall (m :: * -> *) a b.
Monad m =>
ConduitT () a m () -> Fold a b -> m b
runConduitFold forall (m :: * -> *).
MonadResource m =>
ConduitM () (TxIn, TxOut CurrentEra) (ReaderT SqlBackend m) ()
sourceUTxO forall a. Fold (TxIn, a) (Map TxIn a)
noSharingMap
  forall (m :: * -> *).
MonadIO m =>
UTxO CurrentEra
-> LedgerState
-> DState CurrentEra
-> ReaderT SqlBackend m (LedgerState CurrentEra)
getLedgerState (forall era. Map TxIn (TxOut era) -> UTxO era
Shelley.UTxO Map TxIn (BabbageTxOut CurrentEra)
m) LedgerState
ledgerState DState CurrentEra
dstate

getLedgerStateNoSharing ::
  (MonadUnliftIO m, MonadResource m) =>
  Entity EpochState ->
  ReaderT SqlBackend m (Shelley.LedgerState CurrentEra)
getLedgerStateNoSharing :: forall (m :: * -> *).
(MonadUnliftIO m, MonadResource m) =>
Entity EpochState -> ReaderT SqlBackend m (LedgerState CurrentEra)
getLedgerStateNoSharing Entity EpochState
ese = do
  ledgerState :: LedgerState
ledgerState@LedgerState {PState CurrentEra
DStateId
Key UtxoState
EpochStateId
ledgerStatePstateBin :: PState CurrentEra
ledgerStateEpochStateId :: EpochStateId
ledgerStateDstateId :: DStateId
ledgerStateUtxoId :: Key UtxoState
ledgerStateEpochStateId :: LedgerState -> EpochStateId
ledgerStatePstateBin :: LedgerState -> PState CurrentEra
ledgerStateDstateId :: LedgerState -> DStateId
ledgerStateUtxoId :: LedgerState -> Key UtxoState
..} <-
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => [Char] -> a
error [Char]
"Impossible") (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall record. Entity record -> record
entityVal)
      forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m (Maybe (Entity record))
selectFirst [forall typ. (typ ~ EpochStateId) => EntityField LedgerState typ
LedgerStateEpochStateId forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. forall record. Entity record -> Key record
entityKey Entity EpochState
ese] []
  DState CurrentEra
dstate <- forall (m :: * -> *).
MonadIO m =>
DStateId -> ReaderT SqlBackend m (DState CurrentEra)
getDStateNoSharing DStateId
ledgerStateDstateId
  Map TxIn (BabbageTxOut CurrentEra)
m <- forall (m :: * -> *) a b.
Monad m =>
ConduitT () a m () -> Fold a b -> m b
runConduitFold forall (m :: * -> *).
MonadResource m =>
ConduitM () (TxIn, TxOut CurrentEra) (ReaderT SqlBackend m) ()
sourceUTxO forall a. Fold (TxIn, a) (Map TxIn a)
noSharingMap
  forall (m :: * -> *).
MonadIO m =>
UTxO CurrentEra
-> LedgerState
-> DState CurrentEra
-> ReaderT SqlBackend m (LedgerState CurrentEra)
getLedgerState (forall era. Map TxIn (TxOut era) -> UTxO era
Shelley.UTxO Map TxIn (BabbageTxOut CurrentEra)
m) LedgerState
ledgerState DState CurrentEra
dstate

loadEpochState :: MonadUnliftIO m => T.Text -> m (Shelley.EpochState CurrentEra)
loadEpochState :: forall (m :: * -> *).
MonadUnliftIO m =>
Text -> m (EpochState CurrentEra)
loadEpochState Text
fp = forall (m :: * -> *) a.
MonadUnliftIO m =>
Text -> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a -> m a
runSqlite Text
fp forall a b. (a -> b) -> a -> b
$ do
  ese :: Entity EpochState
ese@(Entity EpochStateId
_ EpochState {PParams CurrentEra
Coin
NonMyopic
epochStateSnapShotsFee :: Coin
epochStateNonMyopic :: NonMyopic
epochStatePp :: PParams CurrentEra
epochStatePrevPp :: PParams CurrentEra
epochStateReserves :: Coin
epochStateTreasury :: Coin
epochStateSnapShotsFee :: EpochState -> Coin
epochStateNonMyopic :: EpochState -> NonMyopic
epochStatePp :: EpochState -> PParams CurrentEra
epochStatePrevPp :: EpochState -> PParams CurrentEra
epochStateReserves :: EpochState -> Coin
epochStateTreasury :: EpochState -> Coin
..}) <- forall record backend (m :: * -> *).
(PersistEntityBackend record ~ BaseBackend backend, MonadIO m,
 PersistEntity record, PersistStoreRead backend) =>
Key record -> ReaderT backend m (Entity record)
getJustEntity EpochStateId
esId
  SnapShots
snapshots <- forall (m :: * -> *).
MonadResource m =>
Entity EpochState -> ReaderT SqlBackend m SnapShots
getSnapShotsNoSharing Entity EpochState
ese
  LedgerState CurrentEra
ledgerState <- forall (m :: * -> *).
(MonadUnliftIO m, MonadResource m) =>
Entity EpochState -> ReaderT SqlBackend m (LedgerState CurrentEra)
getLedgerStateNoSharing Entity EpochState
ese
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    Shelley.EpochState
      { esAccountState :: AccountState
esAccountState =
          Shelley.AccountState
            { asTreasury :: Coin
asTreasury = Coin
epochStateTreasury
            , asReserves :: Coin
asReserves = Coin
epochStateReserves
            }
      , esLState :: LedgerState CurrentEra
esLState = LedgerState CurrentEra
ledgerState
      , esSnapshots :: SnapShots
esSnapshots = SnapShots
snapshots
      , esNonMyopic :: NonMyopic
esNonMyopic = NonMyopic
epochStateNonMyopic
      }
      forall a b. a -> (a -> b) -> b
& forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams CurrentEra
epochStatePp
      forall a b. a -> (a -> b) -> b
& forall era. EraGov era => Lens' (EpochState era) (PParams era)
prevPParamsEpochStateL forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams CurrentEra
epochStatePrevPp

loadEpochStateWithSharing :: MonadUnliftIO m => T.Text -> m (Shelley.EpochState CurrentEra)
loadEpochStateWithSharing :: forall (m :: * -> *).
MonadUnliftIO m =>
Text -> m (EpochState CurrentEra)
loadEpochStateWithSharing Text
fp = forall (m :: * -> *) a.
MonadUnliftIO m =>
Text -> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a -> m a
runSqlite Text
fp forall a b. (a -> b) -> a -> b
$ do
  ese :: Entity EpochState
ese@(Entity EpochStateId
_ EpochState {PParams CurrentEra
Coin
NonMyopic
epochStateSnapShotsFee :: Coin
epochStateNonMyopic :: NonMyopic
epochStatePp :: PParams CurrentEra
epochStatePrevPp :: PParams CurrentEra
epochStateReserves :: Coin
epochStateTreasury :: Coin
epochStateSnapShotsFee :: EpochState -> Coin
epochStateNonMyopic :: EpochState -> NonMyopic
epochStatePp :: EpochState -> PParams CurrentEra
epochStatePrevPp :: EpochState -> PParams CurrentEra
epochStateReserves :: EpochState -> Coin
epochStateTreasury :: EpochState -> Coin
..}) <- forall record backend (m :: * -> *).
(PersistEntityBackend record ~ BaseBackend backend, MonadIO m,
 PersistEntity record, PersistStoreRead backend) =>
Key record -> ReaderT backend m (Entity record)
getJustEntity EpochStateId
esId
  SnapShots
snapshots <- forall (m :: * -> *).
MonadResource m =>
Entity EpochState -> ReaderT SqlBackend m SnapShots
getSnapShotsWithSharing Entity EpochState
ese
  LedgerState CurrentEra
ledgerState <- forall (m :: * -> *).
(MonadUnliftIO m, MonadResource m) =>
Entity EpochState -> ReaderT SqlBackend m (LedgerState CurrentEra)
getLedgerStateWithSharing Entity EpochState
ese
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    Shelley.EpochState
      { esAccountState :: AccountState
esAccountState =
          Shelley.AccountState
            { asTreasury :: Coin
asTreasury = Coin
epochStateTreasury
            , asReserves :: Coin
asReserves = Coin
epochStateReserves
            }
      , esLState :: LedgerState CurrentEra
esLState = LedgerState CurrentEra
ledgerState
      , esSnapshots :: SnapShots
esSnapshots = SnapShots
snapshots
      , esNonMyopic :: NonMyopic
esNonMyopic = NonMyopic
epochStateNonMyopic
      }
      forall a b. a -> (a -> b) -> b
& forall era. EraGov era => Lens' (EpochState era) (PParams era)
prevPParamsEpochStateL forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams CurrentEra
epochStatePrevPp
      forall a b. a -> (a -> b) -> b
& forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams CurrentEra
epochStatePp

loadSnapShotsNoSharing ::
  MonadUnliftIO m => T.Text -> Entity EpochState -> m EpochBoundary.SnapShots
loadSnapShotsNoSharing :: forall (m :: * -> *).
MonadUnliftIO m =>
Text -> Entity EpochState -> m SnapShots
loadSnapShotsNoSharing Text
fp = forall (m :: * -> *) a.
MonadUnliftIO m =>
Text -> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a -> m a
runSqlite Text
fp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadResource m =>
Entity EpochState -> ReaderT SqlBackend m SnapShots
getSnapShotsNoSharing
{-# INLINEABLE loadSnapShotsNoSharing #-}

loadSnapShotsWithSharing ::
  MonadUnliftIO m => T.Text -> Entity EpochState -> m EpochBoundary.SnapShots
loadSnapShotsWithSharing :: forall (m :: * -> *).
MonadUnliftIO m =>
Text -> Entity EpochState -> m SnapShots
loadSnapShotsWithSharing Text
fp = forall (m :: * -> *) a.
MonadUnliftIO m =>
Text -> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a -> m a
runSqlite Text
fp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadResource m =>
Entity EpochState -> ReaderT SqlBackend m SnapShots
getSnapShotsWithSharing
{-# INLINEABLE loadSnapShotsWithSharing #-}

loadSnapShotsNoSharingM :: T.Text -> Entity EpochState -> IO SnapShotsM
loadSnapShotsNoSharingM :: Text -> Entity EpochState -> IO SnapShotsM
loadSnapShotsNoSharingM Text
fp = forall (m :: * -> *) a.
MonadUnliftIO m =>
Text -> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a -> m a
runSqlite Text
fp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadResource m =>
Entity EpochState -> ReaderT SqlBackend m SnapShotsM
getSnapShotsNoSharingM
{-# INLINEABLE loadSnapShotsNoSharingM #-}

loadSnapShotsWithSharingM :: T.Text -> Entity EpochState -> IO SnapShotsM
loadSnapShotsWithSharingM :: Text -> Entity EpochState -> IO SnapShotsM
loadSnapShotsWithSharingM Text
fp = forall (m :: * -> *) a.
MonadUnliftIO m =>
Text -> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a -> m a
runSqlite Text
fp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadResource m =>
Entity EpochState -> ReaderT SqlBackend m SnapShotsM
getSnapShotsWithSharingM
{-# INLINEABLE loadSnapShotsWithSharingM #-}