{-# 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 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 ((&), (.~), (^.))
import Test.Cardano.Ledger.Conway.Era (EraTest, accountsFromAccountsMap, mkTestAccountState)

-- 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
InstantStake CurrentEra
UTxO CurrentEra
Coin
utxosUtxo :: UTxO CurrentEra
utxosDeposited :: Coin
utxosFees :: Coin
utxosGovState :: GovState CurrentEra
utxosInstantStake :: InstantStake CurrentEra
utxosDonation :: Coin
utxosDonation :: forall era. UTxOState era -> Coin
utxosInstantStake :: forall era. UTxOState era -> InstantStake era
utxosGovState :: forall era. UTxOState era -> GovState era
utxosFees :: forall era. UTxOState era -> Coin
utxosDeposited :: forall era. UTxOState era -> Coin
utxosUtxo :: forall era. UTxOState era -> UTxO era
..} = 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
      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}
      txsKey <-
        insert $
          Txs
            { txsInIx = txIx
            , txsInId = txId
            , txsOut = out
            , txsStakeCredential = Nothing
            }
      insert_ $
        UtxoEntry
          { utxoEntryTxId = txKey
          , utxoEntryTxsId = txsKey
          , utxoEntryStateId = 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
Accounts CurrentEra
InstantaneousRewards
GenDelegs
dsAccounts :: Accounts CurrentEra
dsFutureGenDelegs :: Map FutureGenDeleg GenDelegPair
dsGenDelegs :: GenDelegs
dsIRewards :: InstantaneousRewards
dsAccounts :: forall era. DState era -> Accounts era
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 <- 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
  forM_ (Map.toList (dsAccounts ^. State.accountsMapL)) $ \(Credential Staking
cred, AccountState CurrentEra
accountState) -> do
    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))
    insert_ $ -- TODO: fix insertion of DRep and StakePool delegation
      Account
        dstateId
        credId
        Nothing
        (accountState ^. State.balanceAccountStateL)
        (accountState ^. State.depositAccountStateL)
        Nothing
        DRepDelegationNone
        Nothing
  forM_ (Map.toList (Shelley.iRReserves dsIRewards)) $ \(Credential Staking
cred, Coin
c) -> do
    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))
    insert_ (IRReserves dstateId credId c)
  forM_ (Map.toList (Shelley.iRTreasury dsIRewards)) $ \(Credential Staking
cred, Coin
c) -> do
    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))
    insert_ (IRTreasury dstateId credId c)
  pure 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
lsCertState :: forall era. LedgerState era -> CertState era
lsUTxOState :: forall era. LedgerState era -> UTxOState era
..} = do
  stateKey <- UTxOState CurrentEra -> ReaderT SqlBackend m (Key UtxoState)
forall (m :: * -> *).
MonadIO m =>
UTxOState CurrentEra -> ReaderT SqlBackend m (Key UtxoState)
insertUTxOState UTxOState CurrentEra
lsUTxOState
  insertUTxO (Shelley.utxosUtxo lsUTxOState) stateKey
  dstateKey <- insertDState $ lsCertState ^. Shelley.certDStateL
  insert_
    LedgerState
      { ledgerStateUtxoId = stateKey
      , ledgerStateDstateId = dstateKey
      , ledgerStatePstateBin = lsCertState ^. Shelley.certPStateL
      , ledgerStateEpochStateId = 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) StakePoolParams
VMap VB VB (Credential Staking) (KeyHash StakePool)
ssStake :: Stake
ssDelegations :: VMap VB VB (Credential Staking) (KeyHash StakePool)
ssPoolParams :: VMap VB VB (KeyHash StakePool) StakePoolParams
ssDelegations :: SnapShot -> VMap VB VB (Credential Staking) (KeyHash StakePool)
ssPoolParams :: SnapShot -> VMap VB VB (KeyHash StakePool) StakePoolParams
ssStake :: SnapShot -> Stake
..} = do
  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}
  VG.forM_ (VMap.unVMap (State.unStake ssStake)) $ \(Credential Staking
cred, CompactForm Coin
c) -> do
    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))
    insert_ (SnapShotStake snapShotId credId c)
  VG.forM_ (VMap.unVMap ssDelegations) $ \(Credential Staking
cred, KeyHash StakePool
spKeyHash) -> do
    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))
    keyHashId <- insertGetKey (KeyHash (Keys.asWitness spKeyHash))
    insert_ (SnapShotDelegation snapShotId credId keyHashId)
  VG.forM_ (VMap.unVMap ssPoolParams) $ \(KeyHash StakePool
keyHash, StakePoolParams
pps) -> do
    keyHashId <- KeyHash -> ReaderT SqlBackend m KeyHashId
forall (m :: * -> *) backend record.
(MonadIO m, PersistUniqueWrite backend,
 PersistRecordBackend record backend, AtLeastOneUniqueKey record,
 SafeToInsert record) =>
record -> ReaderT backend m (Key record)
insertGetKey (KeyHashWitness -> KeyHash
KeyHash (KeyHash StakePool -> KeyHashWitness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a Witness
Keys.asWitness KeyHash StakePool
keyHash))
    insert_ (SnapShotPool snapShotId keyHashId 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
ssFee :: SnapShots -> Coin
ssStakeGo :: SnapShots -> SnapShot
ssStakeMark :: SnapShots -> SnapShot
ssStakeMarkPoolDistr :: SnapShots -> PoolDistr
ssStakeSet :: 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
esNonMyopic :: forall era. EpochState era -> NonMyopic
esSnapshots :: forall era. EpochState era -> SnapShots
esLState :: forall era. EpochState era -> LedgerState era
esChainAccountState :: forall era. EpochState era -> ChainAccountState
..} = do
  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
        }
  insertSnapShots epochStateKey esSnapshots
  insertLedgerState epochStateKey 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
  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
  mv <- liftIO $ VGM.unsafeNew n
  runConduit $
    zipSources (sourceList [0 ..]) (selectSource fs [])
      .| 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)
  VMap.VMap <$> liftIO (VG.unsafeFreeze =<< VMap.normalizeM 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
  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
  stake <-
    selectMap [SnapShotStakeSnapShotId ==. snapShotId] $ \SnapShotStake {CompactForm Coin
CredentialId
Key SnapShot
snapShotStakeSnapShotId :: Key SnapShot
snapShotStakeCredentialId :: CredentialId
snapShotStakeCoin :: CompactForm Coin
snapShotStakeCoin :: SnapShotStake -> CompactForm Coin
snapShotStakeCredentialId :: SnapShotStake -> CredentialId
snapShotStakeSnapShotId :: SnapShotStake -> Key SnapShot
..} -> do
      Credential 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
      pure (Keys.coerceKeyRole credential, snapShotStakeCoin)
  delegations <-
    selectMap [SnapShotDelegationSnapShotId ==. snapShotId] $ \SnapShotDelegation {KeyHashId
CredentialId
Key SnapShot
snapShotDelegationSnapShotId :: Key SnapShot
snapShotDelegationCredentialId :: CredentialId
snapShotDelegationKeyHash :: KeyHashId
snapShotDelegationKeyHash :: SnapShotDelegation -> KeyHashId
snapShotDelegationCredentialId :: SnapShotDelegation -> CredentialId
snapShotDelegationSnapShotId :: SnapShotDelegation -> Key SnapShot
..} -> do
      Credential 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 keyHash <- getJust snapShotDelegationKeyHash
      -- TODO ^ rename snapShotDelegationKeyHashId
      pure (Keys.coerceKeyRole credential, Keys.coerceKeyRole keyHash)
  poolParams <-
    selectMap [SnapShotPoolSnapShotId ==. snapShotId] $ \SnapShotPool {StakePoolParams
KeyHashId
Key SnapShot
snapShotPoolSnapShotId :: Key SnapShot
snapShotPoolKeyHashId :: KeyHashId
snapShotPoolParams :: StakePoolParams
snapShotPoolParams :: SnapShotPool -> StakePoolParams
snapShotPoolKeyHashId :: SnapShotPool -> KeyHashId
snapShotPoolSnapShotId :: SnapShotPool -> Key SnapShot
..} -> do
      KeyHash keyHash <- KeyHashId -> ReaderT SqlBackend m KeyHash
forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
getJust KeyHashId
snapShotPoolKeyHashId
      pure (Keys.coerceKeyRole keyHash, snapShotPoolParams)
  pure
    SnapShotM
      { ssStake = stake
      , ssDelegations = delegations
      , ssStakePoolParams = 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) StakePoolParams
-> Interns (KeyHash StakePool)
forall k a. Ord k => Map k a -> Interns k
internsFromMap (Map (KeyHash StakePool) StakePoolParams
 -> Interns (KeyHash StakePool))
-> (SnapShotM -> Map (KeyHash StakePool) StakePoolParams)
-> SnapShotM
-> Interns (KeyHash StakePool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SnapShotM -> Map (KeyHash StakePool) StakePoolParams
ssStakePoolParams) [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
  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
  stake <-
    selectMap [SnapShotStakeSnapShotId ==. snapShotId] $ \SnapShotStake {CompactForm Coin
CredentialId
Key SnapShot
snapShotStakeCoin :: SnapShotStake -> CompactForm Coin
snapShotStakeCredentialId :: SnapShotStake -> CredentialId
snapShotStakeSnapShotId :: SnapShotStake -> Key SnapShot
snapShotStakeSnapShotId :: Key SnapShot
snapShotStakeCredentialId :: CredentialId
snapShotStakeCoin :: CompactForm Coin
..} -> do
      Credential 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
      pure (internOtherStakes credential, snapShotStakeCoin)
  stakePoolParams <-
    selectMap [SnapShotPoolSnapShotId ==. snapShotId] $ \SnapShotPool {StakePoolParams
KeyHashId
Key SnapShot
snapShotPoolParams :: SnapShotPool -> StakePoolParams
snapShotPoolKeyHashId :: SnapShotPool -> KeyHashId
snapShotPoolSnapShotId :: SnapShotPool -> Key SnapShot
snapShotPoolSnapShotId :: Key SnapShot
snapShotPoolKeyHashId :: KeyHashId
snapShotPoolParams :: StakePoolParams
..} -> do
      KeyHash keyHash <- KeyHashId -> ReaderT SqlBackend m KeyHash
forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
getJust KeyHashId
snapShotPoolKeyHashId
      pure (internOtherPoolParams keyHash, snapShotPoolParams)
  let internPoolParams = Interns (KeyHash StakePool)
-> KeyHash StakePool -> KeyHash StakePool
forall k. Interns k -> k -> k
interns (Map (KeyHash StakePool) StakePoolParams
-> Interns (KeyHash StakePool)
forall k a. Ord k => Map k a -> Interns k
internsFromMap Map (KeyHash StakePool) StakePoolParams
stakePoolParams) (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
  delegations <-
    selectMap [SnapShotDelegationSnapShotId ==. snapShotId] $ \SnapShotDelegation {KeyHashId
CredentialId
Key SnapShot
snapShotDelegationKeyHash :: SnapShotDelegation -> KeyHashId
snapShotDelegationCredentialId :: SnapShotDelegation -> CredentialId
snapShotDelegationSnapShotId :: SnapShotDelegation -> Key SnapShot
snapShotDelegationSnapShotId :: Key SnapShot
snapShotDelegationCredentialId :: CredentialId
snapShotDelegationKeyHash :: KeyHashId
..} -> do
      Credential 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 keyHash <- getJust snapShotDelegationKeyHash
      pure (internOtherDelegations credential, internPoolParams keyHash)
  pure
    SnapShotM
      { ssStake = stake
      , ssDelegations = delegations
      , ssStakePoolParams = stakePoolParams
      }
{-# 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
  mark <- [SnapShotM]
-> EpochStateId -> SnapShotType -> ReaderT SqlBackend m SnapShotM
forall (m :: * -> *).
MonadResource m =>
[SnapShotM]
-> EpochStateId -> SnapShotType -> ReaderT SqlBackend m SnapShotM
getSnapShotWithSharingM [] EpochStateId
epochStateId SnapShotType
SnapShotMark
  set <- getSnapShotWithSharingM [mark] epochStateId SnapShotSet
  go <- getSnapShotWithSharingM [mark, set] epochStateId SnapShotGo
  pure $
    SnapShotsM
      { ssPstakeMark = mark
      , ssPstakeSet = set
      , ssPstakeGo = go
      , ssFeeSS = 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
  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
  stake <-
    selectVMap [SnapShotStakeSnapShotId ==. snapShotId] $ \SnapShotStake {CompactForm Coin
CredentialId
Key SnapShot
snapShotStakeCoin :: SnapShotStake -> CompactForm Coin
snapShotStakeCredentialId :: SnapShotStake -> CredentialId
snapShotStakeSnapShotId :: SnapShotStake -> Key SnapShot
snapShotStakeSnapShotId :: Key SnapShot
snapShotStakeCredentialId :: CredentialId
snapShotStakeCoin :: CompactForm Coin
..} -> do
      Credential 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
      pure (Keys.coerceKeyRole credential, snapShotStakeCoin)
  delegations <-
    selectVMap [SnapShotDelegationSnapShotId ==. snapShotId] $ \SnapShotDelegation {KeyHashId
CredentialId
Key SnapShot
snapShotDelegationKeyHash :: SnapShotDelegation -> KeyHashId
snapShotDelegationCredentialId :: SnapShotDelegation -> CredentialId
snapShotDelegationSnapShotId :: SnapShotDelegation -> Key SnapShot
snapShotDelegationSnapShotId :: Key SnapShot
snapShotDelegationCredentialId :: CredentialId
snapShotDelegationKeyHash :: KeyHashId
..} -> do
      Credential 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 keyHash <- getJust snapShotDelegationKeyHash
      -- TODO ^ rename snapShotDelegationKeyHashId
      pure (Keys.coerceKeyRole credential, Keys.coerceKeyRole keyHash)
  poolParams <-
    selectVMap [SnapShotPoolSnapShotId ==. snapShotId] $ \SnapShotPool {StakePoolParams
KeyHashId
Key SnapShot
snapShotPoolParams :: SnapShotPool -> StakePoolParams
snapShotPoolKeyHashId :: SnapShotPool -> KeyHashId
snapShotPoolSnapShotId :: SnapShotPool -> Key SnapShot
snapShotPoolSnapShotId :: Key SnapShot
snapShotPoolKeyHashId :: KeyHashId
snapShotPoolParams :: StakePoolParams
..} -> do
      KeyHash keyHash <- KeyHashId -> ReaderT SqlBackend m KeyHash
forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
getJust KeyHashId
snapShotPoolKeyHashId
      pure (Keys.coerceKeyRole keyHash, snapShotPoolParams)
  pure
    State.SnapShot
      { ssStake = State.Stake stake
      , ssDelegations = delegations
      , ssPoolParams = 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
  mark <- EpochStateId -> SnapShotType -> ReaderT SqlBackend m SnapShot
forall (m :: * -> *).
MonadResource m =>
EpochStateId -> SnapShotType -> ReaderT SqlBackend m SnapShot
getSnapShotNoSharing EpochStateId
epochStateId SnapShotType
SnapShotMark
  set <- getSnapShotNoSharing epochStateId SnapShotSet
  go <- getSnapShotNoSharing epochStateId SnapShotGo
  pure $
    State.SnapShots
      { ssStakeMark = mark
      , ssStakeMarkPoolDistr = State.calculatePoolDistr mark
      , ssStakeSet = set
      , ssStakeGo = go
      , ssFee = 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
  mark <- EpochStateId -> SnapShotType -> ReaderT SqlBackend m SnapShotM
forall (m :: * -> *).
MonadResource m =>
EpochStateId -> SnapShotType -> ReaderT SqlBackend m SnapShotM
getSnapShotNoSharingM EpochStateId
epochStateId SnapShotType
SnapShotMark
  set <- getSnapShotNoSharingM epochStateId SnapShotSet
  go <- getSnapShotNoSharingM epochStateId SnapShotGo
  pure $
    SnapShotsM
      { ssPstakeMark = mark
      , ssPstakeSet = set
      , ssPstakeGo = go
      , ssFeeSS = 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) StakePoolParams
-> Interns (KeyHash StakePool)
forall k (kv :: * -> *) a. Ord k => VMap VB kv k a -> Interns k
internsFromVMap (VMap VB VB (KeyHash StakePool) StakePoolParams
 -> Interns (KeyHash StakePool))
-> (SnapShot -> VMap VB VB (KeyHash StakePool) StakePoolParams)
-> SnapShot
-> Interns (KeyHash StakePool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SnapShot -> VMap VB VB (KeyHash StakePool) StakePoolParams
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
  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
  stake <-
    selectVMap [SnapShotStakeSnapShotId ==. snapShotId] $ \SnapShotStake {CompactForm Coin
CredentialId
Key SnapShot
snapShotStakeCoin :: SnapShotStake -> CompactForm Coin
snapShotStakeCredentialId :: SnapShotStake -> CredentialId
snapShotStakeSnapShotId :: SnapShotStake -> Key SnapShot
snapShotStakeSnapShotId :: Key SnapShot
snapShotStakeCredentialId :: CredentialId
snapShotStakeCoin :: CompactForm Coin
..} -> do
      Credential 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
      pure (internOtherStakes credential, snapShotStakeCoin)
  poolParams <-
    selectVMap [SnapShotPoolSnapShotId ==. snapShotId] $ \SnapShotPool {StakePoolParams
KeyHashId
Key SnapShot
snapShotPoolParams :: SnapShotPool -> StakePoolParams
snapShotPoolKeyHashId :: SnapShotPool -> KeyHashId
snapShotPoolSnapShotId :: SnapShotPool -> Key SnapShot
snapShotPoolSnapShotId :: Key SnapShot
snapShotPoolKeyHashId :: KeyHashId
snapShotPoolParams :: StakePoolParams
..} -> do
      KeyHash keyHash <- KeyHashId -> ReaderT SqlBackend m KeyHash
forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
getJust KeyHashId
snapShotPoolKeyHashId
      pure (internOtherPoolParams keyHash, snapShotPoolParams)
  let internPoolParams = Interns (KeyHash StakePool)
-> KeyHash StakePool -> KeyHash StakePool
forall k. Interns k -> k -> k
interns (VMap VB VB (KeyHash StakePool) StakePoolParams
-> Interns (KeyHash StakePool)
forall k (kv :: * -> *) a. Ord k => VMap VB kv k a -> Interns k
internsFromVMap VMap VB VB (KeyHash StakePool) StakePoolParams
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
  delegations <-
    selectVMap [SnapShotDelegationSnapShotId ==. snapShotId] $ \SnapShotDelegation {KeyHashId
CredentialId
Key SnapShot
snapShotDelegationKeyHash :: SnapShotDelegation -> KeyHashId
snapShotDelegationCredentialId :: SnapShotDelegation -> CredentialId
snapShotDelegationSnapShotId :: SnapShotDelegation -> Key SnapShot
snapShotDelegationSnapShotId :: Key SnapShot
snapShotDelegationCredentialId :: CredentialId
snapShotDelegationKeyHash :: KeyHashId
..} -> do
      Credential 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 keyHash <- getJust snapShotDelegationKeyHash
      pure (internOtherDelegations credential, internPoolParams keyHash)
  pure
    State.SnapShot
      { ssStake = State.Stake stake
      , ssDelegations = delegations
      , ssPoolParams = 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
  mark <- [SnapShot]
-> EpochStateId -> SnapShotType -> ReaderT SqlBackend m SnapShot
forall (m :: * -> *).
MonadResource m =>
[SnapShot]
-> EpochStateId -> SnapShotType -> ReaderT SqlBackend m SnapShot
getSnapShotWithSharing [] EpochStateId
epochStateId SnapShotType
SnapShotMark
  set <- getSnapShotWithSharing [mark] epochStateId SnapShotSet
  go <- getSnapShotWithSharing [mark, set] epochStateId SnapShotGo
  pure $
    State.SnapShots
      { ssStakeMark = mark
      , ssStakeMarkPoolDistr = State.calculatePoolDistr mark
      , ssStakeSet = set
      , ssStakeGo = go
      , ssFee = 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.Credential Keys.Staking) 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 {..} <- 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
  pure
    Shelley.LedgerState
      { Shelley.lsUTxOState =
          Shelley.smartUTxOState
            emptyPParams
            utxo
            utxoStateDeposited
            utxoStateFees
            utxoStateGovState -- Maintain invariant
            utxoStateDonation
      , Shelley.lsCertState =
          def
            & certPStateL .~ ledgerStatePstateBin
            & certDStateL .~ 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 {..} <- 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
  accountsMap <- getAccountsMap dstateId
  -- 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)
  iRReserves <-
    Map.fromList <$> do
      ds <- selectList [IRReservesDstateId ==. dstateId] []
      forM ds $ \(Entity Key IRReserves
_ IRReserves {Coin
CredentialId
DStateId
iRReservesDstateId :: DStateId
iRReservesCredentialId :: CredentialId
iRReservesCoin :: Coin
iRReservesCoin :: IRReserves -> Coin
iRReservesCredentialId :: IRReserves -> CredentialId
iRReservesDstateId :: IRReserves -> DStateId
..}) -> do
        Credential 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
        pure (Keys.coerceKeyRole credential, iRReservesCoin)
  iRTreasury <-
    Map.fromList <$> do
      ds <- selectList [IRTreasuryDstateId ==. dstateId] []
      forM ds $ \(Entity Key IRTreasury
_ IRTreasury {Coin
CredentialId
DStateId
iRTreasuryDstateId :: DStateId
iRTreasuryCredentialId :: CredentialId
iRTreasuryCoin :: Coin
iRTreasuryCoin :: IRTreasury -> Coin
iRTreasuryCredentialId :: IRTreasury -> CredentialId
iRTreasuryDstateId :: IRTreasury -> DStateId
..}) -> do
        Credential 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
        pure (Keys.coerceKeyRole credential, iRTreasuryCoin)
  pure
    Shelley.DState
      { dsAccounts = accountsFromAccountsMap accountsMap
      , dsFutureGenDelegs = unEnc dStateFGenDelegs
      , dsGenDelegs = dStateGenDelegs
      , dsIRewards =
          Shelley.InstantaneousRewards
            { iRReserves = iRReserves
            , iRTreasury = iRTreasury
            , deltaReserves = dStateIrDeltaReserves
            , deltaTreasury = dStateIrDeltaTreasury
            }
      }

getAccountsMap ::
  (MonadIO m, EraTest era) =>
  DStateId ->
  ReaderT SqlBackend m (Map.Map (Credential.Credential r') (State.AccountState era))
getAccountsMap :: forall (m :: * -> *) era (r' :: KeyRole).
(MonadIO m, EraTest era) =>
DStateId
-> ReaderT SqlBackend m (Map (Credential r') (AccountState era))
getAccountsMap DStateId
dstateId =
  [(Credential r', AccountState era)]
-> Map (Credential r') (AccountState era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Credential r', AccountState era)]
 -> Map (Credential r') (AccountState era))
-> ReaderT SqlBackend m [(Credential r', AccountState era)]
-> ReaderT SqlBackend m (Map (Credential r') (AccountState era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
    rws <- [Filter Account]
-> [SelectOpt Account] -> ReaderT SqlBackend m [Entity Account]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [EntityField Account DStateId
forall typ. (typ ~ DStateId) => EntityField Account typ
AccountDstateId EntityField Account DStateId -> DStateId -> Filter Account
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. DStateId
dstateId] []
    forM rws $ \(Entity Key Account
_ Account {Maybe Ptr
Maybe KeyHashId
Maybe CredentialId
CompactForm Coin
CredentialId
DStateId
DRepDelegation
accountDstateId :: DStateId
accountCredentialId :: CredentialId
accountPtr :: Maybe Ptr
accountBalance :: CompactForm Coin
accountDeposit :: CompactForm Coin
accountKeyHashStakePoolId :: Maybe KeyHashId
accountDrep :: DRepDelegation
accountCredentialDRepId :: Maybe CredentialId
accountCredentialDRepId :: Account -> Maybe CredentialId
accountDrep :: Account -> DRepDelegation
accountKeyHashStakePoolId :: Account -> Maybe KeyHashId
accountDeposit :: Account -> CompactForm Coin
accountBalance :: Account -> CompactForm Coin
accountPtr :: Account -> Maybe Ptr
accountCredentialId :: Account -> CredentialId
accountDstateId :: Account -> DStateId
..}) -> do
      Credential 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
accountCredentialId
      mStakePool <- forM accountKeyHashStakePoolId (fmap (Keys.coerceKeyRole . keyHashWitness) . getJust)
      -- mDRep <- forM accountCredentialDRepId (fmap (Keys.coerceKeyRole . credentialWitness) . getJust)
      pure
        ( Keys.coerceKeyRole credential
        , mkTestAccountState accountPtr accountDeposit mStakePool Nothing
            & State.balanceAccountStateL .~ accountBalance
        )

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 {..} <- 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
  accountsMap <- getAccountsMap dstateId
  -- 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)
  iRReserves <-
    Map.fromList <$> do
      ds <- selectList [IRReservesDstateId ==. dstateId] []
      forM ds $ \(Entity Key IRReserves
_ IRReserves {Coin
CredentialId
DStateId
iRReservesCoin :: IRReserves -> Coin
iRReservesCredentialId :: IRReserves -> CredentialId
iRReservesDstateId :: IRReserves -> DStateId
iRReservesDstateId :: DStateId
iRReservesCredentialId :: CredentialId
iRReservesCoin :: Coin
..}) -> do
        Credential 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
-> Map (Credential Staking) (AccountState CurrentEra)
-> 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) (AccountState CurrentEra)
accountsMap
        pure (cred, iRReservesCoin)
  iRTreasury <-
    Map.fromList <$> do
      ds <- selectList [IRTreasuryDstateId ==. dstateId] []
      forM ds $ \(Entity Key IRTreasury
_ IRTreasury {Coin
CredentialId
DStateId
iRTreasuryCoin :: IRTreasury -> Coin
iRTreasuryCredentialId :: IRTreasury -> CredentialId
iRTreasuryDstateId :: IRTreasury -> DStateId
iRTreasuryDstateId :: DStateId
iRTreasuryCredentialId :: CredentialId
iRTreasuryCoin :: Coin
..}) -> do
        Credential 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
-> Map (Credential Staking) (AccountState CurrentEra)
-> 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) (AccountState CurrentEra)
accountsMap
        pure (cred, iRTreasuryCoin)
  pure
    Shelley.DState
      { dsAccounts = accountsFromAccountsMap accountsMap
      , dsFutureGenDelegs = unEnc dStateFGenDelegs
      , dsGenDelegs = dStateGenDelegs
      , dsIRewards =
          Shelley.InstantaneousRewards
            { iRReserves = iRReserves
            , iRTreasury = iRTreasury
            , deltaReserves = dStateIrDeltaReserves
            , deltaTreasury = 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 {..} <- 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 <- getDStateNoSharing ledgerStateDstateId
    m <- runConduitFold sourceUTxO noSharingMap
    getLedgerState (Shelley.UTxO m) ledgerState 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
    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
    getLedgerStateWithSharing 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 {..} <- 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 <- getDStateWithSharing ledgerStateDstateId
    ls <- getLedgerState (Shelley.UTxO mempty) ledgerState dstate
    m <- runConduitFold sourceUTxO txIxSharing
    pure (ls, 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 {..} <-
    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 <- getDStateWithSharing ledgerStateDstateId
  m <- runConduitFold sourceUTxO noSharingMap
  getLedgerState (Shelley.UTxO m) ledgerState 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 {..} <-
    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 <- getDStateNoSharing ledgerStateDstateId
  m <- runConduitFold sourceUTxO noSharingMap
  getLedgerState (Shelley.UTxO m) ledgerState 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 {..}) <- 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 <- getSnapShotsNoSharing ese
  ledgerState <- getLedgerStateNoSharing ese
  pure $
    Shelley.EpochState
      { esChainAccountState =
          State.ChainAccountState
            { casTreasury = epochStateTreasury
            , casReserves = epochStateReserves
            }
      , esLState = ledgerState
      , esSnapshots = snapshots
      , esNonMyopic = epochStateNonMyopic
      }
      & curPParamsEpochStateL .~ epochStatePp
      & prevPParamsEpochStateL .~ 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 {..}) <- 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 <- getSnapShotsWithSharing ese
  ledgerState <- getLedgerStateWithSharing ese
  pure $
    Shelley.EpochState
      { esChainAccountState =
          State.ChainAccountState
            { casTreasury = epochStateTreasury
            , casReserves = epochStateReserves
            }
      , esLState = ledgerState
      , esSnapshots = snapshots
      , esNonMyopic = epochStateNonMyopic
      }
      & prevPParamsEpochStateL .~ epochStatePrevPp
      & curPParamsEpochStateL .~ 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 #-}