reference input feature (#4074)

<!--
Detail in a few bullet points the work accomplished in this PR.

Before you submit, don't forget to:

* Make sure the GitHub PR fields are correct:
   ✓ Set a good Title for your PR.
   ✓ Assign yourself to the PR.
   ✓ Assign one or more reviewer(s).
   ✓ Link to a Jira issue, and/or other GitHub issues or PRs.
   ✓ In the PR description delete any empty sections
     and all text commented in <!--, so that this text does not appear
     in merge commit messages.

* Don't waste reviewers' time:
   ✓ If it's a draft, select the Create Draft PR option.
✓ Self-review your changes to make sure nothing unexpected slipped
through.

* Try to make your intent clear:
   ✓ Write a good Description that explains what this PR is meant to do.
   ✓ Jira will detect and link to this PR once created, but you can also
     link this PR in the description of the corresponding Jira ticket.
   ✓ Highlight what Testing you have done.
   ✓ Acknowledge any changes required to the Documentation.
-->

- [x] I have added md file
- [x] I have updated swagger
- [x] I have updated `ApiConstructTransactionData` and `ApiMintBurnData`
- [x] Make sure the feature is safe in a sense that `not_implemented`
will be triggered

### Comments

<!-- Additional comments, links, or screenshots to attach, if any. -->

### Issue Number

<!-- Reference the Jira/GitHub issue that this PR relates to, and which
requirements it tackles.
  Note: Jira issues of the form ADP- will be auto-linked. -->

lib/wallet/api/http/Cardano/Wallet/Api/Http/Server/Error.hs

@@ -452,6 +452,9 @@ instance IsServerError ErrConstructTx where
             [ "I cannot construct a delegating transaction for a shared wallet "
             , "that is lacking a delegation script template."
             ]
+        ErrConstructTxNotImplemented ->
+            apiError err501 NotImplemented
+                "This feature is not yet implemented."
 
 instance IsServerError ErrGetPolicyId where
     toServerError = \case

lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs

@@ -313,6 +313,7 @@ import Cardano.Wallet.Api.Types
     , ApiForeignStakeKey (..)
     , ApiIncompleteSharedWallet (..)
     , ApiMintBurnData (..)
+    , ApiMintBurnDataFromScript (..)
     , ApiMintBurnOperation (..)
     , ApiMintData (..)
     , ApiMnemonicT (..)
@@ -589,7 +590,7 @@ import Data.Coerce
 import Data.Either
     ( isLeft, isRight )
 import Data.Either.Extra
-    ( eitherToMaybe )
+    ( eitherToMaybe, fromLeft' )
 import Data.Function
     ( (&) )
 import Data.Functor
@@ -2434,7 +2435,7 @@ constructTransaction
     -> ApiConstructTransactionData n
     -> Handler (ApiConstructTransaction n)
 constructTransaction api argGenChange knownPools poolStatus apiWalletId body = do
-    body & \(ApiConstructTransactionData _ _ _ _ _ _ _) ->
+    body & \(ApiConstructTransactionData _ _ _ _ _ _ _ _) ->
     -- Above is the way to get a compiler error when number of fields changes,
     -- in order not to forget to update the pattern below:
         case body of
@@ -2456,6 +2457,9 @@ constructTransaction api argGenChange knownPools poolStatus apiWalletId body = d
     delegationRequest <-
         liftHandler $ traverse parseDelegationRequest $ body ^. #delegations
 
+    when (isJust $ body ^. #referencePolicyScriptTemplate) $
+        liftHandler $ throwE ErrConstructTxNotImplemented
+
     let metadata =
             body ^? #metadata . traverse . #txMetadataWithSchema_metadata
 
@@ -2499,10 +2503,10 @@ constructTransaction api argGenChange knownPools poolStatus apiWalletId body = d
             if isJust mintBurnData then do
                 (policyXPub, _) <-
                     liftHandler $ W.readPolicyPublicKey wrk
-                let isMinting (ApiMintBurnData _ _ (ApiMint _)) = True
+                let isMinting (ApiMintBurnDataFromScript _ _ (ApiMint _)) = True
                     isMinting _ = False
                 let getMinting = \case
-                        ApiMintBurnData
+                        ApiMintBurnDataFromScript
                             (ApiT scriptT)
                             (Just (ApiT tName))
                             (ApiMint (ApiMintData _ amt)) ->
@@ -2513,7 +2517,7 @@ constructTransaction api argGenChange knownPools poolStatus apiWalletId body = d
                                 amt
                         _ -> error "getMinting should not be used in this way"
                 let getBurning = \case
-                        ApiMintBurnData
+                        ApiMintBurnDataFromScript
                             (ApiT scriptT)
                             (Just (ApiT tName))
                             (ApiBurn (ApiBurnData amt)) ->
@@ -2553,7 +2557,7 @@ constructTransaction api argGenChange knownPools poolStatus apiWalletId body = d
                 pure $ F.toList (addressAmountToTxOut <$> content)
 
         let mintWithAddress
-                (ApiMintBurnData _ _ (ApiMint (ApiMintData (Just _) _)))
+                (ApiMintBurnDataFromScript _ _ (ApiMint (ApiMintData (Just _) _)))
                 = True
             mintWithAddress _ = False
         let mintingOuts = case mintBurnData of
@@ -2613,29 +2617,42 @@ constructTransaction api argGenChange knownPools poolStatus apiWalletId body = d
     parseMintBurnData
         :: ApiConstructTransactionData n
         -> (SlotNo, SlotNo)
-        -> Either ErrConstructTx (Maybe (NonEmpty (ApiMintBurnData n)))
+        -> Either ErrConstructTx (Maybe (NonEmpty (ApiMintBurnDataFromScript n)))
     parseMintBurnData tx validity = do
-        let mbMintingBurning :: Maybe (NonEmpty (ApiMintBurnData n))
-            mbMintingBurning = fmap handleMissingAssetName <$> tx ^. #mintBurn
+        when (notAllFromScript (tx ^. #mintBurn)) $
+            Left ErrConstructTxNotImplemented
+        let mbMintingBurning :: Maybe (NonEmpty (ApiMintBurnDataFromScript n))
+            mbMintingBurning =
+                fmap (handleMissingAssetName . takeMintingFromScript)
+                <$> tx ^. #mintBurn
         for mbMintingBurning $ \mintBurnData -> do
             guardWrongMintingTemplate mintBurnData
             guardAssetNameTooLong mintBurnData
             guardAssetQuantityOutOfBounds mintBurnData
             guardOutsideValidityInterval validity mintBurnData
             Right mintBurnData
       where
-        handleMissingAssetName :: ApiMintBurnData n -> ApiMintBurnData n
+        notAllFromScript = \case
+            Nothing -> False
+            Just mintData ->
+                any isRight $ mintBurnData <$> NE.toList mintData
+
+        -- we checked that only left are present in preceding line
+        takeMintingFromScript (ApiMintBurnData mintData) =
+            fromLeft' mintData
+
+        handleMissingAssetName :: ApiMintBurnDataFromScript n -> ApiMintBurnDataFromScript n
         handleMissingAssetName mb = case mb ^. #assetName of
             Nothing -> mb {assetName = Just (ApiT nullTokenName)}
             Just _ -> mb
 
         guardWrongMintingTemplate
-            :: NonEmpty (ApiMintBurnData n) -> Either ErrConstructTx ()
+            :: NonEmpty (ApiMintBurnDataFromScript n) -> Either ErrConstructTx ()
         guardWrongMintingTemplate mintBurnData =
             when (any wrongMintingTemplate mintBurnData)
                 $ Left ErrConstructTxWrongMintingBurningTemplate
           where
-            wrongMintingTemplate (ApiMintBurnData (ApiT script) _ _) =
+            wrongMintingTemplate (ApiMintBurnDataFromScript (ApiT script) _ _) =
                 isLeft (validateScriptOfTemplate RecommendedValidation script)
                 || countCosigners script /= (1 :: Int)
                 || existsNonZeroCosigner script
@@ -2644,37 +2661,37 @@ constructTransaction api argGenChange knownPools poolStatus apiWalletId body = d
                 foldScript (\cosigner a -> a || cosigner /= Cosigner 0) False
 
         guardAssetNameTooLong
-            :: NonEmpty (ApiMintBurnData n) -> Either ErrConstructTx ()
+            :: NonEmpty (ApiMintBurnDataFromScript n) -> Either ErrConstructTx ()
         guardAssetNameTooLong mintBurnData =
             when (any assetNameTooLong mintBurnData)
                 $ Left ErrConstructTxAssetNameTooLong
           where
             assetNameTooLong = \case
-                ApiMintBurnData _ (Just (ApiT (UnsafeTokenName bs))) _ ->
+                ApiMintBurnDataFromScript _ (Just (ApiT (UnsafeTokenName bs))) _ ->
                     BS.length bs > tokenNameMaxLength
                 _ -> error "tokenName should be nonempty at this step"
 
         guardAssetQuantityOutOfBounds
-            :: NonEmpty (ApiMintBurnData n) -> Either ErrConstructTx ()
+            :: NonEmpty (ApiMintBurnDataFromScript n) -> Either ErrConstructTx ()
         guardAssetQuantityOutOfBounds mintBurnData =
             when (any assetQuantityOutOfBounds mintBurnData)
                 $ Left ErrConstructTxMintOrBurnAssetQuantityOutOfBounds
           where
             assetQuantityOutOfBounds = \case
-                ApiMintBurnData _ _ (ApiMint (ApiMintData _ amt)) ->
+                ApiMintBurnDataFromScript _ _ (ApiMint (ApiMintData _ amt)) ->
                     amt <= 0 || amt > unTokenQuantity txMintBurnMaxTokenQuantity
-                ApiMintBurnData _ _ (ApiBurn (ApiBurnData amt)) ->
+                ApiMintBurnDataFromScript _ _ (ApiBurn (ApiBurnData amt)) ->
                     amt <= 0 || amt > unTokenQuantity txMintBurnMaxTokenQuantity
 
         guardOutsideValidityInterval
             :: (SlotNo, SlotNo)
-            -> NonEmpty (ApiMintBurnData n)
+            -> NonEmpty (ApiMintBurnDataFromScript n)
             -> Either ErrConstructTx ()
         guardOutsideValidityInterval (before, hereafter) mintBurnData =
             when (any notWithinValidityInterval mintBurnData) $
                 Left ErrConstructTxValidityIntervalNotWithinScriptTimelock
           where
-            notWithinValidityInterval (ApiMintBurnData (ApiT script) _ _) =
+            notWithinValidityInterval (ApiMintBurnDataFromScript (ApiT script) _ _) =
                 not $ withinSlotInterval before hereafter $
                     scriptSlotIntervals script
 
@@ -2700,7 +2717,7 @@ constructTransaction api argGenChange knownPools poolStatus apiWalletId body = d
         }
 
     toMintTxOut policyXPub
-        (ApiMintBurnData (ApiT scriptT) (Just (ApiT tName))
+        (ApiMintBurnDataFromScript (ApiT scriptT) (Just (ApiT tName))
             (ApiMint (ApiMintData (Just addr) amt))) =
                 let (assetId, tokenQuantity, _) =
                         toTokenMapAndScript ShelleyKeyS

lib/wallet/api/http/Cardano/Wallet/Api/Types.hs

@@ -96,6 +96,8 @@ module Cardano.Wallet.Api.Types
     , ApiMaintenanceAction (..)
     , ApiMaintenanceActionPostData (..)
     , ApiMintBurnData (..)
+    , ApiMintBurnDataFromScript (..)
+    , ApiMintBurnDataFromInput (..)
     , ApiMintBurnOperation (..)
     , ApiMintData(..)
     , ApiMultiDelegationAction (..)
@@ -394,6 +396,8 @@ import Cardano.Wallet.Shelley.Compatibility
     ( decodeAddress, encodeAddress )
 import Cardano.Wallet.TokenMetadata
     ( TokenMetadataError (..) )
+import Cardano.Wallet.Transaction
+    ( ReferenceInput )
 import Cardano.Wallet.Util
     ( ShowFmt (..) )
 import "cardano-addresses" Codec.Binary.Encoding
@@ -1079,6 +1083,7 @@ data ApiConstructTransactionData (n :: NetworkDiscriminant) =
     , mintBurn :: !(Maybe (NonEmpty (ApiMintBurnData n)))
     , delegations :: !(Maybe (NonEmpty ApiMultiDelegationAction))
     , validityInterval :: !(Maybe ApiValidityInterval)
+    , referencePolicyScriptTemplate :: !(Maybe (ApiT (Script Cosigner)))
     , encoding :: !(Maybe ApiSealedTxEncoding)
     }
     deriving (Eq, Generic, Show, Typeable)
@@ -3082,7 +3087,29 @@ instance ToJSON (ApiT SmashServer) where
 -- The used key derivation index is the same for all engaged derivation keys and
 -- ix=0 is assumed to be used. The verification key derivation is performed
 -- according to CIP 1855.
-data ApiMintBurnData (n :: NetworkDiscriminant) = ApiMintBurnData
+newtype ApiMintBurnData (n :: NetworkDiscriminant) = ApiMintBurnData
+    { mintBurnData :: Either (ApiMintBurnDataFromScript n) (ApiMintBurnDataFromInput n) }
+    deriving (Eq, Generic, Show)
+    deriving anyclass NFData
+
+instance HasSNetworkId n =>  FromJSON (ApiMintBurnData n) where
+    parseJSON obj = do
+        refInp <-
+            (withObject "mintBurnPostData" $
+             \o -> o .:? "reference_input" :: Aeson.Parser (Maybe ReferenceInput)) obj
+        case refInp of
+            Nothing -> do
+                xs <- parseJSON obj :: Aeson.Parser (ApiMintBurnDataFromScript n)
+                pure $ ApiMintBurnData $ Left xs
+            _ -> do
+                xs <- parseJSON obj :: Aeson.Parser (ApiMintBurnDataFromInput n)
+                pure $ ApiMintBurnData $ Right xs
+
+instance HasSNetworkId n => ToJSON (ApiMintBurnData n) where
+    toJSON (ApiMintBurnData (Left c))= toJSON c
+    toJSON (ApiMintBurnData (Right c))= toJSON c
+
+data ApiMintBurnDataFromScript (n :: NetworkDiscriminant) = ApiMintBurnDataFromScript
     { policyScriptTemplate
         :: !(ApiT (Script Cosigner))
         -- ^ A script regulating minting/burning policy. 'self' is expected
@@ -3095,7 +3122,22 @@ data ApiMintBurnData (n :: NetworkDiscriminant) = ApiMintBurnData
         -- ^ The minting or burning operation to perform.
     }
     deriving (Eq, Generic, Show)
-    deriving (FromJSON, ToJSON) via DefaultRecord (ApiMintBurnData n)
+    deriving (FromJSON, ToJSON) via DefaultRecord (ApiMintBurnDataFromScript n)
+    deriving anyclass NFData
+
+data ApiMintBurnDataFromInput (n :: NetworkDiscriminant) = ApiMintBurnDataFromInput
+    { referenceInput
+        :: !ReferenceInput
+        -- ^ A reference input that contains script regulating minting/burning policy.
+    , assetName
+        :: !(Maybe (ApiT W.TokenName))
+        -- ^ The name of the asset to mint/burn.
+    , operation
+        :: !(ApiMintBurnOperation n)
+        -- ^ The minting or burning operation to perform.
+    }
+    deriving (Eq, Generic, Show)
+    deriving (FromJSON, ToJSON) via DefaultRecord (ApiMintBurnDataFromInput n)
     deriving anyclass NFData
 
 -- | A user may choose to either mint tokens or burn tokens with each operation.

lib/wallet/src/Cardano/Wallet.hs

@@ -3428,6 +3428,7 @@ data ErrConstructTx
     | ErrConstructTxValidityIntervalNotWithinScriptTimelock
     | ErrConstructTxSharedWalletIncomplete
     | ErrConstructTxDelegationInvalid
+    | ErrConstructTxNotImplemented
     deriving (Show, Eq)
 
 -- | Errors that can occur when getting policy id.