[CAD-2449] Add API endpoint for checking valid pool id.

schema/force-resync.sql

@@ -0,0 +1,7 @@
+-- Clear block information, force re-sync.
+TRUNCATE pool_metadata;
+TRUNCATE pool_metadata_reference CASCADE;
+TRUNCATE pool;
+TRUNCATE retired_pool;
+TRUNCATE pool_metadata_fetch_error CASCADE;
+TRUNCATE block;

schema/migration-2-0006-20210108.sql

@@ -0,0 +1,22 @@
+-- Persistent generated migration.
+
+CREATE FUNCTION migrate() RETURNS void AS $$
+DECLARE
+  next_version int ;
+BEGIN
+  SELECT stage_two + 1 INTO next_version FROM schema_version ;
+  IF next_version = 6 THEN
+    -- Fix the pool table.
+    DROP TABLE "pool";
+    CREATe TABLE "pool"("id" SERIAL8  PRIMARY KEY UNIQUE,"pool_id" text NOT NULL);
+    ALTER TABLE "pool" ADD CONSTRAINT "unique_pool_id" UNIQUE("pool_id");
+    -- Hand written SQL statements can be added here.
+    UPDATE schema_version SET stage_two = 6 ;
+    RAISE NOTICE 'DB has been migrated to stage_two version %', next_version ;
+  END IF ;
+END ;
+$$ LANGUAGE plpgsql ;
+
+SELECT migrate() ;
+
+DROP FUNCTION migrate() ;

smash-servant-types/src/Cardano/SMASH/API.hs

@@ -104,6 +104,7 @@ type EnlistPoolAPI = BasicAuthURL :> "api" :> APIVersion :> "enlist" :> ReqBody
 
 type RetiredPoolsAPI = "api" :> APIVersion :> "retired" :> ApiRes Get [PoolId]
 
+type CheckPoolAPI = "api" :> APIVersion :> "exists" :> Capture "poolId" PoolId :> ApiRes Get PoolId
 
 -- The full API.
 type SmashAPI =  OfflineMetadataAPI
@@ -113,6 +114,7 @@ type SmashAPI =  OfflineMetadataAPI
             :<|> EnlistPoolAPI
             :<|> FetchPoolErrorAPI
             :<|> RetiredPoolsAPI
+            :<|> CheckPoolAPI
 #ifdef TESTING_MODE
             :<|> RetirePoolAPI
             :<|> AddPoolAPI

smash/app/Main.hs

@@ -34,6 +34,7 @@ import           Options.Applicative                    (Parser, ParserInfo,
                                                          ParserPrefs)
 import qualified Options.Applicative                    as Opt
 
+import           System.FilePath                        ((</>))
 import qualified System.Metrics.Prometheus.Metric.Gauge as Gauge
 
 import qualified Cardano.BM.Setup                       as Logging
@@ -67,9 +68,10 @@ main = do
 data Command
   = CreateAdminUser !ApplicationUser
   | DeleteAdminUser !ApplicationUser
-  | CreateMigration MigrationDir
-  | RunMigrations ConfigFile MigrationDir (Maybe LogFileDir)
-  | RunApplication
+  | CreateMigration !MigrationDir
+  | RunMigrations !ConfigFile !MigrationDir !(Maybe LogFileDir)
+  | ForceResync !ConfigFile !MigrationDir !(Maybe LogFileDir)
+  | RunApplication !ConfigFile
 #ifdef TESTING_MODE
   | RunStubApplication
 #endif
@@ -85,13 +87,21 @@ runCommand :: Command -> IO ()
 runCommand cmd =
   case cmd of
     CreateAdminUser applicationUser -> do
-        adminUserE <- createAdminUser DB.postgresqlDataLayer applicationUser
+
+        let dataLayer :: DB.DataLayer
+            dataLayer = DB.postgresqlDataLayer Nothing
+
+        adminUserE <- createAdminUser dataLayer applicationUser
         case adminUserE of
             Left err -> panic $ DB.renderLookupFail err
             Right adminUser -> putTextLn $ "Created admin user: " <> show adminUser
 
     DeleteAdminUser applicationUser -> do
-        adminUserE <- deleteAdminUser DB.postgresqlDataLayer applicationUser
+
+        let dataLayer :: DB.DataLayer
+            dataLayer = DB.postgresqlDataLayer Nothing
+
+        adminUserE <- deleteAdminUser dataLayer applicationUser
         case adminUserE of
             Left err -> panic $ DB.renderLookupFail err
             Right adminUser -> putTextLn $ "Deleted admin user: " <> show adminUser
@@ -106,7 +116,21 @@ runCommand cmd =
                     Just (LogFileDir dir) -> return $ DB.SmashLogFileDir dir
         DB.runMigrations trce (\pgConfig -> pgConfig) (DB.SmashMigrationDir mdir) smashLogFileDir
 
-    RunApplication -> runApp defaultConfiguration
+    -- We could reuse the log file dir in the future
+    ForceResync configFile (MigrationDir mdir) _mldir -> do
+        trce <- setupTraceFromConfig configFile
+        pgConfig <- DB.readPGPassFileEnv
+
+        -- Just run the force-resync which deletes all the state tables.
+        DB.runSingleScript trce pgConfig (mdir </> "force-resync.sql")
+
+    RunApplication configFile -> do
+        trce <- setupTraceFromConfig configFile
+
+        let dataLayer :: DB.DataLayer
+            dataLayer = DB.postgresqlDataLayer (Just trce)
+
+        runApp dataLayer defaultConfiguration
 #ifdef TESTING_MODE
     RunStubApplication -> runAppStubbed defaultConfiguration
 #endif
@@ -140,8 +164,11 @@ runCardanoSyncWithSmash dbSyncNodeParams = do
                     Gauge.set queuePostWrite $ mQueuePostWrite metrics
                 }
 
+    let dataLayer :: DB.DataLayer
+        dataLayer = DB.postgresqlDataLayer (Just tracer)
+
     -- The plugin requires the @DataLayer@.
-    let smashDbSyncNodePlugin = poolMetadataDbSyncNodePlugin DB.postgresqlDataLayer
+    let smashDbSyncNodePlugin = poolMetadataDbSyncNodePlugin dataLayer
 
     let runDbStartupCall = runDbStartup smashDbSyncNodePlugin
 
@@ -171,7 +198,7 @@ runCardanoSyncWithSmash dbSyncNodeParams = do
 
                 -- This is how all the calls should work, implemented on the base @DataLayer@.
                 , csdlAddGenesisMetaBlock = \meta block -> runExceptT $ do
-                    let addGenesisMetaBlock = DB.dlAddGenesisMetaBlock DB.postgresqlDataLayer
+                    let addGenesisMetaBlock = DB.dlAddGenesisMetaBlock dataLayer
 
                     let metaDB = convertToDB meta
                     let blockDB = convertToDB block
@@ -190,7 +217,7 @@ runCardanoSyncWithSmash dbSyncNodeParams = do
 
     race_
         (runDbSyncNode cardanoSyncDataLayer metricsLayer runDbStartupCall smashDbSyncNodePlugin dbSyncNodeParams runDBThreadFunction)
-        (runApp defaultConfiguration)
+        (runApp dataLayer defaultConfiguration)
 
     -- Finish and close the metrics server
     -- TODO(KS): Bracket!
@@ -330,6 +357,10 @@ pCommand =
         ( Opt.info pRunMigrations
           $ Opt.progDesc "Run the database migrations (which are idempotent)."
           )
+    <> Opt.command "force-resync"
+        ( Opt.info pForceResync
+          $ Opt.progDesc "Clears all the block information and forces a resync."
+          )
     <> Opt.command "run-app"
         ( Opt.info pRunApp
           $ Opt.progDesc "Run the application that just serves the pool info."
@@ -363,10 +394,14 @@ pCommand =
     pRunMigrations =
         RunMigrations <$> pConfigFile <*> pSmashMigrationDir <*> optional pLogFileDir
 
+    pForceResync :: Parser Command
+    pForceResync =
+        ForceResync <$> pConfigFile <*> pSmashMigrationDir <*> optional pLogFileDir
+
     -- Empty right now but we might add some params over time. Like ports and stuff?
     pRunApp :: Parser Command
     pRunApp =
-        pure RunApplication
+        RunApplication <$> pConfigFile
 
 #ifdef TESTING_MODE
     pRunStubApp :: Parser Command

smash/smash.cabal

@@ -133,6 +133,7 @@ executable smash-exe
     , esqueleto
     , transformers
     , prometheus
+    , filepath
 
   default-language:   Haskell2010
   default-extensions:

smash/src/Cardano/SMASH/DB.hs

@@ -21,6 +21,7 @@ module Cardano.SMASH.DB
 
 import           Cardano.Prelude
 
+import           Cardano.BM.Trace                          (Trace, logInfo)
 import           Control.Monad.Trans.Except.Extra          (left, newExceptT)
 
 import           Data.IORef                                (IORef, modifyIORef,
@@ -37,6 +38,7 @@ import           Cardano.SMASH.DBSync.Db.Insert            (insertAdminUser,
                                                             insertBlock,
                                                             insertDelistedPool,
                                                             insertMeta,
+                                                            insertPool,
                                                             insertPoolMetadata,
                                                             insertPoolMetadataFetchError,
                                                             insertPoolMetadataReference,
@@ -58,6 +60,7 @@ import           Cardano.SMASH.DBSync.Db.Schema            as X (AdminUser (..),
                                                                  DelistedPool (..),
                                                                  Meta (..),
                                                                  MetaId,
+                                                                 Pool (..),
                                                                  PoolMetadata (..),
                                                                  PoolMetadataFetchError (..),
                                                                  PoolMetadataFetchErrorId,
@@ -97,6 +100,9 @@ data DataLayer = DataLayer
     , dlAddFetchError           :: PoolMetadataFetchError -> IO (Either DBFail PoolMetadataFetchErrorId)
     , dlGetFetchErrors          :: PoolId -> Maybe UTCTime -> IO (Either DBFail [PoolFetchError])
 
+    , dlGetPool                 :: PoolId -> IO (Either DBFail PoolId)
+    , dlAddPool                 :: PoolId -> IO (Either DBFail PoolId)
+
     , dlAddGenesisMetaBlock     :: X.Meta -> X.Block -> IO (Either DBFail (MetaId, BlockId))
 
     , dlGetSlotHash             :: SlotNo -> IO (Maybe (SlotNo, ByteString))
@@ -156,6 +162,9 @@ stubbedDataLayer ioDataMap (DelistedPoolsIORef ioDelistedPool) (RetiredPoolsIORe
     , dlAddFetchError       = \_ -> panic "!"
     , dlGetFetchErrors      = \_ -> panic "!"
 
+    , dlGetPool             = \_ -> panic "!"
+    , dlAddPool             = \_ -> panic "!"
+
     , dlAddGenesisMetaBlock = \_ _ -> panic "!"
 
     , dlGetSlotHash         = \_ -> panic "!"
@@ -189,23 +198,23 @@ createStubbedDataLayer = do
     return dataLayer
 
 -- TODO(KS): Passing the optional tracer.
-postgresqlDataLayer :: DataLayer
-postgresqlDataLayer = DataLayer
+postgresqlDataLayer :: Maybe (Trace IO Text) -> DataLayer
+postgresqlDataLayer tracer = DataLayer
     { dlGetPoolMetadata = \poolId poolMetadataHash' -> do
-        poolMetadata <- runDbAction Nothing $ queryPoolMetadata poolId poolMetadataHash'
+        poolMetadata <- runDbAction tracer $ queryPoolMetadata poolId poolMetadataHash'
         let poolTickerName = poolMetadataTickerName <$> poolMetadata
         let poolMetadata' = poolMetadataMetadata <$> poolMetadata
         return $ (,) <$> poolTickerName <*> poolMetadata'
     , dlAddPoolMetadata     = \mRefId poolId poolHash poolMetadata poolTicker -> do
         let poolTickerName = TickerName $ getPoolTicker poolTicker
-        poolMetadataId <- runDbAction Nothing $ insertPoolMetadata $ PoolMetadata poolId poolTickerName poolHash poolMetadata mRefId
+        poolMetadataId <- runDbAction tracer $ insertPoolMetadata $ PoolMetadata poolId poolTickerName poolHash poolMetadata mRefId
 
         case poolMetadataId of
             Left err  -> return $ Left err
             Right _id -> return $ Right poolMetadata
 
     , dlAddMetaDataReference = \poolId poolUrl poolMetadataHash' -> do
-        poolMetadataRefId <- runDbAction Nothing $ insertPoolMetadataReference $
+        poolMetadataRefId <- runDbAction tracer $ insertPoolMetadataReference $
             PoolMetadataReference
                 { poolMetadataReferenceUrl = poolUrl
                 , poolMetadataReferenceHash = poolMetadataHash'
@@ -214,78 +223,92 @@ postgresqlDataLayer = DataLayer
         return poolMetadataRefId
 
     , dlAddReservedTicker = \tickerName poolMetadataHash' ->
-        runDbAction Nothing $ insertReservedTicker $ ReservedTicker tickerName poolMetadataHash'
+        runDbAction tracer $ insertReservedTicker $ ReservedTicker tickerName poolMetadataHash'
     , dlCheckReservedTicker = \tickerName ->
-        runDbAction Nothing $ queryReservedTicker tickerName
+        runDbAction tracer $ queryReservedTicker tickerName
 
     , dlGetDelistedPools = do
-        delistedPoolsDB <- runDbAction Nothing queryAllDelistedPools
+        delistedPoolsDB <- runDbAction tracer queryAllDelistedPools
         -- Convert from DB-specific type to the "general" type
         return $ map (\delistedPoolDB -> PoolId . getPoolId $ delistedPoolPoolId delistedPoolDB) delistedPoolsDB
     , dlCheckDelistedPool = \poolId -> do
-        runDbAction Nothing $ queryDelistedPool poolId
+        runDbAction tracer $ queryDelistedPool poolId
     , dlAddDelistedPool  = \poolId -> do
-        delistedPoolId <- runDbAction Nothing $ insertDelistedPool $ DelistedPool poolId
+        delistedPoolId <- runDbAction tracer $ insertDelistedPool $ DelistedPool poolId
 
         case delistedPoolId of
             Left err  -> return $ Left err
             Right _id -> return $ Right poolId
     , dlRemoveDelistedPool = \poolId -> do
-        isDeleted <- runDbAction Nothing $ deleteDelistedPool poolId
+        isDeleted <- runDbAction tracer $ deleteDelistedPool poolId
         -- Up for a discussion, but this might be more sensible in the lower DB layer.
         if isDeleted
             then return $ Right poolId
             else return $ Left RecordDoesNotExist
 
     , dlAddRetiredPool  = \poolId -> do
-        retiredPoolId <- runDbAction Nothing $ insertRetiredPool $ RetiredPool poolId
+        retiredPoolId <- runDbAction tracer $ insertRetiredPool $ RetiredPool poolId
 
         case retiredPoolId of
             Left err  -> return $ Left err
             Right _id -> return $ Right poolId
     , dlGetRetiredPools = do
-        retiredPools <- runDbAction Nothing $ queryAllRetiredPools
+        retiredPools <- runDbAction tracer $ queryAllRetiredPools
         return $ Right $ map retiredPoolPoolId retiredPools
 
     , dlGetAdminUsers       = do
-        adminUsers <- runDbAction Nothing $ queryAdminUsers
+        adminUsers <- runDbAction tracer $ queryAdminUsers
         return $ Right adminUsers
     , dlAddAdminUser        = \(ApplicationUser user pass') -> do
         let adminUser = AdminUser user pass'
-        adminUserId <- runDbAction Nothing $ insertAdminUser adminUser
+        adminUserId <- runDbAction tracer $ insertAdminUser adminUser
         case adminUserId of
             Left err  -> return $ Left err
             Right _id -> return $ Right adminUser
     , dlRemoveAdminUser     = \(ApplicationUser user pass') -> do
         let adminUser = AdminUser user pass'
-        isDeleted <- runDbAction Nothing $ deleteAdminUser adminUser
+        isDeleted <- runDbAction tracer $ deleteAdminUser adminUser
         if isDeleted
             then return $ Right adminUser
             else return $ Left $ UnknownError "Admin user not deleted. Both username and password must match."
 
     , dlAddFetchError       = \poolMetadataFetchError -> do
-        poolMetadataFetchErrorId <- runDbAction Nothing $ insertPoolMetadataFetchError poolMetadataFetchError
+        poolMetadataFetchErrorId <- runDbAction tracer $ insertPoolMetadataFetchError poolMetadataFetchError
         return poolMetadataFetchErrorId
     , dlGetFetchErrors      = \poolId mTimeFrom -> do
-        poolMetadataFetchErrors <- runDbAction Nothing (queryPoolMetadataFetchErrorByTime poolId mTimeFrom)
+        poolMetadataFetchErrors <- runDbAction tracer (queryPoolMetadataFetchErrorByTime poolId mTimeFrom)
         pure $ sequence $ Right <$> map convertPoolMetadataFetchError poolMetadataFetchErrors
 
+    , dlGetPool             = \poolId -> do
+        pool <- runDbAction tracer $ queryPoolByPoolId poolId
+        case pool of
+            Left err   -> return $ Left err
+            Right _val -> return $ Right poolId
+    , dlAddPool             = \poolId -> do
+        case tracer of
+            Nothing -> pure ()
+            Just trcr -> logInfo trcr $ "Inserting pool, pool id -'" <> show poolId <> "'."
+        poolId' <- runDbAction tracer $ insertPool (Pool poolId)
+        case poolId' of
+            Left err   -> return $ Left err
+            Right _val -> return $ Right poolId
+
     , dlAddGenesisMetaBlock = \meta block -> do
         -- This whole function has to be atomic!
         runExceptT $ do
             -- Well, in theory this should be handled differently.
-            count <- newExceptT (Right <$> (runDbAction Nothing $ queryBlockCount))
+            count <- newExceptT (Right <$> (runDbAction tracer $ queryBlockCount))
 
             when (count > 0) $
               left $ UnknownError "Shelley.insertValidateGenesisDist: Genesis data mismatch."
 
-            metaId <- newExceptT $ runDbAction Nothing $ insertMeta $ meta
-            blockId <- newExceptT $ runDbAction Nothing $ insertBlock $ block
+            metaId <- newExceptT $ runDbAction tracer $ insertMeta $ meta
+            blockId <- newExceptT $ runDbAction tracer $ insertBlock $ block
 
             pure (metaId, blockId)
 
     , dlGetSlotHash = \slotNo ->
-            runDbAction Nothing $ querySlotHash slotNo
+        runDbAction tracer $ querySlotHash slotNo
 
     }
 

smash/src/Cardano/SMASH/DBSync/Db/Insert.hs

@@ -4,6 +4,7 @@
 module Cardano.SMASH.DBSync.Db.Insert
   ( insertBlock
   , insertMeta
+  , insertPool
   , insertPoolMetadata
   , insertPoolMetadataReference
   , insertReservedTicker
@@ -38,6 +39,9 @@ insertBlock = insertByReturnKey
 insertMeta :: (MonadIO m) => Meta -> ReaderT SqlBackend m (Either DBFail MetaId)
 insertMeta meta = insertByReturnKey meta
 
+insertPool :: (MonadIO m) => Pool -> ReaderT SqlBackend m (Either DBFail PoolId)
+insertPool pool = insertByReturnKey pool
+
 insertPoolMetadata :: (MonadIO m) => PoolMetadata -> ReaderT SqlBackend m (Either DBFail PoolMetadataId)
 insertPoolMetadata = insertByReturnKey