add compile code for uniswap pools to be built and submitted to alonz…

…o node
IntersectMBO · Oct 12, 2021 · 009a014 · 009a014
1 parent 23c674d
commit 009a014
Show file tree

Hide file tree

Showing 3 changed files with 53 additions and 14 deletions.
diff --git a/plutus-use-cases/src/Plutus/Contracts/UniPools.hs b/plutus-use-cases/src/Plutus/Contracts/UniPools.hs
@@ -3,17 +3,21 @@
 module Plutus.Contracts.UniPools where
 
 import           Cardano.Api
+import           Cardano.Api.Shelley
+import qualified Data.Aeson                        as Aeson
+import qualified Data.ByteString.Lazy              as LBS
 import           Ledger
 import           Plutus.Contracts.Currency
 import           Plutus.Contracts.Uniswap.OffChain
 import           Plutus.Contracts.Uniswap.Pool
 import           Plutus.Contracts.Uniswap.Types
+import           PlutusTx
 
 main :: Integer -> Integer -> Ledger.TxId -> Integer -> [(TokenName, Integer)] -> IO ()
 main amountA amountB txHash txIndex tokenList = do
   let adaCoin = mkCoin "" ""
       pikaCoin = mkCoin "e41bbd4c8c419c825945d05499ba41cc53181b44b8ac056d24dbdb42" "PikaCoin"
-      us = Uniswap $ mkCoin "258208e5d61b5a0675062a08cd13adcf47e337547a9afe8cdfc06f0e" "Uniswap"
+      us = Uniswap $ mkCoin "b3ac23c200b650f3a5780c9facbd185518a4cd8eb9dca7df08c6f348" "Uniswap"
   let cp = CreateParams {
               cpCoinA = adaCoin
             , cpCoinB = pikaCoin
@@ -32,6 +36,8 @@ main amountA amountB txHash txIndex tokenList = do
       usDat1   = Factory $ lp:lps
       usDat2   = Pool lp liquidity
       psC      = poolStateCoin us
+      lPolicy    = liquidityPolicy us
+      lPolicyScript = toCardanoApiScript $ getMintingPolicy lPolicy
       lC       = mkCoin (liquidityCurrency us) $ lpTicker lp
       usVal    = unitValue $ usCoin us
       lpVal    = valueOf (cpCoinA cp) (cpAmountA cp)
@@ -43,19 +49,49 @@ main amountA amountB txHash txIndex tokenList = do
       pol = curPolicy c
       uniPoolsPolicyScript = toCardanoApiScript $ getMintingPolicy pol
   print pikaCoin
-  mPolicy <- writeFileTextEnvelope "uniPools.plutus" Nothing uniPoolsPolicyScript
-  print "uniPools.plutus written..."
+
+  _ <- writeFileTextEnvelope "uniPools.plutus" Nothing uniPoolsPolicyScript
+
+  let uniswapPlutusScript = toCardanoApiScript $ getValidator $ uniswapScript us
+  _ <- writeFileTextEnvelope "unipool/recover-uniswapPlutusScript.plutus" Nothing uniswapPlutusScript
+
   print lp
   writeFile "unipool/liquidityPool" $ show lp
+
   print usDat1
-  writeFile "unipool/factory" $ show usDat1
+  writeFile "unipool/factoryDatum.hash" $ show $ DatumHash $ dataHash $ toBuiltinData $ usDat1
+  let factoryScriptDataFromDatum = fromPlutusData $ builtinDataToData $ toBuiltinData usDat1
+      factoryScriptDataJson = scriptDataToJson ScriptDataJsonDetailedSchema factoryScriptDataFromDatum
+  LBS.writeFile "./unipool/factoryDatum.plutus" $ Aeson.encode factoryScriptDataJson
+
+  print usDat2
+  _ <- writeFile "unipool/poolDatum.hash" $ show $ DatumHash $ dataHash $ toBuiltinData $ usDat2
+  let poolScriptDataFromDatum = fromPlutusData $ builtinDataToData $ toBuiltinData usDat2
+      poolScriptDataJson = scriptDataToJson ScriptDataJsonDetailedSchema poolScriptDataFromDatum
+  LBS.writeFile "./unipool/poolDatum.plutus" $ Aeson.encode poolScriptDataJson
+
+  let poolScriptDataFromDatum' = fromPlutusData $ builtinDataToData $ toBuiltinData $ Factory []
+      poolScriptDataJson' = scriptDataToJson ScriptDataJsonDetailedSchema poolScriptDataFromDatum'
+  LBS.writeFile "./unipool/poolDatum.empty.plutus" $ Aeson.encode poolScriptDataJson'
+
   print psC
   writeFile "unipool/poolStateCoin" $ show psC
+
+  print lPolicyScript
+  _ <- writeFileTextEnvelope "unipool/liquidityCurrencyPolicy.plutus" Nothing lPolicyScript
+
+  let redeemerUniswapAction :: UniswapAction
+      redeemerUniswapAction = Create $ LiquidityPool pikaCoin adaCoin
+  let redeemerCoder = fromPlutusData $ builtinDataToData $ toBuiltinData redeemerUniswapAction
+      redeemerJson = scriptDataToJson ScriptDataJsonDetailedSchema redeemerCoder
+  LBS.writeFile "./unipool/unipool-redeemer" $ Aeson.encode redeemerJson
+
   -- TODO: Verify if the following information will not be needed for the buildPool.sh script
   print usInst
   print usScript
-  print usDat2
-  print lC
   print usVal
   print lpVal
+  print liquidity
+  print lC
+  print us
 
diff --git a/plutus-use-cases/src/Plutus/Contracts/Uniswap/OffChain.hs b/plutus-use-cases/src/Plutus/Contracts/Uniswap/OffChain.hs
@@ -28,7 +28,7 @@ module Plutus.Contracts.Uniswap.OffChain
     , start, create, add, remove, close, swap, pools
     , ownerEndpoint, userEndpoints
     , uniswapScript, uniswap, uniswapInstance
-    , poolStateCoin, liquidityCurrency
+    , poolStateCoin, liquidityCurrency, liquidityPolicy
     ) where
 
 import           Control.Lens                     (view)
@@ -86,7 +86,7 @@ data UserContractState =
 
 uniswapTokenName, poolStateTokenName :: TokenName
 uniswapTokenName = "Uniswap"
-poolStateTokenName = "Pool State"
+poolStateTokenName = "PoolState"
 
 uniswapInstance :: Uniswap -> Scripts.TypedValidator Uniswapping
 uniswapInstance us = Scripts.mkTypedValidator @Uniswapping

diff --git a/plutus-use-cases/src/Plutus/Contracts/Uniswap/Pool.hs b/plutus-use-cases/src/Plutus/Contracts/Uniswap/Pool.hs
@@ -93,16 +93,19 @@ checkSwap oldA' oldB' newA' newB' =
 -- tokens it exchanges. This should be such that looking for a pool exchanging
 -- any two tokens always yields a unique name.
 lpTicker :: LiquidityPool -> TokenName
-lpTicker LiquidityPool{..}  = TokenName hash
+lpTicker LiquidityPool{..}  =
+  -- TODO: Ensure this is unique according to their currency symbols
+  TokenName $ unTokenName y1 <> unTokenName y2 <> unTokenName y1 <> unTokenName y2
+
     where
       cA@(csA, tokA) = unAssetClass (unCoin lpCoinA)
       cB@(csB, tokB) = unAssetClass (unCoin lpCoinB)
       ((x1, y1), (x2, y2))
         | cA < cB   = ((csA, tokA), (csB, tokB))
         | otherwise = ((csB, tokB), (csA, tokA))
 
-      h1   = sha2_256 $ unTokenName y1
-      h2   = sha2_256 $ unTokenName y2
-      h3   = sha2_256 $ unCurrencySymbol x1
-      h4   = sha2_256 $ unCurrencySymbol x2
-      hash = sha2_256 $ h1 <> h2 <> h3 <> h4
+--       h1   = sha2_256 $ unTokenName y1
+--       h2   = sha2_256 $ unTokenName y2
+--       h3   = sha2_256 $ unCurrencySymbol x1
+--       h4   = sha2_256 $ unCurrencySymbol x2
+--       hash = sha2_256 $ h1 <> h2 <> h3 <> h4