querying funds

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

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
+-}

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

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