[CAD-2724] CLI option to switch to existing SMASH server filtering.

smash-servant-types/smash-servant-types.cabal

@@ -46,6 +46,7 @@ library
     , cardano-api
     , base16-bytestring
     , persistent
+    , network-uri
     , servant
     , servant-server
     , servant-swagger

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

@@ -10,6 +10,7 @@
 
 module Cardano.SMASH.API
     ( API
+    , DelistedPoolsAPI
     , fullAPI
     , smashApi
     ) where
@@ -23,11 +24,11 @@ import           Data.Aeson                    (FromJSON, ToJSON (..),
 import           Data.Swagger                  (Swagger (..))
 
 import           Network.Wai                   (Request, lazyRequestBody)
-import           Servant                       ((:<|>) (..), (:>), BasicAuth,
-                                                Capture, Get, HasServer (..),
-                                                Header, Headers, JSON,
-                                                OctetStream, Patch, Post,
-                                                QueryParam, ReqBody)
+import           Servant                       (BasicAuth, Capture, Get,
+                                                HasServer (..), Header, Headers,
+                                                JSON, OctetStream, Patch, Post,
+                                                QueryParam, ReqBody,
+                                                (:<|>) (..), (:>))
 import           Servant.Server                (err400)
 import           Servant.Server.Internal       (DelayedIO, addBodyCheck,
                                                 delayedFailFatal, errBody,
@@ -37,11 +38,13 @@ import           Servant.Swagger               (HasSwagger (..))
 
 import           Cardano.SMASH.DBSync.Db.Error (DBFail (..))
 import           Cardano.SMASH.Types           (ApiResult, HealthStatus,
-                                                PoolFetchError, PoolId (..),
-                                                PoolId, PoolIdBlockNumber (..),
+                                                PolicyResult, PoolFetchError,
+                                                PoolId (..),
+                                                PoolIdBlockNumber (..),
                                                 PoolMetadataHash,
-                                                PoolMetadataRaw, TickerName,
-                                                TimeStringFormat, User)
+                                                PoolMetadataRaw, SmashURL,
+                                                TickerName, TimeStringFormat,
+                                                UniqueTicker, User)
 
 
 -- Showing errors as JSON. To be reused when we need more general error handling.
@@ -80,11 +83,14 @@ type ApiRes verb a = verb '[JSON] (ApiResult DBFail a)
 -- The basic auth.
 type BasicAuthURL = BasicAuth "smash" User
 
+-- GET api/v1/metadata/{hash}
+type OfflineMetadataAPI = "api" :> APIVersion :> "metadata" :> Capture "id" PoolId :> Capture "hash" PoolMetadataHash :> Get '[JSON] (Headers '[Header "Cache-Control" Text] (ApiResult DBFail PoolMetadataRaw))
+
 -- GET api/v1/status
 type HealthStatusAPI = "api" :> APIVersion :> "status" :> ApiRes Get HealthStatus
 
--- GET api/v1/metadata/{hash}
-type OfflineMetadataAPI = "api" :> APIVersion :> "metadata" :> Capture "id" PoolId :> Capture "hash" PoolMetadataHash :> Get '[JSON] (Headers '[Header "Cache-Control" Text] (ApiResult DBFail PoolMetadataRaw))
+-- GET api/v1/tickers
+type ReservedTickersAPI = "api" :> APIVersion :> "tickers" :> ApiRes Get [UniqueTicker]
 
 -- GET api/v1/delisted
 type DelistedPoolsAPI = "api" :> APIVersion :> "delisted" :> ApiRes Get [PoolId]
@@ -97,10 +103,20 @@ type FetchPoolErrorAPI = "api" :> APIVersion :> "errors" :> Capture "poolId" Poo
 type DelistPoolAPI = "api" :> APIVersion :> "delist" :> ReqBody '[JSON] PoolId :> ApiRes Patch PoolId
 
 type EnlistPoolAPI = "api" :> APIVersion :> "enlist" :> ReqBody '[JSON] PoolId :> ApiRes Patch PoolId
+
+type AddTickerAPI = "api" :> APIVersion :> "tickers" :> Capture "name" TickerName :> ReqBody '[JSON] PoolMetadataHash :> ApiRes Post TickerName
+
+-- Enabling the SMASH server to fetch the policies from remote SMASH server. Policies like delisting or unique ticker names.
+type FetchPoliciesAPI = "api" :> APIVersion :> "policies" :> ReqBody '[JSON] SmashURL :> ApiRes Post PolicyResult
 #else
 type DelistPoolAPI = BasicAuthURL :> "api" :> APIVersion :> "delist" :> ReqBody '[JSON] PoolId :> ApiRes Patch PoolId
 
 type EnlistPoolAPI = BasicAuthURL :> "api" :> APIVersion :> "enlist" :> ReqBody '[JSON] PoolId :> ApiRes Patch PoolId
+
+type AddTickerAPI = "api" :> APIVersion :> "tickers" :> Capture "name" TickerName :> ReqBody '[JSON] PoolMetadataHash :> ApiRes Post TickerName
+
+-- Enabling the SMASH server to fetch the policies from remote SMASH server. Policies like delisting or unique ticker names.
+type FetchPoliciesAPI = BasicAuthURL :> "api" :> APIVersion :> "policies" :> ReqBody '[JSON] SmashURL :> ApiRes Post PolicyResult
 #endif
 
 type RetiredPoolsAPI = "api" :> APIVersion :> "retired" :> ApiRes Get [PoolId]
@@ -110,20 +126,21 @@ type CheckPoolAPI = "api" :> APIVersion :> "exists" :> Capture "poolId" PoolId :
 -- The full API.
 type SmashAPI =  OfflineMetadataAPI
             :<|> HealthStatusAPI
+            :<|> ReservedTickersAPI
             :<|> DelistedPoolsAPI
             :<|> DelistPoolAPI
             :<|> EnlistPoolAPI
             :<|> FetchPoolErrorAPI
             :<|> RetiredPoolsAPI
             :<|> CheckPoolAPI
+            :<|> AddTickerAPI
+            :<|> FetchPoliciesAPI
 #ifdef TESTING_MODE
             :<|> RetirePoolAPI
             :<|> AddPoolAPI
-            :<|> AddTickerAPI
 
 type RetirePoolAPI = "api" :> APIVersion :> "retired" :> ReqBody '[JSON] PoolIdBlockNumber :> ApiRes Patch PoolId
 type AddPoolAPI = "api" :> APIVersion :> "metadata" :> Capture "id" PoolId :> Capture "hash" PoolMetadataHash :> ReqBody '[OctetStream] PoolMetadataRaw :> ApiRes Post PoolId
-type AddTickerAPI = "api" :> APIVersion :> "tickers" :> Capture "name" TickerName :> ReqBody '[JSON] PoolMetadataHash :> ApiRes Post TickerName
 
 #endif
 

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

@@ -18,6 +18,8 @@ module Cardano.SMASH.Types
     , bytestringToPoolMetaHash
     , PoolMetadataRaw (..)
     , TickerName (..)
+    , UniqueTicker (..)
+    , PolicyResult (..)
     -- * Wrapper
     , PoolName (..)
     , PoolDescription (..)
@@ -33,6 +35,7 @@ module Cardano.SMASH.Types
     -- * API
     , ApiResult (..)
     -- * HTTP
+    , SmashURL (..)
     , FetchError (..)
     , PoolFetchError (..)
     , TimeStringFormat (..)
@@ -60,6 +63,7 @@ import           Data.Swagger                  (NamedSchema (..),
                                                 ToSchema (..))
 import           Data.Text.Encoding            (encodeUtf8Builder)
 
+import           Network.URI                   (URI, parseURI)
 import           Servant                       (FromHttpApiData (..),
                                                 MimeUnrender (..), OctetStream)
 
@@ -69,6 +73,30 @@ import           Cardano.SMASH.DBSync.Db.Types
 import qualified Data.ByteString.Lazy          as BL
 import qualified Data.Text.Encoding            as E
 
+-- | The Smash @URI@ containing remote filtering data.
+newtype SmashURL = SmashURL { getSmashURL :: URI }
+    deriving (Eq, Show, Generic)
+
+instance ToJSON SmashURL where
+    toJSON (SmashURL uri) =
+        object
+            [ "smashURL" .= (show uri :: Text)
+            ]
+
+instance FromJSON SmashURL where
+    parseJSON = withObject "SmashURL" $ \o -> do
+        uri <- o .: "smashURL"
+
+        let parsedURI = parseURI uri
+
+        case parsedURI of
+            Nothing -> fail "Not a valid URI for SMASH server."
+            Just uri' -> return $ SmashURL uri'
+
+instance ToSchema SmashURL where
+  declareNamedSchema _ =
+    return $ NamedSchema (Just "SmashURL") $ mempty
+
 -- | The basic @Configuration@.
 data Configuration = Configuration
     { cPortNumber :: !Int
@@ -89,6 +117,43 @@ examplePoolOfflineMetadata =
         (PoolTicker "testp")
         (PoolHomepage "https://iohk.io")
 
+data PolicyResult = PolicyResult
+    { prSmashURL :: !SmashURL
+    , prHealthStatus :: !HealthStatus
+    , prDelistedPools :: ![PoolId]
+    , prUniqueTickers :: ![UniqueTicker]
+    } deriving (Eq, Show, Generic)
+
+instance ToJSON PolicyResult where
+    toJSON (PolicyResult smashURL healthStatus delistedPools uniqueTickers) =
+        object
+            [ "smashURL" .= toJSON smashURL
+            , "healthStatus" .= toJSON healthStatus
+            , "delistedPools" .= toJSON delistedPools
+            , "uniqueTickers" .= toJSON uniqueTickers
+            ]
+
+instance ToSchema PolicyResult
+
+newtype UniqueTicker = UniqueTicker { getUniqueTicker :: (TickerName, PoolMetadataHash) }
+    deriving (Eq, Show, Generic)
+
+instance ToJSON UniqueTicker where
+    toJSON (UniqueTicker (tickerName, poolMetadataHash)) =
+        object
+            [ "tickerName" .= getTickerName tickerName
+            , "poolMetadataHash" .= getPoolMetadataHash poolMetadataHash
+            ]
+
+instance FromJSON UniqueTicker where
+    parseJSON = withObject "UniqueTicker" $ \o -> do
+        tickerName <- o .: "tickerName"
+        poolMetadataHash <- o .: "poolMetadataHash"
+
+        return . UniqueTicker $ (tickerName, poolMetadataHash)
+
+instance ToSchema UniqueTicker
+
 instance ToParamSchema TickerName
 
 instance ToSchema TickerName

smash/smash.cabal

@@ -75,6 +75,8 @@ library
     , http-client
     , http-client-tls
     , http-types
+    , http-conduit
+    , unordered-containers
     , io-sim-classes
     , iohk-monitoring
     , monad-logger

smash/src/Cardano/SMASH/DB.hs

@@ -107,6 +107,8 @@ data DataLayer = DataLayer
     , dlGetPool                 :: PoolId -> IO (Either DBFail PoolId)
     , dlAddPool                 :: PoolId -> IO (Either DBFail PoolId)
 
+    --, dlAddRemoteSmashPolicy    :: SmashURI -> IO (Either DBFail SmashURI)
+
     , dlAddGenesisMetaBlock     :: X.Meta -> X.Block -> IO (Either DBFail (MetaId, BlockId))
 
     , dlGetSlotHash             :: SlotNo -> IO (Maybe (SlotNo, ByteString))