refactoring

This commit is contained in:
Lars Brünjes 2021-05-10 16:39:44 +02:00
parent 395ebef4a8
commit b5ce65494d
No known key found for this signature in database
GPG key ID: B488B9045DC1A087
2 changed files with 81 additions and 31 deletions

View file

@ -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

View file

@ -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