From 5009f6ee98c721ecb7da4e13db6a096147eef878 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Mon, 26 Oct 2020 12:39:52 +0100 Subject: [PATCH] Improve stub server --- app/Main.hs | 23 ++++++++++++++++++++++- doc/getting-started/how-to-run-smash.md | 17 +++++++++++++++++ smash.cabal | 3 +++ src/Cardano/SMASH/API.hs | 2 ++ src/Cardano/SMASH/DB.hs | 14 ++++++++------ src/Cardano/SMASH/Lib.hs | 23 ++++++++++++----------- src/Cardano/SMASH/Types.hs | 10 ++++++++-- 7 files changed, 72 insertions(+), 20 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index aa41cd8..3c5d8d3 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + module Main where import Cardano.Prelude @@ -42,6 +44,9 @@ data Command = CreateMigration SmashMigrationDir | RunMigrations SmashMigrationDir (Maybe SmashLogFileDir) | RunApplication +#ifdef TESTING_MODE + | RunStubApplication +#endif | RunApplicationWithDbSync SmashDbSyncNodeParams | InsertPool FilePath PoolId PoolMetadataHash | ReserveTickerName Text PoolMetadataHash @@ -52,13 +57,17 @@ runCommand cmd = CreateMigration mdir -> doCreateMigration mdir RunMigrations mdir mldir -> runMigrations (\pgConfig -> pgConfig) False mdir mldir RunApplication -> runApp defaultConfiguration +#ifdef TESTING_MODE + RunStubApplication -> runAppStubbed defaultConfiguration +#endif RunApplicationWithDbSync dbSyncNodeParams -> race_ (runDbSyncNode poolMetadataDbSyncNodePlugin dbSyncNodeParams) (runApp defaultConfiguration) InsertPool poolMetadataJsonPath poolId poolHash -> do putTextLn "Inserting pool metadata!" - result <- runPoolInsertion poolMetadataJsonPath poolId poolHash + poolMetadataJson <- readFile poolMetadataJsonPath + result <- runPoolInsertion postgresqlDataLayer poolMetadataJson poolId poolHash either (\err -> putTextLn $ "Error occured. " <> renderLookupFail err) (\_ -> putTextLn "Insertion completed!") @@ -146,6 +155,12 @@ pCommand = ( Opt.info pRunApp $ Opt.progDesc "Run the application that just serves the pool info." ) +#ifdef TESTING_MODE + <> Opt.command "run-stub-app" + ( Opt.info pRunStubApp + $ Opt.progDesc "Run the stub application that just serves the pool info." + ) +#endif <> Opt.command "run-app-with-db-sync" ( Opt.info pRunAppWithDbSync $ Opt.progDesc "Run the application that syncs up the pool info and serves it." @@ -173,6 +188,12 @@ pCommand = pRunApp = pure RunApplication +#ifdef TESTING_MODE + pRunStubApp :: Parser Command + pRunStubApp = + pure RunStubApplication +#endif + -- Empty right now but we might add some params over time. Like ports and stuff? pRunAppWithDbSync :: Parser Command pRunAppWithDbSync = diff --git a/doc/getting-started/how-to-run-smash.md b/doc/getting-started/how-to-run-smash.md index e3396f2..9e6291d 100644 --- a/doc/getting-started/how-to-run-smash.md +++ b/doc/getting-started/how-to-run-smash.md @@ -121,3 +121,20 @@ Or if you have Basic Auth enabled (replace with you username/pass you have in yo curl -u ksaric:cirask -X PATCH -v http://localhost:3100/api/v1/delist -H 'content-type: application/json' -d '{"poolId": "062693863e0bcf9f619238f020741381d4d3748aae6faf1c012e80e7"}' ``` +## Running stub server for local testing purposes + +Make sure to build SMASH in testing mode: + +``` +stack install --flag 'smash:testing-mode' --flag 'smash:disable-basic-auth' + +smash-exe run-stub-app + +curl -X POST -v \ + -H 'content-type: application/octet-stream' \ + --data-binary @test_pool.json \ + http://localhost:3100/api/v1/metadata/5ee7591bf30eaa4f5dce70b4a676eb02d5be8012d188f04fe3beffb0/cc019105f084aef2a956b2f7f2c0bf4e747bf7696705312c244620089429df6f + +curl -X GET -v \ + http://localhost:3100/api/v1/metadata/5ee7591bf30eaa4f5dce70b4a676eb02d5be8012d188f04fe3beffb0/cc019105f084aef2a956b2f7f2c0bf4e747bf7696705312c244620089429df6f +``` diff --git a/smash.cabal b/smash.cabal index ae77844..2bd8c30 100644 --- a/smash.cabal +++ b/smash.cabal @@ -153,6 +153,9 @@ executable smash-exe -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -Wpartial-fields + if flag(testing-mode) + cpp-options: -DTESTING_MODE + test-suite smash-test type: exitcode-stdio-1.0 main-is: Spec.hs diff --git a/src/Cardano/SMASH/API.hs b/src/Cardano/SMASH/API.hs index 0564ea8..b9bbaff 100644 --- a/src/Cardano/SMASH/API.hs +++ b/src/Cardano/SMASH/API.hs @@ -73,8 +73,10 @@ type SmashAPI = OfflineMetadataAPI :<|> RetiredPoolsAPI #ifdef TESTING_MODE :<|> RetirePoolAPI + :<|> AddPoolAPI type RetirePoolAPI = "api" :> APIVersion :> "retired" :> ReqBody '[JSON] PoolId :> ApiRes Patch PoolId +type AddPoolAPI = "api" :> APIVersion :> "metadata" :> Capture "id" PoolId :> Capture "hash" PoolMetadataHash :> ReqBody '[OctetStream] PoolMetadataWrapped :> ApiRes Post PoolId #endif -- | API for serving @swagger.json@. diff --git a/src/Cardano/SMASH/DB.hs b/src/Cardano/SMASH/DB.hs index a7f7c16..f5c12fd 100644 --- a/src/Cardano/SMASH/DB.hs +++ b/src/Cardano/SMASH/DB.hs @@ -88,24 +88,26 @@ data DataLayer = DataLayer -- We do need state here. _This is thread safe._ -- __This is really our model here.__ stubbedDataLayer - :: IORef (Map (PoolId, PoolMetadataHash) Text) + :: IORef (Map (PoolId, PoolMetadataHash) (Text, Text)) -> IORef [PoolId] -> DataLayer stubbedDataLayer ioDataMap ioDelistedPool = DataLayer { dlGetPoolMetadata = \poolId poolmdHash -> do ioDataMap' <- readIORef ioDataMap case (Map.lookup (poolId, poolmdHash) ioDataMap') of - Just poolOfflineMetadata' -> return . Right $ ("Test", poolOfflineMetadata') + Just (poolTicker', poolOfflineMetadata') + -> return . Right $ (poolTicker', poolOfflineMetadata') Nothing -> return $ Left (DbLookupPoolMetadataHash poolId poolmdHash) , dlAddPoolMetadata = \ _ poolId poolmdHash poolMetadata poolTicker -> do -- TODO(KS): What if the pool metadata already exists? - _ <- modifyIORef ioDataMap (Map.insert (poolId, poolmdHash) poolMetadata) + _ <- modifyIORef ioDataMap (Map.insert (poolId, poolmdHash) + (getPoolTicker poolTicker, poolMetadata)) return . Right $ poolMetadata , dlAddMetaDataReference = \poolId poolUrl poolMetadataHash -> panic "!" , dlAddReservedTicker = \tickerName poolMetadataHash -> panic "!" - , dlCheckReservedTicker = \tickerName -> panic "!" + , dlCheckReservedTicker = \tickerName -> pure Nothing , dlGetDelistedPools = readIORef ioDelistedPool , dlCheckDelistedPool = \poolId -> do @@ -128,9 +130,9 @@ stubbedDataLayer ioDataMap ioDelistedPool = DataLayer } -- The approximation for the table. -stubbedInitialDataMap :: Map (PoolId, PoolMetadataHash) Text +stubbedInitialDataMap :: Map (PoolId, PoolMetadataHash) (Text, Text) stubbedInitialDataMap = Map.fromList - [ ((PoolId "AAAAC3NzaC1lZDI1NTE5AAAAIKFx4CnxqX9mCaUeqp/4EI1+Ly9SfL23/Uxd0Ieegspc", PoolMetadataHash "HASH"), show examplePoolOfflineMetadata) + [ ((PoolId "AAAAC3NzaC1lZDI1NTE5AAAAIKFx4CnxqX9mCaUeqp/4EI1+Ly9SfL23/Uxd0Ieegspc", PoolMetadataHash "HASH"), ("Test", show examplePoolOfflineMetadata)) ] -- The approximation for the table. diff --git a/src/Cardano/SMASH/Lib.hs b/src/Cardano/SMASH/Lib.hs index 67641d9..7cdc0d7 100644 --- a/src/Cardano/SMASH/Lib.hs +++ b/src/Cardano/SMASH/Lib.hs @@ -139,17 +139,10 @@ mkApp configuration = do convertToAppUsers (AdminUser username' password') = ApplicationUser username' password' --runPoolInsertion poolMetadataJsonPath poolHash -runPoolInsertion :: FilePath -> PoolId -> PoolMetadataHash -> IO (Either DBFail Text) -runPoolInsertion poolMetadataJsonPath poolId poolHash = do - putTextLn $ "Inserting pool! " <> (toS poolMetadataJsonPath) <> " " <> (show poolId) +runPoolInsertion :: DataLayer -> Text -> PoolId -> PoolMetadataHash -> IO (Either DBFail Text) +runPoolInsertion dataLayer poolMetadataJson poolId poolHash = do + putTextLn $ "Inserting pool! " <> (show poolId) - let dataLayer :: DataLayer - dataLayer = postgresqlDataLayer - - --PoolHash -> ByteString -> IO (Either DBFail PoolHash) - poolMetadataJson <- readFile poolMetadataJsonPath - - -- Let us try to decode the contents to JSON. decodedMetadata <- case (eitherDecode' $ BL.fromStrict (encodeUtf8 poolMetadataJson)) of Left err -> panic $ toS err Right result -> return result @@ -198,7 +191,7 @@ convertIOToHandler = Handler . ExceptT . try -- | Combined server of a Smash service with Swagger documentation. server :: Configuration -> DataLayer -> Server API -server _configuration dataLayer +server configuration dataLayer = return todoSwagger :<|> getPoolOfflineMetadata dataLayer :<|> getHealthStatus @@ -209,6 +202,7 @@ server _configuration dataLayer :<|> getRetiredPools dataLayer #ifdef TESTING_MODE :<|> retirePool dataLayer + :<|> addPool dataLayer #endif @@ -344,5 +338,12 @@ retirePool dataLayer poolId = convertIOToHandler $ do retiredPoolId <- addRetiredPool poolId return . ApiResult $ retiredPoolId + +addPool :: DataLayer -> PoolId -> PoolMetadataHash -> PoolMetadataWrapped -> Handler (ApiResult DBFail PoolId) +addPool dataLayer poolId poolHash (PoolMetadataWrapped poolMetadataJson) = + fmap ApiResult + $ convertIOToHandler + $ (fmap . second) (const poolId) + $ runPoolInsertion dataLayer poolMetadataJson poolId poolHash #endif diff --git a/src/Cardano/SMASH/Types.hs b/src/Cardano/SMASH/Types.hs index f864019..dde4e3f 100644 --- a/src/Cardano/SMASH/Types.hs +++ b/src/Cardano/SMASH/Types.hs @@ -44,7 +44,7 @@ import Cardano.Prelude import Control.Monad.Fail (fail) import Data.Aeson (FromJSON (..), ToJSON (..), - object, withObject, (.:), (.=)) + object, pairs, withObject, (.:), (.=)) import qualified Data.Aeson as Aeson import Data.Aeson.Encoding (unsafeToEncoding) import qualified Data.Aeson.Types as Aeson @@ -58,11 +58,14 @@ import Data.Swagger (NamedSchema (..), ToSchema (..)) import Data.Text.Encoding (encodeUtf8Builder) -import Servant (FromHttpApiData (..)) +import Servant (FromHttpApiData (..), MimeUnrender (..), OctetStream) import Cardano.SMASH.DBSync.Db.Error import Cardano.SMASH.DBSync.Db.Types +import qualified Data.Text.Encoding as E +import qualified Data.ByteString.Lazy as BL + -- | The basic @Configuration@. data Configuration = Configuration { cPortNumber :: !Int @@ -259,6 +262,9 @@ instance ToSchema PoolOfflineMetadata newtype PoolMetadataWrapped = PoolMetadataWrapped Text deriving (Eq, Ord, Show, Generic) +instance MimeUnrender OctetStream PoolMetadataWrapped where + mimeUnrender _ = Right . PoolMetadataWrapped . E.decodeUtf8 . BL.toStrict + -- Here we are usingg the unsafe encoding since we already have the JSON format -- from the database. instance ToJSON PoolMetadataWrapped where