diff --git a/smash-servant-types/smash-servant-types.cabal b/smash-servant-types/smash-servant-types.cabal index ad1ad3d..564bcae 100644 --- a/smash-servant-types/smash-servant-types.cabal +++ b/smash-servant-types/smash-servant-types.cabal @@ -46,6 +46,7 @@ library , cardano-api , base16-bytestring , persistent + , network-uri , servant , servant-server , servant-swagger diff --git a/smash-servant-types/src/Cardano/SMASH/API.hs b/smash-servant-types/src/Cardano/SMASH/API.hs index 867c7ea..d015ae0 100644 --- a/smash-servant-types/src/Cardano/SMASH/API.hs +++ b/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 diff --git a/smash-servant-types/src/Cardano/SMASH/Types.hs b/smash-servant-types/src/Cardano/SMASH/Types.hs index 7246ea6..586c16e 100644 --- a/smash-servant-types/src/Cardano/SMASH/Types.hs +++ b/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 diff --git a/smash/smash.cabal b/smash/smash.cabal index 7eb492c..0307894 100644 --- a/smash/smash.cabal +++ b/smash/smash.cabal @@ -49,6 +49,7 @@ library Cardano.SMASH.FetchQueue Cardano.SMASH.Lib Cardano.SMASH.Offline + Cardano.SMASH.HttpClient other-modules: Paths_smash hs-source-dirs: src @@ -75,6 +76,7 @@ library , http-client , http-client-tls , http-types + , http-conduit , io-sim-classes , iohk-monitoring , monad-logger @@ -94,6 +96,7 @@ library , smash-servant-types , swagger2 , template-haskell + , safe-exceptions , text , time , transformers diff --git a/smash/src/Cardano/SMASH/DB.hs b/smash/src/Cardano/SMASH/DB.hs index 96faa4a..c0f0db8 100644 --- a/smash/src/Cardano/SMASH/DB.hs +++ b/smash/src/Cardano/SMASH/DB.hs @@ -198,7 +198,9 @@ cachedDataLayer dbDataLayer (InMemoryCacheIORef inMemoryCacheIORef) = , dlAddMetaDataReference = dlAddMetaDataReference dbDataLayer -- TODO(KS): Cache hit? - , dlGetReservedTickers = dlGetReservedTickers dbDataLayer + , dlGetReservedTickers = do + inMemoryCache <- readIORef inMemoryCacheIORef + return $ imcReservedTickers inMemoryCache , dlAddReservedTicker = \tickerName poolMetadataHash' -> runExceptT $ do -- Modify database let addReservedTicker = dlAddReservedTicker dbDataLayer diff --git a/smash/src/Cardano/SMASH/HttpClient.hs b/smash/src/Cardano/SMASH/HttpClient.hs new file mode 100644 index 0000000..f912efb --- /dev/null +++ b/smash/src/Cardano/SMASH/HttpClient.hs @@ -0,0 +1,113 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Cardano.SMASH.HttpClient + ( httpClientFetchPolicies + , httpApiCall + , renderHttpClientError + ) where + +import Cardano.Prelude + +import Control.Monad.Trans.Except.Extra + +import Cardano.SMASH.DBSync.Db.Types (PoolId) + +import Cardano.SMASH.Types (HealthStatus, + PolicyResult (..), + SmashURL (..)) +import Data.Aeson (FromJSON, parseJSON) +import Data.Aeson.Types (parseEither) + +import Network.HTTP.Simple (Request, getResponseBody, + getResponseStatusCode, + httpJSONEither, + parseRequestThrow) + +-- |The possible errors for the http client. +data HttpClientError + = HttpClientCannotParseEndpoint !Text + | HttpClientInvalidClientBody + | HttpClientCannotParseJSON !Text + | HttpClientStatusNotOk + +-- |Render the http client error. +renderHttpClientError :: HttpClientError -> Text +renderHttpClientError = \case + HttpClientCannotParseEndpoint endpoint -> + mconcat + [ "Http client cannot parse the '" + , endpoint + , "' endpoint" + ] + HttpClientInvalidClientBody -> + "Http client invalid response body." + HttpClientCannotParseJSON reason -> + mconcat + [ "Http client cannot parse the response JSON - '" + , reason + , "'." + ] + HttpClientStatusNotOk -> + "Http client returned status not ok. Status should be 200." + +-- |Fetch the remote SMASH server policies. +httpClientFetchPolicies :: SmashURL -> IO (Either HttpClientError PolicyResult) +httpClientFetchPolicies smashURL = runExceptT $ do + + -- https://smash.cardano-mainnet.iohk.io + let baseSmashURL = show $ getSmashURL smashURL + + -- TODO(KS): This would be nice. + --let delistedEndpoint = symbolVal (Proxy :: Proxy DelistedPoolsAPI) + --let smashDelistedEndpoint = baseSmashURL <> delistedEndpoint + + let statusEndpoint = baseSmashURL <> "/api/v1/status" + let delistedEndpoint = baseSmashURL <> "/api/v1/delisted" + let reservedTickersEndpoint = baseSmashURL <> "/api/v1/tickers" + + statusRequest <- parseRequestEither statusEndpoint + delistedRequest <- parseRequestEither delistedEndpoint + _reservedTickersRequest <- parseRequestEither reservedTickersEndpoint + + healthStatus :: HealthStatus <- httpApiCall statusRequest + delistedPools :: [PoolId] <- httpApiCall delistedRequest + + -- TODO(KS): Current version doesn't have exposed the tickers endpoint and would fail! + -- uniqueTickers :: [UniqueTicker] <- httpApiCall reservedTickersRequest + uniqueTickers <- pure [] + + let policyResult = + PolicyResult + { prSmashURL = smashURL + , prHealthStatus = healthStatus + , prDelistedPools = delistedPools + , prUniqueTickers = uniqueTickers + } + + return policyResult + +-- |A simple HTTP call for remote server. +httpApiCall :: forall a. (FromJSON a) => Request -> ExceptT HttpClientError IO a +httpApiCall request = do + + httpResult <- httpJSONEither request + let httpResponseBody = getResponseBody httpResult + + httpResponse <- firstExceptT (\_ -> HttpClientInvalidClientBody) $ hoistEither httpResponseBody + + let httpStatusCode = getResponseStatusCode httpResult + + when (httpStatusCode /= 200) $ + left HttpClientStatusNotOk + + case parseEither parseJSON httpResponse of + Left reason -> left $ HttpClientCannotParseJSON (toS reason) + Right value -> right value + +-- |When any exception occurs, we simply map it to an http client error. +parseRequestEither :: Text -> ExceptT HttpClientError IO Request +parseRequestEither requestEndpoint = do + let parsedRequest = newExceptT (try $ parseRequestThrow (toS requestEndpoint) :: IO (Either SomeException Request)) + firstExceptT (\_ -> HttpClientCannotParseEndpoint requestEndpoint) parsedRequest + diff --git a/smash/src/Cardano/SMASH/Lib.hs b/smash/src/Cardano/SMASH/Lib.hs index 2379f91..af8edeb 100644 --- a/smash/src/Cardano/SMASH/Lib.hs +++ b/smash/src/Cardano/SMASH/Lib.hs @@ -4,6 +4,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} @@ -19,8 +20,7 @@ module Cardano.SMASH.Lib ) where #ifdef TESTING_MODE -import Cardano.SMASH.Types (PoolIdBlockNumber (..), - TickerName, pomTicker) +import Cardano.SMASH.Types (PoolIdBlockNumber (..), pomTicker) import Data.Aeson (eitherDecode') import qualified Data.ByteString.Lazy as BL #endif @@ -53,15 +53,20 @@ import Cardano.SMASH.API (API, fullAPI, smashApi) import Cardano.SMASH.DB (AdminUser (..), DBFail (..), DataLayer (..), createCachedDataLayer) +import Cardano.SMASH.HttpClient (httpClientFetchPolicies, + renderHttpClientError) import Cardano.SMASH.Types (ApiResult (..), ApplicationUser (..), ApplicationUsers (..), Configuration (..), - HealthStatus (..), PoolFetchError, + HealthStatus (..), + PolicyResult (..), PoolFetchError, PoolId (..), PoolMetadataHash, PoolMetadataRaw (..), - TimeStringFormat (..), User, + SmashURL (..), TickerName, + TimeStringFormat (..), + UniqueTicker (..), User, UserValidity (..), checkIfUserValid, defaultConfiguration, @@ -213,16 +218,18 @@ server _configuration dataLayer = return todoSwagger :<|> getPoolOfflineMetadata dataLayer :<|> getHealthStatus + :<|> getReservedTickers dataLayer :<|> getDelistedPools dataLayer :<|> delistPool dataLayer :<|> enlistPool dataLayer :<|> getPoolErrorAPI dataLayer :<|> getRetiredPools dataLayer :<|> checkPool dataLayer + :<|> addTicker dataLayer + :<|> fetchPolicies dataLayer #ifdef TESTING_MODE :<|> retirePool dataLayer :<|> addPool dataLayer - :<|> addTicker dataLayer #endif @@ -274,6 +281,17 @@ getHealthStatus = return . ApiResult . Right $ , hsVersion = toS $ showVersion version } +-- |Get all reserved tickers. +getReservedTickers :: DataLayer -> Handler (ApiResult DBFail [UniqueTicker]) +getReservedTickers dataLayer = convertIOToHandler $ do + + let getReservedTickers' = dlGetReservedTickers dataLayer + reservedTickers <- getReservedTickers' + + let uniqueTickers = map UniqueTicker reservedTickers + + return . ApiResult . Right $ uniqueTickers + -- |Get all delisted pools getDelistedPools :: DataLayer -> Handler (ApiResult DBFail [PoolId]) getDelistedPools dataLayer = convertIOToHandler $ do @@ -283,20 +301,17 @@ getDelistedPools dataLayer = convertIOToHandler $ do return . ApiResult . Right $ allDelistedPools - #ifdef DISABLE_BASIC_AUTH delistPool :: DataLayer -> PoolId -> Handler (ApiResult DBFail PoolId) -delistPool dataLayer poolId = convertIOToHandler $ do - - let addDelistedPool = dlAddDelistedPool dataLayer - delistedPoolE <- addDelistedPool poolId - - case delistedPoolE of - Left dbFail -> throwDBFailException dbFail - Right poolId' -> return . ApiResult . Right $ poolId' +delistPool dataLayer poolId = delistPool' dataLayer poolId #else delistPool :: DataLayer -> User -> PoolId -> Handler (ApiResult DBFail PoolId) -delistPool dataLayer _user poolId = convertIOToHandler $ do +delistPool dataLayer _user poolId = delistPool' dataLayer poolId +#endif + +-- |General delist pool. +delistPool' :: DataLayer -> PoolId -> Handler (ApiResult DBFail PoolId) +delistPool' dataLayer poolId = convertIOToHandler $ do let addDelistedPool = dlAddDelistedPool dataLayer delistedPoolE <- addDelistedPool poolId @@ -304,21 +319,18 @@ delistPool dataLayer _user poolId = convertIOToHandler $ do case delistedPoolE of Left dbFail -> throwDBFailException dbFail Right poolId' -> return . ApiResult . Right $ poolId' -#endif #ifdef DISABLE_BASIC_AUTH enlistPool :: DataLayer -> PoolId -> Handler (ApiResult DBFail PoolId) -enlistPool dataLayer poolId = convertIOToHandler $ do - - let removeDelistedPool = dlRemoveDelistedPool dataLayer - delistedPool' <- removeDelistedPool poolId - - case delistedPool' of - Left _err -> throwIO err404 - Right poolId' -> return . ApiResult . Right $ poolId +enlistPool dataLayer poolId = enlistPool' dataLayer poolId #else enlistPool :: DataLayer -> User -> PoolId -> Handler (ApiResult DBFail PoolId) -enlistPool dataLayer _user poolId = convertIOToHandler $ do +enlistPool dataLayer _user poolId = enlistPool' dataLayer poolId +#endif + +-- |General enlist pool function. +enlistPool' :: DataLayer -> PoolId -> Handler (ApiResult DBFail PoolId) +enlistPool' dataLayer poolId = convertIOToHandler $ do let removeDelistedPool = dlRemoveDelistedPool dataLayer delistedPool' <- removeDelistedPool poolId @@ -326,7 +338,6 @@ enlistPool dataLayer _user poolId = convertIOToHandler $ do case delistedPool' of Left _err -> throwIO err404 Right poolId' -> return . ApiResult . Right $ poolId' -#endif getPoolErrorAPI :: DataLayer -> PoolId -> Maybe TimeStringFormat -> Handler (ApiResult DBFail [PoolFetchError]) getPoolErrorAPI dataLayer poolId mTimeInt = convertIOToHandler $ do @@ -365,6 +376,50 @@ checkPool dataLayer poolId = convertIOToHandler $ do return . ApiResult $ existingPoolId +addTicker :: DataLayer -> TickerName -> PoolMetadataHash -> Handler (ApiResult DBFail TickerName) +addTicker dataLayer tickerName poolMetadataHash = convertIOToHandler $ do + + let addReservedTicker = dlAddReservedTicker dataLayer + reservedTickerE <- addReservedTicker tickerName poolMetadataHash + + case reservedTickerE of + Left dbFail -> throwDBFailException dbFail + Right _reservedTicker -> return . ApiResult . Right $ tickerName + +#ifdef DISABLE_BASIC_AUTH +fetchPolicies :: DataLayer -> SmashURL -> Handler (ApiResult DBFail PolicyResult) +fetchPolicies dataLayer smashURL = fetchPolicies' dataLayer smashURL +#else +fetchPolicies :: DataLayer -> User -> SmashURL -> Handler (ApiResult DBFail PolicyResult) +fetchPolicies dataLayer _user smashURL = fetchPolicies' dataLayer smashURL +#endif + +-- |General fetch policies function. +fetchPolicies' :: DataLayer -> SmashURL -> Handler (ApiResult DBFail PolicyResult) +fetchPolicies' dataLayer smashURL = convertIOToHandler $ do + + -- Fetch from the remote SMASH server. + policyResult <- httpClientFetchPolicies smashURL + + let delistedPools = + case policyResult of + Left httpClientErr -> panic $ renderHttpClientError httpClientErr + Right policyResult' -> prDelistedPools policyResult' + + -- Clear the database + let getDelistedPools' = dlGetDelistedPools dataLayer + existingDelistedPools <- getDelistedPools' + + let removeDelistedPool = dlRemoveDelistedPool dataLayer + _ <- mapM removeDelistedPool existingDelistedPools + + let addDelistedPool = dlAddDelistedPool dataLayer + _newDelistedPools <- mapM addDelistedPool delistedPools + + -- Horrible. + case policyResult of + Left httpClientErr -> return . ApiResult . Left . UnknownError $ renderHttpClientError httpClientErr + Right policyResult' -> return . ApiResult . Right $ policyResult' #ifdef TESTING_MODE retirePool :: DataLayer -> PoolIdBlockNumber -> Handler (ApiResult DBFail PoolId) @@ -384,16 +439,6 @@ addPool dataLayer poolId poolHash poolMetadataRaw = convertIOToHandler $ do Left dbFail -> throwDBFailException dbFail Right _poolMetadata -> return . ApiResult . Right $ poolId -addTicker :: DataLayer -> TickerName -> PoolMetadataHash -> Handler (ApiResult DBFail TickerName) -addTicker dataLayer tickerName poolMetadataHash = convertIOToHandler $ do - - let addReservedTicker = dlAddReservedTicker dataLayer - reservedTickerE <- addReservedTicker tickerName poolMetadataHash - - case reservedTickerE of - Left dbFail -> throwDBFailException dbFail - Right _reservedTicker -> return . ApiResult . Right $ tickerName - runPoolInsertion :: DataLayer -> PoolMetadataRaw -> PoolId -> PoolMetadataHash -> IO (Either DBFail PoolMetadataRaw) runPoolInsertion dataLayer poolMetadataRaw poolId poolHash = do