This repository has been archived by the owner on Dec 8, 2022. It is now read-only.
-
Notifications
You must be signed in to change notification settings - Fork 7
/
DbSyncPlugin.hs
150 lines (117 loc) · 5.65 KB
/
DbSyncPlugin.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
module DbSyncPlugin
( poolMetadataDbSyncNodePlugin
) where
import Cardano.Prelude
import Cardano.BM.Trace (Trace,
logInfo)
import Control.Monad.Logger (LoggingT)
import Control.Monad.Trans.Except.Extra (firstExceptT, newExceptT, runExceptT)
import Control.Monad.Trans.Reader (ReaderT)
import DB (DBFail (..),
DataLayer (..),
postgresqlDataLayer)
import Offline (fetchInsertNewPoolMetadata)
import Types (PoolId (..), PoolMetadataHash (..),
PoolUrl (..))
import qualified Cardano.Chain.Block as Byron
import qualified Data.ByteString.Base16 as B16
import Database.Persist.Sql (IsolationLevel (..), SqlBackend, transactionSaveWithIsolation)
import qualified Cardano.Db.Insert as DB
import qualified Cardano.Db.Query as DB
import qualified Cardano.Db.Schema as DB
import Cardano.DbSync.Error
import Cardano.DbSync.Types as DbSync
import Cardano.DbSync (DbSyncNodePlugin (..))
import qualified Cardano.DbSync.Era.Shelley.Util as Shelley
import Shelley.Spec.Ledger.BaseTypes (strictMaybeToMaybe)
import qualified Shelley.Spec.Ledger.BaseTypes as Shelley
import qualified Shelley.Spec.Ledger.TxData as Shelley
import Ouroboros.Consensus.Byron.Ledger (ByronBlock (..))
import Ouroboros.Consensus.Shelley.Ledger.Block (ShelleyBlock)
import Ouroboros.Consensus.Shelley.Protocol.Crypto (TPraosStandardCrypto)
poolMetadataDbSyncNodePlugin :: DbSyncNodePlugin
poolMetadataDbSyncNodePlugin =
DbSyncNodePlugin
{ plugOnStartup = []
, plugInsertBlock = [insertCardanoBlock]
, plugRollbackBlock = []
}
insertCardanoBlock
:: Trace IO Text
-> DbSyncEnv
-> DbSync.BlockDetails
-> ReaderT SqlBackend (LoggingT IO) (Either DbSyncNodeError ())
insertCardanoBlock tracer _env block = do
case block of
ByronBlockDetails blk _details -> Right <$> insertByronBlock tracer blk
ShelleyBlockDetails blk _details -> insertShelleyBlock tracer blk
-- We don't care about Byron, no pools there
insertByronBlock
:: Trace IO Text -> ByronBlock
-> ReaderT SqlBackend (LoggingT IO) ()
insertByronBlock tracer blk = do
case byronBlockRaw blk of
Byron.ABOBBlock {} -> pure ()
Byron.ABOBBoundary {} -> liftIO $ logInfo tracer "Byron EBB"
transactionSaveWithIsolation Serializable
insertShelleyBlock
:: Trace IO Text
-> ShelleyBlock TPraosStandardCrypto
-> ReaderT SqlBackend (LoggingT IO) (Either DbSyncNodeError ())
insertShelleyBlock tracer blk = do
runExceptT $ do
meta <- firstExceptT (\(e :: DBFail) -> NEError $ show e) . newExceptT $ DB.queryMeta
let slotsPerEpoch = DB.metaSlotsPerEpoch meta
_blkId <- lift . DB.insertBlock $
DB.Block
{ DB.blockHash = Shelley.blockHash blk
, DB.blockEpochNo = Just $ Shelley.slotNumber blk `div` slotsPerEpoch
, DB.blockSlotNo = Just $ Shelley.slotNumber blk
, DB.blockBlockNo = Just $ Shelley.blockNumber blk
}
zipWithM_ (insertTx tracer) [0 .. ] (Shelley.blockTxs blk)
liftIO $ do
logInfo tracer $ mconcat
[ "insertShelleyBlock pool info: slot ", show (Shelley.slotNumber blk)
, ", block ", show (Shelley.blockNumber blk)
]
lift $ transactionSaveWithIsolation Serializable
insertTx
:: (MonadIO m)
=> Trace IO Text -> Word64 -> ShelleyTx
-> ExceptT DbSyncNodeError (ReaderT SqlBackend m) ()
insertTx tracer _blockIndex tx =
mapM_ (insertPoolCert tracer) (Shelley.txPoolCertificates tx)
insertPoolCert
:: (MonadIO m)
=> Trace IO Text -> ShelleyPoolCert
-> ExceptT DbSyncNodeError (ReaderT SqlBackend m) ()
insertPoolCert tracer pCert =
case pCert of
Shelley.RegPool pParams -> insertPoolRegister tracer pParams
Shelley.RetirePool _keyHash _epochNum -> pure ()
-- Currently we just maintain the data for the pool, we might not want to
-- know whether it's registered
insertPoolRegister
:: forall m. (MonadIO m)
=> Trace IO Text
-> ShelleyPoolParams
-> ExceptT DbSyncNodeError (ReaderT SqlBackend m) ()
insertPoolRegister tracer params = do
let poolIdHash = B16.encode . Shelley.unKeyHashBS $ Shelley._poolPubKey params
let poolId = PoolId poolIdHash
liftIO . logInfo tracer $ "Inserting pool register with pool id: " <> decodeUtf8 poolIdHash
case strictMaybeToMaybe $ Shelley._poolMD params of
Just md -> do
liftIO . logInfo tracer $ "Inserting metadata."
let metadataUrl = PoolUrl . Shelley.urlToText $ Shelley._poolMDUrl md
let metadataHash = PoolMetadataHash . B16.encode $ Shelley._poolMDHash md
-- Ah. We can see there is garbage all over the code. Needs refactoring.
refId <- lift . liftIO $ (dlAddMetaDataReference postgresqlDataLayer) poolId metadataUrl metadataHash
liftIO $ fetchInsertNewPoolMetadata tracer refId poolId md
liftIO . logInfo tracer $ "Metadata inserted."
Nothing -> pure ()
liftIO . logInfo tracer $ "Inserted pool register."
pure ()