From c2c678d7535f2f770a2ed2d9247a5447194f2418 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Fri, 23 Oct 2020 15:06:42 +0200 Subject: [PATCH] Improve stub server 1. expose a cli option to start the stub server in test-mode 2. add an endpoint to insert pool metadata manually in test-mode --- app/Main.hs | 28 ++++++++++++++++++- doc/getting-started/how-to-run-smash.md | 12 ++++++++ smash.cabal | 2 ++ src/DB.hs | 3 +- src/Lib.hs | 37 ++++++++++++------------- 5 files changed, 60 insertions(+), 22 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 906d2aa..2dba096 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + module Main where import Cardano.Prelude @@ -19,6 +21,8 @@ import Data.Monoid ((<>)) import Options.Applicative (Parser, ParserInfo, ParserPrefs) import qualified Options.Applicative as Opt +import qualified Data.ByteString.Lazy as BL +import Data.Aeson (eitherDecode') main :: IO () @@ -40,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 @@ -50,13 +57,20 @@ 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 + decodedMetadata <- case (eitherDecode' $ BL.fromStrict (encodeUtf8 poolMetadataJson)) of + Left err -> panic $ toS err + Right result -> return result + result <- runPoolInsertion postgresqlDataLayer decodedMetadata poolId poolHash either (\err -> putTextLn $ "Error occured. " <> renderLookupFail err) (\_ -> putTextLn "Insertion completed!") @@ -144,6 +158,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." @@ -171,6 +191,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..033a079 100644 --- a/doc/getting-started/how-to-run-smash.md +++ b/doc/getting-started/how-to-run-smash.md @@ -121,3 +121,15 @@ 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' +smash-exe run-stub-app +curl -X POST -v -H 'content-type: application/json' -d @test_pool.json http://localhost:3100/api/ +v1/add/062693863e0bcf9f619238f020741381d4d3748aae6faf1c012e80e7/cbdfc4f21feb0a414b2b9471fa56b0ebd312825e63db776d68cc3fa0ca1f5a2f +curl -X GET -v http://localhost:3100/api/v1/metadata/062693863e0bcf9f619238f020741381d4d3748aae6f +af1c012e80e7/cbdfc4f21feb0a414b2b9471fa56b0ebd312825e63db776d68cc3fa0ca1f5a2f +``` diff --git a/smash.cabal b/smash.cabal index 0fddc0e..f8f798e 100644 --- a/smash.cabal +++ b/smash.cabal @@ -148,6 +148,8 @@ executable smash-exe ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.7 && <5 + , aeson + , bytestring , cardano-prelude , smash , cardano-db-sync diff --git a/src/DB.hs b/src/DB.hs index b141a99..4149966 100644 --- a/src/DB.hs +++ b/src/DB.hs @@ -52,6 +52,7 @@ import Cardano.Db.Schema as X (AdminUser (..), Block (..), RetiredPool (..), poolMetadataMetadata) import qualified Cardano.Db.Types as Types +import qualified Prelude as Prelude -- | This is the data layer for the DB. -- The resulting operation has to be @IO@, it can be made more granular, @@ -102,7 +103,7 @@ stubbedDataLayer ioDataMap ioDelistedPool = DataLayer , dlAddMetaDataReference = \poolId poolUrl poolMetadataHash -> panic "!" , dlAddReservedTicker = \tickerName poolMetadataHash -> panic "!" - , dlCheckReservedTicker = \tickerName -> panic "!" + , dlCheckReservedTicker = \tickerName -> pure Nothing , dlGetDelistedPools = readIORef ioDelistedPool , dlCheckDelistedPool = \poolId -> do diff --git a/src/Lib.hs b/src/Lib.hs index 8e470e5..7b23dc6 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -18,7 +18,7 @@ module Lib import Cardano.Prelude hiding (Handler) -import Data.Aeson (eitherDecode') +import Data.Aeson (eitherDecode', encode) import qualified Data.ByteString.Lazy as BL import Data.IORef (newIORef) import Data.Swagger (Info (..), Swagger (..)) @@ -35,7 +35,8 @@ import Servant (Application, BasicAuth, BasicAuthData (..), BasicAuthResult (..), Capture, Context (..), Get, Handler (..), - Header, Headers, JSON, Patch, + Header, Headers, JSON, Patch, Post, + NoContent(..), QueryParam, ReqBody, Server, err403, err404, serveWithContext) import Servant.API.ResponseHeaders (addHeader) @@ -46,6 +47,8 @@ import Types import Paths_smash (version) +import qualified Data.Text.Encoding as E + -- |For api versioning. type APIVersion = "v1" @@ -92,8 +95,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 :> "add" :> Capture "id" PoolId :> Capture "hash" PoolMetadataHash :> ReqBody '[JSON] PoolOfflineMetadata :> ApiRes Post PoolId #endif @@ -186,24 +191,11 @@ 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) - - 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 - - let addPoolMetadata = dlAddPoolMetadata dataLayer - - addPoolMetadata Nothing poolId poolHash poolMetadataJson (pomTicker decodedMetadata) +runPoolInsertion :: DataLayer -> PoolOfflineMetadata -> PoolId -> PoolMetadataHash -> IO (Either DBFail Text) +runPoolInsertion dataLayer poolMetadata poolId poolHash = do + putTextLn $ "Inserting pool! " <> (show poolId) + dlAddPoolMetadata dataLayer Nothing poolId poolHash (E.decodeUtf8 . BL.toStrict . encode $ poolMetadata) + (pomTicker poolMetadata) runTickerNameInsertion :: Text -> PoolMetadataHash -> IO (Either DBFail ReservedTickerId) runTickerNameInsertion tickerName poolMetadataHash = do @@ -256,6 +248,7 @@ server configuration dataLayer :<|> getRetiredPools dataLayer #ifdef TESTING_MODE :<|> retirePool dataLayer + :<|> addPool dataLayer #endif @@ -391,6 +384,10 @@ retirePool dataLayer poolId = convertIOToHandler $ do retiredPoolId <- addRetiredPool poolId return . ApiResult $ retiredPoolId + +addPool :: DataLayer -> PoolId -> PoolMetadataHash -> PoolOfflineMetadata -> Handler (ApiResult DBFail PoolId) +addPool dataLayer poolId poolHash poolMetadata = fmap ApiResult $ convertIOToHandler $ + (fmap . second) (const poolId) $ runPoolInsertion dataLayer poolMetadata poolId poolHash #endif -- For now, we just ignore the @BasicAuth@ definition.