mirror of
https://github.com/FiloSpaTeam/plutus-pioneer-program.git
synced 2024-09-21 17:27:56 +02:00
59 lines
1.8 KiB
Haskell
59 lines
1.8 KiB
Haskell
{-# 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
|