Merge #102

102: Improve stub server r=ksaric a=hasufell 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 Related: #97 Co-authored-by: Julian Ospald <[email protected]>
input-output-hk · Oct 26, 2020 · 9aee92e · 9aee92e
2 parents e5fa1cf + 5009f6e
commit 9aee92e
Show file tree

Hide file tree

Showing 7 changed files with 72 additions and 20 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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