mirror of
https://github.com/FiloSpaTeam/plutus-pioneer-program.git
synced 2024-11-15 03:12:34 +01:00
123 lines
4.3 KiB
Haskell
123 lines
4.3 KiB
Haskell
{-# LANGUAGE NumericUnderscores #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
|
|
module Main
|
|
( main
|
|
) where
|
|
|
|
import Control.Concurrent
|
|
import Control.Exception
|
|
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 System.IO
|
|
import Text.Read (readMaybe)
|
|
|
|
import Week06.Oracle.PAB (OracleContracts)
|
|
|
|
main :: IO ()
|
|
main = do
|
|
[i :: Int] <- map read <$> getArgs
|
|
uuid <- read <$> readFile ('W' : show i ++ ".cid")
|
|
hSetBuffering stdout NoBuffering
|
|
putStrLn $ "swap contract instance id for Wallet " ++ show i ++ ": " ++ show uuid
|
|
go uuid
|
|
where
|
|
go :: UUID -> IO a
|
|
go uuid = do
|
|
cmd <- readCommand
|
|
case cmd of
|
|
Offer amt -> offer uuid amt
|
|
Retrieve -> retrieve uuid
|
|
Use -> use uuid
|
|
Funds -> getFunds uuid
|
|
go uuid
|
|
|
|
readCommand :: IO Command
|
|
readCommand = do
|
|
putStr "enter command (Offer amt, Retrieve or Use): "
|
|
s <- getLine
|
|
maybe readCommand return $ readMaybe s
|
|
|
|
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
|
|
POST
|
|
(http "127.0.0.1" /: "api" /: "new" /: "contract" /: "instance" /: pack (show uuid) /: "endpoint" /: "offer")
|
|
(ReqBodyJson amt)
|
|
(Proxy :: Proxy (JsonResponse ()))
|
|
(port 8080)
|
|
liftIO $ putStrLn $ if responseStatusCode v == 200
|
|
then "offered swap of " ++ show amt ++ " lovelace"
|
|
else "error offering swap"
|
|
where
|
|
h :: HttpException -> IO ()
|
|
h _ = threadDelay 1_000_000 >> offer uuid amt
|
|
|
|
retrieve :: UUID -> IO ()
|
|
retrieve uuid = handle h $ runReq defaultHttpConfig $ do
|
|
v <- req
|
|
POST
|
|
(http "127.0.0.1" /: "api" /: "new" /: "contract" /: "instance" /: pack (show uuid) /: "endpoint" /: "retrieve")
|
|
(ReqBodyJson ())
|
|
(Proxy :: Proxy (JsonResponse ()))
|
|
(port 8080)
|
|
liftIO $ putStrLn $ if responseStatusCode v == 200
|
|
then "retrieved swaps"
|
|
else "error retrieving swaps"
|
|
where
|
|
h :: HttpException -> IO ()
|
|
h _ = threadDelay 1_000_000 >> retrieve uuid
|
|
|
|
use :: UUID -> IO ()
|
|
use uuid = handle h $ runReq defaultHttpConfig $ do
|
|
v <- req
|
|
POST
|
|
(http "127.0.0.1" /: "api" /: "new" /: "contract" /: "instance" /: pack (show uuid) /: "endpoint" /: "use")
|
|
(ReqBodyJson ())
|
|
(Proxy :: Proxy (JsonResponse ()))
|
|
(port 8080)
|
|
liftIO $ putStrLn $ if responseStatusCode v == 200
|
|
then "used swap"
|
|
else "error using swap"
|
|
where
|
|
h :: HttpException -> IO ()
|
|
h _ = threadDelay 1_000_000 >> use uuid
|
|
|
|
|