mirror of
https://github.com/FiloSpaTeam/plutus-pioneer-program.git
synced 2024-11-21 22:32:00 +01:00
refactoring
This commit is contained in:
Lars Brünjes
parent
395ebef4a8
commit
b5ce65494d
2 changed files with 81 additions and 31 deletions
|
|
@ -15,50 +15,75 @@ module Main
|
|||
( main
|
||||
) where
|
||||
|
||||
import Control.Monad (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, ToJSON)
|
||||
import Data.Text.Prettyprint.Doc (Pretty (..), viaShow)
|
||||
import GHC.Generics (Generic)
|
||||
import Plutus.Contract (BlockchainActions, ContractError)
|
||||
import Plutus.PAB.Effects.Contract (ContractEffect (..))
|
||||
import Plutus.PAB.Effects.Contract.Builtin (Builtin, SomeBuiltin (..), type (.\\), endpointsToSchemas, handleBuiltin)
|
||||
import Plutus.PAB.Effects.ContractTest.Uniswap as US
|
||||
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 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 (..))
|
||||
import Wallet.Emulator.Types (Wallet (..), walletPubKey)
|
||||
|
||||
import qualified Week06.Oracle.Core as Oracle
|
||||
import qualified Week06.Oracle.Swap as Oracle
|
||||
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 on port 8080. Press enter to exit."
|
||||
Simulator.logString @(Builtin OracleContracts) "Starting Oracle PAB webserver. Press enter to exit."
|
||||
shutdown <- PAB.Server.startServerDebug
|
||||
|
||||
cidOracle <- Simulator.activateContract (Wallet 1) Oracle
|
||||
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
|
||||
|
||||
data OracleContracts = Oracle | Swap Oracle.Oracle
|
||||
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
|
||||
|
||||
oracleParams :: Oracle.OracleParams
|
||||
oracleParams = Oracle.OracleParams
|
||||
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 = "ff"
|
||||
, Oracle.opToken = "USDT"
|
||||
, Oracle.opSymbol = cs
|
||||
, Oracle.opToken = usdt
|
||||
}
|
||||
|
||||
handleOracleContracts ::
|
||||
|
|
@ -69,13 +94,36 @@ handleOracleContracts ::
|
|||
~> Eff effs
|
||||
handleOracleContracts = handleBuiltin getSchema getContract where
|
||||
getSchema = \case
|
||||
Oracle -> endpointsToSchemas @(Oracle.OracleSchema .\\ BlockchainActions)
|
||||
Swap _ -> endpointsToSchemas @(Oracle.SwapSchema .\\ BlockchainActions)
|
||||
Init -> endpointsToSchemas @Empty
|
||||
Oracle _ -> endpointsToSchemas @(Oracle.OracleSchema .\\ BlockchainActions)
|
||||
Funds -> endpointsToSchemas @Empty
|
||||
Swap _ -> endpointsToSchemas @(Oracle.SwapSchema .\\ BlockchainActions)
|
||||
getContract = \case
|
||||
Oracle -> SomeBuiltin $ Oracle.runOracle oracleParams
|
||||
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
|
||||
|
|
|
|||
|
|
@ -34,7 +34,7 @@ library
|
|||
executable oracle
|
||||
main-is: oracle.hs
|
||||
hs-source-dirs: app
|
||||
ghc-options: -threaded
|
||||
ghc-options: -Wall -threaded
|
||||
build-depends: aeson
|
||||
, base ^>= 4.14.1.0
|
||||
, freer-extras
|
||||
|
|
@ -43,4 +43,6 @@ executable oracle
|
|||
, plutus-ledger
|
||||
, plutus-pab
|
||||
, plutus-pioneer-program-week06
|
||||
, plutus-use-cases
|
||||
, prettyprinter
|
||||
, text
|
||||
|
|
|
|||
Loading…
Reference in a new issue