mirror of
https://github.com/FiloSpaTeam/plutus-pioneer-program.git
synced 2024-11-25 08:12:00 +01:00
60 lines
2.1 KiB
Haskell
60 lines
2.1 KiB
Haskell
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE DeriveAnyClass #-}
|
|
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE DerivingStrategies #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE LambdaCase #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE RankNTypes #-}
|
|
{-# LANGUAGE TypeApplications #-}
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
{-# LANGUAGE TypeOperators #-}
|
|
|
|
module Uniswap where
|
|
|
|
import Control.Monad (forM_, when)
|
|
import Data.Aeson (FromJSON, ToJSON)
|
|
import qualified Data.Semigroup as Semigroup
|
|
import Data.Text.Prettyprint.Doc (Pretty (..), viaShow)
|
|
import GHC.Generics (Generic)
|
|
import Ledger
|
|
import Ledger.Constraints
|
|
import Ledger.Value as Value
|
|
import Plutus.Contract hiding (when)
|
|
import qualified Plutus.Contracts.Currency as Currency
|
|
import qualified Plutus.Contracts.Uniswap as Uniswap
|
|
import Wallet.Emulator.Types (Wallet (..), walletPubKey)
|
|
|
|
data UniswapContracts =
|
|
Init
|
|
| UniswapStart
|
|
| UniswapUser Uniswap.Uniswap
|
|
deriving (Eq, Ord, Show, Generic)
|
|
deriving anyclass (FromJSON, ToJSON)
|
|
|
|
instance Pretty UniswapContracts where
|
|
pretty = viaShow
|
|
|
|
initContract :: Contract (Maybe (Semigroup.Last Currency.OneShotCurrency)) Currency.CurrencySchema Currency.CurrencyError ()
|
|
initContract = do
|
|
ownPK <- pubKeyHash <$> ownPubKey
|
|
cur <- Currency.forgeContract ownPK [(tn, fromIntegral (length wallets) * amount) | tn <- tokenNames]
|
|
let cs = Currency.currencySymbol cur
|
|
v = mconcat [Value.singleton cs tn amount | tn <- tokenNames]
|
|
forM_ wallets $ \w -> do
|
|
let pkh = pubKeyHash $ walletPubKey w
|
|
when (pkh /= ownPK) $ do
|
|
tx <- submitTx $ mustPayToPubKey pkh v
|
|
awaitTxConfirmed $ txId tx
|
|
tell $ Just $ Semigroup.Last cur
|
|
where
|
|
amount = 1000000
|
|
|
|
wallets :: [Wallet]
|
|
wallets = [Wallet i | i <- [1 .. 4]]
|
|
|
|
tokenNames :: [TokenName]
|
|
tokenNames = ["A", "B", "C", "D"]
|
|
|
|
cidFile :: Wallet -> FilePath
|
|
cidFile w = "W" ++ show (getWallet w) ++ ".cid"
|