From ddd08a89b3887c81836ee280df8d108f19da1228 Mon Sep 17 00:00:00 2001 From: ksaric Date: Tue, 6 Oct 2020 17:34:27 +0200 Subject: [PATCH] [CAD-1926] Retired pools should be ignored. --- doc/getting-started/how-to-install-smash.md | 8 ++ schema/migration-2-0004-20201006.sql | 20 ++++ smash.cabal | 7 ++ src/Cardano/Db/Insert.hs | 4 + src/Cardano/Db/Query.hs | 26 ++++- src/Cardano/Db/Schema.hs | 6 ++ src/DB.hs | 19 +++- src/DbSyncPlugin.hs | 111 +++++++++++++------- src/Lib.hs | 41 ++++++-- 9 files changed, 191 insertions(+), 51 deletions(-) create mode 100644 schema/migration-2-0004-20201006.sql diff --git a/doc/getting-started/how-to-install-smash.md b/doc/getting-started/how-to-install-smash.md index bad41ab..36e957d 100644 --- a/doc/getting-started/how-to-install-smash.md +++ b/doc/getting-started/how-to-install-smash.md @@ -316,3 +316,11 @@ The returned list consists of objects that contain: - cause - what is the cause of the error and why is it failing - retryCount - the number of times we retried to fetch the offline metadata +## Pool unregistrations + +It is possible that a pool unregisters, in which case all it's metadata will be unavailable. You can check what pools have unregistered by: +``` +curl --verbose --header "Content-Type: application/json" http://localhost:3100/api/v1/retired +``` + + diff --git a/schema/migration-2-0004-20201006.sql b/schema/migration-2-0004-20201006.sql new file mode 100644 index 0000000..74f5d91 --- /dev/null +++ b/schema/migration-2-0004-20201006.sql @@ -0,0 +1,20 @@ +-- 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 = 4 THEN + CREATe TABLE "retired_pool"("id" SERIAL8 PRIMARY KEY UNIQUE,"pool_id" text NOT NULL); + ALTER TABLE "retired_pool" ADD CONSTRAINT "unique_retired_pool_id" UNIQUE("pool_id"); + -- Hand written SQL statements can be added here. + UPDATE schema_version SET stage_two = 4 ; + RAISE NOTICE 'DB has been migrated to stage_two version %', next_version ; + END IF ; +END ; +$$ LANGUAGE plpgsql ; + +SELECT migrate() ; + +DROP FUNCTION migrate() ; diff --git a/smash.cabal b/smash.cabal index dab51a9..0fddc0e 100644 --- a/smash.cabal +++ b/smash.cabal @@ -22,11 +22,18 @@ Flag disable-basic-auth description: Disable basic authentication scheme for other authentication mechanisms. default: False +Flag testing-mode + description: A flag for allowing operations that promote easy testing. + default: False + library if flag(disable-basic-auth) cpp-options: -DDISABLE_BASIC_AUTH + if flag(testing-mode) + cpp-options: -DTESTING_MODE + exposed-modules: Lib Offline diff --git a/src/Cardano/Db/Insert.hs b/src/Cardano/Db/Insert.hs index 3af7a74..d0b7175 100644 --- a/src/Cardano/Db/Insert.hs +++ b/src/Cardano/Db/Insert.hs @@ -8,6 +8,7 @@ module Cardano.Db.Insert , insertPoolMetadataReference , insertReservedTicker , insertDelistedPool + , insertRetiredPool , insertAdminUser , insertPoolMetadataFetchError @@ -54,6 +55,9 @@ insertReservedTicker reservedTicker = do insertDelistedPool :: (MonadIO m) => DelistedPool -> ReaderT SqlBackend m DelistedPoolId insertDelistedPool = insertByReturnKey +insertRetiredPool :: (MonadIO m) => RetiredPool -> ReaderT SqlBackend m RetiredPoolId +insertRetiredPool = insertByReturnKey + insertAdminUser :: (MonadIO m) => AdminUser -> ReaderT SqlBackend m AdminUserId insertAdminUser = insertByReturnKey diff --git a/src/Cardano/Db/Query.hs b/src/Cardano/Db/Query.hs index de4bc32..a94d954 100644 --- a/src/Cardano/Db/Query.hs +++ b/src/Cardano/Db/Query.hs @@ -18,6 +18,7 @@ module Cardano.Db.Query , queryReservedTicker , queryAdminUsers , queryPoolMetadataFetchError + , queryAllRetiredPools ) where import Cardano.Prelude hiding (Meta, from, isJust, @@ -31,11 +32,12 @@ import Data.ByteString.Char8 (ByteString) import Data.Maybe (catMaybes, listToMaybe) import Data.Word (Word64) -import Database.Esqueleto (Entity, PersistField, SqlExpr, +import Database.Esqueleto (Entity, PersistField, SqlExpr, ValueList, Value, countRows, desc, entityVal, - from, isNothing, just, limit, not_, - orderBy, select, unValue, val, - where_, (&&.), (==.), (^.)) + from, isNothing, just, limit, subList_select, + notIn, not_, orderBy, select, + unValue, val, where_, (&&.), (==.), + (^.)) import Database.Persist.Sql (SqlBackend, selectList) import Cardano.Db.Error @@ -47,9 +49,23 @@ 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 ^. PoolMetadataPoolId ==. val poolId &&. poolMetadata ^. PoolMetadataHash ==. val poolMetadataHash) + where_ (poolMetadata ^. PoolMetadataPoolId ==. val poolId + &&. poolMetadata ^. PoolMetadataHash ==. val poolMetadataHash + &&. poolMetadata ^. PoolMetadataPoolId `notIn` retiredPoolsPoolId) pure poolMetadata pure $ maybeToEither (DbLookupPoolMetadataHash poolId poolMetadataHash) entityVal (listToMaybe res) + where + -- |Subselect that selects all the retired pool ids. + retiredPoolsPoolId :: SqlExpr (ValueList (Types.PoolId)) + retiredPoolsPoolId = + subList_select . from $ \(retiredPool :: SqlExpr (Entity RetiredPool)) -> + return $ retiredPool ^. RetiredPoolPoolId + +-- |Return all retired pools. +queryAllRetiredPools :: MonadIO m => ReaderT SqlBackend m [RetiredPool] +queryAllRetiredPools = do + res <- selectList [] [] + pure $ entityVal <$> res -- | Count the number of blocks in the Block table. queryBlockCount :: MonadIO m => ReaderT SqlBackend m Word diff --git a/src/Cardano/Db/Schema.hs b/src/Cardano/Db/Schema.hs index b020d03..bc0cae6 100644 --- a/src/Cardano/Db/Schema.hs +++ b/src/Cardano/Db/Schema.hs @@ -79,6 +79,12 @@ share poolId PoolId sqltype=text UniquePoolId poolId + -- The retired pools. + + RetiredPool + poolId Types.PoolId sqltype=text + UniqueRetiredPoolId poolId + -- The pool metadata fetch error. We duplicate the poolId for easy access. PoolMetadataFetchError diff --git a/src/DB.hs b/src/DB.hs index 1f0c736..83b179f 100644 --- a/src/DB.hs +++ b/src/DB.hs @@ -28,7 +28,8 @@ import Cardano.Db.Insert (insertDelistedPool, insertPoolMetadata, insertPoolMetadataFetchError, insertPoolMetadataReference, - insertReservedTicker) + insertReservedTicker, + insertRetiredPool) import Cardano.Db.Query (DBFail (..), queryPoolMetadata) import Cardano.Db.Error as X @@ -47,6 +48,7 @@ import Cardano.Db.Schema as X (AdminUser (..), Block (..), PoolMetadataReferenceId, ReservedTicker (..), ReservedTickerId (..), + RetiredPool (..), poolMetadataMetadata) import qualified Cardano.Db.Types as Types @@ -68,6 +70,9 @@ data DataLayer = DataLayer , dlAddDelistedPool :: PoolId -> IO (Either DBFail PoolId) , dlRemoveDelistedPool :: PoolId -> IO (Either DBFail PoolId) + , dlAddRetiredPool :: PoolId -> IO (Either DBFail PoolId) + , dlGetRetiredPools :: IO (Either DBFail [PoolId]) + , dlGetAdminUsers :: IO (Either DBFail [AdminUser]) -- TODO(KS): Switch to PoolFetchError! @@ -109,6 +114,9 @@ stubbedDataLayer ioDataMap ioDelistedPool = DataLayer _ <- modifyIORef ioDelistedPool (\pools -> filter (/= poolId) pools) return $ Right poolId + , dlAddRetiredPool = \poolId -> panic "!" + , dlGetRetiredPools = panic "!" + , dlGetAdminUsers = return $ Right [] , dlAddFetchError = \_ -> panic "!" @@ -132,7 +140,7 @@ postgresqlDataLayer = DataLayer let poolTickerName = Types.getTickerName . poolMetadataTickerName <$> poolMetadata let poolMetadata' = Types.getPoolMetadata . poolMetadataMetadata <$> poolMetadata return $ (,) <$> poolTickerName <*> poolMetadata' - , dlAddPoolMetadata = \ mRefId poolId poolHash poolMetadata poolTicker -> do + , dlAddPoolMetadata = \mRefId poolId poolHash poolMetadata poolTicker -> do let poolTickerName = Types.TickerName $ getPoolTicker poolTicker _ <- runDbAction Nothing $ insertPoolMetadata $ PoolMetadata poolId poolTickerName poolHash (Types.PoolMetadataRaw poolMetadata) mRefId return $ Right poolMetadata @@ -167,6 +175,13 @@ postgresqlDataLayer = DataLayer then return $ Right poolId else return $ Left RecordDoesNotExist + , dlAddRetiredPool = \poolId -> do + _retiredPoolId <- runDbAction Nothing $ insertRetiredPool $ RetiredPool poolId + return $ Right poolId + , dlGetRetiredPools = do + retiredPools <- runDbAction Nothing $ queryAllRetiredPools + return $ Right $ map retiredPoolPoolId retiredPools + , dlGetAdminUsers = do adminUsers <- runDbAction Nothing $ queryAdminUsers return $ Right adminUsers diff --git a/src/DbSyncPlugin.hs b/src/DbSyncPlugin.hs index de59ead..36b6d50 100644 --- a/src/DbSyncPlugin.hs +++ b/src/DbSyncPlugin.hs @@ -3,6 +3,8 @@ module DbSyncPlugin ( poolMetadataDbSyncNodePlugin + -- * For future testing + , insertCardanoBlock ) where import Cardano.Prelude @@ -11,21 +13,25 @@ import Cardano.BM.Trace (Trace, logError, logInfo) import Control.Monad.Logger (LoggingT) -import Control.Monad.Trans.Except.Extra (firstExceptT, newExceptT, runExceptT) +import Control.Monad.Trans.Except.Extra (firstExceptT, + newExceptT, + runExceptT) import Control.Monad.Trans.Reader (ReaderT) import DB (DBFail (..), DataLayer (..), postgresqlDataLayer) -import Offline (fetchInsertNewPoolMetadata) +import Offline (fetchInsertNewPoolMetadata) import Types (PoolId (..), PoolMetadataHash (..), PoolUrl (..)) -import qualified Cardano.Chain.Block as Byron +import qualified Cardano.Chain.Block as Byron import qualified Data.ByteString.Base16 as B16 -import Database.Persist.Sql (IsolationLevel (..), SqlBackend, transactionSaveWithIsolation) +import Database.Persist.Sql (IsolationLevel (..), + SqlBackend, + transactionSaveWithIsolation) import qualified Cardano.Db.Insert as DB import qualified Cardano.Db.Query as DB @@ -37,48 +43,57 @@ import Cardano.DbSync.Types as DbSync import Cardano.DbSync (DbSyncNodePlugin (..)) import qualified Cardano.DbSync.Era.Shelley.Util as Shelley +import qualified Cardano.DbSync.Era.Byron.Util as Byron -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.Byron.Ledger (ByronBlock (..)) -import Ouroboros.Consensus.Shelley.Ledger.Block (ShelleyBlock) +import Ouroboros.Consensus.Byron.Ledger (ByronBlock (..)) +import Ouroboros.Consensus.Shelley.Ledger.Block (ShelleyBlock) import Ouroboros.Consensus.Shelley.Protocol.Crypto (TPraosStandardCrypto) +-- |Pass in the @DataLayer@. poolMetadataDbSyncNodePlugin :: DbSyncNodePlugin poolMetadataDbSyncNodePlugin = DbSyncNodePlugin { plugOnStartup = [] - , plugInsertBlock = [insertCardanoBlock] + , plugInsertBlock = [insertCardanoBlock postgresqlDataLayer] , plugRollbackBlock = [] } insertCardanoBlock - :: Trace IO Text + :: DataLayer + -> Trace IO Text -> DbSyncEnv -> DbSync.BlockDetails -> ReaderT SqlBackend (LoggingT IO) (Either DbSyncNodeError ()) -insertCardanoBlock tracer _env block = do +insertCardanoBlock dataLayer tracer _env block = do case block of - ByronBlockDetails blk _details -> Right <$> insertByronBlock tracer blk - ShelleyBlockDetails blk _details -> insertShelleyBlock tracer blk + ByronBlockDetails blk details -> Right <$> insertByronBlock tracer blk details + ShelleyBlockDetails blk _details -> insertShelleyBlock dataLayer tracer blk -- We don't care about Byron, no pools there insertByronBlock - :: Trace IO Text -> ByronBlock + :: Trace IO Text -> ByronBlock -> DbSync.SlotDetails -> ReaderT SqlBackend (LoggingT IO) () -insertByronBlock tracer blk = do +insertByronBlock tracer blk _details = do case byronBlockRaw blk of - Byron.ABOBBlock {} -> pure () - Byron.ABOBBoundary {} -> liftIO $ logInfo tracer "Byron EBB" + Byron.ABOBBlock byronBlock -> do + let slotNum = Byron.slotNumber byronBlock + -- Output in intervals, don't add too much noise to the output. + when (slotNum `mod` 5000 == 0) $ + liftIO . logInfo tracer $ "Byron block, slot: " <> show slotNum + Byron.ABOBBoundary {} -> pure () + transactionSaveWithIsolation Serializable insertShelleyBlock - :: Trace IO Text + :: DataLayer + -> Trace IO Text -> ShelleyBlock TPraosStandardCrypto -> ReaderT SqlBackend (LoggingT IO) (Either DbSyncNodeError ()) -insertShelleyBlock tracer blk = do +insertShelleyBlock dataLayer tracer blk = do runExceptT $ do meta <- firstExceptT (\(e :: DBFail) -> NEError $ show e) . newExceptT $ DB.queryMeta @@ -93,7 +108,7 @@ insertShelleyBlock tracer blk = do , DB.blockBlockNo = Just $ Shelley.blockNumber blk } - zipWithM_ (insertTx tracer) [0 .. ] (Shelley.blockTxs blk) + zipWithM_ (insertTx dataLayer tracer) [0 .. ] (Shelley.blockTxs blk) liftIO $ do logInfo tracer $ mconcat @@ -104,21 +119,26 @@ insertShelleyBlock tracer blk = do insertTx :: (MonadIO m) - => Trace IO Text -> Word64 -> ShelleyTx + => DataLayer + -> Trace IO Text + -> Word64 + -> ShelleyTx -> ExceptT DbSyncNodeError (ReaderT SqlBackend m) () -insertTx tracer _blockIndex tx = - mapM_ (insertCertificate tracer) (Shelley.txCertificates tx) +insertTx dataLayer tracer _blockIndex tx = + mapM_ (insertCertificate dataLayer tracer) (Shelley.txCertificates tx) insertCertificate :: (MonadIO m) - => Trace IO Text -> (Word16, ShelleyDCert) + => DataLayer + -> Trace IO Text + -> (Word16, ShelleyDCert) -> ExceptT DbSyncNodeError (ReaderT SqlBackend m) () -insertCertificate tracer (_idx, cert) = +insertCertificate dataLayer tracer (_idx, cert) = case cert of Shelley.DCertDeleg _deleg -> liftIO $ logInfo tracer "insertCertificate: DCertDeleg" - Shelley.DCertPool pool -> insertPoolCert tracer pool + Shelley.DCertPool pool -> insertPoolCert dataLayer tracer pool Shelley.DCertMir _mir -> liftIO $ logInfo tracer "insertCertificate: DCertMir" Shelley.DCertGenesis _gen -> @@ -126,21 +146,36 @@ insertCertificate tracer (_idx, cert) = insertPoolCert :: (MonadIO m) - => Trace IO Text -> ShelleyPoolCert + => DataLayer + -> Trace IO Text + -> ShelleyPoolCert -> ExceptT DbSyncNodeError (ReaderT SqlBackend m) () -insertPoolCert tracer pCert = +insertPoolCert dataLayer 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 + Shelley.RegPool pParams -> insertPoolRegister dataLayer tracer pParams + + -- RetirePool (KeyHash 'StakePool era) _ = PoolId + Shelley.RetirePool poolPubKey _epochNum -> do + let poolIdHash = B16.encode . Shelley.unKeyHashBS $ poolPubKey + let poolId = PoolId . decodeUtf8 $ poolIdHash + + liftIO . logInfo tracer $ "Retiring pool with poolId: " <> show poolId + + let addRetiredPool = dlAddRetiredPool dataLayer + + eitherPoolId <- liftIO $ addRetiredPool poolId + + case eitherPoolId of + Left err -> liftIO . logError tracer $ "Error adding retiring pool: " <> show err + Right poolId' -> liftIO . logInfo tracer $ "Added retiring pool with poolId: " <> show poolId' insertPoolRegister :: forall m. (MonadIO m) - => Trace IO Text + => DataLayer + -> Trace IO Text -> ShelleyPoolParams -> ExceptT DbSyncNodeError (ReaderT SqlBackend m) () -insertPoolRegister tracer params = do +insertPoolRegister dataLayer tracer params = do let poolIdHash = B16.encode . Shelley.unKeyHashBS $ Shelley._poolPubKey params let poolId = PoolId . decodeUtf8 $ poolIdHash @@ -153,9 +188,11 @@ insertPoolRegister tracer params = do let metadataHash = PoolMetadataHash . decodeUtf8 . 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 + -- TODO(KS): Move this above! + let addMetaDataReference = dlAddMetaDataReference dataLayer + refId <- lift . liftIO $ addMetaDataReference poolId metadataUrl metadataHash - liftIO $ fetchInsertNewPoolMetadata postgresqlDataLayer tracer refId poolId md + liftIO $ fetchInsertNewPoolMetadata dataLayer tracer refId poolId md liftIO . logInfo tracer $ "Metadata inserted." diff --git a/src/Lib.hs b/src/Lib.hs index d1698d1..ec349e4 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -52,8 +52,8 @@ type OfflineMetadataAPI = "api" :> "v1" :> "metadata" :> Capture "id" PoolId :> -- GET api/v1/delisted type DelistedPoolsAPI = "api" :> "v1" :> "delisted" :> ApiRes Get [PoolId] --- POST api/v1/delist #ifdef DISABLE_BASIC_AUTH +-- POST api/v1/delist type DelistPoolAPI = "api" :> "v1" :> "delist" :> ReqBody '[JSON] PoolId :> ApiRes Patch PoolId type EnlistPoolAPI = "api" :> "v1" :> "enlist" :> ReqBody '[JSON] PoolId :> ApiRes Patch PoolId @@ -70,12 +70,22 @@ type EnlistPoolAPI = BasicAuthURL :> "api" :> "v1" :> "enlist" :> ReqBody '[JSON type FetchPoolErrorAPI = BasicAuthURL :> "api" :> "v1" :> "errors" :> QueryParam "poolId" PoolId :> ApiRes Get [PoolFetchError] #endif +type RetiredPoolsAPI = "api" :> "v1" :> "retired" :> ApiRes Get [PoolId] + + -- The full API. type SmashAPI = OfflineMetadataAPI :<|> DelistedPoolsAPI :<|> DelistPoolAPI :<|> EnlistPoolAPI :<|> FetchPoolErrorAPI + :<|> RetiredPoolsAPI +#ifdef TESTING_MODE + :<|> RetirePoolAPI + +type RetirePoolAPI = "api" :> "v1" :> "retired" :> ReqBody '[JSON] PoolId :> ApiRes Patch PoolId +#endif + -- | Swagger spec for Todo API. todoSwagger :: Swagger @@ -231,7 +241,11 @@ server configuration dataLayer :<|> getDelistedPools dataLayer :<|> delistPool dataLayer :<|> enlistPool dataLayer - :<|> fetchPoolErrorAPI dataLayer + :<|> getPoolErrorAPI dataLayer + :<|> getRetiredPools dataLayer +#ifdef TESTING_MODE + :<|> retirePool dataLayer +#endif -- 403 if it is delisted @@ -271,7 +285,7 @@ getPoolOfflineMetadata dataLayer poolId poolHash = fmap (addHeader "always") . c else throwIO err404 --- Get all delisted pools +-- |Get all delisted pools getDelistedPools :: DataLayer -> Handler (ApiResult DBFail [PoolId]) getDelistedPools dataLayer = convertIOToHandler $ do let getAllDelisted = dlGetDelistedPools dataLayer @@ -322,16 +336,16 @@ enlistPool dataLayer user poolId = convertIOToHandler $ do #ifdef DISABLE_BASIC_AUTH -fetchPoolErrorAPI :: DataLayer -> Maybe PoolId -> Handler (ApiResult DBFail [PoolFetchError]) -fetchPoolErrorAPI dataLayer mPoolId = convertIOToHandler $ do +getPoolErrorAPI :: DataLayer -> Maybe PoolId -> Handler (ApiResult DBFail [PoolFetchError]) +getPoolErrorAPI dataLayer mPoolId = convertIOToHandler $ do let getFetchErrors = dlGetFetchErrors dataLayer fetchErrors <- getFetchErrors mPoolId return . ApiResult $ fetchErrors #else -fetchPoolErrorAPI :: DataLayer -> User -> Maybe PoolId -> Handler (ApiResult DBFail [PoolFetchError]) -fetchPoolErrorAPI dataLayer _user mPoolId = convertIOToHandler $ do +getPoolErrorAPI :: DataLayer -> User -> Maybe PoolId -> Handler (ApiResult DBFail [PoolFetchError]) +getPoolErrorAPI dataLayer _user mPoolId = convertIOToHandler $ do let getFetchErrors = dlGetFetchErrors dataLayer fetchErrors <- getFetchErrors mPoolId @@ -339,6 +353,19 @@ fetchPoolErrorAPI dataLayer _user mPoolId = convertIOToHandler $ do return . ApiResult $ fetchErrors #endif +getRetiredPools :: DataLayer -> Handler (ApiResult DBFail [PoolId]) +getRetiredPools dataLayer = convertIOToHandler $ do + let getRetiredPools = dlGetRetiredPools dataLayer + retiredPools <- getRetiredPools + return . ApiResult $ retiredPools + +#ifdef TESTING_MODE +retirePool :: DataLayer -> PoolId -> Handler (ApiResult DBFail PoolId) +retirePool dataLayer poolId = convertIOToHandler $ do + let addRetiredPool = dlAddRetiredPool dataLayer + retiredPoolId <- addRetiredPool poolId + return . ApiResult $ retiredPoolId +#endif -- For now, we just ignore the @BasicAuth@ definition. instance (HasSwagger api) => HasSwagger (BasicAuth name typo :> api) where