Skip to content

Commit 9783081

Browse files
kdermekderme
committed
Move queries to their module
1 parent f5c44ac commit 9783081

File tree

5 files changed

+73
-88
lines changed

5 files changed

+73
-88
lines changed

‎cardano-db-sync/src/Cardano/DbSync/Cache.hs

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -158,7 +158,7 @@ queryStakeAddrWithCacheRetBs trce cache cacheUA nw cred = do
158158
let !bs = Ledger.serialiseRewardAccount (Ledger.RewardAccount nw cred)
159159
case cache of
160160
NoCache -> do
161-
mapLeft (,bs) <$> queryStakeAddress bs
161+
mapLeft (,bs) <$> resolveStakeAddress bs
162162
ActiveCache ci -> do
163163
prevCache <- liftIO $ readTVarIO (cStakeRawHashes ci)
164164
let isNewCache = LRU.getSize prevCache < 1
@@ -184,7 +184,7 @@ queryStakeAddrWithCacheRetBs trce cache cacheUA nw cred = do
184184
liftIO $ atomically $ writeTVar (cStakeRawHashes ci) lruCache
185185
pure $ Right addrId
186186
Nothing -> do
187-
queryRes <- mapLeft (,bs) <$> queryStakeAddress bs
187+
queryRes <- mapLeft (,bs) <$> resolveStakeAddress bs
188188
liftIO $ missCreds (cStats ci)
189189
case queryRes of
190190
Left _ -> pure queryRes
@@ -205,7 +205,7 @@ queryPoolKeyWithCache ::
205205
queryPoolKeyWithCache cache cacheUA hsh =
206206
case cache of
207207
NoCache -> do
208-
mPhId <- queryPoolHashId (Generic.unKeyHashRaw hsh)
208+
mPhId <- DB.queryPoolHashId (Generic.unKeyHashRaw hsh)
209209
case mPhId of
210210
Nothing -> pure $ Left (DB.DbLookupMessage "PoolKeyHash")
211211
Just phId -> pure $ Right phId
@@ -223,7 +223,7 @@ queryPoolKeyWithCache cache cacheUA hsh =
223223
pure $ Right phId
224224
Nothing -> do
225225
liftIO $ missPools (cStats ci)
226-
mPhId <- queryPoolHashId (Generic.unKeyHashRaw hsh)
226+
mPhId <- DB.queryPoolHashId (Generic.unKeyHashRaw hsh)
227227
case mPhId of
228228
Nothing -> pure $ Left (DB.DbLookupMessage "PoolKeyHash")
229229
Just phId -> do

‎cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Query.hs

Lines changed: 3 additions & 80 deletions
Original file line numberDiff line numberDiff line change
@@ -1,68 +1,29 @@
11
{-# LANGUAGE DataKinds #-}
22
{-# LANGUAGE FlexibleContexts #-}
3-
{-# LANGUAGE OverloadedStrings #-}
43
{-# LANGUAGE ScopedTypeVariables #-}
5-
{-# LANGUAGE TypeApplications #-}
64
{-# LANGUAGE NoImplicitPrelude #-}
75

86
module Cardano.DbSync.Era.Shelley.Query (
9-
queryPoolHashId,
10-
queryStakeAddress,
11-
queryStakeRefPtr,
7+
resolveStakeAddress,
128
resolveInputTxId,
139
resolveInputTxOutId,
1410
resolveInputValue,
1511
resolveInputTxOutIdValue,
1612
queryResolveInputCredentials,
17-
queryPoolUpdateByBlock,
1813
) where
1914

2015
import Cardano.Db
2116
import qualified Cardano.DbSync.Era.Shelley.Generic as Generic
2217
import Cardano.DbSync.Util
23-
import Cardano.Ledger.BaseTypes (CertIx (..), TxIx (..))
24-
import Cardano.Ledger.Credential (Ptr (..))
2518
import Cardano.Prelude hiding (Ptr, from, maybeToEither, on)
26-
import Cardano.Slotting.Slot (SlotNo (..))
2719
import Database.Esqueleto.Experimental (
2820
SqlBackend,
29-
Value (..),
30-
desc,
31-
from,
32-
innerJoin,
33-
just,
34-
limit,
35-
on,
36-
orderBy,
37-
select,
38-
table,
39-
val,
40-
where_,
41-
(:&) ((:&)),
42-
(==.),
43-
(^.),
4421
)
4522

4623
{- HLINT ignore "Fuse on/on" -}
4724

48-
queryPoolHashId :: MonadIO m => ByteString -> ReaderT SqlBackend m (Maybe PoolHashId)
49-
queryPoolHashId hash = do
50-
res <- select $ do
51-
phash <- from $ table @PoolHash
52-
where_ (phash ^. PoolHashHashRaw ==. val hash)
53-
pure (phash ^. PoolHashId)
54-
pure $ unValue <$> listToMaybe res
55-
56-
queryStakeAddress ::
57-
MonadIO m =>
58-
ByteString ->
59-
ReaderT SqlBackend m (Either LookupFail StakeAddressId)
60-
queryStakeAddress addr = do
61-
res <- select $ do
62-
saddr <- from $ table @StakeAddress
63-
where_ (saddr ^. StakeAddressHashRaw ==. val addr)
64-
pure (saddr ^. StakeAddressId)
65-
pure $ maybeToEither (DbLookupMessage $ "StakeAddress " <> renderByteArray addr) unValue (listToMaybe res)
25+
resolveStakeAddress :: MonadIO m => ByteString -> ReaderT SqlBackend m (Either LookupFail StakeAddressId)
26+
resolveStakeAddress addr = queryStakeAddress addr renderByteArray
6627

6728
resolveInputTxId :: MonadIO m => Generic.TxIn -> ReaderT SqlBackend m (Either LookupFail TxId)
6829
resolveInputTxId = queryTxId . Generic.txInHash
@@ -82,41 +43,3 @@ resolveInputTxOutIdValue txIn =
8243
queryResolveInputCredentials :: MonadIO m => Generic.TxIn -> ReaderT SqlBackend m (Either LookupFail (Maybe ByteString, Bool))
8344
queryResolveInputCredentials txIn = do
8445
queryTxOutCredentials (Generic.txInHash txIn, fromIntegral (Generic.txInIndex txIn))
85-
86-
queryStakeRefPtr :: MonadIO m => Ptr -> ReaderT SqlBackend m (Maybe StakeAddressId)
87-
queryStakeRefPtr (Ptr (SlotNo slot) (TxIx txIx) (CertIx certIx)) = do
88-
res <- select $ do
89-
(blk :& tx :& sr) <-
90-
from
91-
$ table @Block
92-
`innerJoin` table @Tx
93-
`on` (\(blk :& tx) -> blk ^. BlockId ==. tx ^. TxBlockId)
94-
`innerJoin` table @StakeRegistration
95-
`on` (\(_blk :& tx :& sr) -> sr ^. StakeRegistrationTxId ==. tx ^. TxId)
96-
97-
where_ (blk ^. BlockSlotNo ==. just (val slot))
98-
where_ (tx ^. TxBlockIndex ==. val (fromIntegral txIx))
99-
where_ (sr ^. StakeRegistrationCertIndex ==. val (fromIntegral certIx))
100-
-- Need to order by DelegationSlotNo descending for correct behavior when there are two
101-
-- or more delegation certificates in a single epoch.
102-
orderBy [desc (blk ^. BlockSlotNo)]
103-
limit 1
104-
pure (sr ^. StakeRegistrationAddrId)
105-
pure $ unValue <$> listToMaybe res
106-
107-
-- Check if there are other PoolUpdates in the same blocks for the same pool
108-
queryPoolUpdateByBlock :: MonadIO m => BlockId -> PoolHashId -> ReaderT SqlBackend m Bool
109-
queryPoolUpdateByBlock blkId poolHashId = do
110-
res <- select $ do
111-
(blk :& _tx :& poolUpdate) <-
112-
from
113-
$ table @Block
114-
`innerJoin` table @Tx
115-
`on` (\(blk :& tx) -> blk ^. BlockId ==. tx ^. TxBlockId)
116-
`innerJoin` table @PoolUpdate
117-
`on` (\(_blk :& tx :& poolUpdate) -> tx ^. TxId ==. poolUpdate ^. PoolUpdateRegisteredTxId)
118-
where_ (poolUpdate ^. PoolUpdateHashId ==. val poolHashId)
119-
where_ (blk ^. BlockId ==. val blkId)
120-
limit 1
121-
pure (blk ^. BlockEpochNo)
122-
pure $ not (null res)

‎cardano-db-sync/src/Cardano/DbSync/Era/Universal/Insert/Other.hs

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -23,7 +23,6 @@ import qualified Cardano.Db as DB
2323
import Cardano.DbSync.Cache (insertDatumAndCache, queryDatum, queryMAWithCache, queryOrInsertRewardAccount, queryOrInsertStakeAddress)
2424
import Cardano.DbSync.Cache.Types (CacheAction (..), CacheStatus (..))
2525
import qualified Cardano.DbSync.Era.Shelley.Generic as Generic
26-
import Cardano.DbSync.Era.Shelley.Query (queryStakeRefPtr)
2726
import Cardano.DbSync.Era.Universal.Insert.Grouped
2827
import Cardano.DbSync.Era.Util (safeDecodeToJson)
2928
import Cardano.DbSync.Error
@@ -158,7 +157,7 @@ insertStakeAddressRefIfMissing trce cache addr =
158157
Ledger.StakeRefBase cred -> do
159158
Just <$> queryOrInsertStakeAddress trce cache DoNotUpdateCache nw cred
160159
Ledger.StakeRefPtr ptr -> do
161-
queryStakeRefPtr ptr
160+
DB.queryStakeRefPtr ptr
162161
Ledger.StakeRefNull -> pure Nothing
163162

164163
insertMultiAsset ::

‎cardano-db-sync/src/Cardano/DbSync/Era/Universal/Insert/Pool.hs

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -28,7 +28,6 @@ import Cardano.DbSync.Cache (
2828
)
2929
import Cardano.DbSync.Cache.Types (CacheAction (..), CacheStatus (..))
3030
import qualified Cardano.DbSync.Era.Shelley.Generic as Generic
31-
import Cardano.DbSync.Era.Shelley.Query
3231
import Cardano.DbSync.Error
3332
import Cardano.DbSync.Types (PoolKeyHash)
3433
import Cardano.DbSync.Util
@@ -99,7 +98,7 @@ insertPoolRegister trce cache isMember mdeposits network (EpochNo epoch) blkId t
9998
-- if the pool is not registered at the end of the previous block, check for
10099
-- other registrations at the current block. If this is the first registration
101100
-- then it's +2, else it's +3.
102-
otherUpdates <- lift $ queryPoolUpdateByBlock blkId poolHashId
101+
otherUpdates <- lift $ DB.queryPoolUpdateByBlock blkId poolHashId
103102
pure $ not otherUpdates
104103

105104
-- Ignore the network in the `RewardAccount` and use the provided one instead.

‎cardano-db/src/Cardano/Db/Query.hs

Lines changed: 64 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -65,6 +65,10 @@ module Cardano.Db.Query (
6565
queryCommitteeHash,
6666
queryProposalConstitution,
6767
queryProposalCommittee,
68+
queryPoolHashId,
69+
queryStakeAddress,
70+
queryStakeRefPtr,
71+
queryPoolUpdateByBlock,
6872
-- queries used in smash
6973
queryOffChainPoolData,
7074
queryPoolRegister,
@@ -129,6 +133,8 @@ module Cardano.Db.Query (
129133
import Cardano.Db.Error
130134
import Cardano.Db.Schema
131135
import Cardano.Db.Types
136+
import Cardano.Ledger.BaseTypes (CertIx (..), TxIx (..))
137+
import Cardano.Ledger.Credential (Ptr (..))
132138
import Cardano.Slotting.Slot (SlotNo (..))
133139
import Control.Monad.Extra (join, whenJust)
134140
import Control.Monad.IO.Class (MonadIO)
@@ -875,6 +881,64 @@ queryProposalCommittee mgapId = do
875881
Nothing -> isNothing (c ^. CommitteeGovActionProposalId)
876882
Just vl -> c ^. CommitteeGovActionProposalId ==. val (Just vl)
877883

884+
queryPoolHashId :: MonadIO m => ByteString -> ReaderT SqlBackend m (Maybe PoolHashId)
885+
queryPoolHashId hash = do
886+
res <- select $ do
887+
phash <- from $ table @PoolHash
888+
where_ (phash ^. PoolHashHashRaw ==. val hash)
889+
pure (phash ^. PoolHashId)
890+
pure $ unValue <$> listToMaybe res
891+
892+
queryStakeAddress ::
893+
MonadIO m =>
894+
ByteString ->
895+
(ByteString -> Text) ->
896+
ReaderT SqlBackend m (Either LookupFail StakeAddressId)
897+
queryStakeAddress addr toText = do
898+
res <- select $ do
899+
saddr <- from $ table @StakeAddress
900+
where_ (saddr ^. StakeAddressHashRaw ==. val addr)
901+
pure (saddr ^. StakeAddressId)
902+
pure $ maybeToEither (DbLookupMessage $ "StakeAddress " <> toText addr) unValue (listToMaybe res)
903+
904+
queryStakeRefPtr :: MonadIO m => Ptr -> ReaderT SqlBackend m (Maybe StakeAddressId)
905+
queryStakeRefPtr (Ptr (SlotNo slot) (TxIx txIx) (CertIx certIx)) = do
906+
res <- select $ do
907+
(blk :& tx :& sr) <-
908+
from
909+
$ table @Block
910+
`innerJoin` table @Tx
911+
`on` (\(blk :& tx) -> blk ^. BlockId ==. tx ^. TxBlockId)
912+
`innerJoin` table @StakeRegistration
913+
`on` (\(_blk :& tx :& sr) -> sr ^. StakeRegistrationTxId ==. tx ^. TxId)
914+
915+
where_ (blk ^. BlockSlotNo ==. just (val slot))
916+
where_ (tx ^. TxBlockIndex ==. val (fromIntegral txIx))
917+
where_ (sr ^. StakeRegistrationCertIndex ==. val (fromIntegral certIx))
918+
-- Need to order by DelegationSlotNo descending for correct behavior when there are two
919+
-- or more delegation certificates in a single epoch.
920+
orderBy [desc (blk ^. BlockSlotNo)]
921+
limit 1
922+
pure (sr ^. StakeRegistrationAddrId)
923+
pure $ unValue <$> listToMaybe res
924+
925+
-- Check if there are other PoolUpdates in the same blocks for the same pool
926+
queryPoolUpdateByBlock :: MonadIO m => BlockId -> PoolHashId -> ReaderT SqlBackend m Bool
927+
queryPoolUpdateByBlock blkId poolHashId = do
928+
res <- select $ do
929+
(blk :& _tx :& poolUpdate) <-
930+
from
931+
$ table @Block
932+
`innerJoin` table @Tx
933+
`on` (\(blk :& tx) -> blk ^. BlockId ==. tx ^. TxBlockId)
934+
`innerJoin` table @PoolUpdate
935+
`on` (\(_blk :& tx :& poolUpdate) -> tx ^. TxId ==. poolUpdate ^. PoolUpdateRegisteredTxId)
936+
where_ (poolUpdate ^. PoolUpdateHashId ==. val poolHashId)
937+
where_ (blk ^. BlockId ==. val blkId)
938+
limit 1
939+
pure (blk ^. BlockEpochNo)
940+
pure $ not (null res)
941+
878942
{--------------------------------------------
879943
Queries use in SMASH
880944
----------------------------------------------}

0 commit comments

Comments
 (0)