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

adding liquidity

Browse source
This commit is contained in:
Lars Brünjes 2021-06-09 15:51:57 +02:00
parent c77890da1f
commit 67f69605b7
No known key found for this signature in database
GPG key ID: B488B9045DC1A087
1 changed files with 20 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -11,14 +11,13 @@ import Control.Exception
import Control.Monad (forM_, when) import Control.Monad (forM_, when)
import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.IO.Class (MonadIO (..))
import Data.Aeson (Result (..), ToJSON, decode, fromJSON) import Data.Aeson (Result (..), ToJSON, decode, fromJSON)
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Lazy as LB import qualified Data.ByteString.Lazy as LB
import Data.Monoid (Last (..)) import Data.Monoid (Last (..))
import Data.Proxy (Proxy (..)) import Data.Proxy (Proxy (..))
import Data.String (IsString (..)) import Data.String (IsString (..))
import Data.Text (Text, pack) import Data.Text (Text, pack)
import Data.UUID hiding (fromString) import Data.UUID hiding (fromString)
import Ledger.Value (AssetClass (..), CurrencySymbol, Value, flattenValue, TokenName (unTokenName)) import Ledger.Value (AssetClass (..), CurrencySymbol, Value, flattenValue, TokenName)
import Network.HTTP.Req import Network.HTTP.Req
import qualified Plutus.Contracts.Uniswap as US import qualified Plutus.Contracts.Uniswap as US
import Plutus.PAB.Events.ContractInstanceState (PartiallyDecodedResponse (..)) import Plutus.PAB.Events.ContractInstanceState (PartiallyDecodedResponse (..))
@ -50,6 +49,7 @@ 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
Add amtA tnA amtB tnB -> addLiquidity cid $ toAddParams cs amtA tnA amtB tnB
Swap amtA tnA tnB -> swap cid $ toSwapParams cs amtA tnA tnB Swap amtA tnA tnB -> swap cid $ toSwapParams cs amtA tnA tnB
go cid cs go cid cs
@ -57,12 +57,13 @@ data Command =
Funds Funds
| Pools | Pools
| Create Integer Char Integer Char | Create Integer Char Integer Char
| Add Integer Char Integer Char
| Swap Integer Char Char | Swap Integer Char Char
deriving (Show, Read, Eq, Ord) deriving (Show, Read, Eq, Ord)
readCommandIO :: IO Command readCommandIO :: IO Command
readCommandIO = do readCommandIO = do
putStrLn "Enter a command: Funds, Pools, Create amtA tnA amtB tnB, Swap amtA tnA tnB" putStrLn "Enter a command: Funds, Pools, Create amtA tnA amtB tnB, Add amtA tnA amtB tnB, Swap amtA tnA tnB"
s <- getLine s <- getLine
maybe readCommandIO return $ readMaybe s maybe readCommandIO return $ readMaybe s
@ -72,6 +73,9 @@ 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 cs tnA) (toCoin cs 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)
toAddParams :: CurrencySymbol -> Integer -> Char -> Integer -> Char -> US.AddParams
toAddParams cs amtA tnA amtB tnB = US.AddParams (toCoin cs tnA) (toCoin cs tnB) (US.Amount amtA) (US.Amount amtB)
toSwapParams :: CurrencySymbol -> Integer -> Char -> Char -> US.SwapParams 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) toSwapParams cs amtA tnA tnB = US.SwapParams (toCoin cs tnA) (toCoin cs tnB) (US.Amount amtA) (US.Amount 0)
@ -131,6 +135,19 @@ createPool cid cp = do
Left err' -> putStrLn $ "error: " ++ show err' Left err' -> putStrLn $ "error: " ++ show err'
_ -> go _ -> go
addLiquidity :: UUID -> US.AddParams -> IO ()
addLiquidity cid ap = do
callEndpoint cid "add" ap
threadDelay 2_000_000
go
where
go = do
e <- getStatus cid
case e of
Right US.Added -> putStrLn "added"
Left err' -> putStrLn $ "error: " ++ show err'
_ -> go
swap :: UUID -> US.SwapParams -> IO () swap :: UUID -> US.SwapParams -> IO ()
swap cid sp = do swap cid sp = do
callEndpoint cid "swap" sp callEndpoint cid "swap" sp