{-# 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.Keys as Keys
import Cardano.Ledger.Shelley.LedgerState (curPParamsEpochStateL, prevPParamsEpochStateL)
import qualified Cardano.Ledger.Shelley.LedgerState as Shelley
import Cardano.Ledger.State (EraCertState (..))
import qualified Cardano.Ledger.State as State
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 Conduit
import Control.Foldl (Fold (..))
import Control.Monad
import Control.Monad.Trans.Reader
import Data.Conduit.Internal (zipSources)
import Data.Conduit.List (sourceList)
import Data.Default (def)
import Data.Functor
import qualified Data.IntMap.Strict as IntMap
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import qualified Data.VMap as VMap
import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Generic.Mutable as VGM
import Database.Persist.Sqlite
import Lens.Micro ((&), (.~), (^.))

-- Populate database

insertGetKey ::
  ( MonadIO m
  , PersistUniqueWrite backend
  , PersistRecordBackend record backend
  , AtLeastOneUniqueKey record
  , SafeToInsert record
  ) =>
  record ->
  ReaderT backend m (Key record)
insertGetKey :: forall (m :: * -> *) backend record.
(MonadIO m, PersistUniqueWrite backend,
 PersistRecordBackend record backend, AtLeastOneUniqueKey record,
 SafeToInsert record) =>
record -> ReaderT backend m (Key record)
insertGetKey = (Either (Entity record) (Key record) -> Key record)
-> ReaderT backend m (Either (Entity record) (Key record))
-> ReaderT backend m (Key record)
forall a b. (a -> b) -> ReaderT backend m a -> ReaderT backend m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Entity record -> Key record)
-> (Key record -> Key record)
-> Either (Entity record) (Key record)
-> Key record
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Entity record -> Key record
forall record. Entity record -> Key record
entityKey Key record -> Key record
forall a. a -> a
id) (ReaderT backend m (Either (Entity record) (Key record))
 -> ReaderT backend m (Key record))
-> (record
    -> ReaderT backend m (Either (Entity record) (Key record)))
-> record
-> ReaderT backend m (Key record)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. record -> ReaderT backend m (Either (Entity record) (Key record))
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
InstantStake CurrentEra
Coin
utxosUtxo :: UTxO CurrentEra
utxosDeposited :: Coin
utxosFees :: Coin
utxosGovState :: GovState CurrentEra
utxosInstantStake :: InstantStake CurrentEra
utxosDonation :: Coin
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
utxosInstantStake :: forall era. UTxOState era -> InstantStake era
utxosDonation :: forall era. UTxOState era -> Coin
..} = do
  UtxoState -> ReaderT SqlBackend m (Key UtxoState)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m (Key record)
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend,
 SafeToInsert record) =>
record -> ReaderT SqlBackend m (Key record)
insert (UtxoState -> ReaderT SqlBackend m (Key UtxoState))
-> UtxoState -> ReaderT SqlBackend m (Key UtxoState)
forall a b. (a -> b) -> a -> b
$
    UtxoState
      { utxoStateDeposited :: Coin
utxoStateDeposited = Coin
utxosDeposited
      , utxoStateFees :: Coin
utxoStateFees = Coin
utxosFees
      , utxoStateGovState :: ConwayGovState CurrentEra
utxoStateGovState = GovState CurrentEra
ConwayGovState 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
  ((TxIn, BabbageTxOut CurrentEra) -> ReaderT SqlBackend m ())
-> [(TxIn, BabbageTxOut CurrentEra)] -> ReaderT SqlBackend m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (TxIn, BabbageTxOut CurrentEra) -> ReaderT SqlBackend m ()
insertTxOut ([(TxIn, BabbageTxOut CurrentEra)] -> ReaderT SqlBackend m ())
-> [(TxIn, BabbageTxOut CurrentEra)] -> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$ Map TxIn (BabbageTxOut CurrentEra)
-> [(TxIn, BabbageTxOut CurrentEra)]
forall k a. Map k a -> [(k, a)]
Map.toList (UTxO CurrentEra -> Map TxIn (TxOut CurrentEra)
forall era. UTxO era -> Map TxIn (TxOut era)
Shelley.unUTxO UTxO CurrentEra
utxo)
  where
    insertTxOut :: (TxIn, BabbageTxOut CurrentEra) -> ReaderT SqlBackend m ()
insertTxOut (TxIn.TxIn TxId
txId TxIx
txIx, BabbageTxOut CurrentEra
out) = do
      Key Tx
txKey <-
        Tx -> ReaderT SqlBackend m (Key Tx)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m (Key record)
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend,
 SafeToInsert record) =>
record -> ReaderT SqlBackend m (Key record)
insert (Tx -> ReaderT SqlBackend m (Key Tx))
-> Tx -> ReaderT SqlBackend m (Key Tx)
forall a b. (a -> b) -> a -> b
$ Tx {txInIx :: TxIx
txInIx = TxIx
txIx, txInId :: TxId
txInId = TxId
txId, txOut :: BabbageTxOut CurrentEra
txOut = BabbageTxOut CurrentEra
out}
      Key Txs
txsKey <-
        Txs -> ReaderT SqlBackend m (Key Txs)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m (Key record)
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend,
 SafeToInsert record) =>
record -> ReaderT SqlBackend m (Key record)
insert (Txs -> ReaderT SqlBackend m (Key Txs))
-> Txs -> ReaderT SqlBackend m (Key Txs)
forall a b. (a -> b) -> a -> b
$
          Txs
            { txsInIx :: TxIx
txsInIx = TxIx
txIx
            , txsInId :: TxId
txsInId = TxId
txId
            , txsOut :: BabbageTxOut CurrentEra
txsOut = BabbageTxOut CurrentEra
out
            , txsStakeCredential :: Maybe CredentialId
txsStakeCredential = Maybe CredentialId
forall a. Maybe a
Nothing
            }
      UtxoEntry -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m ()
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend,
 SafeToInsert record) =>
record -> ReaderT SqlBackend m ()
insert_ (UtxoEntry -> ReaderT SqlBackend m ())
-> UtxoEntry -> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$
        UtxoEntry
          { utxoEntryTxId :: Key Tx
utxoEntryTxId = Key Tx
txKey
          , utxoEntryTxsId :: Key Txs
utxoEntryTxsId = Key Txs
txsKey
          , utxoEntryStateId :: Key UtxoState
utxoEntryStateId = Key UtxoState
stateKey
          }

insertDState :: MonadIO m => Shelley.DState CurrentEra -> ReaderT SqlBackend m DStateId
insertDState :: forall (m :: * -> *).
MonadIO m =>
DState CurrentEra -> ReaderT SqlBackend m DStateId
insertDState Shelley.DState {Map FutureGenDeleg GenDelegPair
InstantaneousRewards
GenDelegs
UMap
dsUnified :: UMap
dsFutureGenDelegs :: Map FutureGenDeleg GenDelegPair
dsGenDelegs :: GenDelegs
dsIRewards :: InstantaneousRewards
dsUnified :: forall era. DState era -> UMap
dsFutureGenDelegs :: forall era. DState era -> Map FutureGenDeleg GenDelegPair
dsGenDelegs :: forall era. DState era -> GenDelegs
dsIRewards :: forall era. DState era -> InstantaneousRewards
..} = do
  let irDeltaReserves :: DeltaCoin
irDeltaReserves = InstantaneousRewards -> DeltaCoin
Shelley.deltaReserves InstantaneousRewards
dsIRewards
  let irDeltaTreasury :: DeltaCoin
irDeltaTreasury = InstantaneousRewards -> DeltaCoin
Shelley.deltaTreasury InstantaneousRewards
dsIRewards
  DStateId
dstateId <- DState -> ReaderT SqlBackend m DStateId
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m (Key record)
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend,
 SafeToInsert record) =>
record -> ReaderT SqlBackend m (Key record)
insert (DState -> ReaderT SqlBackend m DStateId)
-> DState -> ReaderT SqlBackend m DStateId
forall a b. (a -> b) -> a -> b
$ FGenDelegs -> GenDelegs -> DeltaCoin -> DeltaCoin -> DState
DState (Map FutureGenDeleg GenDelegPair -> FGenDelegs
forall a. a -> Enc a
Enc Map FutureGenDeleg GenDelegPair
dsFutureGenDelegs) GenDelegs
dsGenDelegs DeltaCoin
irDeltaReserves DeltaCoin
irDeltaTreasury
  [(Credential 'Staking, Coin)]
-> ((Credential 'Staking, Coin) -> ReaderT SqlBackend m ())
-> ReaderT SqlBackend m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map (Credential 'Staking) Coin -> [(Credential 'Staking, Coin)]
forall k a. Map k a -> [(k, a)]
Map.toList (UMap -> Map (Credential 'Staking) Coin
rewardMap UMap
dsUnified)) (((Credential 'Staking, Coin) -> ReaderT SqlBackend m ())
 -> ReaderT SqlBackend m ())
-> ((Credential 'Staking, Coin) -> ReaderT SqlBackend m ())
-> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$ \(Credential 'Staking
cred, Coin
c) -> do
    CredentialId
credId <- Credential -> ReaderT SqlBackend m CredentialId
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 (Credential 'Staking -> CredentialWitness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
Keys.asWitness Credential 'Staking
cred))
    Reward -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m ()
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend,
 SafeToInsert record) =>
record -> ReaderT SqlBackend m ()
insert_ (DStateId -> CredentialId -> Coin -> Reward
Reward DStateId
dstateId CredentialId
credId Coin
c)
  [(Credential 'Staking, KeyHash 'StakePool)]
-> ((Credential 'Staking, KeyHash 'StakePool)
    -> ReaderT SqlBackend m ())
-> ReaderT SqlBackend m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map (Credential 'Staking) (KeyHash 'StakePool)
-> [(Credential 'Staking, KeyHash 'StakePool)]
forall k a. Map k a -> [(k, a)]
Map.toList (UMap -> Map (Credential 'Staking) (KeyHash 'StakePool)
sPoolMap UMap
dsUnified)) (((Credential 'Staking, KeyHash 'StakePool)
  -> ReaderT SqlBackend m ())
 -> ReaderT SqlBackend m ())
-> ((Credential 'Staking, KeyHash 'StakePool)
    -> ReaderT SqlBackend m ())
-> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$ \(Credential 'Staking
cred, KeyHash 'StakePool
spKeyHash) -> do
    CredentialId
credId <- Credential -> ReaderT SqlBackend m CredentialId
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 (Credential 'Staking -> CredentialWitness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
Keys.asWitness Credential 'Staking
cred))
    Key KeyHash
keyHashId <- KeyHash -> ReaderT SqlBackend m (Key KeyHash)
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 (KeyHash 'StakePool -> KeyHashWitness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
Keys.asWitness KeyHash 'StakePool
spKeyHash))
    Delegation -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m ()
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend,
 SafeToInsert record) =>
record -> ReaderT SqlBackend m ()
insert_ (DStateId -> CredentialId -> Key KeyHash -> Delegation
Delegation DStateId
dstateId CredentialId
credId Key KeyHash
keyHashId)
  [(Ptr, Credential 'Staking)]
-> ((Ptr, Credential 'Staking) -> ReaderT SqlBackend m ())
-> ReaderT SqlBackend m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map Ptr (Credential 'Staking) -> [(Ptr, Credential 'Staking)]
forall k a. Map k a -> [(k, a)]
Map.toList (UMap -> Map Ptr (Credential 'Staking)
ptrMap UMap
dsUnified)) (((Ptr, Credential 'Staking) -> ReaderT SqlBackend m ())
 -> ReaderT SqlBackend m ())
-> ((Ptr, Credential 'Staking) -> ReaderT SqlBackend m ())
-> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$ \(Ptr
ptr, Credential 'Staking
cred) -> do
    CredentialId
credId <- Credential -> ReaderT SqlBackend m CredentialId
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 (Credential 'Staking -> CredentialWitness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
Keys.asWitness Credential 'Staking
cred))
    Ptr -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m ()
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend,
 SafeToInsert record) =>
record -> ReaderT SqlBackend m ()
insert_ (DStateId -> CredentialId -> Ptr -> Ptr
Ptr DStateId
dstateId CredentialId
credId Ptr
ptr)
  [(Credential 'Staking, Coin)]
-> ((Credential 'Staking, Coin) -> ReaderT SqlBackend m ())
-> ReaderT SqlBackend m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map (Credential 'Staking) Coin -> [(Credential 'Staking, Coin)]
forall k a. Map k a -> [(k, a)]
Map.toList (InstantaneousRewards -> Map (Credential 'Staking) Coin
Shelley.iRReserves InstantaneousRewards
dsIRewards)) (((Credential 'Staking, Coin) -> ReaderT SqlBackend m ())
 -> ReaderT SqlBackend m ())
-> ((Credential 'Staking, Coin) -> ReaderT SqlBackend m ())
-> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$ \(Credential 'Staking
cred, Coin
c) -> do
    CredentialId
credId <- Credential -> ReaderT SqlBackend m CredentialId
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 (Credential 'Staking -> CredentialWitness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
Keys.asWitness Credential 'Staking
cred))
    IRReserves -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m ()
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend,
 SafeToInsert record) =>
record -> ReaderT SqlBackend m ()
insert_ (DStateId -> CredentialId -> Coin -> IRReserves
IRReserves DStateId
dstateId CredentialId
credId Coin
c)
  [(Credential 'Staking, Coin)]
-> ((Credential 'Staking, Coin) -> ReaderT SqlBackend m ())
-> ReaderT SqlBackend m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map (Credential 'Staking) Coin -> [(Credential 'Staking, Coin)]
forall k a. Map k a -> [(k, a)]
Map.toList (InstantaneousRewards -> Map (Credential 'Staking) Coin
Shelley.iRTreasury InstantaneousRewards
dsIRewards)) (((Credential 'Staking, Coin) -> ReaderT SqlBackend m ())
 -> ReaderT SqlBackend m ())
-> ((Credential 'Staking, Coin) -> ReaderT SqlBackend m ())
-> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$ \(Credential 'Staking
cred, Coin
c) -> do
    CredentialId
credId <- Credential -> ReaderT SqlBackend m CredentialId
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 (Credential 'Staking -> CredentialWitness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
Keys.asWitness Credential 'Staking
cred))
    IRTreasury -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m ()
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend,
 SafeToInsert record) =>
record -> ReaderT SqlBackend m ()
insert_ (DStateId -> CredentialId -> Coin -> IRTreasury
IRTreasury DStateId
dstateId CredentialId
credId Coin
c)
  DStateId -> ReaderT SqlBackend m DStateId
forall a. a -> ReaderT SqlBackend m a
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 :: UTxOState CurrentEra
lsCertState :: CertState CurrentEra
lsUTxOState :: forall era. LedgerState era -> UTxOState era
lsCertState :: forall era. LedgerState era -> CertState era
..} = do
  Key UtxoState
stateKey <- UTxOState CurrentEra -> ReaderT SqlBackend m (Key UtxoState)
forall (m :: * -> *).
MonadIO m =>
UTxOState CurrentEra -> ReaderT SqlBackend m (Key UtxoState)
insertUTxOState UTxOState CurrentEra
lsUTxOState
  UTxO CurrentEra -> Key UtxoState -> ReaderT SqlBackend m ()
forall (m :: * -> *).
MonadIO m =>
UTxO CurrentEra -> Key UtxoState -> ReaderT SqlBackend m ()
insertUTxO (UTxOState CurrentEra -> UTxO CurrentEra
forall era. UTxOState era -> UTxO era
Shelley.utxosUtxo UTxOState CurrentEra
lsUTxOState) Key UtxoState
stateKey
  DStateId
dstateKey <- DState CurrentEra -> ReaderT SqlBackend m DStateId
forall (m :: * -> *).
MonadIO m =>
DState CurrentEra -> ReaderT SqlBackend m DStateId
insertDState (DState CurrentEra -> ReaderT SqlBackend m DStateId)
-> DState CurrentEra -> ReaderT SqlBackend m DStateId
forall a b. (a -> b) -> a -> b
$ CertState CurrentEra
ConwayCertState CurrentEra
lsCertState ConwayCertState CurrentEra
-> Getting
     (DState CurrentEra)
     (ConwayCertState CurrentEra)
     (DState CurrentEra)
-> DState CurrentEra
forall s a. s -> Getting a s a -> a
^. (DState CurrentEra
 -> Const (DState CurrentEra) (DState CurrentEra))
-> CertState CurrentEra
-> Const (DState CurrentEra) (CertState CurrentEra)
Getting
  (DState CurrentEra)
  (ConwayCertState CurrentEra)
  (DState CurrentEra)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState CurrentEra) (DState CurrentEra)
Shelley.certDStateL
  LedgerState -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m ()
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend,
 SafeToInsert record) =>
record -> ReaderT SqlBackend m ()
insert_
    LedgerState
      { ledgerStateUtxoId :: Key UtxoState
ledgerStateUtxoId = Key UtxoState
stateKey
      , ledgerStateDstateId :: DStateId
ledgerStateDstateId = DStateId
dstateKey
      , ledgerStatePstateBin :: PState CurrentEra
ledgerStatePstateBin = CertState CurrentEra
ConwayCertState CurrentEra
lsCertState ConwayCertState CurrentEra
-> Getting
     (PState CurrentEra)
     (ConwayCertState CurrentEra)
     (PState CurrentEra)
-> PState CurrentEra
forall s a. s -> Getting a s a -> a
^. (PState CurrentEra
 -> Const (PState CurrentEra) (PState CurrentEra))
-> CertState CurrentEra
-> Const (PState CurrentEra) (CertState CurrentEra)
Getting
  (PState CurrentEra)
  (ConwayCertState CurrentEra)
  (PState CurrentEra)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState CurrentEra) (PState CurrentEra)
Shelley.certPStateL
      , ledgerStateEpochStateId :: EpochStateId
ledgerStateEpochStateId = EpochStateId
epochStateKey
      }

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

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

insertEpochState ::
  MonadIO m => Shelley.EpochState CurrentEra -> ReaderT SqlBackend m ()
insertEpochState :: forall (m :: * -> *).
MonadIO m =>
EpochState CurrentEra -> ReaderT SqlBackend m ()
insertEpochState es :: EpochState CurrentEra
es@Shelley.EpochState {ChainAccountState
SnapShots
NonMyopic
LedgerState CurrentEra
esChainAccountState :: ChainAccountState
esLState :: LedgerState CurrentEra
esSnapshots :: SnapShots
esNonMyopic :: NonMyopic
esChainAccountState :: forall era. EpochState era -> ChainAccountState
esLState :: forall era. EpochState era -> LedgerState era
esSnapshots :: forall era. EpochState era -> SnapShots
esNonMyopic :: forall era. EpochState era -> NonMyopic
..} = do
  EpochStateId
epochStateKey <-
    EpochState -> ReaderT SqlBackend m EpochStateId
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m (Key record)
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend,
 SafeToInsert record) =>
record -> ReaderT SqlBackend m (Key record)
insert
      EpochState
        { epochStateTreasury :: Coin
epochStateTreasury = ChainAccountState -> Coin
State.casTreasury ChainAccountState
esChainAccountState
        , epochStateReserves :: Coin
epochStateReserves = ChainAccountState -> Coin
State.casReserves ChainAccountState
esChainAccountState
        , epochStatePrevPp :: PParams CurrentEra
epochStatePrevPp = EpochState CurrentEra
es EpochState CurrentEra
-> Getting
     (PParams CurrentEra) (EpochState CurrentEra) (PParams CurrentEra)
-> PParams CurrentEra
forall s a. s -> Getting a s a -> a
^. Getting
  (PParams CurrentEra) (EpochState CurrentEra) (PParams CurrentEra)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState CurrentEra) (PParams CurrentEra)
prevPParamsEpochStateL
        , epochStatePp :: PParams CurrentEra
epochStatePp = EpochState CurrentEra
es EpochState CurrentEra
-> Getting
     (PParams CurrentEra) (EpochState CurrentEra) (PParams CurrentEra)
-> PParams CurrentEra
forall s a. s -> Getting a s a -> a
^. Getting
  (PParams CurrentEra) (EpochState CurrentEra) (PParams CurrentEra)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState CurrentEra) (PParams CurrentEra)
curPParamsEpochStateL
        , epochStateNonMyopic :: NonMyopic
epochStateNonMyopic = NonMyopic
esNonMyopic
        , epochStateSnapShotsFee :: Coin
epochStateSnapShotsFee = SnapShots -> Coin
State.ssFee SnapShots
esSnapshots
        }
  EpochStateId -> SnapShots -> ReaderT SqlBackend m ()
forall (m :: * -> *).
MonadIO m =>
EpochStateId -> SnapShots -> ReaderT SqlBackend m ()
insertSnapShots EpochStateId
epochStateKey SnapShots
esSnapshots
  EpochStateId -> LedgerState CurrentEra -> ReaderT SqlBackend m ()
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 <- [Filter record] -> ReaderT SqlBackend m Int
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m Int
forall (m :: * -> *) record.
(MonadIO m, PersistRecordBackend record SqlBackend) =>
[Filter record] -> ReaderT SqlBackend m Int
count [Filter record]
fs
  KVMVector (Mutable kv) (Mutable vv) RealWorld (k, v)
mv <- IO (KVMVector (Mutable kv) (Mutable vv) RealWorld (k, v))
-> ReaderT
     SqlBackend m (KVMVector (Mutable kv) (Mutable vv) RealWorld (k, v))
forall a. IO a -> ReaderT SqlBackend m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (KVMVector (Mutable kv) (Mutable vv) RealWorld (k, v))
 -> ReaderT
      SqlBackend
      m
      (KVMVector (Mutable kv) (Mutable vv) RealWorld (k, v)))
-> IO (KVMVector (Mutable kv) (Mutable vv) RealWorld (k, v))
-> ReaderT
     SqlBackend m (KVMVector (Mutable kv) (Mutable vv) RealWorld (k, v))
forall a b. (a -> b) -> a -> b
$ Int
-> IO (KVMVector (Mutable kv) (Mutable vv) (PrimState IO) (k, v))
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
Int -> m (v (PrimState m) a)
VGM.unsafeNew Int
n
  ConduitT () Void (ReaderT SqlBackend m) ()
-> ReaderT SqlBackend m ()
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void (ReaderT SqlBackend m) ()
 -> ReaderT SqlBackend m ())
-> ConduitT () Void (ReaderT SqlBackend m) ()
-> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$
    ConduitT () Int (ReaderT SqlBackend m) ()
-> ConduitT () (Entity record) (ReaderT SqlBackend m) ()
-> ConduitT () (Int, Entity record) (ReaderT SqlBackend m) ()
forall (m :: * -> *) a b.
Monad m =>
ConduitT () a m () -> ConduitT () b m () -> ConduitT () (a, b) m ()
zipSources ([Int] -> ConduitT () Int (ReaderT SqlBackend m) ()
forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
sourceList [Int
0 ..]) ([Filter record]
-> [SelectOpt record]
-> ConduitT () (Entity record) (ReaderT SqlBackend m) ()
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 [])
      ConduitT () (Int, Entity record) (ReaderT SqlBackend m) ()
-> ConduitT (Int, Entity record) Void (ReaderT SqlBackend m) ()
-> ConduitT () Void (ReaderT SqlBackend m) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ((Int, Entity record) -> ReaderT SqlBackend m ())
-> ConduitT (Int, Entity record) Void (ReaderT SqlBackend m) ()
forall (m :: * -> *) a o.
Monad m =>
(a -> m ()) -> ConduitT a o m ()
mapM_C (\(Int
i, Entity Key record
_ record
a) -> IO () -> ReaderT SqlBackend m ()
forall a. IO a -> ReaderT SqlBackend m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT SqlBackend m ())
-> ((k, v) -> IO ()) -> (k, v) -> ReaderT SqlBackend m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KVMVector (Mutable kv) (Mutable vv) (PrimState IO) (k, v)
-> Int -> (k, v) -> IO ()
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)
KVMVector (Mutable kv) (Mutable vv) (PrimState IO) (k, v)
mv Int
i ((k, v) -> ReaderT SqlBackend m ())
-> ReaderT SqlBackend m (k, v) -> ReaderT SqlBackend m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< record -> ReaderT SqlBackend m (k, v)
f record
a)
  KVVector kv vv (k, v) -> VMap kv vv k v
forall (kv :: * -> *) (vv :: * -> *) k v.
KVVector kv vv (k, v) -> VMap kv vv k v
VMap.VMap (KVVector kv vv (k, v) -> VMap kv vv k v)
-> ReaderT SqlBackend m (KVVector kv vv (k, v))
-> ReaderT SqlBackend m (VMap kv vv k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (KVVector kv vv (k, v))
-> ReaderT SqlBackend m (KVVector kv vv (k, v))
forall a. IO a -> ReaderT SqlBackend m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Mutable (KVVector kv vv) (PrimState IO) (k, v)
-> IO (KVVector kv vv (k, v))
KVMVector (Mutable kv) (Mutable vv) RealWorld (k, v)
-> IO (KVVector kv vv (k, v))
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
VG.unsafeFreeze (KVMVector (Mutable kv) (Mutable vv) RealWorld (k, v)
 -> IO (KVVector kv vv (k, v)))
-> IO (KVMVector (Mutable kv) (Mutable vv) RealWorld (k, v))
-> IO (KVVector kv vv (k, v))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< KVMVector (Mutable kv) (Mutable vv) (PrimState IO) (k, v)
-> IO (KVMVector (Mutable kv) (Mutable vv) (PrimState IO) (k, v))
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)
KVMVector (Mutable kv) (Mutable vv) (PrimState IO) (k, v)
mv)
{-# INLINEABLE selectVMap #-}

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

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

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

-- Into a Map structure

selectMap ::
  ( MonadResource m
  , Ord k
  , PersistEntity record
  , PersistEntityBackend record ~ SqlBackend
  ) =>
  [Filter record] ->
  (record -> ReaderT SqlBackend m (k, a)) ->
  ReaderT SqlBackend m (Map.Map k a)
selectMap :: forall (m :: * -> *) k record a.
(MonadResource m, Ord k, PersistEntity record,
 PersistEntityBackend record ~ SqlBackend) =>
[Filter record]
-> (record -> ReaderT SqlBackend m (k, a))
-> ReaderT SqlBackend m (Map k a)
selectMap [Filter record]
fs record -> ReaderT SqlBackend m (k, a)
f = do
  ConduitT () Void (ReaderT SqlBackend m) (Map k a)
-> ReaderT SqlBackend m (Map k a)
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void (ReaderT SqlBackend m) (Map k a)
 -> ReaderT SqlBackend m (Map k a))
-> ConduitT () Void (ReaderT SqlBackend m) (Map k a)
-> ReaderT SqlBackend m (Map k a)
forall a b. (a -> b) -> a -> b
$
    [Filter record]
-> [SelectOpt record]
-> ConduitM () (Entity record) (ReaderT SqlBackend m) ()
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 []
      ConduitM () (Entity record) (ReaderT SqlBackend m) ()
-> ConduitT (Entity record) Void (ReaderT SqlBackend m) (Map k a)
-> ConduitT () Void (ReaderT SqlBackend m) (Map k a)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (Entity record -> ReaderT SqlBackend m (k, a))
-> ConduitT (Entity record) (k, a) (ReaderT SqlBackend m) ()
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)
      ConduitT (Entity record) (k, a) (ReaderT SqlBackend m) ()
-> ConduitT (k, a) Void (ReaderT SqlBackend m) (Map k a)
-> ConduitT (Entity record) Void (ReaderT SqlBackend m) (Map k a)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (Map k a -> (k, a) -> Map k a)
-> Map k a -> ConduitT (k, a) Void (ReaderT SqlBackend m) (Map k a)
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) -> k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
k a
v Map k a
m) Map k a
forall a. Monoid a => a
mempty
{-# INLINEABLE selectMap #-}

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

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

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

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

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

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

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

foldDbUTxO ::
  MonadUnliftIO m =>
  -- | Folding function
  (a -> (TxIn.TxIn, TxOut CurrentEra) -> a) ->
  -- | Empty acc
  a ->
  -- | Path to Sqlite db
  T.Text ->
  m a
foldDbUTxO :: forall (m :: * -> *) a.
MonadUnliftIO m =>
(a -> (TxIn, TxOut CurrentEra) -> a) -> a -> Text -> m a
foldDbUTxO a -> (TxIn, TxOut CurrentEra) -> a
f a
m Text
fp = Text -> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
Text -> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a -> m a
runSqlite Text
fp (ConduitT () Void (ReaderT SqlBackend (NoLoggingT (ResourceT m))) a
-> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitM
  ()
  (TxIn, TxOut CurrentEra)
  (ReaderT SqlBackend (NoLoggingT (ResourceT m)))
  ()
ConduitT
  ()
  (TxIn, BabbageTxOut CurrentEra)
  (ReaderT SqlBackend (NoLoggingT (ResourceT m)))
  ()
forall (m :: * -> *).
MonadResource m =>
ConduitM () (TxIn, TxOut CurrentEra) (ReaderT SqlBackend m) ()
sourceUTxO ConduitT
  ()
  (TxIn, BabbageTxOut CurrentEra)
  (ReaderT SqlBackend (NoLoggingT (ResourceT m)))
  ()
-> ConduitT
     (TxIn, BabbageTxOut CurrentEra)
     Void
     (ReaderT SqlBackend (NoLoggingT (ResourceT m)))
     a
-> ConduitT
     () Void (ReaderT SqlBackend (NoLoggingT (ResourceT m))) a
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (a -> (TxIn, BabbageTxOut CurrentEra) -> a)
-> a
-> ConduitT
     (TxIn, BabbageTxOut CurrentEra)
     Void
     (ReaderT SqlBackend (NoLoggingT (ResourceT m)))
     a
forall (m :: * -> *) a b o.
Monad m =>
(a -> b -> a) -> a -> ConduitT b o m a
foldlC a -> (TxIn, TxOut CurrentEra) -> a
a -> (TxIn, BabbageTxOut 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
ledgerStateUtxoId :: LedgerState -> Key UtxoState
ledgerStateDstateId :: LedgerState -> DStateId
ledgerStatePstateBin :: LedgerState -> PState CurrentEra
ledgerStateEpochStateId :: LedgerState -> EpochStateId
ledgerStateUtxoId :: Key UtxoState
ledgerStateDstateId :: DStateId
ledgerStateEpochStateId :: EpochStateId
ledgerStatePstateBin :: PState CurrentEra
..} DState CurrentEra
dstate = do
  UtxoState {ConwayGovState CurrentEra
Coin
utxoStateDeposited :: UtxoState -> Coin
utxoStateFees :: UtxoState -> Coin
utxoStateGovState :: UtxoState -> ConwayGovState CurrentEra
utxoStateDonation :: UtxoState -> Coin
utxoStateDeposited :: Coin
utxoStateFees :: Coin
utxoStateGovState :: ConwayGovState CurrentEra
utxoStateDonation :: Coin
..} <- Key UtxoState -> ReaderT SqlBackend m UtxoState
forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
getJust Key UtxoState
ledgerStateUtxoId
  LedgerState CurrentEra
-> ReaderT SqlBackend m (LedgerState CurrentEra)
forall a. a -> ReaderT SqlBackend m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Shelley.LedgerState
      { lsUTxOState :: UTxOState CurrentEra
Shelley.lsUTxOState =
          PParams CurrentEra
-> UTxO CurrentEra
-> Coin
-> Coin
-> GovState CurrentEra
-> Coin
-> UTxOState CurrentEra
forall era.
EraStake era =>
PParams era
-> UTxO era
-> Coin
-> Coin
-> GovState era
-> Coin
-> UTxOState era
Shelley.smartUTxOState
            PParams CurrentEra
forall era. EraPParams era => PParams era
emptyPParams
            UTxO CurrentEra
utxo
            Coin
utxoStateDeposited
            Coin
utxoStateFees
            GovState CurrentEra
ConwayGovState CurrentEra
utxoStateGovState -- Maintain invariant
            Coin
utxoStateDonation
      , lsCertState :: CertState CurrentEra
Shelley.lsCertState =
          ConwayCertState CurrentEra
forall a. Default a => a
def
            ConwayCertState CurrentEra
-> (ConwayCertState CurrentEra -> ConwayCertState CurrentEra)
-> ConwayCertState CurrentEra
forall a b. a -> (a -> b) -> b
& (PState CurrentEra -> Identity (PState CurrentEra))
-> CertState CurrentEra -> Identity (CertState CurrentEra)
(PState CurrentEra -> Identity (PState CurrentEra))
-> ConwayCertState CurrentEra
-> Identity (ConwayCertState CurrentEra)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState CurrentEra) (PState CurrentEra)
certPStateL ((PState CurrentEra -> Identity (PState CurrentEra))
 -> ConwayCertState CurrentEra
 -> Identity (ConwayCertState CurrentEra))
-> PState CurrentEra
-> ConwayCertState CurrentEra
-> ConwayCertState CurrentEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PState CurrentEra
ledgerStatePstateBin
            ConwayCertState CurrentEra
-> (ConwayCertState CurrentEra -> ConwayCertState CurrentEra)
-> ConwayCertState CurrentEra
forall a b. a -> (a -> b) -> b
& (DState CurrentEra -> Identity (DState CurrentEra))
-> CertState CurrentEra -> Identity (CertState CurrentEra)
(DState CurrentEra -> Identity (DState CurrentEra))
-> ConwayCertState CurrentEra
-> Identity (ConwayCertState CurrentEra)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState CurrentEra) (DState CurrentEra)
certDStateL ((DState CurrentEra -> Identity (DState CurrentEra))
 -> ConwayCertState CurrentEra
 -> Identity (ConwayCertState CurrentEra))
-> DState CurrentEra
-> ConwayCertState CurrentEra
-> ConwayCertState CurrentEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DState CurrentEra
dstate
      }

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

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

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

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

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

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

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

loadDbUTxO :: UTxOFold a -> T.Text -> IO a
loadDbUTxO :: forall a. UTxOFold a -> Text -> IO a
loadDbUTxO (Fold x -> (TxIn, TxOut CurrentEra) -> x
f x
e x -> a
g) Text
fp = Text -> ReaderT SqlBackend (NoLoggingT (ResourceT IO)) a -> IO a
forall (m :: * -> *) a.
MonadUnliftIO m =>
Text -> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a -> m a
runSqlite Text
fp (x -> a
g (x -> a)
-> ReaderT SqlBackend (NoLoggingT (ResourceT IO)) x
-> ReaderT SqlBackend (NoLoggingT (ResourceT IO)) a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConduitT () Void (ReaderT SqlBackend (NoLoggingT (ResourceT IO))) x
-> ReaderT SqlBackend (NoLoggingT (ResourceT IO)) x
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitM
  ()
  (TxIn, TxOut CurrentEra)
  (ReaderT SqlBackend (NoLoggingT (ResourceT IO)))
  ()
ConduitT
  ()
  (TxIn, BabbageTxOut CurrentEra)
  (ReaderT SqlBackend (NoLoggingT (ResourceT IO)))
  ()
forall (m :: * -> *).
MonadResource m =>
ConduitM () (TxIn, TxOut CurrentEra) (ReaderT SqlBackend m) ()
sourceUTxO ConduitT
  ()
  (TxIn, BabbageTxOut CurrentEra)
  (ReaderT SqlBackend (NoLoggingT (ResourceT IO)))
  ()
-> ConduitT
     (TxIn, BabbageTxOut CurrentEra)
     Void
     (ReaderT SqlBackend (NoLoggingT (ResourceT IO)))
     x
-> ConduitT
     () Void (ReaderT SqlBackend (NoLoggingT (ResourceT IO))) x
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (x -> (TxIn, BabbageTxOut CurrentEra) -> x)
-> x
-> ConduitT
     (TxIn, BabbageTxOut CurrentEra)
     Void
     (ReaderT SqlBackend (NoLoggingT (ResourceT IO)))
     x
forall (m :: * -> *) a b o.
Monad m =>
(a -> b -> a) -> a -> ConduitT b o m a
foldlC x -> (TxIn, TxOut CurrentEra) -> x
x -> (TxIn, BabbageTxOut 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 = Text
-> ReaderT
     SqlBackend (NoLoggingT (ResourceT m)) (Entity EpochState)
-> m (Entity EpochState)
forall (m :: * -> *) a.
MonadUnliftIO m =>
Text -> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a -> m a
runSqlite Text
fp (EpochStateId
-> ReaderT
     SqlBackend (NoLoggingT (ResourceT m)) (Entity EpochState)
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
ledgerStateUtxoId :: LedgerState -> Key UtxoState
ledgerStateDstateId :: LedgerState -> DStateId
ledgerStatePstateBin :: LedgerState -> PState CurrentEra
ledgerStateEpochStateId :: LedgerState -> EpochStateId
ledgerStateUtxoId :: Key UtxoState
ledgerStateDstateId :: DStateId
ledgerStateEpochStateId :: EpochStateId
ledgerStatePstateBin :: PState CurrentEra
..} <-
    ReaderT SqlBackend m LedgerState
-> (Entity LedgerState -> ReaderT SqlBackend m LedgerState)
-> Maybe (Entity LedgerState)
-> ReaderT SqlBackend m LedgerState
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> ReaderT SqlBackend m LedgerState
forall a. HasCallStack => [Char] -> a
error [Char]
"Impossible") (LedgerState -> ReaderT SqlBackend m LedgerState
forall a. a -> ReaderT SqlBackend m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LedgerState -> ReaderT SqlBackend m LedgerState)
-> (Entity LedgerState -> LedgerState)
-> Entity LedgerState
-> ReaderT SqlBackend m LedgerState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity LedgerState -> LedgerState
forall record. Entity record -> record
entityVal)
      (Maybe (Entity LedgerState) -> ReaderT SqlBackend m LedgerState)
-> ReaderT SqlBackend m (Maybe (Entity LedgerState))
-> ReaderT SqlBackend m LedgerState
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Filter LedgerState]
-> [SelectOpt LedgerState]
-> ReaderT SqlBackend m (Maybe (Entity LedgerState))
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m (Maybe (Entity record))
forall (m :: * -> *) record.
(MonadIO m, PersistRecordBackend record SqlBackend) =>
[Filter record]
-> [SelectOpt record]
-> ReaderT SqlBackend m (Maybe (Entity record))
selectFirst [EntityField LedgerState EpochStateId
forall typ. (typ ~ EpochStateId) => EntityField LedgerState typ
LedgerStateEpochStateId EntityField LedgerState EpochStateId
-> EpochStateId -> Filter LedgerState
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Entity EpochState -> EpochStateId
forall record. Entity record -> Key record
entityKey Entity EpochState
ese] []
  DState CurrentEra
dstate <- DStateId -> ReaderT SqlBackend m (DState CurrentEra)
forall (m :: * -> *).
MonadIO m =>
DStateId -> ReaderT SqlBackend m (DState CurrentEra)
getDStateWithSharing DStateId
ledgerStateDstateId
  Map TxIn (BabbageTxOut CurrentEra)
m <- ConduitT
  () (TxIn, BabbageTxOut CurrentEra) (ReaderT SqlBackend m) ()
-> Fold
     (TxIn, BabbageTxOut CurrentEra)
     (Map TxIn (BabbageTxOut CurrentEra))
-> ReaderT SqlBackend m (Map TxIn (BabbageTxOut CurrentEra))
forall (m :: * -> *) a b.
Monad m =>
ConduitT () a m () -> Fold a b -> m b
runConduitFold ConduitM () (TxIn, TxOut CurrentEra) (ReaderT SqlBackend m) ()
ConduitT
  () (TxIn, BabbageTxOut CurrentEra) (ReaderT SqlBackend m) ()
forall (m :: * -> *).
MonadResource m =>
ConduitM () (TxIn, TxOut CurrentEra) (ReaderT SqlBackend m) ()
sourceUTxO Fold
  (TxIn, BabbageTxOut CurrentEra)
  (Map TxIn (BabbageTxOut CurrentEra))
forall a. Fold (TxIn, a) (Map TxIn a)
noSharingMap
  UTxO CurrentEra
-> LedgerState
-> DState CurrentEra
-> ReaderT SqlBackend m (LedgerState CurrentEra)
forall (m :: * -> *).
MonadIO m =>
UTxO CurrentEra
-> LedgerState
-> DState CurrentEra
-> ReaderT SqlBackend m (LedgerState CurrentEra)
getLedgerState (Map TxIn (TxOut CurrentEra) -> UTxO CurrentEra
forall era. Map TxIn (TxOut era) -> UTxO era
Shelley.UTxO Map TxIn (TxOut CurrentEra)
Map TxIn (BabbageTxOut CurrentEra)
m) LedgerState
ledgerState DState CurrentEra
dstate

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

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

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

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

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

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