Skip to content

Commit

Permalink
getting funds
Browse files Browse the repository at this point in the history
  • Loading branch information
@brunjlar
brunjlar committed Jun 8, 2021
1 parent 4e4b7dc commit d80641a
Show file tree
Hide file tree
Showing 4 changed files with 52 additions and 43 deletions.
14 changes: 14 additions & 0 deletions code/week10/app/Uniswap.hs
View file
Expand Up @@ -13,14 +13,28 @@
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
Expand Down
62 changes: 34 additions & 28 deletions code/week10/app/uniswap-client.hs
View file
Expand Up @@ -8,16 +8,17 @@ module Main

import Control.Concurrent
import Control.Exception
import Control.Monad (forever)
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.Text (Text, pack)
import Data.UUID
import Ledger.Value (flattenValue)
import Network.HTTP.Req
import Plutus.Contracts.Uniswap (Uniswap)
import Plutus.Contracts.Uniswap (Uniswap, UserContractState (..))
import Plutus.PAB.Events.ContractInstanceState (PartiallyDecodedResponse (..))
import Plutus.PAB.Webserver.Types
import System.Environment (getArgs)
Expand All @@ -26,7 +27,7 @@ import System.IO
import Text.Read (readMaybe)
import Wallet.Emulator.Types (Wallet (..))

import Uniswap (cidFile)
import Uniswap (cidFile, UniswapContracts)

main :: IO ()
main = do
Expand All @@ -36,8 +37,37 @@ main = do
case mus of
Nothing -> putStrLn "invalid uniswap.json" >> exitFailure
Just us -> do
putStrLn $ "cid: " ++ show (cid :: UUID)
putStrLn $ "cid: " ++ show cid
putStrLn $ "uniswap: " ++ show (us :: Uniswap)
forever $ do
getFunds cid
threadDelay 1_000_000

getFunds :: UUID -> IO ()
getFunds uuid = handle h $ runReq defaultHttpConfig $ do
v <- req
POST
(http "127.0.0.1" /: "api" /: "new" /: "contract" /: "instance" /: pack (show uuid) /: "endpoint" /: "funds")
(ReqBodyJson ())
(Proxy :: Proxy (JsonResponse ()))
(port 8080)
if responseStatusCode v /= 200
then liftIO $ putStrLn "error getting funds"
else do
liftIO $ threadDelay 2_000_000
w <- req
GET
(http "127.0.0.1" /: "api" /: "new" /: "contract" /: "instance" /: pack (show uuid) /: "status")
NoReqBody
(Proxy :: Proxy (JsonResponse (ContractInstanceClientState UniswapContracts)))
(port 8080)
liftIO $ putStrLn $ case fromJSON $ observableState $ cicCurrentState $ responseBody w of
Success (Last (Just (Right (Funds f)))) -> "funds: " ++ show (flattenValue f)
Success (Last (Just (Left e))) -> "error: " ++ show (e :: Text)
_ -> "error decoding state"
where
h :: HttpException -> IO ()
h _ = threadDelay 1_000_000 >> getFunds uuid
{-
[i :: Int] <- map read <$> getArgs
uuid <- read <$> readFile ('W' : show i ++ ".cid")
Expand All @@ -64,30 +94,6 @@ main = do
data Command = Offer Integer | Retrieve | Use | Funds
deriving (Show, Read, Eq, Ord)
getFunds :: UUID -> IO ()
getFunds uuid = handle h $ runReq defaultHttpConfig $ do
v <- req
POST
(http "127.0.0.1" /: "api" /: "new" /: "contract" /: "instance" /: pack (show uuid) /: "endpoint" /: "funds")
(ReqBodyJson ())
(Proxy :: Proxy (JsonResponse ()))
(port 8080)
if responseStatusCode v /= 200
then liftIO $ putStrLn "error getting funds"
else do
w <- req
GET
(http "127.0.0.1" /: "api" /: "new" /: "contract" /: "instance" /: pack (show uuid) /: "status")
NoReqBody
(Proxy :: Proxy (JsonResponse (ContractInstanceClientState OracleContracts)))
(port 8080)
liftIO $ putStrLn $ case fromJSON $ observableState $ cicCurrentState $ responseBody w of
Success (Last (Just f)) -> "funds: " ++ show (flattenValue f)
_ -> "error decoding state"
where
h :: HttpException -> IO ()
h _ = threadDelay 1_000_000 >> getFunds uuid
offer :: UUID -> Integer -> IO ()
offer uuid amt = handle h $ runReq defaultHttpConfig $ do
v <- req
Expand Down
18 changes: 3 additions & 15 deletions code/week10/app/uniswap-pab.hs
View file
@@ -1,6 +1,5 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
Expand All @@ -18,13 +17,11 @@ import Control.Monad.Freer (Eff, Member, interpret, ty
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 Data.Aeson (Result (..), encode, fromJSON)
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 Plutus.Contract
import qualified Plutus.Contracts.Currency as Currency
import qualified Plutus.Contracts.Uniswap as Uniswap
Expand All @@ -37,10 +34,11 @@ import qualified Plutus.PAB.Simulator as Simulator
import Plutus.PAB.Types (PABError (..))
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 (..))

import Uniswap as US

main :: IO ()
main = void $ Simulator.runSimulationWith handlers $ do
logString @(Builtin UniswapContracts) "Starting Uniswap PAB webserver on port 8080. Press enter to exit."
Expand Down Expand Up @@ -70,16 +68,6 @@ main = void $ Simulator.runSimulationWith handlers $ do

shutdown

data UniswapContracts =
Init
| UniswapStart
| UniswapUser Uniswap.Uniswap
deriving (Eq, Ord, Show, Generic)
deriving anyclass (FromJSON, ToJSON)

instance Pretty UniswapContracts where
pretty = viaShow

handleUniswapContract ::
( Member (Error PABError) effs
, Member (LogMsg (PABMultiAgentMsg (Builtin UniswapContracts))) effs
Expand Down
1 change: 1 addition & 0 deletions code/week10/plutus-pioneer-program-week10.cabal
View file
Expand Up @@ -66,6 +66,7 @@ executable uniswap-client
, plutus-ledger
, plutus-pab
, plutus-use-cases
, prettyprinter
, req ^>= 3.9.0
, text
, uuid

0 comments on commit d80641a

Please sign in to comment.