Skip to content

Commit a01778e

Browse files
committed
add more queries
1 parent 96182d8 commit a01778e

File tree

10 files changed

+128
-66
lines changed

10 files changed

+128
-66
lines changed

cardano-db/src/Cardano/Db/Error.hs

+6-1
Original file line numberDiff line numberDiff line change
@@ -25,7 +25,6 @@ import qualified Data.ByteString.Base16 as Base16
2525
import qualified Data.Text.Encoding as Text
2626
import qualified Hasql.Session as HsqlS
2727

28-
2928
class AsDbError e where
3029
toDbError :: DbError -> e
3130
fromDbError :: e -> Maybe DbError
@@ -63,6 +62,12 @@ data LookupContext
6362

6463
instance Exception LookupContext
6564

65+
-- catchDbError :: String -> HsqlT.Transaction a -> HsqlT.Transaction a
66+
-- catchDbError context action =
67+
-- action `catch` \e ->
68+
-- throwError $ DbError $ context ++ ": " ++ show e
69+
70+
6671
-- instance Show LookupFail where
6772
-- show =
6873
-- \case

cardano-db/src/Cardano/Db/Operations/Insert.hs

+16-16
Original file line numberDiff line numberDiff line change
@@ -171,23 +171,23 @@ import qualified Hasql.Transaction.Sessions as Transaction
171171
-- Instead we use `insertUnchecked` for tables where there is no uniqueness constraints
172172
-- and `insertChecked` for tables where the uniqueness constraint might hit.
173173

174-
insertManyEpochStakes ::
175-
(MonadBaseControl IO m, MonadIO m) =>
176-
-- | Does constraint already exists
177-
Bool ->
178-
ConstraintNameDB ->
179-
[EpochStake] ->
180-
ReaderT SqlBackend m ()
181-
insertManyEpochStakes = insertManyWithManualUnique "Many EpochStake"
174+
-- insertManyEpochStakes ::
175+
-- (MonadBaseControl IO m, MonadIO m) =>
176+
-- -- | Does constraint already exists
177+
-- Bool ->
178+
-- ConstraintNameDB ->
179+
-- [EpochStake] ->
180+
-- ReaderT SqlBackend m ()
181+
-- insertManyEpochStakes = insertManyWithManualUnique "Many EpochStake"
182182

183-
insertManyRewards ::
184-
(MonadBaseControl IO m, MonadIO m) =>
185-
-- | Does constraint already exists
186-
Bool ->
187-
ConstraintNameDB ->
188-
[Reward] ->
189-
ReaderT SqlBackend m ()
190-
insertManyRewards = insertManyWithManualUnique "Many Rewards"
183+
-- insertManyRewards ::
184+
-- (MonadBaseControl IO m, MonadIO m) =>
185+
-- -- | Does constraint already exists
186+
-- Bool ->
187+
-- ConstraintNameDB ->
188+
-- [Reward] ->
189+
-- ReaderT SqlBackend m ()
190+
-- insertManyRewards = insertManyWithManualUnique "Many Rewards"
191191

192192
-- insertManyRewardRests ::
193193
-- (MonadBaseControl IO m, MonadIO m) =>

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

+1-1
Original file line numberDiff line numberDiff line change
@@ -104,7 +104,7 @@ module Cardano.Db.Operations.Query (
104104
) where
105105

106106
import Cardano.Db.Error
107-
import Cardano.Db.Operations.QueryHelper (defaultUTCTime, isJust, maybeToEither, unValue2, unValue3, unValue5, unValueSumAda)
107+
-- import Cardano.Db.Operations.QueryHelper (defaultUTCTime, isJust, maybeToEither, unValue2, unValue3, unValue5, unValueSumAda)
108108
import Cardano.Db.Schema.Core
109109
import Cardano.Db.Types
110110
import Cardano.Ledger.BaseTypes (CertIx (..), TxIx (..))

cardano-db/src/Cardano/Db/Schema/Core/StakeDeligation.hs

+43-33
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@
44

55
module Cardano.Db.Schema.Core.StakeDeligation where
66

7-
import Contravariant.Extras (contrazip5, contrazip2, contrazip4)
7+
import Contravariant.Extras (contrazip5, contrazip2, contrazip4, contrazip6)
88
import Data.ByteString.Char8 (ByteString)
99
import Data.Functor.Contravariant
1010
import Data.Text (Text)
@@ -48,8 +48,8 @@ instance DbInfo StakeAddress where
4848

4949
type instance Key StakeAddress = StakeAddressId
5050

51-
entityNameStakeAddressDecoder :: D.Row (Entity StakeAddress)
52-
entityNameStakeAddressDecoder =
51+
entityStakeAddressDecoder :: D.Row (Entity StakeAddress)
52+
entityStakeAddressDecoder =
5353
Entity
5454
<$> idDecoder StakeAddressId
5555
<*> stakeAddressDecoder
@@ -61,8 +61,8 @@ stakeAddressDecoder =
6161
<*> D.column (D.nonNullable D.text) -- stakeAddressView
6262
<*> D.column (D.nullable D.bytea) -- stakeAddressScriptHash
6363

64-
entityNameStakeAddressEncoder :: E.Params (Entity StakeAddress)
65-
entityNameStakeAddressEncoder =
64+
entityStakeAddressEncoder :: E.Params (Entity StakeAddress)
65+
entityStakeAddressEncoder =
6666
mconcat
6767
[ entityKey >$< idEncoder getStakeAddressId
6868
, entityVal >$< stakeAddressEncoder
@@ -93,8 +93,8 @@ instance DbInfo StakeRegistration
9393

9494
type instance Key StakeRegistration = StakeRegistrationId
9595

96-
entityNameStakeRegistrationDecoder :: D.Row (Entity StakeRegistration)
97-
entityNameStakeRegistrationDecoder =
96+
entityStakeRegistrationDecoder :: D.Row (Entity StakeRegistration)
97+
entityStakeRegistrationDecoder =
9898
Entity
9999
<$> idDecoder StakeRegistrationId
100100
<*> stakeRegistrationDecoder
@@ -108,8 +108,8 @@ stakeRegistrationDecoder =
108108
<*> maybeDbLovelaceDecoder -- stakeRegistrationDeposit
109109
<*> idDecoder TxId -- stakeRegistrationTxId
110110

111-
entityNameStakeRegistrationEncoder :: E.Params (Entity StakeRegistration)
112-
entityNameStakeRegistrationEncoder =
111+
entityStakeRegistrationEncoder :: E.Params (Entity StakeRegistration)
112+
entityStakeRegistrationEncoder =
113113
mconcat
114114
[ entityKey >$< idEncoder getStakeRegistrationId
115115
, entityVal >$< stakeRegistrationEncoder
@@ -143,8 +143,8 @@ instance DbInfo StakeDeregistration
143143

144144
type instance Key StakeDeregistration = StakeDeregistrationId
145145

146-
entityNameStakeDeregistrationDecoder :: D.Row (Entity StakeDeregistration)
147-
entityNameStakeDeregistrationDecoder =
146+
entityStakeDeregistrationDecoder :: D.Row (Entity StakeDeregistration)
147+
entityStakeDeregistrationDecoder =
148148
Entity
149149
<$> idDecoder StakeDeregistrationId
150150
<*> stakeDeregistrationDecoder
@@ -158,8 +158,8 @@ stakeDeregistrationDecoder =
158158
<*> idDecoder TxId -- stakeDeregistrationTxId
159159
<*> maybeIdDecoder RedeemerId -- stakeDeregistrationRedeemerId
160160

161-
entityNameStakeDeregistrationEncoder :: E.Params (Entity StakeDeregistration)
162-
entityNameStakeDeregistrationEncoder =
161+
entityStakeDeregistrationEncoder :: E.Params (Entity StakeDeregistration)
162+
entityStakeDeregistrationEncoder =
163163
mconcat
164164
[ entityKey >$< idEncoder getStakeDeregistrationId
165165
, entityVal >$< stakeDeregistrationEncoder
@@ -195,8 +195,8 @@ instance DbInfo Delegation
195195

196196
type instance Key Delegation = DelegationId
197197

198-
entityNameDelegationDecoder :: D.Row (Entity Delegation)
199-
entityNameDelegationDecoder =
198+
entityDelegationDecoder :: D.Row (Entity Delegation)
199+
entityDelegationDecoder =
200200
Entity
201201
<$> idDecoder DelegationId
202202
<*> delegationDecoder
@@ -212,8 +212,8 @@ delegationDecoder =
212212
<*> D.column (D.nonNullable $ fromIntegral <$> D.int8) -- delegationSlotNo
213213
<*> maybeIdDecoder RedeemerId -- delegationRedeemerId
214214

215-
entityNameDelegationEncoder :: E.Params (Entity Delegation)
216-
entityNameDelegationEncoder =
215+
entityDelegationEncoder :: E.Params (Entity Delegation)
216+
entityDelegationEncoder =
217217
mconcat
218218
[ entityKey >$< idEncoder getDelegationId
219219
, entityVal >$< delegationEncoder
@@ -253,8 +253,8 @@ instance DbInfo Reward
253253

254254
type instance Key Reward = RewardId
255255

256-
entityNameRewardDecoder :: D.Row (Entity Reward)
257-
entityNameRewardDecoder =
256+
entityRewardDecoder :: D.Row (Entity Reward)
257+
entityRewardDecoder =
258258
Entity
259259
<$> idDecoder RewardId
260260
<*> rewardDecoder
@@ -269,8 +269,8 @@ rewardDecoder =
269269
<*> D.column (D.nonNullable $ fromIntegral <$> D.int8) -- rewardSpendableEpoch
270270
<*> idDecoder PoolHashId -- rewardPoolId
271271

272-
entityNameRewardEncoder :: E.Params (Entity Reward)
273-
entityNameRewardEncoder =
272+
entityRewardEncoder :: E.Params (Entity Reward)
273+
entityRewardEncoder =
274274
mconcat
275275
[ entityKey >$< idEncoder getRewardId
276276
, entityVal >$< rewardEncoder
@@ -287,6 +287,16 @@ rewardEncoder =
287287
, rewardPoolId >$< idEncoder getPoolHashId
288288
]
289289

290+
rewardBulkEncoder :: E.Params ([StakeAddressId], [RewardSource], [DbLovelace], [Word64], [Word64], [PoolHashId])
291+
rewardBulkEncoder =
292+
contrazip6
293+
(manyEncoder $ idBulkEncoder getStakeAddressId)
294+
(manyEncoder $ E.nonNullable rewardSourceEncoder)
295+
(manyEncoder $ E.nonNullable $ fromIntegral . unDbLovelace >$< E.int8)
296+
(manyEncoder $ E.nonNullable $ fromIntegral >$< E.int8)
297+
(manyEncoder $ E.nonNullable $ fromIntegral >$< E.int8)
298+
(manyEncoder $ idBulkEncoder getPoolHashId)
299+
290300
-----------------------------------------------------------------------------------------------------------------------------------
291301
{-|
292302
Table Name: reward_rest
@@ -304,8 +314,8 @@ instance DbInfo RewardRest
304314

305315
type instance Key RewardRest = RewardRestId
306316

307-
entityNameRewardRestDecoder :: D.Row (Entity RewardRest)
308-
entityNameRewardRestDecoder =
317+
entityRewardRestDecoder :: D.Row (Entity RewardRest)
318+
entityRewardRestDecoder =
309319
Entity
310320
<$> idDecoder RewardRestId
311321
<*> rewardRestDecoder
@@ -318,8 +328,8 @@ rewardRestDecoder =
318328
<*> D.column (D.nonNullable $ fromIntegral <$> D.int8) -- rewardRestEarnedEpoch
319329
<*> D.column (D.nonNullable $ fromIntegral <$> D.int8) -- rewardRestSpendableEpoch
320330

321-
entityNameRewardRestEncoder :: E.Params (Entity RewardRest)
322-
entityNameRewardRestEncoder =
331+
entityRewardRestEncoder :: E.Params (Entity RewardRest)
332+
entityRewardRestEncoder =
323333
mconcat
324334
[ entityKey >$< idEncoder getRewardRestId
325335
, entityVal >$< rewardRestEncoder
@@ -363,8 +373,8 @@ instance DbInfo EpochStake
363373

364374
type instance Key EpochStake = EpochStakeId
365375

366-
entityNameEpochStakeDecoder :: D.Row (Entity EpochStake)
367-
entityNameEpochStakeDecoder =
376+
entityEpochStakeDecoder :: D.Row (Entity EpochStake)
377+
entityEpochStakeDecoder =
368378
Entity
369379
<$> idDecoder EpochStakeId
370380
<*> epochStakeDecoder
@@ -377,8 +387,8 @@ epochStakeDecoder =
377387
<*> dbLovelaceDecoder -- epochStakeAmount
378388
<*> D.column (D.nonNullable $ fromIntegral <$> D.int8) -- epochStakeEpochNo
379389

380-
entityNameEpochStakeEncoder :: E.Params (Entity EpochStake)
381-
entityNameEpochStakeEncoder =
390+
entityEpochStakeEncoder :: E.Params (Entity EpochStake)
391+
entityEpochStakeEncoder =
382392
mconcat
383393
[ entityKey >$< idEncoder getEpochStakeId
384394
, entityVal >$< epochStakeEncoder
@@ -417,8 +427,8 @@ instance DbInfo EpochStakeProgress where
417427

418428
type instance Key EpochStakeProgress = EpochStakeProgressId
419429

420-
entityNameEpochStakeProgressDecoder :: D.Row (Entity EpochStakeProgress)
421-
entityNameEpochStakeProgressDecoder =
430+
entityEpochStakeProgressDecoder :: D.Row (Entity EpochStakeProgress)
431+
entityEpochStakeProgressDecoder =
422432
Entity
423433
<$> idDecoder EpochStakeProgressId
424434
<*> epochStakeProgressDecoder
@@ -429,8 +439,8 @@ epochStakeProgressDecoder =
429439
<$> D.column (D.nonNullable $ fromIntegral <$> D.int8) -- epochStakeProgressEpochNo
430440
<*> D.column (D.nonNullable D.bool) -- epochStakeProgressCompleted
431441

432-
entityNameEpochStakeProgressEncoder :: E.Params (Entity EpochStakeProgress)
433-
entityNameEpochStakeProgressEncoder =
442+
entityEpochStakeProgressEncoder :: E.Params (Entity EpochStakeProgress)
443+
entityEpochStakeProgressEncoder =
434444
mconcat
435445
[ entityKey >$< idEncoder getEpochStakeProgressId
436446
, entityVal >$< epochStakeProgressEncoder

cardano-db/src/Cardano/Db/Statement/Base.hs

+15
Original file line numberDiff line numberDiff line change
@@ -50,6 +50,21 @@ queryBlockHashBlockNo hash = runDbT TransReadOnly $ mkDbTransaction "queryBlockH
5050
hashEncoder = E.param (E.nonNullable E.bytea)
5151
blockNoDecoder = HsqlD.rowList (D.column (D.nullable $ fromIntegral <$> D.int8))
5252

53+
54+
queryBlockCount :: MonadIO m => DbAction m Word64
55+
queryBlockCount = runDbT TransReadOnly $ mkDbTransaction "queryBlockCount" $ do
56+
result <- HsqlT.statement () $ HsqlS.Statement sql HsqlE.unit blockCountDecoder True
57+
case result of
58+
[blockCount] -> pure blockCount
59+
_otherwise -> throwError $ DbLookupError mkCallSite "Multiple blocks found with same hash: " (BlockHashContext hash)
60+
where
61+
table = tableName (Proxy @SCB.Block)
62+
63+
sql = TextEnc.encodeUtf8 $ Text.concat
64+
[ "SELECT COUNT(*) FROM " <> table ]
65+
66+
blockCountDecoder = HsqlD.singleRow (D.column (D.nonNullable $ fromIntegral <$> D.int8))
67+
5368
--------------------------------------------------------------------------------
5469
-- | Datum
5570
--------------------------------------------------------------------------------

cardano-db/src/Cardano/Db/Statement/EpochAndProtocol.hs

+4-9
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,7 @@ import qualified Hasql.Decoders as HsqlD
88
import qualified Cardano.Db.Schema.Core.EpochAndProtocol as SEnP
99
import qualified Cardano.Db.Schema.Core.StakeDeligation as SSD
1010
import qualified Cardano.Db.Schema.Ids as Id
11-
import Cardano.Db.Types (DbAction (..), DbTransMode (..))
11+
import Cardano.Db.Types (DbAction (..), DbTransMode (..), DbLovelace)
1212
import Cardano.Prelude (MonadIO (..), Word64, void, Proxy (..), MonadError (..))
1313
import Cardano.Db.Statement.Function.Core (runDbT, mkDbTransaction, ResultType (..), ResultTypeBulk (..))
1414
import Cardano.Db.Statement.Function.Insert (insert, bulkInsert)
@@ -74,11 +74,6 @@ queryAdaPotsWithIdTx blockId =
7474
, " WHERE block_id = $1"
7575
]
7676

77-
catchDbError :: String -> HsqlT.Transaction a -> HsqlT.Transaction a
78-
catchDbError context action =
79-
action `catch` \e ->
80-
throwError $ DbError $ context ++ ": " ++ show e
81-
8277
--------------------------------------------------------------------------------
8378
-- | Epoch
8479
--------------------------------------------------------------------------------
@@ -121,10 +116,10 @@ bulkInsertEpochStake epochStakes = runDbT TransWrite $ mkDbTransaction "bulkInse
121116
NoResultBulk
122117
epochStakes
123118
where
124-
extractEpochStake :: [SSD.EpochStake] -> ([Maybe Id.StakeAddressId], [Maybe Id.EpochId], [Word64], [Word64])
119+
extractEpochStake :: [SSD.EpochStake] -> ([Id.StakeAddressId], [Id.PoolHashId], [DbLovelace], [Word64])
125120
extractEpochStake xs =
126-
( map Id.epochStakeAddrId xs
127-
, map SSD.epochStakeEpochId xs
121+
( map SSD.epochStakeAddrId xs
122+
, map SSD.epochStakePoolId xs
128123
, map SSD.epochStakeAmount xs
129124
, map SSD.epochStakeEpochNo xs
130125
)

cardano-db/src/Cardano/Db/Statement/Function/Query.hs

+5-4
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,10 @@
1-
{-# LANGUAGE OverloadedStrings #-}
1+
{-# LANGUAGE AllowAmbiguousTypes #-}
22
{-# LANGUAGE GADTs #-}
3+
{-# LANGUAGE OverloadedStrings #-}
34
{-# LANGUAGE RankNTypes #-}
45
{-# LANGUAGE ScopedTypeVariables #-}
56
{-# LANGUAGE TypeApplications #-}
6-
{-# LANGUAGE AllowAmbiguousTypes #-}
7+
{-# LANGUAGE TypeOperators #-}
78

89
module Cardano.Db.Statement.Function.Query where
910

@@ -16,7 +17,7 @@ import qualified Data.Text.Encoding as TextEnc
1617

1718
import Cardano.Db.Statement.Function.Core (ResultType (..))
1819
import Cardano.Db.Statement.Types (DbInfo (..), Key)
19-
import Cardano.Prelude (Proxy(..))
20+
import Cardano.Prelude (Proxy(..), MonadIO)
2021
import qualified Data.List.NonEmpty as NE
2122
import Data.Functor.Contravariant (Contravariant (..))
2223

@@ -35,7 +36,7 @@ import Data.Functor.Contravariant (Contravariant (..))
3536
-- votingAnchorId
3637
-- @
3738
queryIdExists
38-
:: forall a b r. (DbInfo a)
39+
:: forall a b r. (DbInfo a, Key a ~ b)
3940
=> HsqlE.Params b -- Encoder for the ID value
4041
-> ResultType Bool r -- Decoder for the boolean result
4142
-> b -- ID value to check

cardano-db/src/Cardano/Db/Statement/GovernanceAndVoting.hs

+16
Original file line numberDiff line numberDiff line change
@@ -146,6 +146,22 @@ insertDrepHashAlwaysAbstain = do
146146
}
147147
pure (entityKey entity)
148148

149+
insertDrepHashAlwaysNoConfidence :: MonadIO m => DbAction m Id.DrepHashId
150+
insertDrepHashAlwaysNoConfidence = do
151+
qr <- queryDrepHashAlwaysNoConfidence
152+
maybe ins pure qr
153+
where
154+
ins = runDbT TransWrite $ mkDbTransaction "insertDrepHashAlwaysNoConfidence" $ do
155+
entity <- insert
156+
SGV.drepHashEncoder
157+
(WithResult (HsqlD.singleRow SGV.entityDrepHashDecoder))
158+
SGV.DrepHash
159+
{ SGV.drepHashRaw = Nothing
160+
, SGV.drepHashView = hardcodedAlwaysNoConfidence
161+
, SGV.drepHashHasScript = False
162+
}
163+
pure (entityKey entity)
164+
149165
insertDrepRegistration :: MonadIO m => SGV.DrepRegistration -> DbAction m Id.DrepRegistrationId
150166
insertDrepRegistration drepRegistration =
151167
runDbT TransWrite $ mkDbTransaction "insertDrepRegistration" $ do

0 commit comments

Comments
 (0)