Merge pull request #55 from input-output-hk/ksaric/CAD-1471

[CAD-1471] Query pool id along with hash when looking for pool info.
input-output-hk · Aug 13, 2020 · ada32e0 · ada32e0
2 parents 8e65add + edb1b9c
commit ada32e0
Show file tree

Hide file tree

Showing 5 changed files with 51 additions and 6 deletions.
diff --git a/smash.cabal b/smash.cabal
@@ -11,7 +11,7 @@ license:        Apache-2.0
 license-file:   LICENSE
 build-type:     Simple
 extra-source-files:
-    README.md
+    README.rst
     ChangeLog.md
 
 source-repository head
@@ -37,6 +37,7 @@ library
     , DbSyncPlugin
     -- DbSync
     , Cardano.SmashDbSync
+    , Cardano.Metrics
     -- Migration
     , Cardano.Db.Database
     , Cardano.Db.Migration

diff --git a/src/Cardano/Db/Database.hs b/src/Cardano/Db/Database.hs
@@ -25,9 +25,10 @@ import           Control.Monad.Trans.Except.Extra (left, newExceptT, runExceptT)
 import           Cardano.Slotting.Slot (SlotNo)
 
 import qualified DB as DB
+import           Cardano.Metrics
+
 import           Cardano.DbSync.DbAction
 import           Cardano.DbSync.Error
-import           Cardano.DbSync.Metrics
 import           Cardano.DbSync.Plugin
 import           Cardano.DbSync.Types
 import           Cardano.DbSync.Util

diff --git a/src/Cardano/Db/Query.hs b/src/Cardano/Db/Query.hs
@@ -33,7 +33,7 @@ import           Database.Esqueleto         (Entity, PersistField, SqlExpr,
                                              Value, countRows, desc, entityVal,
                                              from, isNothing, just, limit, not_,
                                              orderBy, select, unValue, val,
-                                             where_, (==.), (^.))
+                                             where_, (&&.), (==.), (^.))
 import           Database.Persist.Sql       (SqlBackend, selectList)
 
 import           Cardano.Db.Error
@@ -45,7 +45,7 @@ import qualified Cardano.Db.Types           as Types
 queryPoolMetadata :: MonadIO m => Types.PoolId -> Types.PoolMetadataHash -> ReaderT SqlBackend m (Either DBFail PoolMetadata)
 queryPoolMetadata poolId poolMetadataHash = do
   res <- select . from $ \ poolMetadata -> do
-            where_ (poolMetadata ^. PoolMetadataHash ==. val poolMetadataHash)
+            where_ (poolMetadata ^. PoolMetadataPoolId ==. val poolId &&. poolMetadata ^. PoolMetadataHash ==. val poolMetadataHash)
             pure poolMetadata
   pure $ maybeToEither (DbLookupPoolMetadataHash poolId poolMetadataHash) entityVal (listToMaybe res)
 

diff --git a/src/Cardano/Metrics.hs b/src/Cardano/Metrics.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Cardano.Metrics
+  ( Metrics (..)
+  , makeMetrics
+  , registerMetricsServer
+  ) where
+
+import           Cardano.Prelude
+
+import           System.Metrics.Prometheus.Concurrent.RegistryT (RegistryT (..), registerGauge,
+                    runRegistryT, unRegistryT)
+import           System.Metrics.Prometheus.Metric.Gauge (Gauge)
+import           System.Metrics.Prometheus.Http.Scrape (serveHttpTextMetricsT)
+
+
+data Metrics = Metrics
+  { mDbHeight :: !Gauge
+  , mNodeHeight :: !Gauge
+  , mQueuePre :: !Gauge
+  , mQueuePost :: !Gauge
+  , mQueuePostWrite :: !Gauge
+  }
+
+registerMetricsServer :: Int -> IO (Metrics, Async ())
+registerMetricsServer portNumber =
+  runRegistryT $ do
+    metrics <- makeMetrics
+    registry <- RegistryT ask
+    server <- liftIO . async $ runReaderT (unRegistryT $ serveHttpTextMetricsT portNumber []) registry
+    pure (metrics, server)
+
+makeMetrics :: RegistryT IO Metrics
+makeMetrics =
+  Metrics
+    <$> registerGauge "db_block_height" mempty
+    <*> registerGauge "remote_tip_height" mempty
+    <*> registerGauge "action_queue_length_pre" mempty
+    <*> registerGauge "action_queue_length_post" mempty
+    <*> registerGauge "action_queue_length_post_write" mempty
+
diff --git a/src/Cardano/SmashDbSync.hs b/src/Cardano/SmashDbSync.hs
@@ -40,10 +40,11 @@ import           Cardano.Client.Subscription                           (subscrib
 import qualified DB                                                    as DB
 
 import           Cardano.Db.Database
+import           Cardano.Metrics
+
 import           Cardano.DbSync.Config
 import           Cardano.DbSync.Era
 import           Cardano.DbSync.Error
-import           Cardano.DbSync.Metrics
 import           Cardano.DbSync.Plugin                                 (DbSyncNodePlugin (..))
 import           Cardano.DbSync.Tracing.ToObjectOrphans                ()
 import           Cardano.DbSync.Types                                  (ConfigFile (..),
@@ -403,7 +404,7 @@ dbSyncProtocols trce env plugin _version codecs _connectionId =
         currentTip <- getCurrentTipBlockNo
         logDbState trce
         actionQueue <- newDbActionQueue
-        (metrics, server) <- registerMetricsServer
+        (metrics, server) <- registerMetricsServer 8080
         race_
             (race_
                 (runDbThread trce env plugin metrics actionQueue)