implemented swap

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

View file

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