From 4e4b7dc900e4c3325f624c97b6e6a2a79837da33 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Lars=20Br=C3=BCnjes?= Date: Tue, 8 Jun 2021 00:16:05 +0200 Subject: [PATCH] uniswap-pab and reading of Uniswap and cid's in client --- code/week10/.gitignore | 4 +- code/week10/app/Uniswap.hs | 3 + code/week10/app/oracle-pab.hs | 123 ------------------ code/week10/app/uniswap-client.hs | 45 ++++--- code/week10/app/uniswap-pab.hs | 33 ++--- code/week10/cabal.project | 8 +- .../plutus-pioneer-program-week10.cabal | 8 +- 7 files changed, 55 insertions(+), 169 deletions(-) delete mode 100644 code/week10/app/oracle-pab.hs diff --git a/code/week10/.gitignore b/code/week10/.gitignore index 2bbd0a6..8aa6f56 100644 --- a/code/week10/.gitignore +++ b/code/week10/.gitignore @@ -1,6 +1,6 @@ dist-newstyle/ -oracle.cid +uniswap.json +W1.cid W2.cid W3.cid W4.cid -W5.cid diff --git a/code/week10/app/Uniswap.hs b/code/week10/app/Uniswap.hs index ba3b18d..cbbe17f 100644 --- a/code/week10/app/Uniswap.hs +++ b/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" diff --git a/code/week10/app/oracle-pab.hs b/code/week10/app/oracle-pab.hs deleted file mode 100644 index 3939d02..0000000 --- a/code/week10/app/oracle-pab.hs +++ /dev/null @@ -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 diff --git a/code/week10/app/uniswap-client.hs b/code/week10/app/uniswap-client.hs index a6c3f4e..d4ba46b 100644 --- a/code/week10/app/uniswap-client.hs +++ b/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") diff --git a/code/week10/app/uniswap-pab.hs b/code/week10/app/uniswap-pab.hs index 003d470..c32d567 100644 --- a/code/week10/app/uniswap-pab.hs +++ b/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 diff --git a/code/week10/cabal.project b/code/week10/cabal.project index 4d01013..9239082 100644 --- a/code/week10/cabal.project +++ b/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 diff --git a/code/week10/plutus-pioneer-program-week10.cabal b/code/week10/plutus-pioneer-program-week10.cabal index 56fdb82..eae700e 100644 --- a/code/week10/plutus-pioneer-program-week10.cabal +++ b/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