Merge pull request #39 from input-output-hk/erikd/hacking-2

PR the cleanup changes I could salvage from yesterday
input-output-hk · Aug 5, 2020 · 8d60b4d · 8d60b4d
2 parents e2c6c69 + ac52f14
commit 8d60b4d
Show file tree

Hide file tree

Showing 8 changed files with 14,742 additions and 95 deletions.
diff --git a/app/Main.hs b/app/Main.hs
@@ -75,14 +75,6 @@ doCreateMigration mdir = do
 
 -------------------------------------------------------------------------------
 
-opts :: ParserInfo SmashDbSyncNodeParams
-opts =
-  Opt.info (pCommandLine <**> Opt.helper)
-    ( Opt.fullDesc
-    <> Opt.progDesc "Extended Cardano POstgreSQL sync node."
-    )
-
-
 pCommandLine :: Parser SmashDbSyncNodeParams
 pCommandLine =
   SmashDbSyncNodeParams

diff --git a/cabal.project b/cabal.project
@@ -3,6 +3,19 @@ index-state: 2020-07-15T00:00:00Z
 packages:
     ./
 
+-- -----------------------------------------------------------------------------
+-- Disable all tests by defauly and yhen enable specific tests in this repo
+
+tests: False
+
+package smash
+  tests: True
+
+test-show-details: direct
+
+-- -----------------------------------------------------------------------------
+
+
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-db-sync

diff --git a/config/mainnet-byron-genesis.json b/config/mainnet-byron-genesis.json
diff --git a/config/mainnet-config.yaml b/config/mainnet-config.yaml
@@ -8,12 +8,12 @@ Protocol: Cardano
 
 RequiresNetworkMagic: RequiresNoMagic
 
-ByronGenesisFile: /nix/store/2fgv0a6d00f3gic5p7kycgk5r30nnrxy-mainnet_candidate_4-byron-genesis.json
-ByronGenesisHash: 406bd7edfa14db46edb367d18f5b3dba8d0c626b7c1c19f283867a70d05945c9
+ByronGenesisFile: config/mainnet-byron-genesis.json
+ByronGenesisHash: 5f20df933584822601f9e3f8c024eb5eb252fe8cefb24d1317dc3d432e940ebb
 
 # Shelley genesis is not actully used but to specify Protocol Cardano, we need to sepcify one.
-ShelleyGenesisFile: /nix/store/2bj52wchrv4w2h84hx27id63w8v640qc-mainnet_candidate_4-shelley-genesis.json
-ShelleyGenesisHash: ef8a74ab8587db4c95a7b98cd15406faf7044d9ff47b977f54053f7ad4fd9e59
+ShelleyGenesisFile: config/mainnet-shelley-genesis.json
+ShelleyGenesisHash: aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
 
 # ------------------------------------------------------------------------------
 # Logging configuration follows.

diff --git a/config/mainnet-shelley-genesis.json b/config/mainnet-shelley-genesis.json
@@ -0,0 +1,68 @@
+{
+  "activeSlotsCoeff": 0.05,
+  "protocolParams": {
+    "protocolVersion": {
+      "minor": 0,
+      "major": 2
+    },
+    "decentralisationParam": 1,
+    "eMax": 18,
+    "extraEntropy": {
+      "tag": "NeutralNonce"
+    },
+    "maxTxSize": 16384,
+    "maxBlockBodySize": 65536,
+    "maxBlockHeaderSize": 1100,
+    "minFeeA": 44,
+    "minFeeB": 155381,
+    "minUTxOValue": 1000000,
+    "poolDeposit": 500000000,
+    "minPoolCost": 340000000,
+    "keyDeposit": 2000000,
+    "nOpt": 150,
+    "rho": 0.003,
+    "tau": 0.20,
+    "a0": 0.3
+  },
+  "genDelegs": {
+    "ad5463153dc3d24b9ff133e46136028bdc1edbb897f5a7cf1b37950c": {
+      "delegate": "d9e5c76ad5ee778960804094a389f0b546b5c2b140a62f8ec43ea54d",
+      "vrf": "64fa87e8b29a5b7bfbd6795677e3e878c505bc4a3649485d366b50abadec92d7"
+    },
+    "b9547b8a57656539a8d9bc42c008e38d9c8bd9c8adbb1e73ad529497": {
+      "delegate": "855d6fc1e54274e331e34478eeac8d060b0b90c1f9e8a2b01167c048",
+      "vrf": "66d5167a1f426bd1adcc8bbf4b88c280d38c148d135cb41e3f5a39f948ad7fcc"
+    },
+    "60baee25cbc90047e83fd01e1e57dc0b06d3d0cb150d0ab40bbfead1": {
+      "delegate": "7f72a1826ae3b279782ab2bc582d0d2958de65bd86b2c4f82d8ba956",
+      "vrf": "c0546d9aa5740afd569d3c2d9c412595cd60822bb6d9a4e8ce6c43d12bd0f674"
+    },
+    "f7b341c14cd58fca4195a9b278cce1ef402dc0e06deb77e543cd1757": {
+      "delegate": "69ae12f9e45c0c9122356c8e624b1fbbed6c22a2e3b4358cf0cb5011",
+      "vrf": "6394a632af51a32768a6f12dac3485d9c0712d0b54e3f389f355385762a478f2"
+    },
+    "162f94554ac8c225383a2248c245659eda870eaa82d0ef25fc7dcd82": {
+      "delegate": "4485708022839a7b9b8b639a939c85ec0ed6999b5b6dc651b03c43f6",
+      "vrf": "aba81e764b71006c515986bf7b37a72fbb5554f78e6775f08e384dbd572a4b32"
+    },
+    "2075a095b3c844a29c24317a94a643ab8e22d54a3a3a72a420260af6": {
+      "delegate": "6535db26347283990a252313a7903a45e3526ec25ddba381c071b25b",
+      "vrf": "fcaca997b8105bd860876348fc2c6e68b13607f9bbd23515cd2193b555d267af"
+    },
+    "268cfc0b89e910ead22e0ade91493d8212f53f3e2164b2e4bef0819b": {
+      "delegate": "1d4f2e1fda43070d71bb22a5522f86943c7c18aeb4fa47a362c27e23",
+      "vrf": "63ef48bc5355f3e7973100c371d6a095251c80ceb40559f4750aa7014a6fb6db"
+    }
+  },
+  "updateQuorum": 5,
+  "networkId": "Mainnet",
+  "initialFunds": {},
+  "maxLovelaceSupply": 45000000000000000,
+  "networkMagic": 764824073,
+  "epochLength": 432000,
+  "systemStart": "2017-09-23T21:44:51Z",
+  "slotsPerKESPeriod": 129600,
+  "slotLength": 1,
+  "maxKESEvolutions": 62,
+  "securityParam": 2160
+}
diff --git a/smash.cabal b/smash.cabal
@@ -158,6 +158,7 @@ test-suite smash-test
   other-modules:
       Paths_smash
     , SmashSpec
+    , SmashSpecSM
   hs-source-dirs:
       test
   ghc-options: -threaded -rtsopts -with-rtsopts=-N

diff --git a/src/Cardano/SmashDbSync.hs b/src/Cardano/SmashDbSync.hs
@@ -177,7 +177,7 @@ runDbSyncNode plugin enp =
 
     trce <- if not (encEnableLogging enc)
               then pure Logging.nullTracer
-              else liftIO $ Logging.setupTrace (Right $ encLoggingConfig enc) "db-sync-node"
+              else liftIO $ Logging.setupTrace (Right $ encLoggingConfig enc) "smash-node"
 
     logInfo trce $ "Running migrations."
 

diff --git a/src/DbSyncPlugin.hs b/src/DbSyncPlugin.hs
@@ -19,26 +19,28 @@ import           Control.Monad.Trans.Reader                  (ReaderT)
 
 import           DB                                          (DBFail (..),
                                                               DataLayer (..),
-                                                              postgresqlDataLayer,
-                                                              runDbAction)
+                                                              postgresqlDataLayer)
 import           Types                                       (PoolId (..), PoolMetadataHash (..),
-                                                              PoolMetadataRaw (..),
                                                               PoolOfflineMetadata (..),
                                                               PoolUrl (..))
 
-import           Data.Aeson                                  (eitherDecode')
-import qualified Data.ByteString.Lazy                        as BL
+import           Data.Aeson (eitherDecode')
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.Text.Encoding as Text
 
-import qualified Cardano.Crypto.Hash.Blake2b                 as Crypto
-import qualified Cardano.Crypto.Hash.Class                   as Crypto
+import qualified Cardano.Chain.Block as Byron
+
+import qualified Cardano.Crypto.Hash.Class as Crypto
+import qualified Cardano.Crypto.Hash.Blake2b as Crypto
 
 import qualified Data.ByteString.Base16                      as B16
 
-import           Network.HTTP.Client                         hiding (Proxy)
-import           Network.HTTP.Client.TLS                     (tlsManagerSettings)
-import           Network.HTTP.Types.Status                   (statusCode)
+import           Network.HTTP.Client (HttpExceptionContent (..), HttpException (..))
+import qualified Network.HTTP.Client as Http
+import           Network.HTTP.Client.TLS (tlsManagerSettings)
+import qualified Network.HTTP.Types.Status as Http
 
-import           Database.Persist.Sql                        (SqlBackend)
+import           Database.Persist.Sql (IsolationLevel (..), SqlBackend, transactionSaveWithIsolation)
 
 import qualified Cardano.Db.Insert                           as DB
 import qualified Cardano.Db.Query                            as DB
@@ -51,14 +53,14 @@ 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           Shelley.Spec.Ledger.BaseTypes (strictMaybeToMaybe)
+import qualified Shelley.Spec.Ledger.BaseTypes as Shelley
+import qualified Shelley.Spec.Ledger.TxData as Shelley
 
-import           Ouroboros.Consensus.Shelley.Ledger          (ShelleyBlock)
+import           Ouroboros.Consensus.Byron.Ledger (ByronBlock (..))
+import           Ouroboros.Consensus.Shelley.Ledger.Block (ShelleyBlock)
 import           Ouroboros.Consensus.Shelley.Protocol.Crypto (TPraosStandardCrypto)
 
-
 poolMetadataDbSyncNodePlugin :: DbSyncNodePlugin
 poolMetadataDbSyncNodePlugin =
   DbSyncNodePlugin
@@ -72,10 +74,20 @@ insertCardanoBlock
     -> DbSyncEnv
     -> DbSync.BlockDetails
     -> ReaderT SqlBackend (LoggingT IO) (Either DbSyncNodeError ())
-insertCardanoBlock _tracer _env ByronBlockDetails{} =
-    pure $ Right ()  -- we do nothing for Byron era blocks
-insertCardanoBlock tracer _env (ShelleyBlockDetails blk _) =
-    insertShelleyBlock tracer blk
+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
@@ -99,12 +111,11 @@ insertShelleyBlock tracer blk = do
     zipWithM_ (insertTx tracer) [0 .. ] (Shelley.blockTxs blk)
 
     liftIO $ do
-      let epoch = Shelley.slotNumber blk `div` 5000
       logInfo tracer $ mconcat
-        [ "insertShelleyBlock pool info: epoch ", show epoch
-        , ", slot ", show (Shelley.slotNumber blk)
+        [ "insertShelleyBlock pool info: slot ", show (Shelley.slotNumber blk)
         , ", block ", show (Shelley.blockNumber blk)
         ]
+    lift $ transactionSaveWithIsolation Serializable
 
 insertTx
     :: (MonadIO m)
@@ -138,15 +149,9 @@ insertPoolRegister tracer params = do
   poolMetadataId <- case strictMaybeToMaybe $ Shelley._poolMD params of
     Just md -> do
 
-        let eitherPoolMetadata :: IO (Either DbSyncNodeError (Response BL.ByteString))
-            eitherPoolMetadata = runExceptT (fetchInsertPoolMetadata tracer poolId md)
-
-        liftIO $ eitherPoolMetadata >>= \case
-                Left err -> logError tracer $ renderDbSyncNodeError err
-                Right response -> logInfo tracer (decodeUtf8 . BL.toStrict $ responseBody response)
+        liftIO $ fetchInsertPoolMetadataWrap tracer poolId md
 
         liftIO . logInfo tracer $ "Inserting metadata."
-
         let metadataUrl = PoolUrl . Shelley.urlToText $ Shelley._poolMDUrl md
         let metadataHash = PoolMetadataHash . B16.encode $ Shelley._poolMDHash md
 
@@ -168,87 +173,83 @@ insertPoolRegister tracer params = do
   liftIO . logInfo tracer $ "Inserted pool register."
   return poolMetadataId
 
+fetchInsertPoolMetadataWrap
+    :: Trace IO Text
+    -> PoolId
+    -> Shelley.PoolMetaData
+    -> IO ()
+fetchInsertPoolMetadataWrap tracer poolId md = do
+    res <- runExceptT $ fetchInsertPoolMetadata tracer poolId md
+    case res of
+        Left err -> logError tracer $ renderDbSyncNodeError err
+        Right response -> logInfo tracer (decodeUtf8 response)
+
+
 fetchInsertPoolMetadata
     :: Trace IO Text
     -> PoolId
     -> Shelley.PoolMetaData
-    -> ExceptT DbSyncNodeError IO (Response BL.ByteString)
+    -> ExceptT DbSyncNodeError IO ByteString
 fetchInsertPoolMetadata tracer poolId md = do
     -- Fetch the JSON info!
     liftIO . logInfo tracer $ "Fetching JSON metadata."
 
     let poolUrl = Shelley.urlToText (Shelley._poolMDUrl md)
 
     -- This is a bit bad to do each time, but good enough for now.
-    manager <- liftIO $ newManager tlsManagerSettings
+    manager <- liftIO $ Http.newManager tlsManagerSettings
 
     liftIO . logInfo tracer $ "Request created with URL '" <> poolUrl <> "'."
 
-    let exceptRequest :: ExceptT DbSyncNodeError IO Request
-        exceptRequest = handleExceptT (\(e :: HttpException) -> NEError $ show e) (parseRequest $ toS poolUrl)
-
-    request <- exceptRequest
+    request <- handleExceptT (\(e :: HttpException) -> NEError $ show e) (Http.parseRequest $ toS poolUrl)
 
     liftIO . logInfo tracer $ "HTTP Client GET request."
 
-    -- The response size check.
-    _responseRaw <- handleExceptT (\(e :: HttpException) -> NEError $ show e) $ withResponse request manager $ \responseBR -> do
-        -- We read the first chunk that should contain all the bytes from the reponse.
-        responseBSFirstChunk <- brReadSome (responseBody responseBR) 512
-        -- If there are more bytes in the second chunk, we don't go any further since that
-        -- violates the size constraint.
-        responseBSSecondChunk <- brReadSome (responseBody responseBR) 512
-        if BL.null responseBSSecondChunk
-           then pure responseBSFirstChunk
-           else throwIO $ HttpExceptionRequest request NoResponseDataReceived
+    (respBS, status) <- liftIO $ httpGetMax512Bytes request manager
 
-    -- The request for fetching the full content strictly.
-    let httpRequest :: MonadIO n => n (Response BL.ByteString)
-        httpRequest = liftIO $ httpLbs request manager
+    liftIO . logInfo tracer $ "HTTP GET request response: " <> show status
 
-    response <- handleExceptT (\(e :: HttpException) -> NEError $ show e) httpRequest
-
-    liftIO . logInfo tracer $ "HTTP GET request complete."
-    liftIO . logInfo tracer $ "The status code was: " <> (show $ statusCode $ responseStatus response)
-
-    let poolMetadataJson = decodeUtf8 . BL.toStrict $ responseBody response
-
-    let mdHash :: ByteString
-        mdHash = Shelley._poolMDHash md
-
-    let poolHash :: Text
-        poolHash = decodeUtf8 . B16.encode $ mdHash
-
-    liftIO . logInfo tracer $ "Inserting pool with hash: " <> poolHash
-
-    -- Pass this in, not create it here.
-    let dataLayer :: DataLayer
-        dataLayer = postgresqlDataLayer
+    liftIO . logInfo tracer $ "Inserting pool with hash: " <> renderByteStringHex (Shelley._poolMDHash md)
 
     -- Let us try to decode the contents to JSON.
-    let decodedPoolMetadataJSON :: Either DBFail PoolOfflineMetadata
-        decodedPoolMetadataJSON = case (eitherDecode' (responseBody response)) of
-            Left err     -> Left $ UnableToEncodePoolMetadataToJSON $ toS err
-            Right result -> return result
-
-    decodedMetadata <- firstExceptT (\e -> NEError $ show e) (newExceptT $ pure decodedPoolMetadataJSON)
+    decodedMetadata <- case eitherDecode' (LBS.fromStrict respBS) of
+                        Left err -> left $ NEError (show $ UnableToEncodePoolMetadataToJSON (toS err))
+                        Right result -> pure result
 
     -- Let's check the hash
-    let poolHashBytestring = encodeUtf8 poolHash
-    let poolMetadataBytestring = encodeUtf8 poolMetadataJson
-    let hashFromMetadata = B16.encode $ Crypto.digest (Proxy :: Proxy Crypto.Blake2b_256) poolMetadataBytestring
+    let hashFromMetadata = Crypto.digest (Proxy :: Proxy Crypto.Blake2b_256) respBS
 
-    when (hashFromMetadata /= poolHashBytestring) $
-        left . NEError $ "The pool hash does not match: " <> poolHash
+    when (hashFromMetadata /= Shelley._poolMDHash md) $
+        left . NEError $
+          mconcat
+            [ "Pool hash mismatch. Expected ", renderByteStringHex (Shelley._poolMDHash md)
+            , " but got ", renderByteStringHex hashFromMetadata
+            ]
 
     liftIO . logInfo tracer $ "Inserting JSON offline metadata."
 
-    let addPoolMetadata = dlAddPoolMetadata dataLayer
+    let addPoolMetadata = dlAddPoolMetadata postgresqlDataLayer
     _ <- liftIO $ addPoolMetadata
         poolId
-        (PoolMetadataHash poolHashBytestring)
-        poolMetadataJson
+        (PoolMetadataHash . B16.encode $ Shelley._poolMDHash md)
+        (decodeUtf8 respBS)
         (pomTicker decodedMetadata)
 
-    pure response
+    pure respBS
+
+
+httpGetMax512Bytes :: Http.Request -> Http.Manager -> IO (ByteString, Http.Status)
+httpGetMax512Bytes request manager =
+    Http.withResponse request manager $ \responseBR -> do
+        -- We read the first chunk that should contain all the bytes from the reponse.
+        responseBSFirstChunk <- Http.brReadSome (Http.responseBody responseBR) 512
+        -- If there are more bytes in the second chunk, we don't go any further since that
+        -- violates the size constraint.
+        responseBSSecondChunk <- Http.brReadSome (Http.responseBody responseBR) 1
+        if LBS.null responseBSSecondChunk
+           then pure $ (LBS.toStrict responseBSFirstChunk, Http.responseStatus responseBR)
+           -- TODO: this is just WRONG.
+           else throwIO $ HttpExceptionRequest request NoResponseDataReceived
 
+renderByteStringHex :: ByteString -> Text
+renderByteStringHex = Text.decodeUtf8 . B16.encode