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/test/lib/Wst/Test/Gen.hs

@@ -1,5 +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

@@ -1,15 +1,23 @@
 {-| Mock implementation of server API for testing / UI development
 -}
 module Wst.Test.MockServer(
-  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 SmartTokens.Types.ProtocolParams (ProgrammableLogicGlobalParams)
-import Wst.Offchain.Query (UTxODat (UTxODat))
-import Wst.Server.Types (APIInEra, BuildTxAPI, QueryAPI)
+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 =
@@ -19,26 +27,25 @@ mockServer =
 
 mockQueryApi :: Server (QueryAPI C.ConwayEra)
 mockQueryApi =
-  (pure globalParalsUtxo)
-  :<|> undefined
+  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)
 
-mockTxApi :: Server (BuildTxAPI C.ConwayEra)
-mockTxApi = undefined
-
-genUtxo :: Gen a -> Gen (UTxODat era a)
-genUtxo g =
-  UTxODat
-    <$> Gen.genTxIn
-    <*> Gen.genTxOut
-    <*> g
+genTx :: MonadIO m => m (TextEnvelopeJSON (C.Tx C.ConwayEra))
+genTx = liftIO $ fmap TextEnvelopeJSON $ QC.generate $ hedgehog $ Gen.genTx C.shelleyBasedEra
 
-globalParalsUtxo :: UTxODat era ProgrammableLogicGlobalParams
-globalParalsUtxo =
-  UTxODat
-    { uIn = undefined
-    , uOut = undefined
-    , uDatum = mockParams
-    }
+mockTxApi :: Server (BuildTxAPI C.ConwayEra)
+mockTxApi =
+  const genTx
+  :<|> const genTx
+  :<|> const genTx
+  :<|> const genTx
 
-mockParams :: ProgrammableLogicGlobalParams
-mockParams = undefined
+-- | 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/wst-poc.cabal

@@ -146,12 +146,21 @@ executable export-smart-tokens
 
   hs-source-dirs: exe/export-smart-tokens
 
-library wst-poc-test-lib
+library test-lib
   import:          lang
   hs-source-dirs:  test/lib
-  exposed-modules: Wst.Test.Gen
+  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
@@ -182,3 +191,11 @@ test-suite wst-poc-test
     , 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