Merge pull request #83 from input-output-hk/ksaric/CAD-1824

[CAD-1824] List of delisted Stake pools.

src/Cardano/Db/Query.hs

@@ -14,6 +14,7 @@ module Cardano.Db.Query
   , queryLatestBlockNo
   , queryCheckPoints
   , queryDelistedPool
+  , queryAllDelistedPools
   , queryReservedTicker
   , queryAdminUsers
   , queryPoolMetadataFetchError
@@ -140,6 +141,12 @@ queryDelistedPool poolId = do
             pure pool
   pure $ maybe False (\_ -> True) (listToMaybe res)
 
+-- |Return all delisted pools.
+queryAllDelistedPools :: MonadIO m => ReaderT SqlBackend m [DelistedPool]
+queryAllDelistedPools = do
+  res <- selectList [] []
+  pure $ entityVal <$> res
+
 -- | Check if the ticker is in the table.
 queryReservedTicker :: MonadIO m => Text -> ReaderT SqlBackend m (Maybe ReservedTicker)
 queryReservedTicker reservedTickerName = do

src/DB.hs

@@ -62,6 +62,7 @@ data DataLayer = DataLayer
     , dlAddReservedTicker       :: Text -> PoolMetadataHash -> IO (Either DBFail ReservedTickerId)
     , dlCheckReservedTicker     :: Text -> IO (Maybe ReservedTicker)
 
+    , dlGetDelistedPools        :: IO [PoolId]
     , dlCheckDelistedPool       :: PoolId -> IO Bool
     , dlAddDelistedPool         :: PoolId -> IO (Either DBFail PoolId)
 
@@ -97,6 +98,8 @@ stubbedDataLayer ioDataMap ioDelistedPool = DataLayer
 
     , dlAddMetaDataReference = \poolId poolUrl poolMetadataHash -> panic "!"
 
+    , dlGetDelistedPools = readIORef ioDelistedPool
+
     , dlCheckDelistedPool = \poolId -> do
         blacklistedPool' <- readIORef ioDelistedPool
         return $ poolId `elem` blacklistedPool'
@@ -152,6 +155,11 @@ postgresqlDataLayer = DataLayer
     , dlCheckReservedTicker = \tickerName ->
         runDbAction Nothing $ queryReservedTicker tickerName
 
+    , dlGetDelistedPools = do
+        delistedPoolsDB <- runDbAction Nothing 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
 

src/Lib.hs

@@ -49,6 +49,9 @@ type ApiRes verb a = verb '[JSON] (ApiResult DBFail a)
 -- GET api/v1/metadata/{hash}
 type OfflineMetadataAPI = "api" :> "v1" :> "metadata" :> Capture "id" PoolId :> Capture "hash" PoolMetadataHash :> Get '[JSON] (Headers '[Header "Cache" Text] (ApiResult DBFail PoolMetadataWrapped))
 
+-- GET api/v1/delisted
+type DelistedPoolsAPI = "api" :> "v1" :> "delisted" :> ApiRes Get [PoolId]
+
 -- POST api/v1/delist
 #ifdef DISABLE_BASIC_AUTH
 type DelistPoolAPI = "api" :> "v1" :> "delist" :> ReqBody '[JSON] PoolId :> ApiRes Patch PoolId
@@ -63,7 +66,7 @@ type DelistPoolAPI = BasicAuthURL :> "api" :> "v1" :> "delist" :> ReqBody '[JSON
 type FetchPoolErrorAPI = BasicAuthURL :> "api" :> "v1" :> "errors" :> QueryParam "poolId" PoolId :> ApiRes Get [PoolFetchError]
 #endif
 
-type SmashAPI = OfflineMetadataAPI :<|> DelistPoolAPI :<|> FetchPoolErrorAPI
+type SmashAPI = OfflineMetadataAPI :<|> DelistPoolAPI :<|> FetchPoolErrorAPI :<|> DelistedPoolsAPI
 
 -- | Swagger spec for Todo API.
 todoSwagger :: Swagger
@@ -222,6 +225,7 @@ server configuration dataLayer
     :<|>    getPoolOfflineMetadata dataLayer
     :<|>    postDelistPool dataLayer
     :<|>    fetchPoolErrorAPI dataLayer
+    :<|>    getDelistedPools dataLayer
 
 #ifdef DISABLE_BASIC_AUTH
 fetchPoolErrorAPI :: DataLayer -> Maybe PoolId -> Handler (ApiResult DBFail [PoolFetchError])
@@ -294,6 +298,14 @@ getPoolOfflineMetadata dataLayer poolId poolHash = fmap (addHeader "always") . c
                         then return . ApiResult . Right $ PoolMetadataWrapped poolMetadata
                         else throwIO err404
 
+
+-- Get all delisted pools
+getDelistedPools :: DataLayer -> Handler (ApiResult DBFail [PoolId])
+getDelistedPools dataLayer = convertIOToHandler $ do
+    let getAllDelisted = dlGetDelistedPools dataLayer
+    allDelistedPools <- getAllDelisted
+    return . ApiResult . Right $ allDelistedPools
+
 -- For now, we just ignore the @BasicAuth@ definition.
 instance (HasSwagger api) => HasSwagger (BasicAuth name typo :> api) where
     toSwagger _ = toSwagger (Proxy :: Proxy api)