db-sync: Implement updating of param_update table

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

@@ -47,10 +47,11 @@ import qualified Shelley.Spec.Ledger.Address as Shelley
 import           Shelley.Spec.Ledger.BaseTypes (strictMaybeToMaybe)
 import qualified Shelley.Spec.Ledger.BaseTypes as Shelley
 import qualified Shelley.Spec.Ledger.Coin as Shelley
+import qualified Shelley.Spec.Ledger.Keys as Shelley
+import qualified Shelley.Spec.Ledger.PParams as Shelley
 import qualified Shelley.Spec.Ledger.Tx as Shelley
 import qualified Shelley.Spec.Ledger.TxData as Shelley
 
-
 insertShelleyBlock
     :: Trace IO Text -> DbSyncEnv -> ShelleyBlock TPraosStandardCrypto -> SlotDetails
     -> ReaderT SqlBackend (LoggingT IO) (Either DbSyncNodeError ())
@@ -137,10 +138,14 @@ insertTx tracer env blkId blockIndex tx = do
     -- Insert the transaction inputs.
     mapM_ (insertTxIn tracer txId) (Shelley.txInputList tx)
 
-    mapM_ (insertPoolCert tracer txId) (Shelley.txPoolCertificates $ Shelley._body tx)
-    mapM_ (insertDelegCert tracer env txId) (Shelley.txDelegationCerts $ Shelley._body tx)
-    mapM_ (insertMirCert tracer env txId) (Shelley.txMirCertificates $ Shelley._body tx)
-    mapM_ (insertWithdrawals tracer txId) (Map.toList . Shelley.unWdrl . Shelley._wdrls $ Shelley._body tx)
+    mapM_ (insertPoolCert tracer txId) $ Shelley.txPoolCertificates tx
+    mapM_ (insertDelegCert tracer env txId) $ Shelley.txDelegationCerts tx
+    mapM_ (insertMirCert tracer env txId) $ Shelley.txMirCertificates tx
+    mapM_ (insertWithdrawals tracer txId) $ Shelley.txWithdrawals tx
+
+    case Shelley.txParamUpdate tx of
+      Nothing -> pure ()
+      Just pu -> insertParamUpdate tracer txId pu
 
 
 insertTxOut
@@ -399,3 +404,40 @@ insertPoolRelay updateId relay =
           , DB.poolRelayDnsSrvName = Just (Shelley.dnsToText name)
           , DB.poolRelayPort = Nothing
           }
+
+
+insertParamUpdate
+    :: (MonadBaseControl IO m, MonadIO m)
+    => Trace IO Text -> DB.TxId -> Shelley.Update TPraosStandardCrypto
+    -> ExceptT DbSyncNodeError (ReaderT SqlBackend m) ()
+insertParamUpdate _tracer txId (Shelley.Update (Shelley.ProposedPPUpdates umap) (EpochNo epoch)) =
+    mapM_ insert $ Map.toList umap
+  where
+    insert
+      :: forall r m. (MonadBaseControl IO m, MonadIO m)
+      => (Shelley.KeyHash r TPraosStandardCrypto, Shelley.PParams' Shelley.StrictMaybe)
+      -> ExceptT DbSyncNodeError (ReaderT SqlBackend m) ()
+    insert (key, pmap) =
+      void . lift . DB.insertParamUpdate $
+        DB.ParamUpdate
+          { DB.paramUpdateEpochNo = epoch
+          , DB.paramUpdateKey = Shelley.unKeyHashBS key
+          , DB.paramUpdateMinFeeA = fromIntegral <$> strictMaybeToMaybe (Shelley._minfeeA pmap)
+          , DB.paramUpdateMinFeeB = fromIntegral <$> strictMaybeToMaybe (Shelley._minfeeB pmap)
+          , DB.paramUpdateMaxBlockSize = fromIntegral <$> strictMaybeToMaybe (Shelley._maxBBSize pmap)
+          , DB.paramUpdateMaxTxSize = fromIntegral <$> strictMaybeToMaybe (Shelley._maxTxSize pmap)
+          , DB.paramUpdateMaxBhSize = fromIntegral <$> strictMaybeToMaybe (Shelley._maxBHSize pmap)
+          , DB.paramUpdateKeyDeposit = fromIntegral . Shelley.unCoin <$> strictMaybeToMaybe (Shelley._keyDeposit pmap)
+          , DB.paramUpdatePoolDeposit = fromIntegral . Shelley.unCoin <$> strictMaybeToMaybe (Shelley._poolDeposit pmap)
+          , DB.paramUpdateMaxEpoch = unEpochNo <$> strictMaybeToMaybe (Shelley._eMax pmap)
+          , DB.paramUpdateNOptimal = fromIntegral <$> strictMaybeToMaybe (Shelley._nOpt pmap)
+          , DB.paramUpdateInfluence = fromRational <$> strictMaybeToMaybe (Shelley._a0 pmap)
+          , DB.paramUpdateMonetaryExpandRate = Shelley.unitIntervalToDouble <$> strictMaybeToMaybe (Shelley._rho pmap)
+          , DB.paramUpdateTreasuryGrowthRate = Shelley.unitIntervalToDouble <$> strictMaybeToMaybe (Shelley._tau pmap)
+          , DB.paramUpdateActiveSlotCoeff = Shelley.unitIntervalToDouble <$> strictMaybeToMaybe (Shelley._d pmap)
+          , DB.paramUpdateEntropy = Shelley.nonceToBytes <$> strictMaybeToMaybe (Shelley._extraEntropy pmap)
+          , DB.paramUpdateProtocolVersion = textShow <$> strictMaybeToMaybe (Shelley._protocolVersion pmap)
+          , DB.paramUpdateMinUTxOValue = fromIntegral . Shelley.unCoin <$> strictMaybeToMaybe (Shelley._minUTxOValue pmap)
+          , DB.paramUpdateMinPoolCost = fromIntegral . Shelley.unCoin <$> strictMaybeToMaybe (Shelley._minPoolCost pmap)
+          , DB.paramUpdateRegisteredTxId = txId
+          }

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

@@ -18,6 +18,7 @@ module Cardano.DbSync.Era.Shelley.Util
   , fakeGenesisHash
   , maybePaymentCred
   , mkSlotLeader
+  , nonceToBytes
   , pointToSlotHash
   , renderAddress
   , renderHash
@@ -26,13 +27,16 @@ module Cardano.DbSync.Era.Shelley.Util
   , stakingCredHash
   , txFee
   , txHash
+  , txDelegationCerts
   , txInputList
   , txOutputList
   , txOutputSum
   , txMirCertificates
+  , txParamUpdate
   , txPoolCertificates
-  , txDelegationCerts
+  , txWithdrawals
   , unHeaderHash
+  , unitIntervalToDouble
   , unKeyHashBS
   , unTxHash
   ) where
@@ -55,6 +59,7 @@ import qualified Data.Binary.Put as Binary
 import qualified Data.ByteString.Base16 as Base16
 import qualified Data.ByteString.Char8 as BS
 import qualified Data.ByteString.Lazy.Char8 as LBS
+import qualified Data.Map.Strict as Map
 import           Data.Sequence.Strict (StrictSeq (..))
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
@@ -73,6 +78,7 @@ import qualified Shelley.Spec.Ledger.BlockChain as Shelley
 import qualified Shelley.Spec.Ledger.Hashing as Shelley
 import qualified Shelley.Spec.Ledger.Keys as Shelley
 import qualified Shelley.Spec.Ledger.OCert as Shelley
+import qualified Shelley.Spec.Ledger.PParams as Shelley
 import qualified Shelley.Spec.Ledger.Tx as Shelley
 import qualified Shelley.Spec.Ledger.TxData as Shelley
 
@@ -146,6 +152,12 @@ mkSlotLeader blk mPoolId =
   in Db.SlotLeader slHash mPoolId slName
 
 
+nonceToBytes :: Shelley.Nonce -> ByteString
+nonceToBytes nonce =
+  case nonce of
+    Shelley.Nonce hash -> Crypto.hashToBytes hash
+    Shelley.NeutralNonce -> BS.replicate 28 '\0'
+
 -- | Convert from Ouroboros 'Point' to `Shelley' types.
 pointToSlotHash :: Point (Shelley.ShelleyBlock TPraosStandardCrypto) -> Maybe (SlotNo, ShelleyHash)
 pointToSlotHash (Point x) =
@@ -181,9 +193,9 @@ stakingCredHash env cred =
   in Shelley.serialiseRewardAcnt $ Shelley.RewardAcnt network cred
 
 
-txDelegationCerts :: ShelleyTxBody -> [ShelleyDelegCert]
-txDelegationCerts txBody =
-    mapMaybe extractDelegationCerts $ toList (Shelley._certs txBody)
+txDelegationCerts :: ShelleyTx -> [ShelleyDelegCert]
+txDelegationCerts tx =
+    mapMaybe extractDelegationCerts $ toList (Shelley._certs $ Shelley._body tx)
   where
     extractDelegationCerts :: ShelleyDCert -> Maybe ShelleyDelegCert
     extractDelegationCerts dcert =
@@ -200,19 +212,22 @@ txHash = Crypto.hashToBytes . Shelley.hashAnnotated . Shelley._body
 txInputList :: ShelleyTx -> [ShelleyTxIn]
 txInputList = toList . Shelley._inputs . Shelley._body
 
-txMirCertificates :: ShelleyTxBody -> [ShelleyMIRCert]
-txMirCertificates txBody =
-    mapMaybe extractMirCert $ toList (Shelley._certs txBody)
+txMirCertificates :: ShelleyTx -> [ShelleyMIRCert]
+txMirCertificates tx =
+    mapMaybe extractMirCert $ toList (Shelley._certs $ Shelley._body tx)
   where
     extractMirCert :: ShelleyDCert -> Maybe ShelleyMIRCert
     extractMirCert dcert =
       case dcert of
         Shelley.DCertMir mcert -> Just mcert
         _otherwise -> Nothing
 
-txPoolCertificates :: ShelleyTxBody -> [ShelleyPoolCert]
-txPoolCertificates txBody =
-    mapMaybe extractPoolCertificate $ toList (Shelley._certs txBody)
+txParamUpdate :: ShelleyTx -> Maybe (Shelley.Update TPraosStandardCrypto)
+txParamUpdate = Shelley.strictMaybeToMaybe . Shelley._txUpdate . Shelley._body
+
+txPoolCertificates :: ShelleyTx -> [ShelleyPoolCert]
+txPoolCertificates tx =
+    mapMaybe extractPoolCertificate $ toList (Shelley._certs $ Shelley._body tx)
   where
     extractPoolCertificate :: ShelleyDCert -> Maybe ShelleyPoolCert
     extractPoolCertificate dcert =
@@ -232,9 +247,15 @@ txOutputSum tx =
     outValue :: ShelleyTxOut -> Word64
     outValue (Shelley.TxOut _ coin) = fromIntegral $ unCoin coin
 
+txWithdrawals :: ShelleyTx -> [(Shelley.RewardAcnt TPraosStandardCrypto, Coin)]
+txWithdrawals = Map.toList . Shelley.unWdrl . Shelley._wdrls . Shelley._body
+
 unHeaderHash :: ShelleyHash -> ByteString
 unHeaderHash = Crypto.hashToBytes . Shelley.unHashHeader . Shelley.unShelleyHash
 
+unitIntervalToDouble :: Shelley.UnitInterval -> Double
+unitIntervalToDouble = fromRational . Shelley.unitIntervalToRational
+
 unKeyHash :: Shelley.KeyHash d crypto -> Crypto.Hash (Shelley.ADDRHASH crypto) (DSIGN.VerKeyDSIGN (Shelley.DSIGN crypto))
 unKeyHash (Shelley.KeyHash x) = x
 

cardano-db/cardano-db.cabal

@@ -71,6 +71,7 @@ library
                       , quiet
                       , resourcet
                       , scientific
+                      , shelley-spec-ledger
                       , text
                       , template-haskell
                       , time

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

@@ -6,6 +6,7 @@ module Cardano.Db.Insert
   , insertDelegation
   , insertEpoch
   , insertMeta
+  , insertParamUpdate
   , insertPoolHash
   , insertPoolMetaData
   , insertPoolOwner
@@ -52,6 +53,9 @@ insertEpoch = insertByReturnKey "Epoch"
 insertMeta :: (MonadBaseControl IO m, MonadIO m) => Meta -> ReaderT SqlBackend m MetaId
 insertMeta = insertByReturnKey "Meta"
 
+insertParamUpdate :: (MonadBaseControl IO m, MonadIO m) => ParamUpdate -> ReaderT SqlBackend m ParamUpdateId
+insertParamUpdate = insertByReturnKey "ParamUpdate"
+
 insertPoolHash :: (MonadBaseControl IO m, MonadIO m) => PoolHash -> ReaderT SqlBackend m PoolHashId
 insertPoolHash = insertByReturnKey "PoolHash"
 

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

@@ -250,23 +250,26 @@ share
 
   ParamUpdate
     epochNo             Word64              sqltype=uinteger
-    minFee              Word64              sqltype=uinteger
-    maxFee              Word64              sqltype=uinteger
-    maxBlockSize        Word64              sqltype=uinteger
-    maxTxSize           Word64              sqltype=uinteger
-    maxBhSize           Word64              sqltype=uinteger
-    keyDeposit          Word64              sqltype=lovelace
-    poolDeposit         Word64              sqltype=lovelace
-    maxEpoch            Word64              sqltype=uinteger
-    nOptimal            Word64              sqltype=uinteger
-    influence           Double              -- sqltype=rational
-    monetaryExpandRate  Word64              sqltype=interval
-    treasuryGrowthRate  Word64              sqltype=interval
-    activeSlotCoeff     Word64              sqltype=interval
-    decentralisation    Word64              sqltype=interval
-    entropy             ByteString          sqltype=hash32type
-    protocolVersion     ByteString          -- sqltype=protocol_version????
-    minCoin             Word64              sqltype=lovelace
-    UniqueParamUpdate   epochNo
+    key                 ByteString          sqltype=hash28type
+    minFeeA             Word64 Maybe        sqltype=uinteger
+    minFeeB             Word64 Maybe        sqltype=uinteger
+    maxBlockSize        Word64 Maybe        sqltype=uinteger
+    maxTxSize           Word64 Maybe        sqltype=uinteger
+    maxBhSize           Word64 Maybe        sqltype=uinteger
+    keyDeposit          Word64 Maybe        sqltype=lovelace
+    poolDeposit         Word64 Maybe        sqltype=lovelace
+    maxEpoch            Word64 Maybe        sqltype=uinteger
+    nOptimal            Word64 Maybe        sqltype=uinteger
+    influence           Double Maybe        -- sqltype=rational
+    monetaryExpandRate  Double Maybe        -- sqltype=interval
+    treasuryGrowthRate  Double Maybe        -- sqltype=interval
+    activeSlotCoeff     Double Maybe        -- sqltype=interval
+    entropy             ByteString Maybe    sqltype=hash32type
+    protocolVersion     Text Maybe
+    minUTxOValue        Word64 Maybe        sqltype=lovelace
+    minPoolCost         Word64 Maybe        sqltype=lovelace
+
+    registeredTxId      TxId                -- Slot number in which update registered.
+    UniqueParamUpdate   key registeredTxId
 
   |]

cardano-db/src/Cardano/Db/Schema/Orphans.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE StandaloneDeriving #-}
 
 {-# OPTIONS_GHC -Wno-orphans #-}
 
@@ -13,6 +14,8 @@ import qualified Data.Text as Text
 import Database.Persist.Class (PersistField (..))
 import Database.Persist.Types (PersistValue (..))
 
+import Shelley.Spec.Ledger.PParams (ProtVer (..))
+
 instance PersistField DbWord64 where
   toPersistValue = PersistText . Text.pack . show . unDbWord64
   fromPersistValue (PersistText bs) = Right $ DbWord64 (read $ Text.unpack bs)
@@ -25,3 +28,11 @@ instance PersistField Word128 where
   fromPersistValue x =
     Left $ mconcat [ "Failed to parse Haskell type Word128: ", Text.pack (show x) ]
 
+instance PersistField ProtVer where
+  toPersistValue = PersistText . Text.pack . show
+  fromPersistValue (PersistText txt) = Right $ read $ Text.unpack txt
+  fromPersistValue x =
+    Left $ mconcat [ "Failed to parse Haskell type ProtVer: ", Text.pack (show x) ]
+
+-- Projectile vomit here.
+deriving instance Read ProtVer

schema/migration-2-0003-20200727.sql → schema/migration-2-0003-20200728.sql

@@ -70,8 +70,9 @@ BEGIN
     EXECUTE 'ALTER TABLE "stake" ADD CONSTRAINT "unique_stake" UNIQUE("addr_id","stake")' ;
     EXECUTE 'ALTER TABLE "stake" ADD CONSTRAINT "stake_addr_id_fkey" FOREIGN KEY("addr_id") REFERENCES "stake_address"("id")' ;
     EXECUTE 'ALTER TABLE "stake" ADD CONSTRAINT "stake_tx_id_fkey" FOREIGN KEY("tx_id") REFERENCES "tx"("id")' ;
-    EXECUTE 'CREATe TABLE "param_update"("id" SERIAL8  PRIMARY KEY UNIQUE,"epoch_no" uinteger NOT NULL,"min_fee" uinteger NOT NULL,"max_fee" uinteger NOT NULL,"max_block_size" uinteger NOT NULL,"max_tx_size" uinteger NOT NULL,"max_bh_size" uinteger NOT NULL,"key_deposit" lovelace NOT NULL,"pool_deposit" lovelace NOT NULL,"max_epoch" uinteger NOT NULL,"n_optimal" uinteger NOT NULL,"influence" DOUBLE PRECISION NOT NULL,"monetary_expand_rate" interval NOT NULL,"treasury_growth_rate" interval NOT NULL,"active_slot_coeff" interval NOT NULL,"decentralisation" interval NOT NULL,"entropy" hash32type NOT NULL,"protocol_version" BYTEA NOT NULL,"min_coin" lovelace NOT NULL)' ;
-    EXECUTE 'ALTER TABLE "param_update" ADD CONSTRAINT "unique_param_update" UNIQUE("epoch_no")' ;
+    EXECUTE 'CREATe TABLE "param_update"("id" SERIAL8  PRIMARY KEY UNIQUE,"epoch_no" uinteger NOT NULL,"key" hash28type NOT NULL,"min_fee_a" uinteger NULL,"min_fee_b" uinteger NULL,"max_block_size" uinteger NULL,"max_tx_size" uinteger NULL,"max_bh_size" uinteger NULL,"key_deposit" lovelace NULL,"pool_deposit" lovelace NULL,"max_epoch" uinteger NULL,"n_optimal" uinteger NULL,"influence" DOUBLE PRECISION NULL,"monetary_expand_rate" DOUBLE PRECISION NULL,"treasury_growth_rate" DOUBLE PRECISION NULL,"active_slot_coeff" DOUBLE PRECISION NULL,"entropy" hash32type NULL,"protocol_version" VARCHAR NULL,"min_u_tx_o_value" lovelace NULL,"min_pool_cost" lovelace NULL,"registered_tx_id" INT8 NOT NULL)' ;
+    EXECUTE 'ALTER TABLE "param_update" ADD CONSTRAINT "unique_param_update" UNIQUE("key","registered_tx_id")' ;
+    EXECUTE 'ALTER TABLE "param_update" ADD CONSTRAINT "param_update_registered_tx_id_fkey" FOREIGN KEY("registered_tx_id") REFERENCES "tx"("id")' ;
     -- Hand written SQL statements can be added here.
     UPDATE schema_version SET stage_two = 3 ;
     RAISE NOTICE 'DB has been migrated to stage_two version %', next_version ;