claudiomaradonna/plutus-pioneer-program
1
0
Fork 0
mirror of https://github.com/FiloSpaTeam/plutus-pioneer-program.git synced 2024-11-21 22:32:00 +01:00
Code Issues Projects Releases Packages Wiki Activity

getting pools

Browse source
This commit is contained in:
Lars Brünjes 2021-06-08 22:27:06 +02:00
parent d6524c0796
commit f09f5ddc4f
No known key found for this signature in database
GPG key ID: B488B9045DC1A087
1 changed files with 49 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

57
code/week10/app/uniswap-client.hs
View file

@ -18,7 +18,7 @@ import Data.Text (Text, pack)
import Data.UUID
import Ledger.Value (CurrencySymbol, flattenValue)
import Network.HTTP.Req
import Plutus.Contracts.Uniswap (Uniswap, UserContractState (..))
import qualified Plutus.Contracts.Uniswap as US
import Plutus.PAB.Events.ContractInstanceState (PartiallyDecodedResponse (..))
import Plutus.PAB.Webserver.Types
import System.Environment (getArgs)
@ -38,12 +38,27 @@ main = do
case (mus, mcs) of
(Just us, Just cs) -> do
putStrLn $ "cid: " ++ show cid
putStrLn $ "uniswap: " ++ show (us :: Uniswap)
putStrLn $ "uniswap: " ++ show (us :: US.Uniswap)
putStrLn $ "symbol: " ++ show (cs :: CurrencySymbol)
forever $ do
getFunds cid
threadDelay 1_000_000
go cid
_ -> putStrLn "invalid uniswap.json and/or symbol.json" >> exitFailure
where
go :: UUID -> IO a
go cid = do
cmd <- readCommandIO
case cmd of
Funds -> getFunds cid
Pools -> getPools cid
go cid
data Command = Funds | Pools
deriving (Show, Read, Eq, Ord)
readCommandIO :: IO Command
readCommandIO = do
putStrLn "Enter a command: Funds, Pools"
s <- getLine
maybe readCommandIO return $ readMaybe s
getFunds :: UUID -> IO ()
getFunds uuid = handle h $ runReq defaultHttpConfig $ do
@ -64,9 +79,35 @@ getFunds uuid = handle h $ runReq defaultHttpConfig $ do
(Proxy :: Proxy (JsonResponse (ContractInstanceClientState UniswapContracts)))
(port 8080)
liftIO $ putStrLn $ case fromJSON $ observableState $ cicCurrentState $ responseBody w of
Success (Last (Just (Right (Funds f)))) -> "funds: " ++ show (flattenValue f)
Success (Last (Just (Left e))) -> "error: " ++ show (e :: Text)
_ -> "error decoding state"
Success (Last (Just (Right (US.Funds f)))) -> "funds: " ++ show (flattenValue f)
Success (Last (Just (Left e))) -> "error: " ++ show (e :: Text)
_ -> "error decoding state"
where
h :: HttpException -> IO ()
h _ = threadDelay 1_000_000 >> getFunds uuid
getPools :: UUID -> IO ()
getPools uuid = handle h $ runReq defaultHttpConfig $ do
v <- req
POST
(http "127.0.0.1" /: "api" /: "new" /: "contract" /: "instance" /: pack (show uuid) /: "endpoint" /: "pools")
(ReqBodyJson ())
(Proxy :: Proxy (JsonResponse ()))
(port 8080)
if responseStatusCode v /= 200
then liftIO $ putStrLn "error getting funds"
else do
liftIO $ threadDelay 2_000_000
w <- req
GET
(http "127.0.0.1" /: "api" /: "new" /: "contract" /: "instance" /: pack (show uuid) /: "status")
NoReqBody
(Proxy :: Proxy (JsonResponse (ContractInstanceClientState UniswapContracts)))
(port 8080)
liftIO $ putStrLn $ case fromJSON $ observableState $ cicCurrentState $ responseBody w of
Success (Last (Just (Right (US.Pools ps)))) -> "pools: " ++ show ps
Success (Last (Just (Left e))) -> "error: " ++ show (e :: Text)
_ -> "error decoding state"
where
h :: HttpException -> IO ()
h _ = threadDelay 1_000_000 >> getFunds uuid