{-# 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.Class (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 (EraCrypto CurrentEra)
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 (EraCrypto era)
utxosDonation :: forall era. UTxOState era -> Coin
utxosDonation :: Coin
utxosStakeDistr :: IncrementalStake (EraCrypto CurrentEra)
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 C, 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 (EraCrypto era)) (TxOut era)
Shelley.unUTxO UTxO CurrentEra
utxo)
  where
    insertTxOut :: (TxIn C, BabbageTxOut CurrentEra) -> ReaderT SqlBackend m ()
insertTxOut (TxIn.TxIn TxId C
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 C
txInId = TxId C
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 C
txsInId = TxId C
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 (EraCrypto CurrentEra))
  (GenDelegPair (EraCrypto CurrentEra))
InstantaneousRewards (EraCrypto CurrentEra)
UMap (EraCrypto CurrentEra)
GenDelegs (EraCrypto CurrentEra)
dsUnified :: forall era. DState era -> UMap (EraCrypto era)
dsFutureGenDelegs :: forall era.
DState era
-> Map
     (FutureGenDeleg (EraCrypto era)) (GenDelegPair (EraCrypto era))
dsGenDelegs :: forall era. DState era -> GenDelegs (EraCrypto era)
dsIRewards :: forall era. DState era -> InstantaneousRewards (EraCrypto era)
dsIRewards :: InstantaneousRewards (EraCrypto CurrentEra)
dsGenDelegs :: GenDelegs (EraCrypto CurrentEra)
dsFutureGenDelegs :: Map
  (FutureGenDeleg (EraCrypto CurrentEra))
  (GenDelegPair (EraCrypto CurrentEra))
dsUnified :: UMap (EraCrypto CurrentEra)
..} = do
  let irDeltaReserves :: DeltaCoin
irDeltaReserves = forall c. InstantaneousRewards c -> DeltaCoin
Shelley.deltaReserves InstantaneousRewards (EraCrypto CurrentEra)
dsIRewards
  let irDeltaTreasury :: DeltaCoin
irDeltaTreasury = forall c. InstantaneousRewards c -> DeltaCoin
Shelley.deltaTreasury InstantaneousRewards (EraCrypto CurrentEra)
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 C -> DeltaCoin -> DeltaCoin -> DState
DState (forall a. a -> Enc a
Enc Map
  (FutureGenDeleg (EraCrypto CurrentEra))
  (GenDelegPair (EraCrypto CurrentEra))
dsFutureGenDelegs) GenDelegs (EraCrypto CurrentEra)
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 (forall c. UMap c -> Map (Credential 'Staking c) Coin
rewardMap UMap (EraCrypto CurrentEra)
dsUnified)) forall a b. (a -> b) -> a -> b
$ \(Credential 'Staking C
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) c.
HasKeyRole a =>
a r c -> a 'Witness c
Keys.asWitness Credential 'Staking C
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 (forall c.
UMap c -> Map (Credential 'Staking c) (KeyHash 'StakePool c)
sPoolMap UMap (EraCrypto CurrentEra)
dsUnified)) forall a b. (a -> b) -> a -> b
$ \(Credential 'Staking C
cred, KeyHash 'StakePool C
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) c.
HasKeyRole a =>
a r c -> a 'Witness c
Keys.asWitness Credential 'Staking C
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) c.
HasKeyRole a =>
a r c -> a 'Witness c
Keys.asWitness KeyHash 'StakePool C
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 (forall c. UMap c -> Map Ptr (Credential 'Staking c)
ptrMap UMap (EraCrypto CurrentEra)
dsUnified)) forall a b. (a -> b) -> a -> b
$ \(Ptr
ptr, Credential 'Staking C
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) c.
HasKeyRole a =>
a r c -> a 'Witness c
Keys.asWitness Credential 'Staking C
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 (forall c.
InstantaneousRewards c -> Map (Credential 'Staking c) Coin
Shelley.iRReserves InstantaneousRewards (EraCrypto CurrentEra)
dsIRewards)) forall a b. (a -> b) -> a -> b
$ \(Credential 'Staking C
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) c.
HasKeyRole a =>
a r c -> a 'Witness c
Keys.asWitness Credential 'Staking C
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 (forall c.
InstantaneousRewards c -> Map (Credential 'Staking c) Coin
Shelley.iRTreasury InstantaneousRewards (EraCrypto CurrentEra)
dsIRewards)) forall a b. (a -> b) -> a -> b
$ \(Credential 'Staking C
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) c.
HasKeyRole a =>
a r c -> a 'Witness c
Keys.asWitness Credential 'Staking C
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 C ->
  ReaderT SqlBackend m ()
insertSnapShot :: forall (m :: * -> *).
MonadIO m =>
EpochStateId
-> SnapShotType -> SnapShot C -> ReaderT SqlBackend m ()
insertSnapShot EpochStateId
snapShotEpochStateId SnapShotType
snapShotType EpochBoundary.SnapShot {Stake C
VMap VB VB (Credential 'Staking C) (KeyHash 'StakePool C)
VMap VB VB (KeyHash 'StakePool C) (PoolParams C)
$sel:ssStake:SnapShot :: forall c. SnapShot c -> Stake c
$sel:ssDelegations:SnapShot :: forall c.
SnapShot c
-> VMap VB VB (Credential 'Staking c) (KeyHash 'StakePool c)
$sel:ssPoolParams:SnapShot :: forall c.
SnapShot c -> VMap VB VB (KeyHash 'StakePool c) (PoolParams c)
ssPoolParams :: VMap VB VB (KeyHash 'StakePool C) (PoolParams C)
ssDelegations :: VMap VB VB (Credential 'Staking C) (KeyHash 'StakePool C)
ssStake :: Stake C
..} = 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 (forall c.
Stake c -> VMap VB VP (Credential 'Staking c) (CompactForm Coin)
EpochBoundary.unStake Stake C
ssStake)) forall a b. (a -> b) -> a -> b
$ \(Credential 'Staking C
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) c.
HasKeyRole a =>
a r c -> a 'Witness c
Keys.asWitness Credential 'Staking C
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 C) (KeyHash 'StakePool C)
ssDelegations) forall a b. (a -> b) -> a -> b
$ \(Credential 'Staking C
cred, KeyHash 'StakePool C
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) c.
HasKeyRole a =>
a r c -> a 'Witness c
Keys.asWitness Credential 'Staking C
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) c.
HasKeyRole a =>
a r c -> a 'Witness c
Keys.asWitness KeyHash 'StakePool C
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 C) (PoolParams C)
ssPoolParams) forall a b. (a -> b) -> a -> b
$ \(KeyHash 'StakePool C
keyHash, PoolParams C
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) c.
HasKeyRole a =>
a r c -> a 'Witness c
Keys.asWitness KeyHash 'StakePool C
keyHash))
    forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m ()
insert_ (Key SnapShot -> Key KeyHash -> PoolParams C -> SnapShotPool
SnapShotPool Key SnapShot
snapShotId Key KeyHash
keyHashId PoolParams C
pps)

insertSnapShots ::
  MonadIO m =>
  Key EpochState ->
  EpochBoundary.SnapShots C ->
  ReaderT SqlBackend m ()
insertSnapShots :: forall (m :: * -> *).
MonadIO m =>
EpochStateId -> SnapShots C -> ReaderT SqlBackend m ()
insertSnapShots EpochStateId
epochStateKey EpochBoundary.SnapShots {SnapShot C
PoolDistr C
Coin
$sel:ssStakeMark:SnapShots :: forall c. SnapShots c -> SnapShot c
$sel:ssStakeMarkPoolDistr:SnapShots :: forall c. SnapShots c -> PoolDistr c
$sel:ssStakeSet:SnapShots :: forall c. SnapShots c -> SnapShot c
$sel:ssStakeGo:SnapShots :: forall c. SnapShots c -> SnapShot c
$sel:ssFee:SnapShots :: forall c. SnapShots c -> Coin
ssFee :: Coin
ssStakeGo :: SnapShot C
ssStakeSet :: SnapShot C
ssStakeMarkPoolDistr :: PoolDistr C
ssStakeMark :: SnapShot C
..} = 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 C -> ReaderT SqlBackend m ()
insertSnapShot EpochStateId
epochStateKey))
    [ (SnapShotType
SnapShotMark, SnapShot C
ssStakeMark)
    , (SnapShotType
SnapShotSet, SnapShot C
ssStakeSet)
    , (SnapShotType
SnapShotGo, SnapShot C
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 (EraCrypto CurrentEra)
AccountState
LedgerState CurrentEra
NonMyopic (EraCrypto CurrentEra)
esAccountState :: forall era. EpochState era -> AccountState
esLState :: forall era. EpochState era -> LedgerState era
esSnapshots :: forall era. EpochState era -> SnapShots (EraCrypto era)
esNonMyopic :: forall era. EpochState era -> NonMyopic (EraCrypto era)
esNonMyopic :: NonMyopic (EraCrypto CurrentEra)
esSnapshots :: SnapShots (EraCrypto CurrentEra)
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 C
epochStateNonMyopic = NonMyopic (EraCrypto CurrentEra)
esNonMyopic
        , epochStateSnapShotsFee :: Coin
epochStateSnapShotsFee = forall c. SnapShots c -> Coin
EpochBoundary.ssFee SnapShots (EraCrypto CurrentEra)
esSnapshots
        }
  forall (m :: * -> *).
MonadIO m =>
EpochStateId -> SnapShots C -> ReaderT SqlBackend m ()
insertSnapShots EpochStateId
epochStateKey SnapShots (EraCrypto CurrentEra)
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 C)
getSnapShotNoSharingM :: forall (m :: * -> *).
MonadResource m =>
EpochStateId -> SnapShotType -> ReaderT SqlBackend m (SnapShotM C)
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 C) (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) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
Keys.coerceKeyRole CredentialWitness
credential, CompactForm Coin
snapShotStakeCoin)
  Map (Credential 'Staking C) (KeyHash 'StakePool C)
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) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
Keys.coerceKeyRole CredentialWitness
credential, forall (a :: KeyRole -> * -> *) (r :: KeyRole) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
Keys.coerceKeyRole KeyHashWitness
keyHash)
  Map (KeyHash 'StakePool C) (PoolParams C)
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 C
Key KeyHash
Key SnapShot
snapShotPoolParams :: SnapShotPool -> PoolParams C
snapShotPoolKeyHashId :: SnapShotPool -> Key KeyHash
snapShotPoolSnapShotId :: SnapShotPool -> Key SnapShot
snapShotPoolParams :: PoolParams C
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) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
Keys.coerceKeyRole KeyHashWitness
keyHash, PoolParams C
snapShotPoolParams)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    SnapShotM
      { ssStake :: Map (Credential 'Staking C) (CompactForm Coin)
ssStake = Map (Credential 'Staking C) (CompactForm Coin)
stake
      , ssDelegations :: Map (Credential 'Staking C) (KeyHash 'StakePool C)
ssDelegations = Map (Credential 'Staking C) (KeyHash 'StakePool C)
delegations
      , ssPoolParams :: Map (KeyHash 'StakePool C) (PoolParams C)
ssPoolParams = Map (KeyHash 'StakePool C) (PoolParams C)
poolParams
      }
{-# INLINEABLE getSnapShotNoSharingM #-}

getSnapShotWithSharingM ::
  MonadResource m =>
  [SnapShotM C] ->
  Key EpochState ->
  SnapShotType ->
  ReaderT SqlBackend m (SnapShotM C)
getSnapShotWithSharingM :: forall (m :: * -> *).
MonadResource m =>
[SnapShotM C]
-> EpochStateId
-> SnapShotType
-> ReaderT SqlBackend m (SnapShotM C)
getSnapShotWithSharingM [SnapShotM C]
otherSnapShots EpochStateId
epochStateId SnapShotType
snapShotType = do
  let internOtherStakes :: CredentialWitness -> Credential 'Staking C
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
. forall c.
SnapShotM c -> Map (Credential 'Staking c) (CompactForm Coin)
ssStake) [SnapShotM C]
otherSnapShots)
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: KeyRole -> * -> *) (r :: KeyRole) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
Keys.coerceKeyRole
  let internOtherPoolParams :: KeyHashWitness -> KeyHash 'StakePool C
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
. forall c. SnapShotM c -> Map (KeyHash 'StakePool c) (PoolParams c)
ssPoolParams) [SnapShotM C]
otherSnapShots)
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: KeyRole -> * -> *) (r :: KeyRole) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
Keys.coerceKeyRole
  let internOtherDelegations :: CredentialWitness -> Credential 'Staking C
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
. forall c.
SnapShotM c -> Map (Credential 'Staking c) (KeyHash 'StakePool c)
ssDelegations) [SnapShotM C]
otherSnapShots)
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: KeyRole -> * -> *) (r :: KeyRole) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
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 C) (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 C
internOtherStakes CredentialWitness
credential, CompactForm Coin
snapShotStakeCoin)
  Map (KeyHash 'StakePool C) (PoolParams C)
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 C
Key KeyHash
Key SnapShot
snapShotPoolParams :: PoolParams C
snapShotPoolKeyHashId :: Key KeyHash
snapShotPoolSnapShotId :: Key SnapShot
snapShotPoolParams :: SnapShotPool -> PoolParams C
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 C
internOtherPoolParams KeyHashWitness
keyHash, PoolParams C
snapShotPoolParams)
  let internPoolParams :: KeyHashWitness -> KeyHash 'StakePool C
internPoolParams = forall k. Interns k -> k -> k
interns (forall k a. Ord k => Map k a -> Interns k
internsFromMap Map (KeyHash 'StakePool C) (PoolParams C)
poolParams) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: KeyRole -> * -> *) (r :: KeyRole) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
Keys.coerceKeyRole
  Map (Credential 'Staking C) (KeyHash 'StakePool C)
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 C
internOtherDelegations CredentialWitness
credential, KeyHashWitness -> KeyHash 'StakePool C
internPoolParams KeyHashWitness
keyHash)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    SnapShotM
      { ssStake :: Map (Credential 'Staking C) (CompactForm Coin)
ssStake = Map (Credential 'Staking C) (CompactForm Coin)
stake
      , ssDelegations :: Map (Credential 'Staking C) (KeyHash 'StakePool C)
ssDelegations = Map (Credential 'Staking C) (KeyHash 'StakePool C)
delegations
      , ssPoolParams :: Map (KeyHash 'StakePool C) (PoolParams C)
ssPoolParams = Map (KeyHash 'StakePool C) (PoolParams C)
poolParams
      }
{-# INLINEABLE getSnapShotWithSharingM #-}

getSnapShotsWithSharingM ::
  MonadResource m =>
  Entity EpochState ->
  ReaderT SqlBackend m (SnapShotsM C)
getSnapShotsWithSharingM :: forall (m :: * -> *).
MonadResource m =>
Entity EpochState -> ReaderT SqlBackend m (SnapShotsM C)
getSnapShotsWithSharingM (Entity EpochStateId
epochStateId EpochState {Coin
epochStateSnapShotsFee :: Coin
epochStateSnapShotsFee :: EpochState -> Coin
epochStateSnapShotsFee}) = do
  SnapShotM C
mark <- forall (m :: * -> *).
MonadResource m =>
[SnapShotM C]
-> EpochStateId
-> SnapShotType
-> ReaderT SqlBackend m (SnapShotM C)
getSnapShotWithSharingM [] EpochStateId
epochStateId SnapShotType
SnapShotMark
  SnapShotM C
set <- forall (m :: * -> *).
MonadResource m =>
[SnapShotM C]
-> EpochStateId
-> SnapShotType
-> ReaderT SqlBackend m (SnapShotM C)
getSnapShotWithSharingM [SnapShotM C
mark] EpochStateId
epochStateId SnapShotType
SnapShotSet
  SnapShotM C
go <- forall (m :: * -> *).
MonadResource m =>
[SnapShotM C]
-> EpochStateId
-> SnapShotType
-> ReaderT SqlBackend m (SnapShotM C)
getSnapShotWithSharingM [SnapShotM C
mark, SnapShotM C
set] EpochStateId
epochStateId SnapShotType
SnapShotGo
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    SnapShotsM
      { ssPstakeMark :: SnapShotM C
ssPstakeMark = SnapShotM C
mark
      , ssPstakeSet :: SnapShotM C
ssPstakeSet = SnapShotM C
set
      , ssPstakeGo :: SnapShotM C
ssPstakeGo = SnapShotM C
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 C)
getSnapShotNoSharing :: forall (m :: * -> *).
MonadResource m =>
EpochStateId -> SnapShotType -> ReaderT SqlBackend m (SnapShot C)
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 C) (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) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
Keys.coerceKeyRole CredentialWitness
credential, CompactForm Coin
snapShotStakeCoin)
  VMap VB VB (Credential 'Staking C) (KeyHash 'StakePool C)
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) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
Keys.coerceKeyRole CredentialWitness
credential, forall (a :: KeyRole -> * -> *) (r :: KeyRole) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
Keys.coerceKeyRole KeyHashWitness
keyHash)
  VMap VB VB (KeyHash 'StakePool C) (PoolParams C)
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 C
Key KeyHash
Key SnapShot
snapShotPoolParams :: PoolParams C
snapShotPoolKeyHashId :: Key KeyHash
snapShotPoolSnapShotId :: Key SnapShot
snapShotPoolParams :: SnapShotPool -> PoolParams C
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) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
Keys.coerceKeyRole KeyHashWitness
keyHash, PoolParams C
snapShotPoolParams)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    EpochBoundary.SnapShot
      { $sel:ssStake:SnapShot :: Stake C
ssStake = forall c.
VMap VB VP (Credential 'Staking c) (CompactForm Coin) -> Stake c
EpochBoundary.Stake VMap VB VP (Credential 'Staking C) (CompactForm Coin)
stake
      , $sel:ssDelegations:SnapShot :: VMap VB VB (Credential 'Staking C) (KeyHash 'StakePool C)
ssDelegations = VMap VB VB (Credential 'Staking C) (KeyHash 'StakePool C)
delegations
      , $sel:ssPoolParams:SnapShot :: VMap VB VB (KeyHash 'StakePool C) (PoolParams C)
ssPoolParams = VMap VB VB (KeyHash 'StakePool C) (PoolParams C)
poolParams
      }
{-# INLINEABLE getSnapShotNoSharing #-}

getSnapShotsNoSharing ::
  MonadResource m =>
  Entity EpochState ->
  ReaderT SqlBackend m (EpochBoundary.SnapShots C)
getSnapShotsNoSharing :: forall (m :: * -> *).
MonadResource m =>
Entity EpochState -> ReaderT SqlBackend m (SnapShots C)
getSnapShotsNoSharing (Entity EpochStateId
epochStateId EpochState {Coin
epochStateSnapShotsFee :: Coin
epochStateSnapShotsFee :: EpochState -> Coin
epochStateSnapShotsFee}) = do
  SnapShot C
mark <- forall (m :: * -> *).
MonadResource m =>
EpochStateId -> SnapShotType -> ReaderT SqlBackend m (SnapShot C)
getSnapShotNoSharing EpochStateId
epochStateId SnapShotType
SnapShotMark
  SnapShot C
set <- forall (m :: * -> *).
MonadResource m =>
EpochStateId -> SnapShotType -> ReaderT SqlBackend m (SnapShot C)
getSnapShotNoSharing EpochStateId
epochStateId SnapShotType
SnapShotSet
  SnapShot C
go <- forall (m :: * -> *).
MonadResource m =>
EpochStateId -> SnapShotType -> ReaderT SqlBackend m (SnapShot C)
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 C
ssStakeMark = SnapShot C
mark
      , $sel:ssStakeMarkPoolDistr:SnapShots :: PoolDistr C
ssStakeMarkPoolDistr = forall c. SnapShot c -> PoolDistr c
EpochBoundary.calculatePoolDistr SnapShot C
mark
      , $sel:ssStakeSet:SnapShots :: SnapShot C
ssStakeSet = SnapShot C
set
      , $sel:ssStakeGo:SnapShots :: SnapShot C
ssStakeGo = SnapShot C
go
      , $sel:ssFee:SnapShots :: Coin
ssFee = Coin
epochStateSnapShotsFee
      }
{-# INLINEABLE getSnapShotsNoSharing #-}

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

getSnapShotWithSharing ::
  MonadResource m =>
  [EpochBoundary.SnapShot C] ->
  Key EpochState ->
  SnapShotType ->
  ReaderT SqlBackend m (EpochBoundary.SnapShot C)
getSnapShotWithSharing :: forall (m :: * -> *).
MonadResource m =>
[SnapShot C]
-> EpochStateId
-> SnapShotType
-> ReaderT SqlBackend m (SnapShot C)
getSnapShotWithSharing [SnapShot C]
otherSnapShots EpochStateId
epochStateId SnapShotType
snapShotType = do
  let internOtherStakes :: CredentialWitness -> Credential 'Staking C
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
. forall c.
Stake c -> VMap VB VP (Credential 'Staking c) (CompactForm Coin)
EpochBoundary.unStake forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. SnapShot c -> Stake c
EpochBoundary.ssStake) [SnapShot C]
otherSnapShots)
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: KeyRole -> * -> *) (r :: KeyRole) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
Keys.coerceKeyRole
  let internOtherPoolParams :: KeyHashWitness -> KeyHash 'StakePool C
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
. forall c.
SnapShot c -> VMap VB VB (KeyHash 'StakePool c) (PoolParams c)
EpochBoundary.ssPoolParams) [SnapShot C]
otherSnapShots)
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: KeyRole -> * -> *) (r :: KeyRole) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
Keys.coerceKeyRole
  let internOtherDelegations :: CredentialWitness -> Credential 'Staking C
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
. forall c.
SnapShot c
-> VMap VB VB (Credential 'Staking c) (KeyHash 'StakePool c)
EpochBoundary.ssDelegations) [SnapShot C]
otherSnapShots)
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: KeyRole -> * -> *) (r :: KeyRole) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
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 C) (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 C
internOtherStakes CredentialWitness
credential, CompactForm Coin
snapShotStakeCoin)
  VMap VB VB (KeyHash 'StakePool C) (PoolParams C)
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 C
Key KeyHash
Key SnapShot
snapShotPoolParams :: PoolParams C
snapShotPoolKeyHashId :: Key KeyHash
snapShotPoolSnapShotId :: Key SnapShot
snapShotPoolParams :: SnapShotPool -> PoolParams C
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 C
internOtherPoolParams KeyHashWitness
keyHash, PoolParams C
snapShotPoolParams)
  let internPoolParams :: KeyHashWitness -> KeyHash 'StakePool C
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 C) (PoolParams C)
poolParams) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: KeyRole -> * -> *) (r :: KeyRole) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
Keys.coerceKeyRole
  VMap VB VB (Credential 'Staking C) (KeyHash 'StakePool C)
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 C
internOtherDelegations CredentialWitness
credential, KeyHashWitness -> KeyHash 'StakePool C
internPoolParams KeyHashWitness
keyHash)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    EpochBoundary.SnapShot
      { $sel:ssStake:SnapShot :: Stake C
ssStake = forall c.
VMap VB VP (Credential 'Staking c) (CompactForm Coin) -> Stake c
EpochBoundary.Stake VMap VB VP (Credential 'Staking C) (CompactForm Coin)
stake
      , $sel:ssDelegations:SnapShot :: VMap VB VB (Credential 'Staking C) (KeyHash 'StakePool C)
ssDelegations = VMap VB VB (Credential 'Staking C) (KeyHash 'StakePool C)
delegations
      , $sel:ssPoolParams:SnapShot :: VMap VB VB (KeyHash 'StakePool C) (PoolParams C)
ssPoolParams = VMap VB VB (KeyHash 'StakePool C) (PoolParams C)
poolParams
      }
{-# INLINEABLE getSnapShotWithSharing #-}

getSnapShotsWithSharing ::
  MonadResource m =>
  Entity EpochState ->
  ReaderT SqlBackend m (EpochBoundary.SnapShots C)
getSnapShotsWithSharing :: forall (m :: * -> *).
MonadResource m =>
Entity EpochState -> ReaderT SqlBackend m (SnapShots C)
getSnapShotsWithSharing (Entity EpochStateId
epochStateId EpochState {Coin
epochStateSnapShotsFee :: Coin
epochStateSnapShotsFee :: EpochState -> Coin
epochStateSnapShotsFee}) = do
  SnapShot C
mark <- forall (m :: * -> *).
MonadResource m =>
[SnapShot C]
-> EpochStateId
-> SnapShotType
-> ReaderT SqlBackend m (SnapShot C)
getSnapShotWithSharing [] EpochStateId
epochStateId SnapShotType
SnapShotMark
  SnapShot C
set <- forall (m :: * -> *).
MonadResource m =>
[SnapShot C]
-> EpochStateId
-> SnapShotType
-> ReaderT SqlBackend m (SnapShot C)
getSnapShotWithSharing [SnapShot C
mark] EpochStateId
epochStateId SnapShotType
SnapShotSet
  SnapShot C
go <- forall (m :: * -> *).
MonadResource m =>
[SnapShot C]
-> EpochStateId
-> SnapShotType
-> ReaderT SqlBackend m (SnapShot C)
getSnapShotWithSharing [SnapShot C
mark, SnapShot C
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 C
ssStakeMark = SnapShot C
mark
      , $sel:ssStakeMarkPoolDistr:SnapShots :: PoolDistr C
ssStakeMarkPoolDistr = forall c. SnapShot c -> PoolDistr c
EpochBoundary.calculatePoolDistr SnapShot C
mark
      , $sel:ssStakeSet:SnapShots :: SnapShot C
ssStakeSet = SnapShot C
set
      , $sel:ssStakeGo:SnapShots :: SnapShot C
ssStakeGo = SnapShot C
go
      , $sel:ssFee:SnapShots :: Coin
ssFee = Coin
epochStateSnapShotsFee
      }
{-# INLINEABLE getSnapShotsWithSharing #-}

sourceUTxO ::
  MonadResource m =>
  ConduitM () (TxIn.TxIn C, TxOut CurrentEra) (ReaderT SqlBackend m) ()
sourceUTxO :: forall (m :: * -> *).
MonadResource m =>
ConduitM () (TxIn C, 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 C
TxIx
txOut :: BabbageTxOut CurrentEra
txInId :: TxId C
txInIx :: TxIx
txOut :: Tx -> BabbageTxOut CurrentEra
txInId :: Tx -> TxId C
txInIx :: Tx -> TxIx
..}) -> (forall c. TxId c -> TxIx -> TxIn c
TxIn.TxIn TxId C
txInId TxIx
txInIx, BabbageTxOut CurrentEra
txOut))

sourceWithSharingUTxO ::
  MonadResource m =>
  Map.Map (Credential.StakeCredential C) a ->
  ConduitM () (TxIn.TxIn C, TxOut CurrentEra) (ReaderT SqlBackend m) ()
sourceWithSharingUTxO :: forall (m :: * -> *) a.
MonadResource m =>
Map (Credential 'Staking C) a
-> ConduitM () (TxIn C, TxOut CurrentEra) (ReaderT SqlBackend m) ()
sourceWithSharingUTxO Map (Credential 'Staking C) a
stakeCredentials =
  forall (m :: * -> *).
MonadResource m =>
ConduitM () (TxIn C, 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 (EraCrypto era)
 -> Credential 'Staking (EraCrypto era))
-> BabbageTxOut era -> BabbageTxOut era
internBabbageTxOut (forall k a. Ord k => k -> Map k a -> k
`intern` Map (Credential 'Staking C) a
stakeCredentials)))

foldDbUTxO ::
  MonadUnliftIO m =>
  -- | Folding function
  (a -> (TxIn.TxIn C, TxOut CurrentEra) -> a) ->
  -- | Empty acc
  a ->
  -- | Path to Sqlite db
  T.Text ->
  m a
foldDbUTxO :: forall (m :: * -> *) a.
MonadUnliftIO m =>
(a -> (TxIn C, TxOut CurrentEra) -> a) -> a -> Text -> m a
foldDbUTxO a -> (TxIn C, 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 C, 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 C, 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 C
FGenDelegs
dStateIrDeltaTreasury :: DState -> DeltaCoin
dStateIrDeltaReserves :: DState -> DeltaCoin
dStateGenDelegs :: DState -> GenDelegs C
dStateFGenDelegs :: DState -> FGenDelegs
dStateIrDeltaTreasury :: DeltaCoin
dStateIrDeltaReserves :: DeltaCoin
dStateGenDelegs :: GenDelegs C
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 C) 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) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
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 C) (KeyHash 'StakePool C)
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) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
Keys.coerceKeyRole CredentialWitness
credential, forall (a :: KeyRole -> * -> *) (r :: KeyRole) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
Keys.coerceKeyRole KeyHashWitness
keyHash)
  Map (Credential 'Staking C) (DRep C)
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 C)
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) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
Keys.coerceKeyRole CredentialWitness
credential)
  Map (Credential 'Staking C) 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) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
Keys.coerceKeyRole CredentialWitness
credential, Coin
iRReservesCoin)
  Map (Credential 'Staking C) 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) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
Keys.coerceKeyRole CredentialWitness
credential, Coin
iRTreasuryCoin)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Shelley.DState
      { dsUnified :: UMap (EraCrypto CurrentEra)
dsUnified = forall c.
Map (Credential 'Staking c) RDPair
-> Map Ptr (Credential 'Staking c)
-> Map (Credential 'Staking c) (KeyHash 'StakePool c)
-> Map (Credential 'Staking c) (DRep c)
-> UMap c
unify Map (Credential 'Staking C) RDPair
rewards Map Ptr (Credential 'Staking C)
ptrs Map (Credential 'Staking C) (KeyHash 'StakePool C)
delegations Map (Credential 'Staking C) (DRep C)
dreps
      , dsFutureGenDelegs :: Map
  (FutureGenDeleg (EraCrypto CurrentEra))
  (GenDelegPair (EraCrypto CurrentEra))
dsFutureGenDelegs = forall a. Enc a -> a
unEnc FGenDelegs
dStateFGenDelegs
      , dsGenDelegs :: GenDelegs (EraCrypto CurrentEra)
dsGenDelegs = GenDelegs C
dStateGenDelegs
      , dsIRewards :: InstantaneousRewards (EraCrypto CurrentEra)
dsIRewards =
          Shelley.InstantaneousRewards
            { iRReserves :: Map (Credential 'Staking C) Coin
iRReserves = Map (Credential 'Staking C) Coin
iRReserves
            , iRTreasury :: Map (Credential 'Staking C) Coin
iRTreasury = Map (Credential 'Staking C) 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 C
FGenDelegs
dStateIrDeltaTreasury :: DeltaCoin
dStateIrDeltaReserves :: DeltaCoin
dStateGenDelegs :: GenDelegs C
dStateFGenDelegs :: FGenDelegs
dStateIrDeltaTreasury :: DState -> DeltaCoin
dStateIrDeltaReserves :: DState -> DeltaCoin
dStateGenDelegs :: DState -> GenDelegs C
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 C) 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) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
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 C) (KeyHash 'StakePool C)
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 C
cred = forall k a. Ord k => k -> Map k a -> k
intern (forall (a :: KeyRole -> * -> *) (r :: KeyRole) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
Keys.coerceKeyRole CredentialWitness
credential) Map (Credential 'Staking C) 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 C
cred, forall (a :: KeyRole -> * -> *) (r :: KeyRole) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
Keys.coerceKeyRole KeyHashWitness
keyHash)
  Map (Credential 'Staking C) (DRep C)
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 C)
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 C
cred = forall k a. Ord k => k -> Map k a -> k
intern (forall (a :: KeyRole -> * -> *) (r :: KeyRole) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
Keys.coerceKeyRole CredentialWitness
credential) Map (Credential 'Staking C) RDPair
rewards
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr
ptrPtr, Credential 'Staking C
cred)
  Map (Credential 'Staking C) 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 C
cred = forall k a. Ord k => k -> Map k a -> k
intern (forall (a :: KeyRole -> * -> *) (r :: KeyRole) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
Keys.coerceKeyRole CredentialWitness
credential) Map (Credential 'Staking C) RDPair
rewards
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Credential 'Staking C
cred, Coin
iRReservesCoin)
  Map (Credential 'Staking C) 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 C
cred = forall k a. Ord k => k -> Map k a -> k
intern (forall (a :: KeyRole -> * -> *) (r :: KeyRole) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
Keys.coerceKeyRole CredentialWitness
credential) Map (Credential 'Staking C) RDPair
rewards
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Credential 'Staking C
cred, Coin
iRTreasuryCoin)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Shelley.DState
      { dsUnified :: UMap (EraCrypto CurrentEra)
dsUnified = forall c.
Map (Credential 'Staking c) RDPair
-> Map Ptr (Credential 'Staking c)
-> Map (Credential 'Staking c) (KeyHash 'StakePool c)
-> Map (Credential 'Staking c) (DRep c)
-> UMap c
unify Map (Credential 'Staking C) RDPair
rewards Map Ptr (Credential 'Staking C)
ptrs Map (Credential 'Staking C) (KeyHash 'StakePool C)
delegations Map (Credential 'Staking C) (DRep C)
dreps
      , dsFutureGenDelegs :: Map
  (FutureGenDeleg (EraCrypto CurrentEra))
  (GenDelegPair (EraCrypto CurrentEra))
dsFutureGenDelegs = forall a. Enc a -> a
unEnc FGenDelegs
dStateFGenDelegs
      , dsGenDelegs :: GenDelegs (EraCrypto CurrentEra)
dsGenDelegs = GenDelegs C
dStateGenDelegs
      , dsIRewards :: InstantaneousRewards (EraCrypto CurrentEra)
dsIRewards =
          Shelley.InstantaneousRewards
            { iRReserves :: Map (Credential 'Staking C) Coin
iRReserves = Map (Credential 'Staking C) Coin
iRReserves
            , iRTreasury :: Map (Credential 'Staking C) Coin
iRTreasury = Map (Credential 'Staking C) 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 (EraCrypto era)) (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 C, TxOut CurrentEra) (ReaderT SqlBackend m) ()
sourceUTxO forall a. Fold (TxIn C, a) (Map (TxIn C) 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 C) (BabbageTxOut CurrentEra)
m <- forall (m :: * -> *) a b.
Monad m =>
ConduitT () a m () -> Fold a b -> m b
runConduitFold forall (m :: * -> *).
MonadResource m =>
ConduitM () (TxIn C, TxOut CurrentEra) (ReaderT SqlBackend m) ()
sourceUTxO forall a. Fold (TxIn C, a) (Map (TxIn C) a)
noSharingMap
    forall (m :: * -> *).
MonadIO m =>
UTxO CurrentEra
-> LedgerState
-> DState CurrentEra
-> ReaderT SqlBackend m (LedgerState CurrentEra)
getLedgerState (forall era. Map (TxIn (EraCrypto era)) (TxOut era) -> UTxO era
Shelley.UTxO Map (TxIn C) (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 C) (TxOut CurrentEra))
    )
loadLedgerStateDStateTxIxSharing :: forall (m :: * -> *).
MonadUnliftIO m =>
Text
-> m (LedgerState CurrentEra,
      IntMap (Map (TxId C) (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 (EraCrypto era)) (TxOut era) -> UTxO era
Shelley.UTxO forall a. Monoid a => a
mempty) LedgerState
ledgerState DState CurrentEra
dstate
    IntMap (Map (TxId C) (BabbageTxOut CurrentEra))
m <- forall (m :: * -> *) a b.
Monad m =>
ConduitT () a m () -> Fold a b -> m b
runConduitFold forall (m :: * -> *).
MonadResource m =>
ConduitM () (TxIn C, TxOut CurrentEra) (ReaderT SqlBackend m) ()
sourceUTxO forall a. Fold (TxIn C, a) (IntMap (Map (TxId C) a))
txIxSharing
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (LedgerState CurrentEra
ls, IntMap (Map (TxId C) (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 C, 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 C, 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 C, 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 C) (BabbageTxOut CurrentEra)
m <- forall (m :: * -> *) a b.
Monad m =>
ConduitT () a m () -> Fold a b -> m b
runConduitFold forall (m :: * -> *).
MonadResource m =>
ConduitM () (TxIn C, TxOut CurrentEra) (ReaderT SqlBackend m) ()
sourceUTxO forall a. Fold (TxIn C, a) (Map (TxIn C) a)
noSharingMap
  forall (m :: * -> *).
MonadIO m =>
UTxO CurrentEra
-> LedgerState
-> DState CurrentEra
-> ReaderT SqlBackend m (LedgerState CurrentEra)
getLedgerState (forall era. Map (TxIn (EraCrypto era)) (TxOut era) -> UTxO era
Shelley.UTxO Map (TxIn C) (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 C) (BabbageTxOut CurrentEra)
m <- forall (m :: * -> *) a b.
Monad m =>
ConduitT () a m () -> Fold a b -> m b
runConduitFold forall (m :: * -> *).
MonadResource m =>
ConduitM () (TxIn C, TxOut CurrentEra) (ReaderT SqlBackend m) ()
sourceUTxO forall a. Fold (TxIn C, a) (Map (TxIn C) a)
noSharingMap
  forall (m :: * -> *).
MonadIO m =>
UTxO CurrentEra
-> LedgerState
-> DState CurrentEra
-> ReaderT SqlBackend m (LedgerState CurrentEra)
getLedgerState (forall era. Map (TxIn (EraCrypto era)) (TxOut era) -> UTxO era
Shelley.UTxO Map (TxIn C) (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 C
epochStateSnapShotsFee :: Coin
epochStateNonMyopic :: NonMyopic C
epochStatePp :: PParams CurrentEra
epochStatePrevPp :: PParams CurrentEra
epochStateReserves :: Coin
epochStateTreasury :: Coin
epochStateSnapShotsFee :: EpochState -> Coin
epochStateNonMyopic :: EpochState -> NonMyopic C
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 C
snapshots <- forall (m :: * -> *).
MonadResource m =>
Entity EpochState -> ReaderT SqlBackend m (SnapShots C)
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 (EraCrypto CurrentEra)
esSnapshots = SnapShots C
snapshots
      , esNonMyopic :: NonMyopic (EraCrypto CurrentEra)
esNonMyopic = NonMyopic C
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 C
epochStateSnapShotsFee :: Coin
epochStateNonMyopic :: NonMyopic C
epochStatePp :: PParams CurrentEra
epochStatePrevPp :: PParams CurrentEra
epochStateReserves :: Coin
epochStateTreasury :: Coin
epochStateSnapShotsFee :: EpochState -> Coin
epochStateNonMyopic :: EpochState -> NonMyopic C
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 C
snapshots <- forall (m :: * -> *).
MonadResource m =>
Entity EpochState -> ReaderT SqlBackend m (SnapShots C)
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 (EraCrypto CurrentEra)
esSnapshots = SnapShots C
snapshots
      , esNonMyopic :: NonMyopic (EraCrypto CurrentEra)
esNonMyopic = NonMyopic C
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 C)
loadSnapShotsNoSharing :: forall (m :: * -> *).
MonadUnliftIO m =>
Text -> Entity EpochState -> m (SnapShots C)
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 C)
getSnapShotsNoSharing
{-# INLINEABLE loadSnapShotsNoSharing #-}

loadSnapShotsWithSharing ::
  MonadUnliftIO m => T.Text -> Entity EpochState -> m (EpochBoundary.SnapShots C)
loadSnapShotsWithSharing :: forall (m :: * -> *).
MonadUnliftIO m =>
Text -> Entity EpochState -> m (SnapShots C)
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 C)
getSnapShotsWithSharing
{-# INLINEABLE loadSnapShotsWithSharing #-}

loadSnapShotsNoSharingM :: T.Text -> Entity EpochState -> IO (SnapShotsM C)
loadSnapShotsNoSharingM :: Text -> Entity EpochState -> IO (SnapShotsM C)
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 C)
getSnapShotsNoSharingM
{-# INLINEABLE loadSnapShotsNoSharingM #-}

loadSnapShotsWithSharingM :: T.Text -> Entity EpochState -> IO (SnapShotsM C)
loadSnapShotsWithSharingM :: Text -> Entity EpochState -> IO (SnapShotsM C)
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 C)
getSnapShotsWithSharingM
{-# INLINEABLE loadSnapShotsWithSharingM #-}