Add mock server (#34)

* Extra library for tests
* Add wst-poc-mock-server executable

README.md

@@ -56,6 +56,7 @@ USDC, another fiat-stablecoin, currently has [264 blacklisted addresses](https:/
 
 # Contributing
 
-Run the tests with `cabal test all`.
+* Run the tests with `cabal test all`.
+* Run `cabal run wst-poc-mock-server`  to start a mock server that serves fake data
 
 Bug reports and contributions are welcome!

src/exe/wst-poc-mock-server/Main.hs

@@ -0,0 +1,6 @@
+module Main where
+
+import Wst.Test.MockServer (runMockServer)
+
+main :: IO ()
+main = runMockServer

src/lib/Wst/Cli.hs

@@ -1,17 +1,22 @@
+{-# LANGUAGE NamedFieldPuns    #-}
 {-# LANGUAGE OverloadedStrings #-}
 module Wst.Cli(runMain) where
 
-import Blammo.Logging.Simple (MonadLogger, logError, logInfo, runLoggerLoggingT)
+import Blammo.Logging.Simple (Message ((:#)), MonadLogger, logError, logInfo,
+                              runLoggerLoggingT, (.=))
 import Control.Monad.IO.Class (MonadIO (..))
 import Convex.Wallet.Operator (OperatorConfigSigning)
 import Convex.Wallet.Operator qualified as Operator
+import Data.Functor.Identity (Identity)
+import Data.Proxy (Proxy)
 import Data.String (IsString (..))
 import Options.Applicative (customExecParser, disambiguate, helper, idm, info,
                             prefs, showHelpOnEmpty, showHelpOnError)
 import Wst.App (runWstApp)
 import Wst.Cli.Command (Command (..), ManageCommand (StartServer, Status),
                         parseCommand)
 import Wst.Offchain.Env qualified as Env
+import Wst.Server (ServerArgs (..))
 import Wst.Server qualified as Server
 
 runMain :: IO ()
@@ -32,21 +37,23 @@ runCommand com = do
         Status -> do
           -- TODO: status check (call the query endpoints and print out a summary of the results)
           logInfo "Manage"
-        StartServer -> do
-          logInfo "starting server"
-          liftIO (Server.runServer env')
-
+        StartServer options -> startServer env' options
   case result of
     Left err -> runLoggerLoggingT env $ logError (fromString $ show err)
     Right a -> pure a
 
 deploy :: (MonadLogger m, MonadIO m) => OperatorConfigSigning -> m ()
 deploy config = do
-  logInfo "Loading operator files"
+  logInfo $ "Loading operator files" :# ["key_file" .= Operator.ocSigningKeyFile config]
   _operator <- liftIO (Operator.loadOperatorFiles config)
   -- TODO:
   -- Use blockfrost backend to run Wst.Offchain.Endpoints.Deployment with the operator's funds
   -- Then use operator key to sign
   -- Then submit transaction to blockfrost
   -- Convex.Blockfrost.runBLockfrostT for the monadblockchain / monadutxoquery effects
   pure ()
+
+startServer :: (MonadIO m, MonadLogger m) => Env.CombinedEnv Proxy Identity Proxy Identity w -> Server.ServerArgs -> m ()
+startServer env' serverArgs@ServerArgs{saPort} = do
+  logInfo $ "starting server" :# ["port" .= saPort]
+  liftIO (Server.runServer env' serverArgs)

src/lib/Wst/Cli/Command.hs

@@ -11,10 +11,12 @@ import Control.Monad (when)
 import Convex.Wallet.Operator (OperatorConfigSigning,
                                parseOperatorConfigSigning)
 import Data.String (IsString (..))
-import Options.Applicative (CommandFields, Mod, Parser, ReadM, argument,
-                            command, eitherReader, fullDesc, help, info,
-                            metavar, progDesc, subparser)
+import Options.Applicative (CommandFields, Mod, Parser, ReadM, argument, auto,
+                            command, eitherReader, fullDesc, help, info, long,
+                            metavar, option, optional, progDesc, short,
+                            subparser, value)
 import Text.Read (readMaybe)
+import Wst.Server (ServerArgs (..))
 
 parseCommand :: Parser Command
 parseCommand =
@@ -32,7 +34,7 @@ data Command =
 -- | Commands that require a deployed system
 data ManageCommand =
   Status
-  | StartServer
+  | StartServer ServerArgs
   deriving stock Show
 
 parseDeploy :: Mod CommandFields Command
@@ -46,13 +48,24 @@ parseManage =
     info (Manage <$> parseTxIn <*> parseManageCommand) (fullDesc <> progDesc "Manage a deployed system")
 
 parseManageCommand :: Parser ManageCommand
-parseManageCommand = subparser $ mconcat [parseStatus]
+parseManageCommand = subparser $ mconcat [parseStatus, parseStartServer]
 
 parseStatus :: Mod CommandFields ManageCommand
 parseStatus =
   command "status" $
     info (pure Status) (fullDesc <> progDesc "Show the status of the programmable tokens")
 
+parseStartServer :: Mod CommandFields ManageCommand
+parseStartServer =
+  command "start" $
+    info (StartServer <$> parseServerArgs) (fullDesc <> progDesc "Start the HTTP server")
+
+parseServerArgs :: Parser ServerArgs
+parseServerArgs =
+  ServerArgs
+    <$> option auto (help "The port" <> value 8080 <> long "port" <> short 'p')
+    <*> optional (option auto (help "Folder to serve static files from" <> long "static-files"))
+
 parseTxIn :: Parser TxIn
 parseTxIn =
   argument

src/lib/Wst/Server.hs

@@ -3,7 +3,11 @@
 
 {-| servant server for stablecoin POC
 -}
-module Wst.Server(runServer) where
+module Wst.Server(
+  runServer,
+  ServerArgs(..),
+  defaultServerArgs
+  ) where
 
 import Cardano.Api.Shelley qualified as C
 import Control.Lens qualified as L
@@ -33,10 +37,24 @@ import Wst.Server.Types (APIInEra, AddToBlacklistArgs (..), BuildTxAPI,
                          TextEnvelopeJSON (..),
                          TransferProgrammableTokenArgs (..))
 
-runServer :: (Env.HasRuntimeEnv env, Env.HasDirectoryEnv env) => env -> IO ()
-runServer env = do
-  let app = serve (Proxy @APIInEra) (server env)
-      port = 8081
+data ServerArgs =
+  ServerArgs
+    { saPort :: !Int
+    , saStaticFiles :: Maybe FilePath
+    }
+    deriving stock (Eq, Show)
+
+defaultServerArgs :: ServerArgs
+defaultServerArgs =
+  ServerArgs
+    { saPort = 8080
+    , saStaticFiles = Nothing
+    }
+
+runServer :: (Env.HasRuntimeEnv env, Env.HasDirectoryEnv env) => env -> ServerArgs -> IO ()
+runServer env ServerArgs{saPort} = do
+  let app  = serve (Proxy @APIInEra) (server env)
+      port = saPort
   Warp.run port app
 
 server :: forall env. (Env.HasRuntimeEnv env, Env.HasDirectoryEnv env) => env -> Server APIInEra

src/test/lib/Wst/Test/Gen.hs

@@ -0,0 +1,40 @@
+{-| Generators for testing the POC
+-}
+module Wst.Test.Gen(
+  genGlobalParams,
+  genUTxODat,
+
+  -- * Plutus types
+  -- TODO: move to sc-tools?
+  genCurrencySymbol,
+  genCredential
+) where
+
+import Cardano.Api qualified as C
+import Convex.PlutusLedger.V1 qualified as PL
+import PlutusLedgerApi.V1.Credential (Credential)
+import PlutusLedgerApi.V1.Value (CurrencySymbol)
+import SmartTokens.Types.ProtocolParams (ProgrammableLogicGlobalParams (..))
+import Test.Gen.Cardano.Api.Typed qualified as Gen
+import Test.QuickCheck.Gen (Gen)
+import Test.QuickCheck.Hedgehog (hedgehog)
+import Wst.Offchain.Query (UTxODat (..))
+
+genGlobalParams :: Gen ProgrammableLogicGlobalParams
+genGlobalParams =
+  ProgrammableLogicGlobalParams
+    <$> genCurrencySymbol
+    <*> genCredential
+
+genCurrencySymbol :: Gen CurrencySymbol
+genCurrencySymbol = PL.transPolicyId <$> hedgehog Gen.genPolicyId
+
+genCredential :: Gen Credential
+genCredential = PL.transCredential <$> hedgehog Gen.genPaymentCredential
+
+genUTxODat :: C.IsShelleyBasedEra era => Gen a -> Gen (UTxODat era a)
+genUTxODat a =
+  UTxODat
+    <$> hedgehog Gen.genTxIn
+    <*> hedgehog (Gen.genTxOutUTxOContext C.shelleyBasedEra)
+    <*> a

src/test/lib/Wst/Test/MockServer.hs

@@ -0,0 +1,51 @@
+{-| Mock implementation of server API for testing / UI development
+-}
+module Wst.Test.MockServer(
+  mockServer,
+  runMockServer
+) where
+
+import Cardano.Api qualified as C
+import Control.Monad.IO.Class (MonadIO (..))
+import Data.Proxy (Proxy (..))
+import Network.Wai.Handler.Warp qualified as Warp
+import Servant (Server)
+import Servant.API (NoContent (..), (:<|>) (..))
+import Servant.Server (serve)
+import Test.Gen.Cardano.Api.Typed qualified as Gen
+import Test.QuickCheck qualified as QC
+import Test.QuickCheck.Gen qualified as Gen
+import Test.QuickCheck.Hedgehog (hedgehog)
+import Wst.Server.Types (APIInEra, BuildTxAPI, QueryAPI, TextEnvelopeJSON (..))
+import Wst.Test.Gen qualified as Gen
+
+mockServer :: Server APIInEra
+mockServer =
+  pure NoContent
+  :<|> mockQueryApi
+  :<|> mockTxApi
+
+mockQueryApi :: Server (QueryAPI C.ConwayEra)
+mockQueryApi =
+  liftIO (QC.generate $ Gen.genUTxODat Gen.genGlobalParams)
+  :<|> (\_ -> liftIO $ QC.generate $ Gen.listOf (hedgehog $ Gen.genVerificationKeyHash (C.proxyToAsType Proxy)))
+  :<|> (\_ -> liftIO $ fmap (C.fromLedgerValue C.ShelleyBasedEraConway) $ QC.generate $ hedgehog $ Gen.genValue C.MaryEraOnwardsConway Gen.genAssetId Gen.genPositiveQuantity)
+  :<|> liftIO (fmap (C.fromLedgerValue C.ShelleyBasedEraConway) $ QC.generate $ hedgehog $ Gen.genValue C.MaryEraOnwardsConway Gen.genAssetId Gen.genPositiveQuantity)
+
+genTx :: MonadIO m => m (TextEnvelopeJSON (C.Tx C.ConwayEra))
+genTx = liftIO $ fmap TextEnvelopeJSON $ QC.generate $ hedgehog $ Gen.genTx C.shelleyBasedEra
+
+mockTxApi :: Server (BuildTxAPI C.ConwayEra)
+mockTxApi =
+  const genTx
+  :<|> const genTx
+  :<|> const genTx
+  :<|> const genTx
+
+-- | Start the mock server
+runMockServer :: IO ()
+runMockServer = do
+  let app = serve (Proxy @APIInEra) mockServer
+      port = 8080
+  putStrLn $ "Starting mock server on port " <> show port
+  Warp.run port app

src/test/Wst/Test/Env.hs → src/test/unit/Wst/Test/Env.hs

@@ -27,7 +27,7 @@ admin =
     }
 
 user :: Wallet.Wallet -> Operator Signing
-user w = 
+user w =
   Operator
     { oPaymentKey = PESigning (Wallet.getWallet w)
     , oStakeKey = Nothing

src/wst-poc.cabal

@@ -146,14 +146,30 @@ executable export-smart-tokens
 
   hs-source-dirs: exe/export-smart-tokens
 
+library test-lib
+  import:          lang
+  hs-source-dirs:  test/lib
+  exposed-modules:
+    Wst.Test.Gen
+    Wst.Test.MockServer
+
+  build-depends:
+    , base
+    , cardano-api
+    , cardano-api:gen
+    , convex-base
+    , hedgehog-quickcheck
+    , plutus-ledger-api
+    , QuickCheck
+    , servant
+    , servant-server
+    , warp
+    , wst-poc
+
 test-suite wst-poc-test
   import:         lang
   type:           exitcode-stdio-1.0
-  hs-source-dirs: test
-  ghc-options:
-    -fobject-code -fno-ignore-interface-pragmas
-    -fno-omit-interface-pragmas -fno-specialise -Wno-unused-packages
-
+  hs-source-dirs: test/unit
   main-is:        Spec.hs
   other-modules:
     Wst.Test.Env
@@ -171,7 +187,14 @@ test-suite wst-poc-test
     , convex-wallet
     , lens
     , mtl
-    , plutus-ledger-api
     , tasty
     , tasty-hunit
     , wst-poc
+
+executable wst-poc-mock-server
+  import:         lang
+  main-is:        Main.hs
+  hs-source-dirs: exe/wst-poc-mock-server
+  build-depends:
+    , base
+    , wst-poc:test-lib