Skip to content

Commit b8007fe

Browse files
kdermekderme
authored
Merge pull request #1891 from IntersectMBO/kderme/fix-address
Fix address config
2 parents 08f82fc + 8b940c5 commit b8007fe

File tree

3 files changed

+121
-133
lines changed

3 files changed

+121
-133
lines changed

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -255,7 +255,7 @@ insertTxOut tracer cache iopts (txId, txHash) (Generic.TxOut index addr value ma
255255
pure $
256256
DB.VTxOutW
257257
(mkTxOutVariant mSaId addrId mDatumId mScriptId)
258-
Nothing
258+
(Just vAddress)
259259
-- TODO: Unsure about what we should return here for eutxo
260260
let !eutxo =
261261
case ioTxOutTableType iopts of

‎cardano-db/src/Cardano/Db/Operations/TxOut/TxOutQuery.hs

Lines changed: 120 additions & 116 deletions
Original file line numberDiff line numberDiff line change
@@ -198,6 +198,126 @@ queryTxOutCredentialsVariant (hash, index) = do
198198
pure (address ^. V.AddressPaymentCred, address ^. V.AddressHasScript)
199199
pure $ maybeToEither (DbLookupTxHash hash) unValue2 (listToMaybe res)
200200

201+
--------------------------------------------------------------------------------
202+
-- ADDRESS QUERIES
203+
--------------------------------------------------------------------------------
204+
queryAddressId :: MonadIO m => ByteString -> ReaderT SqlBackend m (Maybe V.AddressId)
205+
queryAddressId addrRaw = do
206+
res <- select $ do
207+
addr <- from $ table @V.Address
208+
where_ (addr ^. V.AddressRaw ==. val addrRaw)
209+
pure (addr ^. V.AddressId)
210+
pure $ unValue <$> listToMaybe res
211+
212+
--------------------------------------------------------------------------------
213+
-- queryTotalSupply
214+
--------------------------------------------------------------------------------
215+
216+
-- | Get the current total supply of Lovelace. This only returns the on-chain supply which
217+
-- does not include staking rewards that have not yet been withdrawn. Before wihdrawal
218+
-- rewards are part of the ledger state and hence not on chain.
219+
queryTotalSupply ::
220+
(MonadIO m) =>
221+
TxOutTableType ->
222+
ReaderT SqlBackend m Ada
223+
queryTotalSupply txOutTableType =
224+
case txOutTableType of
225+
TxOutCore -> query @'TxOutCore
226+
TxOutVariantAddress -> query @'TxOutVariantAddress
227+
where
228+
query ::
229+
forall (a :: TxOutTableType) m.
230+
(MonadIO m, TxOutFields a) =>
231+
ReaderT SqlBackend m Ada
232+
query = do
233+
res <- select $ do
234+
txOut <- from $ table @(TxOutTable a)
235+
txOutUnspentP @a txOut
236+
pure $ sum_ (txOut ^. txOutValueField @a)
237+
pure $ unValueSumAda (listToMaybe res)
238+
239+
--------------------------------------------------------------------------------
240+
-- queryGenesisSupply
241+
--------------------------------------------------------------------------------
242+
243+
-- | Return the total Genesis coin supply.
244+
queryGenesisSupply ::
245+
(MonadIO m) =>
246+
TxOutTableType ->
247+
ReaderT SqlBackend m Ada
248+
queryGenesisSupply txOutTableType =
249+
case txOutTableType of
250+
TxOutCore -> query @'TxOutCore
251+
TxOutVariantAddress -> query @'TxOutVariantAddress
252+
where
253+
query ::
254+
forall (a :: TxOutTableType) m.
255+
(MonadIO m, TxOutFields a) =>
256+
ReaderT SqlBackend m Ada
257+
query = do
258+
res <- select $ do
259+
(_tx :& txOut :& blk) <-
260+
from
261+
$ table @Tx
262+
`innerJoin` table @(TxOutTable a)
263+
`on` (\(tx :& txOut) -> tx ^. TxId ==. txOut ^. txOutTxIdField @a)
264+
`innerJoin` table @Block
265+
`on` (\(tx :& _txOut :& blk) -> tx ^. TxBlockId ==. blk ^. BlockId)
266+
where_ (isNothing $ blk ^. BlockPreviousId)
267+
pure $ sum_ (txOut ^. txOutValueField @a)
268+
pure $ unValueSumAda (listToMaybe res)
269+
270+
-- A predicate that filters out spent 'TxOut' entries.
271+
{-# INLINEABLE txOutUnspentP #-}
272+
txOutUnspentP :: forall a. TxOutFields a => SqlExpr (Entity (TxOutTable a)) -> SqlQuery ()
273+
txOutUnspentP txOut =
274+
where_ . notExists $
275+
from (table @TxIn) >>= \txIn ->
276+
where_
277+
( txOut
278+
^. txOutTxIdField @a
279+
==. txIn
280+
^. TxInTxOutId
281+
&&. txOut
282+
^. txOutIndexField @a
283+
==. txIn
284+
^. TxInTxOutIndex
285+
)
286+
287+
--------------------------------------------------------------------------------
288+
-- queryShelleyGenesisSupply
289+
--------------------------------------------------------------------------------
290+
291+
-- | Return the total Shelley Genesis coin supply. The Shelley Genesis Block
292+
-- is the unique which has a non-null PreviousId, but has null Epoch.
293+
queryShelleyGenesisSupply :: MonadIO m => TxOutTableType -> ReaderT SqlBackend m Ada
294+
queryShelleyGenesisSupply txOutTableType =
295+
case txOutTableType of
296+
TxOutCore -> query @'TxOutCore
297+
TxOutVariantAddress -> query @'TxOutVariantAddress
298+
where
299+
query ::
300+
forall (a :: TxOutTableType) m.
301+
(MonadIO m, TxOutFields a) =>
302+
ReaderT SqlBackend m Ada
303+
query = do
304+
res <- select $ do
305+
(txOut :& _tx :& blk) <-
306+
from
307+
$ table @(TxOutTable a)
308+
`innerJoin` table @Tx
309+
`on` (\(txOut :& tx) -> tx ^. TxId ==. txOut ^. txOutTxIdField @a)
310+
`innerJoin` table @Block
311+
`on` (\(_txOut :& tx :& blk) -> tx ^. TxBlockId ==. blk ^. BlockId)
312+
where_ (isJust $ blk ^. BlockPreviousId)
313+
where_ (isNothing $ blk ^. BlockEpochNo)
314+
pure $ sum_ (txOut ^. txOutValueField @a)
315+
pure $ unValueSumAda (listToMaybe res)
316+
317+
--------------------------------------------------------------------------------
318+
-- Testing or validating. Queries below are not used in production
319+
--------------------------------------------------------------------------------
320+
201321
--------------------------------------------------------------------------------
202322
-- queryUtxoAtBlockNo
203323
--------------------------------------------------------------------------------
@@ -387,17 +507,6 @@ queryScriptOutputsVariant = do
387507
combineToWrapper txOut address =
388508
VTxOutW (entityVal txOut) (Just (entityVal address))
389509

390-
--------------------------------------------------------------------------------
391-
-- ADDRESS QUERIES
392-
--------------------------------------------------------------------------------
393-
queryAddressId :: MonadIO m => ByteString -> ReaderT SqlBackend m (Maybe V.AddressId)
394-
queryAddressId addrRaw = do
395-
res <- select $ do
396-
addr <- from $ table @V.Address
397-
where_ (addr ^. V.AddressRaw ==. val addrRaw)
398-
pure (addr ^. V.AddressId)
399-
pure $ unValue <$> listToMaybe res
400-
401510
--------------------------------------------------------------------------------
402511
-- queryAddressOutputs
403512
--------------------------------------------------------------------------------
@@ -420,94 +529,6 @@ queryAddressOutputs txOutTableType addr = do
420529
Just (Just x) -> x
421530
_otherwise -> DbLovelace 0
422531

423-
--------------------------------------------------------------------------------
424-
-- queryTotalSupply
425-
--------------------------------------------------------------------------------
426-
427-
-- | Get the current total supply of Lovelace. This only returns the on-chain supply which
428-
-- does not include staking rewards that have not yet been withdrawn. Before wihdrawal
429-
-- rewards are part of the ledger state and hence not on chain.
430-
queryTotalSupply ::
431-
(MonadIO m) =>
432-
TxOutTableType ->
433-
ReaderT SqlBackend m Ada
434-
queryTotalSupply txOutTableType =
435-
case txOutTableType of
436-
TxOutCore -> query @'TxOutCore
437-
TxOutVariantAddress -> query @'TxOutVariantAddress
438-
where
439-
query ::
440-
forall (a :: TxOutTableType) m.
441-
(MonadIO m, TxOutFields a) =>
442-
ReaderT SqlBackend m Ada
443-
query = do
444-
res <- select $ do
445-
txOut <- from $ table @(TxOutTable a)
446-
txOutUnspentP @a txOut
447-
pure $ sum_ (txOut ^. txOutValueField @a)
448-
pure $ unValueSumAda (listToMaybe res)
449-
450-
--------------------------------------------------------------------------------
451-
-- queryGenesisSupply
452-
--------------------------------------------------------------------------------
453-
454-
-- | Return the total Genesis coin supply.
455-
queryGenesisSupply ::
456-
(MonadIO m) =>
457-
TxOutTableType ->
458-
ReaderT SqlBackend m Ada
459-
queryGenesisSupply txOutTableType =
460-
case txOutTableType of
461-
TxOutCore -> query @'TxOutCore
462-
TxOutVariantAddress -> query @'TxOutVariantAddress
463-
where
464-
query ::
465-
forall (a :: TxOutTableType) m.
466-
(MonadIO m, TxOutFields a) =>
467-
ReaderT SqlBackend m Ada
468-
query = do
469-
res <- select $ do
470-
(_tx :& txOut :& blk) <-
471-
from
472-
$ table @Tx
473-
`innerJoin` table @(TxOutTable a)
474-
`on` (\(tx :& txOut) -> tx ^. TxId ==. txOut ^. txOutTxIdField @a)
475-
`innerJoin` table @Block
476-
`on` (\(tx :& _txOut :& blk) -> tx ^. TxBlockId ==. blk ^. BlockId)
477-
where_ (isNothing $ blk ^. BlockPreviousId)
478-
pure $ sum_ (txOut ^. txOutValueField @a)
479-
pure $ unValueSumAda (listToMaybe res)
480-
481-
--------------------------------------------------------------------------------
482-
-- queryShelleyGenesisSupply
483-
--------------------------------------------------------------------------------
484-
485-
-- | Return the total Shelley Genesis coin supply. The Shelley Genesis Block
486-
-- is the unique which has a non-null PreviousId, but has null Epoch.
487-
queryShelleyGenesisSupply :: MonadIO m => TxOutTableType -> ReaderT SqlBackend m Ada
488-
queryShelleyGenesisSupply txOutTableType =
489-
case txOutTableType of
490-
TxOutCore -> query @'TxOutCore
491-
TxOutVariantAddress -> query @'TxOutVariantAddress
492-
where
493-
query ::
494-
forall (a :: TxOutTableType) m.
495-
(MonadIO m, TxOutFields a) =>
496-
ReaderT SqlBackend m Ada
497-
query = do
498-
res <- select $ do
499-
(txOut :& _tx :& blk) <-
500-
from
501-
$ table @(TxOutTable a)
502-
`innerJoin` table @Tx
503-
`on` (\(txOut :& tx) -> tx ^. TxId ==. txOut ^. txOutTxIdField @a)
504-
`innerJoin` table @Block
505-
`on` (\(_txOut :& tx :& blk) -> tx ^. TxBlockId ==. blk ^. BlockId)
506-
where_ (isJust $ blk ^. BlockPreviousId)
507-
where_ (isNothing $ blk ^. BlockEpochNo)
508-
pure $ sum_ (txOut ^. txOutValueField @a)
509-
pure $ unValueSumAda (listToMaybe res)
510-
511532
--------------------------------------------------------------------------------
512533
-- Helper Functions
513534
--------------------------------------------------------------------------------
@@ -549,20 +570,3 @@ queryTxOutUnspentCount txOutTableType =
549570
txOutUnspentP @a txOut
550571
pure countRows
551572
pure $ maybe 0 unValue (listToMaybe res)
552-
553-
-- A predicate that filters out spent 'TxOut' entries.
554-
{-# INLINEABLE txOutUnspentP #-}
555-
txOutUnspentP :: forall a. TxOutFields a => SqlExpr (Entity (TxOutTable a)) -> SqlQuery ()
556-
txOutUnspentP txOut =
557-
where_ . notExists $
558-
from (table @TxIn) >>= \txIn ->
559-
where_
560-
( txOut
561-
^. txOutTxIdField @a
562-
==. txIn
563-
^. TxInTxOutId
564-
&&. txOut
565-
^. txOutIndexField @a
566-
==. txIn
567-
^. TxInTxOutIndex
568-
)

‎cardano-db/src/Cardano/Db/Operations/Types.hs

Lines changed: 0 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,6 @@
22
{-# LANGUAGE DataKinds #-}
33
{-# LANGUAGE FlexibleContexts #-}
44
{-# LANGUAGE FlexibleInstances #-}
5-
{-# LANGUAGE PatternSynonyms #-}
65
{-# LANGUAGE RankNTypes #-}
76
{-# LANGUAGE ScopedTypeVariables #-}
87
{-# LANGUAGE TypeFamilyDependencies #-}
@@ -30,16 +29,6 @@ data TxOutW
3029
= CTxOutW !C.TxOut
3130
| VTxOutW !V.TxOut !(Maybe V.Address)
3231

33-
-- Pattern synonyms for easier construction
34-
pattern CoreTxOut :: C.TxOut -> TxOutW
35-
pattern CoreTxOut txOut = CTxOutW txOut
36-
37-
pattern VariantTxOutWithAddr :: V.TxOut -> V.Address -> TxOutW
38-
pattern VariantTxOutWithAddr txOut address = VTxOutW txOut (Just address)
39-
40-
pattern VariantTxOutNoAddr :: V.TxOut -> Maybe V.Address -> TxOutW
41-
pattern VariantTxOutNoAddr txOut maybeAddress = VTxOutW txOut maybeAddress
42-
4332
-- | A wrapper for TxOutId
4433
data TxOutIdW
4534
= CTxOutIdW !C.TxOutId
@@ -193,11 +182,6 @@ extractVariantTxOut (VTxOutW txOut _) = txOut
193182
-- this will never error as we can only have either CoreTxOut or VariantTxOut
194183
extractVariantTxOut (CTxOutW _) = error "Unexpected CTxOut in VariantTxOut list"
195184

196-
extractVariantAddress :: TxOutW -> Maybe V.Address
197-
extractVariantAddress (VTxOutW _ address) = address
198-
-- this will never error as we can only have either CoreTxOut or VariantTxOut
199-
extractVariantAddress (CTxOutW _) = error "Unexpected CTxOut in VariantTxOut list"
200-
201185
convertTxOutIdCore :: [TxOutIdW] -> [C.TxOutId]
202186
convertTxOutIdCore = mapMaybe unwrapCore
203187
where

0 commit comments

Comments
 (0)