oracle client

code/week06/app/oracle-client.hs

@@ -0,0 +1,59 @@
+{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE OverloadedStrings  #-}
+
+module Main
+    ( main
+    ) where
+
+import Control.Concurrent
+import Control.Monad          (when)
+import Control.Monad.IO.Class (MonadIO (..))
+import Data.ByteString        (ByteString)
+import Data.ByteString.Char8  (unpack)
+import Data.Proxy             (Proxy (..))
+import Data.Text              (pack)
+import Data.UUID
+import Network.HTTP.Req
+import Text.Regex.TDFA
+
+main :: IO ()
+main = do
+    uuid <- read <$> readFile "oracle.cid"
+    putStrLn $ "oracle contract instance id: " ++ show uuid
+    go uuid Nothing
+  where
+    go :: UUID -> Maybe Integer -> IO a
+    go uuid m = do
+        x <- getExchangeRate
+        let y = Just x
+        when (m /= y) $
+            updateOracle uuid x
+        threadDelay 5_000_000
+        go uuid y
+
+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/app/swap-client.hs

@@ -0,0 +1,6 @@
+module Main
+    ( main
+    ) where
+
+main :: IO ()
+main = putStrLn "oracle client"

code/week06/hie.yaml

@@ -2,5 +2,9 @@ cradle:
   cabal:
     - path: "./src"
       component: "lib:plutus-pioneer-program-week06"
-    - path: "./app/oracle.hs"
-      component: "exe:oracle"
+    - path: "./app/oracle-pab.hs"
+      component: "exe:oracle-pab"
+    - path: "./app/oracle-client.hs"
+      component: "exe:oracle-client"
+    - path: "./app/swap-client.hs"
+      component: "exe:swap-client"

code/week06/plutus-pioneer-program-week06.cabal

@@ -30,8 +30,8 @@ library
   default-language:    Haskell2010
   ghc-options:         -Wall -fobject-code -fno-ignore-interface-pragmas -fno-omit-interface-pragmas -fno-strictness -fno-spec-constr -fno-specialise
 
-executable oracle
-  main-is: oracle.hs
+executable oracle-pab
+  main-is: oracle-pab.hs
   hs-source-dirs:      app
   ghc-options:         -Wall -threaded
   build-depends:       aeson
@@ -45,3 +45,25 @@ executable oracle
                      , plutus-use-cases
                      , prettyprinter
                      , text
+
+executable oracle-client
+  main-is: oracle-client.hs
+  hs-source-dirs:      app
+  ghc-options:         -Wall
+  build-depends:       aeson
+                     , base ^>= 4.14.1.0
+                     , bytestring
+                     , modern-uri
+                     , regex-tdfa ^>= 1.3.1.0
+                     , req ^>= 3.9.0
+                     , text
+                     , uuid
+
+executable swap-client
+  main-is: swap-client.hs
+  hs-source-dirs:      app
+  ghc-options:         -Wall
+  build-depends:       aeson
+                     , base ^>= 4.14.1.0
+                     , req ^>= 3.9.0
+                     , uuid