uniswap-pab and reading of Uniswap and cid's in client

code/week10/.gitignore

@@ -1,6 +1,6 @@
 dist-newstyle/
-oracle.cid
+uniswap.json
+W1.cid
 W2.cid
 W3.cid
 W4.cid
-W5.cid

code/week10/app/Uniswap.hs

@@ -41,3 +41,6 @@ wallets = [Wallet i | i <- [1 .. 4]]
 
 tokenNames :: [TokenName]
 tokenNames = ["A", "B", "C", "D"]
+
+cidFile :: Wallet -> FilePath
+cidFile w = "W" ++ show (getWallet w) ++ ".cid"

code/week10/app/oracle-pab.hs

@@ -1,123 +0,0 @@
-{-# LANGUAGE DataKinds          #-}
-{-# LANGUAGE DeriveAnyClass     #-}
-{-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE FlexibleContexts   #-}
-{-# LANGUAGE LambdaCase         #-}
-{-# LANGUAGE NumericUnderscores #-}
-{-# LANGUAGE OverloadedStrings  #-}
-{-# LANGUAGE RankNTypes         #-}
-{-# LANGUAGE TypeApplications   #-}
-{-# LANGUAGE TypeFamilies       #-}
-{-# LANGUAGE TypeOperators      #-}
-
-module Main
-    ( main
-    ) where
-
-import           Control.Monad                       (forM_, void, when)
-import           Control.Monad.Freer                 (Eff, Member, interpret, type (~>))
-import           Control.Monad.Freer.Error           (Error)
-import           Control.Monad.Freer.Extras.Log      (LogMsg)
-import           Control.Monad.IO.Class              (MonadIO (..))
-import           Data.Aeson                          (FromJSON, Result (..), fromJSON)
-import           Data.Monoid                         (Last (..))
-import           Data.Text                           (Text, pack)
-import           Ledger
-import           Ledger.Constraints
-import qualified Ledger.Value                        as Value
-import           Plutus.Contract                     hiding (when)
-import           Plutus.PAB.Effects.Contract         (ContractEffect (..))
-import           Plutus.PAB.Effects.Contract.Builtin (Builtin, SomeBuiltin (..), type (.\\), endpointsToSchemas, handleBuiltin)
-import           Plutus.PAB.Monitoring.PABLogMsg     (PABMultiAgentMsg)
-import           Plutus.PAB.Simulator                (SimulatorEffectHandlers)
-import qualified Plutus.PAB.Simulator                as Simulator
-import           Plutus.PAB.Types                    (PABError (..))
-import qualified Plutus.PAB.Webserver.Server         as PAB.Server
-import qualified Plutus.Contracts.Currency           as Currency
-
-import           Wallet.Emulator.Types               (Wallet (..), walletPubKey)
-import           Wallet.Types                        (ContractInstanceId (..))
-
-import qualified Week06.Oracle.Core                  as Oracle
-import           Week06.Oracle.PAB                   (OracleContracts (..))
-import qualified Week06.Oracle.Swap                  as Oracle
-
-main :: IO ()
-main = void $ Simulator.runSimulationWith handlers $ do
-    Simulator.logString @(Builtin OracleContracts) "Starting Oracle PAB webserver. Press enter to exit."
-    shutdown <- PAB.Server.startServerDebug
-
-    cidInit <- Simulator.activateContract (Wallet 1) Init
-    cs      <- waitForLast cidInit
-    _       <- Simulator.waitUntilFinished cidInit
-
-    cidOracle <- Simulator.activateContract (Wallet 1) $ Oracle cs
-    liftIO $ writeFile "oracle.cid" $ show $ unContractInstanceId cidOracle
-    oracle <- waitForLast cidOracle
-
-    forM_ wallets $ \w ->
-        when (w /= Wallet 1) $ do
-            cid <- Simulator.activateContract w $ Swap oracle
-            liftIO $ writeFile ('W' : show (getWallet w) ++ ".cid") $ show $ unContractInstanceId cid
-
-    void $ liftIO getLine
-    shutdown
-
-waitForLast :: FromJSON a => ContractInstanceId -> Simulator.Simulation t a
-waitForLast cid =
-    flip Simulator.waitForState cid $ \json -> case fromJSON json of
-        Success (Last (Just x)) -> Just x
-        _                       -> Nothing
-
-wallets :: [Wallet]
-wallets = [Wallet i | i <- [1 .. 5]]
-
-usdt :: TokenName
-usdt = "USDT"
-
-oracleParams :: CurrencySymbol -> Oracle.OracleParams
-oracleParams cs = Oracle.OracleParams
-    { Oracle.opFees   = 1_000_000
-    , Oracle.opSymbol = cs
-    , Oracle.opToken  = usdt
-    }
-
-handleOracleContracts ::
-    ( Member (Error PABError) effs
-    , Member (LogMsg (PABMultiAgentMsg (Builtin OracleContracts))) effs
-    )
-    => ContractEffect (Builtin OracleContracts)
-    ~> Eff effs
-handleOracleContracts = handleBuiltin getSchema getContract where
-    getSchema = \case
-        Init     -> endpointsToSchemas @Empty
-        Oracle _ -> endpointsToSchemas @(Oracle.OracleSchema .\\ BlockchainActions)
-        Swap _   -> endpointsToSchemas @(Oracle.SwapSchema   .\\ BlockchainActions)
-    getContract = \case
-        Init        -> SomeBuiltin   initContract
-        Oracle cs   -> SomeBuiltin $ Oracle.runOracle $ oracleParams cs
-        Swap oracle -> SomeBuiltin $ Oracle.swap oracle
-
-handlers :: SimulatorEffectHandlers (Builtin OracleContracts)
-handlers =
-    Simulator.mkSimulatorHandlers @(Builtin OracleContracts) []
-    $ interpret handleOracleContracts
-
-initContract :: Contract (Last CurrencySymbol) BlockchainActions Text ()
-initContract = do
-    ownPK <- pubKeyHash <$> ownPubKey
-    cur   <-
-        mapError (pack . show)
-        (Currency.forgeContract ownPK [(usdt, fromIntegral (length wallets) * amount)]
-        :: Contract (Last CurrencySymbol) BlockchainActions Currency.CurrencyError Currency.OneShotCurrency)
-    let cs = Currency.currencySymbol cur
-        v  = Value.singleton cs usdt amount
-    forM_ wallets $ \w -> do
-        let pkh = pubKeyHash $ walletPubKey w
-        when (pkh /= ownPK) $ do
-            tx <- submitTx $ mustPayToPubKey pkh v
-            awaitTxConfirmed $ txId tx
-    tell $ Last $ Just cs
-  where
-    amount :: Integer
-    amount = 100_000_000

code/week10/app/uniswap-client.hs

@@ -6,25 +6,38 @@ module Main
     ( main
     ) where
 
-import Control.Concurrent
-import Control.Exception
-import Control.Monad.IO.Class                  (MonadIO (..))
-import Data.Aeson                              (Result (..), fromJSON)
-import Data.Monoid                             (Last (..))
-import Data.Proxy                              (Proxy (..))
-import Data.Text                               (pack)
-import Data.UUID
-import Ledger.Value                            (flattenValue)
-import Network.HTTP.Req
-import Plutus.PAB.Events.ContractInstanceState (PartiallyDecodedResponse (..))
-import Plutus.PAB.Webserver.Types
-import System.Environment                      (getArgs)
-import System.IO
-import Text.Read                               (readMaybe)
+import           Control.Concurrent
+import           Control.Exception
+import           Control.Monad.IO.Class                  (MonadIO (..))
+import           Data.Aeson                              (Result (..), decode, fromJSON)
+import qualified Data.ByteString.Lazy as LB
+import           Data.Monoid                             (Last (..))
+import           Data.Proxy                              (Proxy (..))
+import           Data.Text                               (pack)
+import           Data.UUID
+import           Ledger.Value                            (flattenValue)
+import           Network.HTTP.Req
+import           Plutus.Contracts.Uniswap                (Uniswap)
+import           Plutus.PAB.Events.ContractInstanceState (PartiallyDecodedResponse (..))
+import           Plutus.PAB.Webserver.Types
+import           System.Environment                      (getArgs)
+import           System.Exit                             (exitFailure)
+import           System.IO
+import           Text.Read                               (readMaybe)
+import           Wallet.Emulator.Types                   (Wallet (..))
+
+import           Uniswap                                 (cidFile)
 
 main :: IO ()
 main = do
-    putStrLn "Uniswap Client"
+    w   <- Wallet . read . head <$> getArgs
+    cid <- read                 <$> readFile (cidFile w)
+    mus <- decode               <$> LB.readFile "uniswap.json"
+    case mus of
+        Nothing -> putStrLn "invalid uniswap.json" >> exitFailure
+        Just us -> do
+            putStrLn $ "cid: " ++ show (cid :: UUID)
+            putStrLn $ "uniswap: " ++ show (us :: Uniswap)
 {-
     [i :: Int] <- map read <$> getArgs
     uuid       <- read <$> readFile ('W' : show i ++ ".cid")

code/week10/app/uniswap-pab.hs

@@ -13,19 +13,18 @@ module Main
     ( main
     ) where
 
-import           Control.Monad                       (forM, void)
+import           Control.Monad                       (forM_, void)
 import           Control.Monad.Freer                 (Eff, Member, interpret, type (~>))
 import           Control.Monad.Freer.Error           (Error)
 import           Control.Monad.Freer.Extras.Log      (LogMsg)
 import           Control.Monad.IO.Class              (MonadIO (..))
 import           Data.Aeson                          (FromJSON, Result (..), ToJSON, encode, fromJSON)
-import qualified Data.Map.Strict                     as Map
+import qualified Data.ByteString.Lazy                as LB
 import qualified Data.Monoid                         as Monoid
 import qualified Data.Semigroup                      as Semigroup
 import           Data.Text                           (Text)
 import           Data.Text.Prettyprint.Doc           (Pretty (..), viaShow)
 import           GHC.Generics                        (Generic)
-import           Ledger.Ada                          (adaSymbol, adaToken)
 import           Plutus.Contract
 import qualified Plutus.Contracts.Currency           as Currency
 import qualified Plutus.Contracts.Uniswap            as Uniswap
@@ -40,6 +39,7 @@ import qualified Plutus.PAB.Webserver.Server         as PAB.Server
 import           Prelude                             hiding (init)
 import           Uniswap                             as US
 import           Wallet.Emulator.Types               (Wallet (..))
+import           Wallet.Types                        (ContractInstanceId (..))
 
 main :: IO ()
 main = void $ Simulator.runSimulationWith handlers $ do
@@ -54,37 +54,20 @@ main = void $ Simulator.runSimulationWith handlers $ do
 
     logString @(Builtin UniswapContracts) $ "Initialization finished. Minted: " ++ show cs
 
-    let coins = Map.fromList [(tn, Uniswap.mkCoin cs tn) | tn <- tokenNames]
-        ada   = Uniswap.mkCoin adaSymbol adaToken
-
     cidStart <- Simulator.activateContract (Wallet 1) UniswapStart
     us       <- flip Simulator.waitForState cidStart $ \json -> case (fromJSON json :: Result (Monoid.Last (Either Text Uniswap.Uniswap))) of
                     Success (Monoid.Last (Just (Right us))) -> Just us
                     _                                       -> Nothing
+    liftIO $ LB.writeFile "uniswap.json" $ encode us
     logString @(Builtin UniswapContracts) $ "Uniswap instance created: " ++ show us
 
-    cids <- fmap Map.fromList $ forM wallets $ \w -> do
+    forM_ wallets $ \w -> do
         cid <- Simulator.activateContract w $ UniswapUser us
+        liftIO $ writeFile (cidFile w) $ show $ unContractInstanceId cid
         logString @(Builtin UniswapContracts) $ "Uniswap user contract started for " ++ show w
-        Simulator.waitForEndpoint cid "funds"
-        _ <- Simulator.callEndpointOnInstance cid "funds" ()
-        v <- flip Simulator.waitForState cid $ \json -> case (fromJSON json :: Result (Monoid.Last (Either Text Uniswap.UserContractState))) of
-                Success (Monoid.Last (Just (Right (Uniswap.Funds v)))) -> Just v
-                _                                                      -> Nothing
-        logString @(Builtin UniswapContracts) $ "initial funds in wallet " ++ show w ++ ": " ++ show v
-        return (w, cid)
 
-    let cp = Uniswap.CreateParams ada (coins Map.! "A") 100000 500000
-    logString @(Builtin UniswapContracts) $ "creating liquidity pool: " ++ show (encode cp)
-    let cid2 = cids Map.! Wallet 2
-    Simulator.waitForEndpoint cid2 "create"
-    _  <- Simulator.callEndpointOnInstance cid2 "create" cp
-    flip Simulator.waitForState (cids Map.! Wallet 2) $ \json -> case (fromJSON json :: Result (Monoid.Last (Either Text Uniswap.UserContractState))) of
-        Success (Monoid.Last (Just (Right Uniswap.Created))) -> Just ()
-        _                                                    -> Nothing
-    logString @(Builtin UniswapContracts) "liquidity pool created"
+    void $ liftIO getLine
 
-    _ <- liftIO getLine
     shutdown
 
 data UniswapContracts =
@@ -115,5 +98,5 @@ handleUniswapContract = Builtin.handleBuiltin getSchema getContract where
 
 handlers :: SimulatorEffectHandlers (Builtin UniswapContracts)
 handlers =
-    Simulator.mkSimulatorHandlers @(Builtin UniswapContracts) [] -- [Init, UniswapStart, UniswapUser ???]
+    Simulator.mkSimulatorHandlers @(Builtin UniswapContracts) []
     $ interpret handleUniswapContract

code/week10/cabal.project

@@ -25,7 +25,8 @@ source-repository-package
     plutus-use-cases
     prettyprinter-configurable
     quickcheck-dynamic
-  tag: 74cb849b6580d937a97aff42636d4ddc6a140ed6
+    word-array
+  tag: 26449c6e6e1c14d335683e5a4f40e2662b9b7e7
 
 -- The following sections are copied from the 'plutus' repository cabal.project at the revision
 -- given above.
@@ -61,6 +62,11 @@ constraints:
 -- (NOTE this will change to ieee754 in newer versions of nixpkgs).
 extra-packages: ieee, filemanip
 
+-- Drops an instance breaking our code. Should be released to Hackage eventually.
+source-repository-package
+  type: git
+  location: https://github.com/Quid2/flat.git
+  tag: 95e5d7488451e43062ca84d5376b3adcc465f1cd
 
 -- Needs some patches, but upstream seems to be fairly dead (no activity in > 1 year)
 source-repository-package

code/week10/plutus-pioneer-program-week10.cabal

@@ -42,8 +42,8 @@ executable uniswap-pab
                  -Wno-missing-import-lists -Wredundant-constraints -O0
     build-depends:
         base >=4.9 && <5,
-        bytestring,
         aeson -any,
+        bytestring -any,
         containers -any,
         freer-extras -any,
         freer-simple -any,
@@ -55,13 +55,17 @@ executable uniswap-pab
         text -any
 
 executable uniswap-client
-  main-is: uniswap-client.hs
+  main-is:             uniswap-client.hs
+  other-modules:       Uniswap
   hs-source-dirs:      app
   ghc-options:         -Wall
   build-depends:       aeson
                      , base ^>= 4.14.1.0
+                     , bytestring
+                     , plutus-contract
                      , plutus-ledger
                      , plutus-pab
+                     , plutus-use-cases
                      , req ^>= 3.9.0
                      , text
                      , uuid