tweak

lib/core-integration/src/Test/Integration/Framework/Request.hs

@@ -62,6 +62,8 @@ import Test.Integration.Framework.Context
 import UnliftIO.Exception
     ( Exception (..), fromEither, handle, throwIO )
 
+import qualified Data.ByteString.Char8 as B8
+import qualified Data.ByteString.Lazy as BL
 import qualified Data.Text as T
 import qualified Network.HTTP.Client as HTTP
 import qualified Network.HTTP.Types.Status as HTTP
@@ -122,7 +124,7 @@ request = baseRequest defaultHeaders handleResponse
             | statusIsSuccessful status = decodeBody
             | otherwise = decodeErrorBody
 
-        decodeBody = first errDecode . eitherDecode
+        decodeBody = first (errDecode . const (B8.unpack $ BL.toStrict body)) . eitherDecode
 
         -- decode API error responses into ClientError
         decodeErrorBody = Left . either errDecode ClientError . eitherDecode

lib/core/src/Cardano/Wallet.hs

@@ -1419,6 +1419,7 @@ instance Buildable PartialTx where
         cardanoTxF :: Cardano.InAnyCardanoEra Cardano.Tx -> Builder
         cardanoTxF (Cardano.InAnyCardanoEra _ tx') = pretty $ pShow tx'
 
+-- NOTE: Might make better sense in the Cardano.Wallet.Shelley.Transaction?
 balanceTransaction
     :: forall m s k ctx.
         ( HasTransactionLayer k ctx
@@ -1533,7 +1534,7 @@ balanceTransaction
         valToCoin Nothing = Left $ ErrBalanceTxUpdateError ErrByronTxNotSupported
 
     surplus <- ExceptT $ pure $ valToCoin $ evaluateTransactionBalance tl candidateTx' nodePParams
-            (UTxOIndex.toUTxO internalUtxoAvailable <> resolvedInputsUTxO ptx)
+            (UTxOIndex.toUTxO internalUtxoAvailable) (view #inputs ptx)
 
     when (surplus > Coin 0 && null extraOutputs) $
         throwE $ ErrBalanceTxNotYetSupported NoChangeNeeded
@@ -1558,24 +1559,16 @@ balanceTransaction
                 evaluateMinimumFee tl nodePParams partialTx
         let update = TxUpdate [] [] [] (UseNewTxFee minfee)
         tx' <- left ErrBalanceTxUpdateError $ updateTx tl tx update
-        let u = (UTxOIndex.toUTxO internalUtxoAvailable <> resolvedInputsUTxO ptx)
 -- FIXME
 --        unless (UTxOIndex.toUTxO internalUtxoAvailable `UTxO.disjoint` u) $
 --            Left ErrBalanceTxOverlappingInputResolution
-        let Just balance = evaluateTransactionBalance tl tx' nodePParams u
+--      FIXME: Just
+        let Just balance = evaluateTransactionBalance tl tx' nodePParams
+                (UTxOIndex.toUTxO internalUtxoAvailable)
+                (view #inputs ptx)
         let minfee' = Cardano.Lovelace $ fromIntegral $ unCoin minfee
         return (balance, minfee')
 
-    resolvedInputsUTxO
-        :: PartialTx
-        -> UTxO
-    resolvedInputsUTxO (PartialTx _ resolvedInputs _) =
-        UTxO $ Map.fromList $ map dropDatumHash resolvedInputs
-      where
-        dropDatumHash (i, o, Nothing) = (i, o)
-        dropDatumHash (_, _, Just _) =
-            error "resolvedInputsUTxO: todo: handle datum hash"
-
     assembleTransaction
         :: TxUpdate
         -> ExceptT ErrBalanceTx m SealedTx

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

@@ -3892,10 +3892,18 @@ instance IsServerError ErrBalanceTx where
             apiError err500 CreatedInvalidTransaction $ mconcat
                 [ "The transaction contains one or more zero ada outputs."
                 ]
+        ErrBalanceTxNotYetSupported NoChangeNeeded ->
+            apiError err500 CreatedInvalidTransaction $ mconcat
+                [ "TODO: No change needed - increase fee"
+                ]
         ErrBalanceTxNotYetSupported Deposits ->
             apiError err500 CreatedInvalidTransaction $ mconcat
                 [ "Deposits/refunds are not yet supported for balancing."
                 ]
+        ErrBalanceTxOverlappingInputResolution ->
+            apiError err403 CreatedInvalidTransaction $ mconcat
+                [ "Input resolution overlaps with wallet UTxO"
+                ] -- TODO: Some overlap needs to be allowed!
         ErrBalanceTxNotYetSupported (UnderestimatedFee _ _) ->
             apiError err500 CreatedInvalidTransaction $ mconcat
                 [ "What was supposed to be an initial overestimation of fees "

lib/core/src/Cardano/Wallet/Transaction.hs

@@ -191,8 +191,9 @@ data TransactionLayer k tx = TransactionLayer
     , evaluateTransactionBalance
         :: SealedTx
         -> Node.ProtocolParameters
-        -> UTxO -- NOTE: The Wallet UTxO type cannot represent datum hashes.
-            -- This is actually important and will need a workaround.
+        -> UTxO
+        -> [(TxIn, TxOut, Maybe (Hash "Datum"))]
+        -- ^ Extra UTxO
         -> Maybe Node.Value
         -- ^ Evaluate the balance of a transaction using the ledger. A valid
         -- transaction must be balanced.

lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs

@@ -111,6 +111,8 @@ import Cardano.Wallet.Primitive.Types.Coin
     ( Coin (..) )
 import Cardano.Wallet.Primitive.Types.Hash
     ( Hash )
+import Cardano.Wallet.Primitive.Types.Hash
+    ( Hash (..) )
 import Cardano.Wallet.Primitive.Types.Redeemer
     ( Redeemer, redeemerData )
 import Cardano.Wallet.Primitive.Types.TokenBundle
@@ -200,7 +202,7 @@ import Data.Kind
 import Data.Map.Strict
     ( Map, (!) )
 import Data.Maybe
-    ( mapMaybe )
+    ( fromMaybe, mapMaybe )
 import Data.Quantity
     ( Quantity (..) )
 import Data.Set
@@ -214,6 +216,8 @@ import GHC.Generics
 import Ouroboros.Network.Block
     ( SlotNo )
 
+import qualified Debug.Trace as Tr
+
 import qualified Cardano.Api as Cardano
 import qualified Cardano.Api.Byron as Byron
 import qualified Cardano.Api.Shelley as Cardano
@@ -574,21 +578,51 @@ _decodeSealedTx :: SealedTx -> (Tx, TokenMap, TokenMap, [Certificate])
 _decodeSealedTx (cardanoTx -> InAnyCardanoEra _era tx) = fromCardanoTx tx
 
 _evaluateTransactionBalance
-    :: SealedTx -> Cardano.ProtocolParameters -> UTxO -> Maybe Cardano.Value
-_evaluateTransactionBalance tx pp utxo = do
+    :: SealedTx
+    -> Cardano.ProtocolParameters
+    -> UTxO
+    -> [(TxIn, TxOut, Maybe (Hash "Datum"))]
+    -> Maybe Cardano.Value
+_evaluateTransactionBalance tx pp utxo extraUTxO = do
     shelleyTx <- inAnyShelleyBasedEra $ cardanoTx tx
     pure $ withShelleyBasedBody shelleyTx $ \era bod ->
         let
-            utxo' =  Cardano.UTxO
-                . Map.fromList
+            utxo' = Map.fromList
                 . map (bimap toCardanoTxIn (toCardanoTxOut era))
                 . Map.toList
                 $ unUTxO utxo
 
+            extraUTxO' = Map.fromList
+                . map (\(i, o, mDatumHash) ->
+                    (toCardanoTxIn i, setDatumHash era mDatumHash (toCardanoTxOut era o))
+                    )
+                $ extraUTxO
+
         in
             lovelaceFromCardanoTxOutValue
-                $ Cardano.evaluateTransactionBalance pp mempty utxo' bod
+                $ Cardano.evaluateTransactionBalance
+                    pp
+                    mempty
+                    (Cardano.UTxO $ utxo' <> extraUTxO')
+                    -- NOTE: We don't want the keys to overlap! Unclear how to
+                    -- address.
+                    bod
   where
+    setDatumHash :: ShelleyBasedEra era -> Maybe (Hash "Datum") -> Cardano.TxOut ctx era -> Cardano.TxOut ctx era
+    setDatumHash _era Nothing o = o
+    setDatumHash era (Just (Hash datumHash)) (Cardano.TxOut addr val _) =
+        Cardano.TxOut addr val (Cardano.TxOutDatumHash scriptDataSupported hash)
+      where
+        scriptDataSupported = case era of
+            ShelleyBasedEraAlonzo  -> Cardano.ScriptDataInAlonzoEra
+            _ -> error "todo: proper error handling - script data not supported in era"
+
+        -- TODO: Proper error handling!
+
+        hash = fromMaybe (error $ "couldn't deserialize hash: " <> show datumHash) $ Cardano.deserialiseFromRawBytes
+            (Cardano.AsHash Cardano.AsScriptData)
+            datumHash
+
     lovelaceFromCardanoTxOutValue
         :: forall era. Cardano.TxOutValue era -> Cardano.Value
     lovelaceFromCardanoTxOutValue (Cardano.TxOutAdaOnly _ ada) =