Fix DataLayer

cardano-db/src/Cardano/Db/Types.hs

@@ -154,21 +154,21 @@ data ScriptType
 data PoolCertAction
   = Retirement Word64   -- retirement epoch
   | Register ByteString -- metadata hash
-  deriving Eq
+  deriving (Eq, Show)
 
 -- | A Unique identifier for a certificate in the
 -- blockchain. Ord instance gives a chronological order.
 data CertNo = CertNo
   { ciBlockNo :: Maybe Word64
   , ciTxIndex :: Word64
   , ciCertIndex :: Word16
-  } deriving (Eq, Ord)
+  } deriving (Eq, Ord, Show)
 
 data PoolCert = PoolCert
   { pcHash :: ByteString
   , pcCertAction :: PoolCertAction
   , pcCertNo :: CertNo
-  } deriving Eq
+  } deriving (Eq, Show)
 
 instance Ord PoolCert where
   compare a b = compare (pcCertNo a) (pcCertNo b)

cardano-smash-server/src/Cardano/SMASH/Server/Impl.hs

@@ -87,11 +87,17 @@ getPoolOfflineMetadata dataLayer poolId poolHash = fmap (addHeader $ cacheContro
     isDelisted <- dlCheckDelistedPool dataLayer poolId
 
     -- When it is delisted, return 403. We don't need any more info.
-    when (isDelisted) $
+    when isDelisted $
         throwIO err403
 
-    metadata <- dlGetPoolMetadata dataLayer poolId poolHash
-    pure $ ApiResult metadata
+    isRetired <- dlCheckRetiredPool dataLayer poolId
+    when isRetired $
+        throwIO err404
+
+    mmetadata <- dlGetPoolMetadata dataLayer poolId poolHash
+    case mmetadata of
+        Left _err -> throwIO err404
+        Right meta -> pure $ ApiResult $ Right $  meta
 
 -- |Simple health status, there are ideas for improvement.
 getHealthStatus :: Handler (ApiResult DBFail HealthStatus)

cardano-smash-server/src/Cardano/SMASH/Server/PoolDataLayer.hs

@@ -6,7 +6,7 @@ module Cardano.SMASH.Server.PoolDataLayer where
 
 import           Cardano.Prelude
 
-import           Cardano.BM.Trace (Trace, logInfo)
+import           Cardano.BM.Trace (Trace)
 
 import qualified Data.ByteString.Base16 as Base16
 import qualified Data.Map.Strict as Map
@@ -34,7 +34,7 @@ data PoolDataLayer =
     , dlRemoveDelistedPool      :: PoolId -> IO (Either DBFail PoolId)
 
     , dlAddRetiredPool          :: PoolId -> Word64 -> IO (Either DBFail PoolId) -- testing mode
-    , dlCheckRetiredPool        :: PoolId -> IO (Either DBFail PoolId)
+    , dlCheckRetiredPool        :: PoolId -> IO Bool
     , dlGetRetiredPools         :: IO (Either DBFail [PoolId])
 
     , dlGetFetchErrors          :: PoolId -> Maybe UTCTime -> IO (Either DBFail [PoolFetchError])
@@ -53,23 +53,11 @@ postgresqlPoolDataLayer tracer = PoolDataLayer {
         Just (_tickerName, metadata) -> pure $ Right $ PoolMetadataRaw metadata
         Nothing -> pure $ Left $ DbLookupPoolMetadataHash poolId poolMetadataHash
   , dlAddPoolMetadata = panic "dlAddPoolMetadata not defined. Will be used only for testing."
-  , dlGetReservedTickers = do
-      pools <- getActivePools tracer Nothing
-      tickers <- Db.runWithConnectionLogging tracer $ forM (Map.toList pools) $ \(ph, meta) -> do
-        mticker <- Db.queryReservedTicker ph meta
-        pure $ map (\ticker -> (TickerName ticker, dbToServantMetaHash meta)) mticker
-      pure $ catMaybes tickers
-  , dlAddReservedTicker = \_ _ -> do
-      _ <- logInfo tracer $ "Add Reserved"
+  , dlGetReservedTickers = pure [] -- TODO: The ticker endpoints need a reword
+  , dlAddReservedTicker = \_ticker _ ->
       pure $ Left RecordDoesNotExist
-  , dlCheckReservedTicker = \ticker _metaHash -> do
-      pools <- getActivePools tracer Nothing
-      tickers <- Db.runWithConnectionLogging tracer $ forM (Map.toList pools) $ \(ph, meta) -> do
-        mticker <- Db.queryReservedTicker ph meta
-        pure $ map (\tickerText -> (TickerName tickerText, dbToServantMetaHash meta)) mticker
-      case Map.lookup ticker (Map.fromList $ catMaybes tickers) of
-        Nothing -> pure Nothing
-        Just _metaHash -> pure $ Just ticker
+  , dlCheckReservedTicker = \_ticker _metaHash -> do
+      pure Nothing
   , dlGetDelistedPools = do
       fmap dbToServantPoolId <$> Db.runWithConnectionLogging tracer Db.queryDelistedPools
   , dlCheckDelistedPool = \poolHash -> do
@@ -91,9 +79,7 @@ postgresqlPoolDataLayer tracer = PoolDataLayer {
   , dlAddRetiredPool = \_ _ -> panic "dlAddRetiredPool not defined. Will be used only for testing"
   , dlCheckRetiredPool = \poolId -> do
       actions <- getCertActions tracer (Just poolId)
-      if isRegistered (servantToDbPoolId poolId) actions
-      then pure $ Right poolId
-      else pure $ Left RecordDoesNotExist
+      pure $ not $ isRegistered (servantToDbPoolId poolId) actions
   , dlGetRetiredPools = do
       ls <- filterRetired <$> getCertActions tracer Nothing
       pure $ Right $ dbToServantPoolId <$> ls
@@ -181,6 +167,24 @@ dbToServantMetaHash bs = PoolMetadataHash $ Text.decodeUtf8 $ Base16.encode bs
 createCachedPoolDataLayer :: Maybe () -> IO PoolDataLayer
 createCachedPoolDataLayer _ = panic "createCachedPoolDataLayer not defined yet"
 
+_getUsedTickers :: Trace IO Text ->  IO [(TickerName, PoolMetadataHash)]
+_getUsedTickers tracer = do
+  pools <- getActivePools tracer Nothing
+  tickers <- Db.runWithConnectionLogging tracer $ forM (Map.toList pools) $ \(ph, meta) -> do
+    mticker <- Db.queryReservedTicker ph meta
+    pure $ map (\ticker -> (TickerName ticker, dbToServantMetaHash meta)) mticker
+  pure $ catMaybes tickers
+
+_checkUsedTicker :: Trace IO Text -> TickerName -> IO (Maybe TickerName)
+_checkUsedTicker tracer ticker = do
+    pools <- getActivePools tracer Nothing
+    tickers <- Db.runWithConnectionLogging tracer $ forM (Map.toList pools) $ \(ph, meta) -> do
+      mticker <- Db.queryReservedTicker ph meta
+      pure $ map (\tickerText -> (TickerName tickerText, dbToServantMetaHash meta)) mticker
+    case Map.lookup ticker (Map.fromList $ catMaybes tickers) of
+      Nothing -> pure Nothing
+      Just _metaHash -> pure $ Just ticker
+
 findLatestPoolAction :: [Db.PoolCert] -> Map ByteString Db.PoolCertAction
 findLatestPoolAction pcerts =
     map Db.pcCertAction $ Map.fromListWith max pcs