Merge pull request #89 from input-output-hk/ksaric/CAD-1926

[CAD-1926] Retired pools should be ignored.

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
+```
+
+

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() ;

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

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
 

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

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

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