From 7152bc5e02d9989c3149df883fe8f7941953a398 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Lars=20Br=C3=BCnjes?= Date: Mon, 10 May 2021 22:41:10 +0200 Subject: [PATCH] querying funds --- code/week06/app/oracle-pab.hs | 13 +-- code/week06/app/swap-client.hs | 82 ++++++++++++++++++- .../plutus-pioneer-program-week06.cabal | 7 +- code/week06/src/Week06/Oracle/PAB.hs | 19 +++++ 4 files changed, 109 insertions(+), 12 deletions(-) create mode 100644 code/week06/src/Week06/Oracle/PAB.hs diff --git a/code/week06/app/oracle-pab.hs b/code/week06/app/oracle-pab.hs index 436f1d4..867976d 100644 --- a/code/week06/app/oracle-pab.hs +++ b/code/week06/app/oracle-pab.hs @@ -1,6 +1,5 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} @@ -13,6 +12,7 @@ module Main ( main + , OracleContracts ) where import Control.Monad (forM_, void, when) @@ -20,11 +20,9 @@ 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, ToJSON, Result (..), fromJSON) +import Data.Aeson (FromJSON, 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 @@ -42,6 +40,7 @@ import Wallet.Emulator.Types (Wallet (..), walletPubKey) import Wallet.Types (ContractInstanceId (..)) import qualified Week06.Oracle.Core as Oracle +import Week06.Oracle.PAB (OracleContracts (..)) import qualified Week06.Oracle.Swap as Oracle main :: IO () @@ -71,12 +70,6 @@ waitForLast cid = Success (Last (Just x)) -> Just x _ -> Nothing -data OracleContracts = Init | Oracle CurrencySymbol | Swap Oracle.Oracle - deriving (Eq, Ord, Show, Generic, FromJSON, ToJSON) - -instance Pretty OracleContracts where - pretty = viaShow - wallets :: [Wallet] wallets = [Wallet i | i <- [1 .. 5]] diff --git a/code/week06/app/swap-client.hs b/code/week06/app/swap-client.hs index fb42941..4967a68 100644 --- a/code/week06/app/swap-client.hs +++ b/code/week06/app/swap-client.hs @@ -1,6 +1,86 @@ +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + module Main ( main ) where +import Control.Concurrent +import Control.Monad (when) +import Control.Monad.IO.Class (MonadIO (..)) +import Data.Aeson (Result (..), fromJSON) +import Data.Monoid (Last (..)) +import Data.Proxy (Proxy (..)) +import Data.Text (pack) +import Data.UUID +import Ledger.Value (flattenValue) +import Network.HTTP.Req +import Plutus.PAB.Events.ContractInstanceState (PartiallyDecodedResponse (..)) +import Plutus.PAB.Webserver.Types +import System.Environment (getArgs) + +import Week06.Oracle.PAB (OracleContracts) + main :: IO () -main = putStrLn "oracle client" +main = do + [(i :: Int)] <- map read <$> getArgs + uuid <- read <$> readFile ('W' : show i ++ ".cid") + putStrLn $ "swap contract instance id for Wallet " ++ show i ++ ": " ++ show uuid + getFunds uuid + +getFunds :: UUID -> IO () +getFunds uuid = 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)) -> "fund: " ++ show (flattenValue f) + _ -> "error decoding state" + +{- + liftIO $ putStrLn $ if responseStatusCode v == 200 + then "updated oracle to " ++ show x + else "error updating oracle" +-} + +{- +updateOracle :: UUID -> Integer -> IO () +updateOracle uuid x = runReq defaultHttpConfig $ do + v <- req + POST + (http "127.0.0.1" /: "api" /: "new" /: "contract" /: "instance" /: pack (show uuid) /: "endpoint" /: "update") + (ReqBodyJson x) + (Proxy :: Proxy (JsonResponse ())) + (port 8080) + liftIO $ putStrLn $ if responseStatusCode v == 200 + then "updated oracle to " ++ show x + else "error updating oracle" + +getExchangeRate :: IO Integer +getExchangeRate = runReq defaultHttpConfig $ do + v <- req + GET + (https "coinmarketcap.com" /: "currencies" /: "cardano") + NoReqBody + bsResponse + mempty + let priceRegex = "priceValue___11gHJ\">\\$([\\.0-9]*)" :: ByteString + (_, _, _, [bs]) = responseBody v =~ priceRegex :: (ByteString, ByteString, ByteString, [ByteString]) + d = read $ unpack bs :: Double + x = round $ 1_000_000 * d + liftIO $ putStrLn $ "queried exchange rate: " ++ show d + return x +-} diff --git a/code/week06/plutus-pioneer-program-week06.cabal b/code/week06/plutus-pioneer-program-week06.cabal index dcb0fc0..4715e45 100644 --- a/code/week06/plutus-pioneer-program-week06.cabal +++ b/code/week06/plutus-pioneer-program-week06.cabal @@ -12,6 +12,7 @@ library hs-source-dirs: src exposed-modules: Week06.Oracle.Core Week06.Oracle.Funds + Week06.Oracle.PAB Week06.Oracle.Swap Week06.Oracle.Test build-depends: aeson @@ -26,6 +27,7 @@ library , plutus-tx-plugin , plutus-tx , plutus-use-cases + , prettyprinter , text default-language: Haskell2010 ghc-options: -Wall -fobject-code -fno-ignore-interface-pragmas -fno-omit-interface-pragmas -fno-strictness -fno-spec-constr -fno-specialise @@ -43,7 +45,6 @@ executable oracle-pab , plutus-pab , plutus-pioneer-program-week06 , plutus-use-cases - , prettyprinter , text executable oracle-client @@ -63,5 +64,9 @@ executable swap-client ghc-options: -Wall build-depends: aeson , base ^>= 4.14.1.0 + , plutus-ledger + , plutus-pab + , plutus-pioneer-program-week06 , req ^>= 3.9.0 + , text , uuid diff --git a/code/week06/src/Week06/Oracle/PAB.hs b/code/week06/src/Week06/Oracle/PAB.hs new file mode 100644 index 0000000..432d259 --- /dev/null +++ b/code/week06/src/Week06/Oracle/PAB.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} + +module Week06.Oracle.PAB + ( OracleContracts (..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Text.Prettyprint.Doc (Pretty (..), viaShow) +import GHC.Generics (Generic) +import Ledger + +import qualified Week06.Oracle.Core as Oracle + +data OracleContracts = Init | Oracle CurrencySymbol | Swap Oracle.Oracle + deriving (Eq, Ord, Show, Generic, FromJSON, ToJSON) + +instance Pretty OracleContracts where + pretty = viaShow