deal with new tx workflow

lib/core-integration/src/Test/Integration/Scenario/API/Shelley/TransactionsNew.hs

@@ -214,8 +214,6 @@ import qualified Data.Text.Encoding as T
 import qualified Network.HTTP.Types.Status as HTTP
 import qualified Test.Integration.Plutus as PlutusScenario
 
-import qualified Debug.Trace as TR
-
 
 spec :: forall n.
     ( DecodeAddress n
@@ -2396,7 +2394,7 @@ spec = describe "NEW_SHELLEY_TRANSACTIONS" $ do
             }|]
         rTx4 <- request @(ApiConstructTransaction n) ctx
             (Link.createUnsignedTransaction @'Shelley src) Default delegationQuit
-        TR.trace ("\n!!!!QUIT!!!\n") $ verify rTx4
+        verify rTx4
             [ expectResponseCode HTTP.status202
             , expectField (#coinSelection . #depositsTaken) (`shouldBe` [])
             , expectField (#coinSelection . #depositsReturned) (`shouldBe` [depositAmt])
@@ -2425,7 +2423,7 @@ spec = describe "NEW_SHELLEY_TRANSACTIONS" $ do
         let txid3 = getFromResponse (#id) submittedTx4
         let queryTx3 = Link.getTransaction @'Shelley src (ApiTxId txid3)
         rGetTx3 <- request @(ApiTransaction n) ctx queryTx3 Default Empty
-        TR.trace ("\n!!!!Sumbited!!!!\n") $ verify rGetTx3
+        verify rGetTx3
             [ expectResponseCode HTTP.status200
             , expectField #depositTaken (`shouldBe` Quantity 0)
             , expectField #depositReturned (`shouldBe` depositAmt)
@@ -2439,7 +2437,7 @@ spec = describe "NEW_SHELLEY_TRANSACTIONS" $ do
 
         -- transaction history shows deposit returned
         rGetTx4 <- request @(ApiTransaction n) ctx queryTx3 Default Empty
-        TR.trace ("\n!!!!In ledger!!!!\n") $ verify rGetTx4
+        verify rGetTx4
             [ expectResponseCode HTTP.status200
             , expectField #depositTaken (`shouldBe` Quantity 0)
             , expectField #depositReturned (`shouldBe` depositAmt)

lib/core/src/Cardano/Wallet.hs

@@ -540,6 +540,8 @@ import Safe
     ( lastMay )
 import Statistics.Quantile
     ( medianUnbiased, quantiles )
+import Text.Pretty.Simple
+    ( pShow )
 import Type.Reflection
     ( Typeable, typeRep )
 import UnliftIO.Exception
@@ -568,8 +570,7 @@ import qualified Data.List.NonEmpty as NE
 import qualified Data.Set as Set
 import qualified Data.Text as T
 import qualified Data.Vector as V
-import Text.Pretty.Simple
-    ( pShow )
+
 
 -- $Development
 -- __Naming Conventions__
@@ -2142,9 +2143,13 @@ mkTxMetaWithoutSel blockHeader wState txCtx inps outs =
                 w@WithdrawalSelf{} -> Coin.add (withdrawalToCoin w)
                 WithdrawalExternal{} -> Prelude.id
                 NoWithdrawal -> Prelude.id
+        dir = if (txCtx ^. #txDelegationAction) == Just Quit then
+                   Incoming
+              else
+                   Outgoing
     in return TxMeta
        { status = Pending
-       , direction = Outgoing
+       , direction = dir
        , slotNo = blockHeader ^. #slotNo
        , blockHeight = blockHeader ^. #blockHeight
        , amount = Coin.distance amtInps amtOuts
@@ -3082,6 +3087,7 @@ data ErrSubmitTransaction
     = ErrSubmitTransactionNoSuchWallet ErrNoSuchWallet
     | ErrSubmitTransactionForeignWallet
     | ErrSubmitTransactionPartiallySignedOrNoSignedTx Int Int
+    | ErrSubmitTransactionMultidelegationNotSupported
     deriving (Show, Eq)
 
 -- | Errors that can occur when constructing an unsigned transaction.

lib/core/src/Cardano/Wallet/Api/Server.hs

@@ -632,8 +632,6 @@ import qualified Data.Text.Encoding as T
 import qualified Network.Wai.Handler.Warp as Warp
 import qualified Network.Wai.Handler.WarpTLS as Warp
 
-import qualified Debug.Trace as TR
-
 -- | How the server should listen for incoming requests.
 data Listen
     = ListenOnPort Port
@@ -2425,6 +2423,17 @@ submitTransaction ctx apiw@(ApiT wid) apitx@(ApiSerialisedTransaction (ApiT seal
     let ourOuts = getOurOuts apiDecoded
     let ourInps = getOurInps apiDecoded
 
+    let ourDel =
+            filter isJust $
+            map isJoiningOrQuitting $ apiDecoded ^. #certificates
+    when (length ourDel > 1) $
+        liftHandler $ throwE ErrSubmitTransactionMultidelegationNotSupported
+
+    let delAction = case ourDel of
+            [Just del] -> Just del
+            [] -> Nothing
+            _ -> error "impossible to be here due to check above"
+
     let allInpsNum = length $ apiDecoded ^. #inputs
     let witsNum = length $ getSealedTxWitnesses sealedTx
     when (allInpsNum > witsNum) $
@@ -2437,10 +2446,16 @@ submitTransaction ctx apiw@(ApiT wid) apitx@(ApiSerialisedTransaction (ApiT seal
         let txCtx = defaultTransactionCtx
                 { txTimeToLive = ttl
                 , txWithdrawal = wdrl
+                , txDelegationAction = delAction
                 }
         txMeta <- liftHandler $ W.constructTxMeta @_ @s @k wrk wid txCtx ourInps ourOuts
+        let txMeta' =
+                if (txCtx ^. #txDelegationAction) == Just Quit then
+                    txMeta & #direction .~ W.Incoming
+                else
+                    txMeta
         liftHandler
-            $ W.submitTx @_ @s @k wrk wid (tx, txMeta, sealedTx)
+            $ W.submitTx @_ @s @k wrk wid (tx, txMeta', sealedTx)
     return $ ApiTxId (apiDecoded ^. #id)
   where
     (tx,_,_,_) = decodeTx tl sealedTx
@@ -2487,6 +2502,15 @@ submitTransaction ctx apiw@(ApiT wid) apitx@(ApiSerialisedTransaction (ApiT seal
             all isInpForeign generalInps &&
             all isWdrlForeign generalWdrls
 
+    isJoiningOrQuitting = \case
+        WalletDelegationCertificate (JoinPool _ (ApiT poolId)) ->
+            Just $ Join poolId
+        WalletDelegationCertificate (QuitPool _) ->
+            Just Quit
+        _ ->
+            Nothing
+
+
 joinStakePool
     :: forall ctx s n k.
         ( ctx ~ ApiLayer s k
@@ -3365,7 +3389,7 @@ mkApiTransaction timeInterpreter setTimeReference tx = do
         (natural (tx ^. (#txMeta . #blockHeight)))
 
     expRef <- traverse makeApiSlotReference' (tx ^. (#txMeta . #expiry))
-    TR.trace ("tx:"<> show tx) $ return $ apiTx & setTimeReference .~ Just timeRef & #expiresAt .~ expRef
+    return $ apiTx & setTimeReference .~ Just timeRef & #expiresAt .~ expRef
   where
     -- Since tx expiry can be far in the future, we use unsafeExtendSafeZone for
     -- now.
@@ -4029,6 +4053,12 @@ instance IsServerError ErrSubmitTransaction where
                 , " inputs and ", toText foundWitsNo, " witnesses included."
                 , " Submit fully-signed transaction."
                 ]
+        ErrSubmitTransactionMultidelegationNotSupported ->
+            apiError err403 CreatedMultidelegationTransaction $ mconcat
+            [ "It looks like the transaction to be sent contains"
+            , "multiple delegations, which is not supported at this moment."
+            , "Please use at most one delegation action in a submitted transaction: join, quit or none."
+            ]
 
 instance IsServerError ErrSubmitTx where
     toServerError = \case