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
input-output-hk · Oct 23, 2020 · de57d39 · de57d39
1 parent 85b3a1e
commit de57d39
Show file tree

Hide file tree

Showing 6 changed files with 74 additions and 24 deletions.
diff --git a/app/Main.hs b/app/Main.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP                 #-}
+
 module Main where
 
 import           Cardano.Prelude
@@ -40,6 +42,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 +55,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!")
@@ -144,6 +153,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 +186,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
@@ -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
@@ -157,6 +157,9 @@ executable smash-exe
   default-extensions:  NoImplicitPrelude
                        OverloadedStrings
 
+  if flag(testing-mode)
+    cpp-options:       -DTESTING_MODE
+
   ghc-options:         -Wall
                        -Wcompat
                        -Wincomplete-record-updates

diff --git a/src/DB.hs b/src/DB.hs
@@ -85,24 +85,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
@@ -125,9 +127,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/Lib.hs b/src/Lib.hs
@@ -35,8 +35,8 @@ import           Servant                     (Application, BasicAuth,
                                               BasicAuthData (..),
                                               BasicAuthResult (..), Capture,
                                               Context (..), Get, Handler (..),
-                                              Header, Headers, JSON, Patch,
-                                              QueryParam, ReqBody, Server,
+                                              Header, Headers, JSON, Patch, Post,
+                                              QueryParam, ReqBody, Server, OctetStream,
                                               err403, err404, serveWithContext)
 import           Servant.API.ResponseHeaders (addHeader)
 import           Servant.Swagger
@@ -47,6 +47,7 @@ import           Types
 import           Paths_smash                 (version)
 
 
+
 -- |For api versioning.
 type APIVersion = "v1"
 
@@ -92,8 +93,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
 
 
@@ -186,24 +189,16 @@ 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
+runPoolInsertion :: DataLayer -> Text -> PoolId -> PoolMetadataHash -> IO (Either DBFail Text)
+runPoolInsertion dataLayer poolMetadataJson poolId poolHash = do
+    putTextLn $ "Inserting pool! " <> (show poolId)
 
-    --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)
+    dlAddPoolMetadata dataLayer Nothing poolId poolHash poolMetadataJson
+      (pomTicker decodedMetadata)
 
 runTickerNameInsertion :: Text -> PoolMetadataHash -> IO (Either DBFail ReservedTickerId)
 runTickerNameInsertion tickerName poolMetadataHash = do
@@ -256,6 +251,7 @@ server configuration dataLayer
     :<|>    getRetiredPools dataLayer
 #ifdef TESTING_MODE
     :<|>    retirePool dataLayer
+    :<|>    addPool dataLayer
 #endif
 
 
@@ -391,6 +387,11 @@ 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
 
 -- For now, we just ignore the @BasicAuth@ definition.

diff --git a/src/Types.hs b/src/Types.hs
@@ -44,7 +44,7 @@ import           Cardano.Prelude
 import           Control.Monad.Fail    (fail)
 
 import           Data.Aeson            (FromJSON (..), ToJSON (..), object,
-                                        withObject, (.:), (.=))
+                                        withObject, (.:), (.=), pairs)
 import qualified Data.Aeson            as Aeson
 import           Data.Aeson.Encoding   (unsafeToEncoding)
 import qualified Data.Aeson.Types      as Aeson
@@ -57,11 +57,14 @@ import           Data.Swagger          (NamedSchema (..), ToParamSchema (..),
                                         ToSchema (..))
 import           Data.Text.Encoding    (encodeUtf8Builder)
 
-import           Servant               (FromHttpApiData (..))
+import           Servant               (FromHttpApiData (..), MimeUnrender (..), OctetStream)
 
 import           Cardano.Db.Error
 import           Cardano.Db.Types
 
+import qualified Data.Text.Encoding as E
+import qualified Data.ByteString.Lazy        as BL
+
 -- | The basic @Configuration@.
 data Configuration = Configuration
     { cPortNumber :: !Int
@@ -258,6 +261,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