{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# 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, ToJSON, Result (..), fromJSON) import Data.Monoid (Last (..)) import Data.Text (Text, pack) import Data.Text.Prettyprint.Doc (Pretty (..), viaShow) import GHC.Generics (Generic) 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 qualified Week06.Oracle.Core as Oracle import qualified Week06.Oracle.Funds as Oracle 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 forM_ wallets $ \w -> void $ Simulator.activateContract w Funds cidInit <- Simulator.activateContract (Wallet 1) Init cs <- waitForLast cidInit _ <- Simulator.waitUntilFinished cidInit cidOracle <- Simulator.activateContract (Wallet 1) $ Oracle cs 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 data OracleContracts = Init | Oracle CurrencySymbol | Funds | Swap Oracle.Oracle deriving (Eq, Ord, Show, Generic, FromJSON, ToJSON) instance Pretty OracleContracts where pretty = viaShow 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) Funds -> endpointsToSchemas @Empty Swap _ -> endpointsToSchemas @(Oracle.SwapSchema .\\ BlockchainActions) getContract = \case Init -> SomeBuiltin initContract Oracle cs -> SomeBuiltin $ Oracle.runOracle $ oracleParams cs Funds -> SomeBuiltin $ Oracle.ownFunds' 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