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

implemented swap

Browse source
This commit is contained in:
Lars Brünjes 2021-06-09 13:54:29 +02:00
parent 1012f99d4a
commit 24e3596598
No known key found for this signature in database
GPG key ID: B488B9045DC1A087
1 changed files with 24 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -48,12 +48,14 @@ main = do
Funds -> getFunds cid
Pools -> getPools cid
Create amtA tnA amtB tnB -> createPool cid $ toCreateParams cs amtA tnA amtB tnB
Swap amtA tnA tnB -> swap cid $ toSwapParams cs amtA tnA tnB
go cid cs
data Command =
Funds
| Pools
| Create Integer Char Integer Char
| Swap Integer Char Char
deriving (Show, Read, Eq, Ord)
readCommandIO :: IO Command
@ -62,11 +64,14 @@ readCommandIO = do
s <- getLine
maybe readCommandIO return $ readMaybe s
toCoin :: CurrencySymbol -> Char -> US.Coin c
toCoin cs tn = US.Coin $ AssetClass (cs, fromString [tn])
toCreateParams :: CurrencySymbol -> Integer -> Char -> Integer -> Char -> US.CreateParams
toCreateParams cs amtA tnA amtB tnB = US.CreateParams (toCoin tnA) (toCoin tnB) (US.Amount amtA) (US.Amount amtB)
where
toCoin :: Char -> US.Coin c
toCoin tn = US.Coin $ AssetClass (cs, fromString [tn])
toCreateParams cs amtA tnA amtB tnB = US.CreateParams (toCoin cs tnA) (toCoin cs tnB) (US.Amount amtA) (US.Amount amtB)
toSwapParams :: CurrencySymbol -> Integer -> Char -> Char -> US.SwapParams
toSwapParams cs amtA tnA tnB = US.SwapParams (toCoin cs tnA) (toCoin cs tnB) (US.Amount amtA) (US.Amount 0)
getFunds :: UUID -> IO ()
getFunds cid = do
@ -93,8 +98,8 @@ getPools cid = do
_ -> go
createPool :: UUID -> US.CreateParams -> IO ()
createPool cid cps = do
callEndpoint cid "create" cps
createPool cid cp = do
callEndpoint cid "create" cp
threadDelay 2_000_000
go
where
@ -105,6 +110,19 @@ createPool cid cps = do
Left err' -> putStrLn $ "error: " ++ show err'
_ -> go
swap :: UUID -> US.SwapParams -> IO ()
swap cid sp = do
callEndpoint cid "swap" sp
threadDelay 2_000_000
go
where
go = do
e <- getStatus cid
case e of
Right US.Swapped -> putStrLn "swapped"
Left err' -> putStrLn $ "error: " ++ show err'
_ -> go
getStatus :: UUID -> IO (Either Text US.UserContractState)
getStatus cid = runReq defaultHttpConfig $ do
w <- req