Merge pull request #85 from geniusyield/84-optional-stake-address

Feat #84: Feature to allow for stake credential to construct mangled …

cabal.project

@@ -64,8 +64,8 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/geniusyield/atlas
-  tag: 44b235ac4f4337dd2b2488b4f79f33a987f2be72
-  --sha256: sha256-EL7o0yYJIC8KvH0kZ9J0n+h/+w4GI4hCz39QyDA7Udg=
+  tag: be490dcc5b99d0ff10e9d7cd801c4e0ae3a4865a
+  --sha256: sha256-HxwD8p7eg1yMo3hVDtGduU9zOQobFPONKj+064fdjVU=
 
 source-repository-package
   type: git

geniusyield-dex-api/src/GeniusYield/DEX/Api/PartialOrderConfig.hs

@@ -15,7 +15,6 @@ module GeniusYield.DEX.Api.PartialOrderConfig
     , fetchPartialOrderConfig
     ) where
 
-import qualified Cardano.Api                as Api
 import           Data.Text                  (pack)
 import           Network.HTTP.Types         (status400)
 
@@ -29,7 +28,6 @@ import qualified PlutusLedgerApi.V1         as Plutus
 import           PlutusTx                   (BuiltinData,
                                              FromData (fromBuiltinData))
 import qualified PlutusTx
-import           PlutusTx.Builtins.Internal (BuiltinByteString (..))
 import           PlutusTx.Ratio             as PlutusTx (Rational)
 
 data PartialOrderConfigDatum = PartialOrderConfigDatum
@@ -113,14 +111,4 @@ fetchPartialOrderConfig addr nftToken = do
             (_, _, d') <- utxoDatumPure' p
             feeAddr    <- addressFromPlutus' $ pociFeeAddr d'
             pure (utxoRef utxo, feeAddr <$ d')
-        _                  -> throwAppError $ PocdException nftToken
-
-mintingPolicyIdFromCurrencySymbol :: Plutus.CurrencySymbol -> Either PlutusToCardanoError GYMintingPolicyId
-mintingPolicyIdFromCurrencySymbol cs =
-  let
-    BuiltinByteString bs = Plutus.unCurrencySymbol cs
-  in
-    case Api.deserialiseFromRawBytes Api.AsPolicyId bs of
-        Left e    -> Left $ DeserialiseRawBytesError $ pack $
-            "mintingPolicyIdFromCurrencySymbol: " <> show cs <> ", error: " <> show e
-        Right pid -> Right $ mintingPolicyIdFromApi pid
+        _                  -> throwAppError $ PocdException nftToken

geniusyield-orderbot-framework/src/GeniusYield/OrderBot.hs

@@ -72,6 +72,8 @@ import           GeniusYield.Transaction               (BuildTxException,
 data OrderBot = OrderBot
     { botSkey            :: !GYPaymentSigningKey
     -- ^ Signing key of the bot.
+    , botStakeAddress    :: !(Maybe GYStakeAddressBech32)
+    -- ^ Optional bech32 encoded stake address.
     , botCollateral      :: !(Maybe (GYTxOutRef, Bool))
     {- ^ UTxO ref of the collateral UTxO in the bot's wallet.
 
@@ -115,6 +117,7 @@ runOrderBot
     di
     OrderBot
     { botSkey
+    , botStakeAddress
     , botCollateral
     , botExecutionStrat = MultiAssetTraverse strat
     , botAssetPairFilter
@@ -127,8 +130,9 @@ runOrderBot
             logDebug = gyLogDebug providers "SOR"
 
             netId   = cfgNetworkId cfg
-            botPkh  = pubKeyHash $ paymentVerificationKey botSkey
-            botAddr = addressFromPubKeyHash netId botPkh
+            botPkh  = paymentKeyHash $ paymentVerificationKey botSkey
+            botChangeAddr = addressFromCredential netId (GYPaymentCredentialByKey botPkh) (stakeAddressToCredential . stakeAddressFromBech32 <$> botStakeAddress)
+            botAddrs = [botChangeAddr]
 
             por     = dexPORefs di
             dex     = mkDEX (dexNftPolicy di)
@@ -140,8 +144,9 @@ runOrderBot
         logInfo $ unlines
             [ ""
             , "Starting bot with given credentials"
-            , "  Public key hash: "       ++ show (pubKeyHashToPlutus botPkh)
-            , "  Address: "               ++ Txt.unpack (addressToText botAddr)
+            , "  Payment key hash: "      ++ show (paymentKeyHashToPlutus botPkh)
+            , "  Wallet Addresses: "      ++ show (Txt.unpack . addressToText <$> botAddrs)
+            , "  Change Address: "        ++ (Txt.unpack . addressToText $ botChangeAddr)
             , "  Collateral: "            ++ show botCollateral
             , "  Reference Script ref: "  ++ show (porValidatorRef por)
             , "  Reference Minting ref: " ++ show (porNftPolicyRef por)
@@ -194,14 +199,14 @@ runOrderBot
                                   ]
 
                 -- We first build all the tx Bodies from the matches
-                txs <- buildTransactions matchesToExecute di netId providers botAddr botCollateral
+                txs <- buildTransactions matchesToExecute di netId providers (botAddrs, botChangeAddr) botCollateral
 
                 logInfo $ unwords [ "Number Of Matches Built:"
                                   , show $ length txs
                                   ]
 
                 -- We filter the txs that are not losing tokens
-                profitableTxs <- filterM (notLosingTokensCheck netId providers botAddr botAssetPairFilter)
+                profitableTxs <- filterM (notLosingTokensCheck netId providers botAddrs botAssetPairFilter)
                                          txs
 
                 logInfo $ unwords [ "Transactions are losing money:"
@@ -248,15 +253,15 @@ buildTransactions
     -> DEXInfo
     -> GYNetworkId
     -> GYProviders
-    -> GYAddress
+    -> ([GYAddress], GYAddress)
     -> Maybe (GYTxOutRef, Bool)
     -> IO [(GYTxBody, MatchResult)]
 buildTransactions matchesToExecute di netId
-                  providers botAddr botCollateral = handle handlerBuildTx $ do
+                  providers (botAddrs, botChangeAddr) botCollateral = handle handlerBuildTx $ do
 
     res <- runGYTxMonadNodeParallelWithStrategy
                GYLegacy
-               netId providers [botAddr] botAddr
+               netId providers botAddrs botChangeAddr
                botCollateral $ traverse resultToSkeleton matchesToExecute
 
     case res of
@@ -288,11 +293,11 @@ buildTransactions matchesToExecute di netId
 notLosingTokensCheck
     :: GYNetworkId
     -> GYProviders
-    -> GYAddress
+    -> [GYAddress]
     -> [OrderAssetPair]
     -> (GYTxBody, MatchResult)
     -> IO Bool
-notLosingTokensCheck netId providers botAddr oapFilter (txBody, matchesToExecute) = do
+notLosingTokensCheck netId providers botAddrs oapFilter (txBody, matchesToExecute) = do
     let logDebug = gyLogDebug providers "SOR"
         logWarn  = gyLogWarning providers "SOR"
         matchesRefs = map matchExecutionInfoUtxoRef matchesToExecute
@@ -342,7 +347,7 @@ notLosingTokensCheck netId providers botAddr oapFilter (txBody, matchesToExecute
 
       utxosValueAtAddr :: GYUTxOs -> GYValue
       utxosValueAtAddr = mconcat . map utxoValue .
-                         filter ((== botAddr) . utxoAddress) . utxosToList
+                         filter ((`elem` botAddrs) . utxoAddress) . utxosToList
 
       utxosLovelaceAndFilteredValueAtAddr
           :: GYUTxOs

geniusyield-orderbot/src/Main.hs

@@ -9,18 +9,18 @@ Stability   : develop
 module Main ( main ) where
 
 import Control.Exception ( throwIO )
-import System.Environment (getArgs)
+import System.Environment ( getArgs )
 import GeniusYield.OrderBot ( runOrderBot )
 import OrderBotConfig ( readBotConfig, buildOrderBot, getDexInfo )
 
 parseArgs :: IO (String, FilePath, Maybe FilePath)
 parseArgs = do
     args <- getArgs
     case args of
-        [action, providerConfigFile,botConfigFile] -> return ( action
-                                                             , providerConfigFile
-                                                             , Just botConfigFile
-                                                             )
+        [action, providerConfigFile, botConfigFile] -> return ( action
+                                                              , providerConfigFile
+                                                              , Just botConfigFile
+                                                              )
         [action, providerConfigFile] -> return (action, providerConfigFile, Nothing)
         _ -> throwIO . userError $ unlines
              [ "Expected two or three command line arguments, in order:"

geniusyield-orderbot/src/OrderBotConfig.hs

@@ -54,6 +54,8 @@ data OrderBotConfig =
     OrderBotConfig
     { botCSkey                  :: Either FilePath GYPaymentSigningKey
     -- ^ Signing key of the bot.
+    , botCStakeAddress          :: Maybe GYStakeAddressBech32
+    -- ^ Optional bech32 encoded stake address.
     , botCCollateral            :: Maybe GYTxOutRef
     {- ^ UTxO ref of the collateral UTxO in the bot's wallet.
 
@@ -98,6 +100,7 @@ instance FromEnv OrderBotConfig where
     fromEnv _ =
         OrderBotConfig
         <$> (Right . parseCBORSKey <$> env "BOTC_SKEY")
+        <*> (fmap fromString <$> envMaybe "BOTC_STAKE_ADDRESS")
         <*> (fmap fromString <$> envMaybe "BOTC_COLLATERAL")
         <*> envWithMsg ("Invalid Strategy. Must be one of: " ++ show allStrategies) "BOTC_EXECUTION_STRAT"
         <*> (parseArray <$> env "BOTC_ASSET_FILTER")
@@ -133,6 +136,7 @@ envWithMsg msg name = maybe (throwError $ unwords ["Error parsing enviroment var
 instance FromJSON OrderBotConfig where
     parseJSON (Object obj) = OrderBotConfig
         <$> (Left <$> obj .: "signingKeyFP")
+        <*> obj .:? "stakeAddress"
         <*> obj .:? "collateral"
         <*> obj .: "strategy"
         <*> (parseScanTokenPairs =<< obj .: "scanTokens")
@@ -179,6 +183,7 @@ instance FromJSON PORConfig where
 buildOrderBot :: OrderBotConfig -> IO OrderBot
 buildOrderBot OrderBotConfig
     { botCSkey
+    , botCStakeAddress
     , botCCollateral
     , botCExecutionStrat
     , botCAssetFilter
@@ -196,6 +201,7 @@ buildOrderBot OrderBotConfig
         else throwIO $ userError "Can't have equivalent order asset pairs scanTokens"
     return $ OrderBot
         { botSkey            = skey
+        , botStakeAddress    = botCStakeAddress
         , botCollateral      = buildCollateral
         , botExecutionStrat  =
             MultiAssetTraverse $ mkIndependentStrategy botCExecutionStrat maxOrderMatch