Merge pull request #3466 from input-output-hk/feature/cbr-349-redeem-ada

[CBR-349] Implement redemption

Author: edsko

wallet-new/cardano-sl-wallet-new.cabal

@@ -146,7 +146,6 @@ library
                        Cardano.Wallet.WalletLayer.Kernel.Transactions
                        Cardano.Wallet.WalletLayer.Kernel.Wallets
                        Cardano.Wallet.WalletLayer.Kernel
-                       Cardano.Wallet.WalletLayer.Error
 
   other-modules:       Paths_cardano_sl_wallet_new
   ghc-options:         -Wall

wallet-new/src/Cardano/Wallet/API/V1/Handlers/Transactions.hs

@@ -17,8 +17,7 @@ import           Data.Coerce (coerce)
 import           Pos.Client.Txp.Util (InputSelectionPolicy (..),
                      defaultInputSelectionPolicy)
 import           Pos.Core (Address, Timestamp)
-import           Pos.Core.Txp (Tx (..), TxId, TxOut (..))
-import           Pos.Crypto (hash)
+import           Pos.Core.Txp (TxId)
 
 import           Cardano.Wallet.API.Request
 import           Cardano.Wallet.API.Response
@@ -28,8 +27,7 @@ import           Cardano.Wallet.Kernel.CoinSelection.FromGeneric
                      (ExpenseRegulation (..), InputGrouping (..))
 import           Cardano.Wallet.Kernel.DB.HdWallet (UnknownHdAccount)
 import           Cardano.Wallet.Kernel.DB.TxMeta (TxMeta)
-import           Cardano.Wallet.Kernel.Util.Core (getCurrentTimestamp,
-                     paymentAmount)
+import qualified Cardano.Wallet.Kernel.Transactions as Kernel
 import           Cardano.Wallet.WalletLayer (ActiveWalletLayer,
                      NewPaymentError (..), PassiveWalletLayer)
 import qualified Cardano.Wallet.WalletLayer as WalletLayer
@@ -109,28 +107,11 @@ estimateFees aw payment@Payment{..} = do
 redeemAda :: ActiveWalletLayer IO
           -> Redemption
           -> Handler (WalletResponse Transaction)
-redeemAda layer redemption = do
-    res <- liftIO $ WalletLayer.redeemAda layer redemption
+redeemAda aw redemption = liftIO $ do
+    res <- WalletLayer.redeemAda aw redemption
     case res of
-         Left e -> throwM e
-         Right tx -> do
-             -- TODO: This is a straight copy and paste from 'newTransaction' in
-             -- "Cardano.Wallet.API.V1.Handlers.Transactions". Once [CBR-239]
-             -- is fixed, we should fix both instances.
-             now <- liftIO getCurrentTimestamp
-             -- NOTE(adn) As part of [CBR-239], we could simply fetch the
-             -- entire 'Transaction' as part of the TxMeta.
-             return $ single Transaction {
-                 txId            = V1 (hash tx)
-               , txConfirmations = 0
-               , txAmount        = V1 (paymentAmount $ _txOutputs tx)
-               , txInputs        = error "TODO, see [CBR-324]"
-               , txOutputs       = fmap outputsToDistribution (_txOutputs tx)
-               , txType          = error "TODO, see [CBR-324]"
-               , txDirection     = OutgoingTransaction
-               , txCreationTime  = V1 now
-               , txStatus        = Creating
-               }
+      Left err        -> throwM err
+      Right (_, meta) -> txFromMeta aw embedErr meta
   where
-    outputsToDistribution :: TxOut -> PaymentDistribution
-    outputsToDistribution (TxOut addr amount) = PaymentDistribution (V1 addr) (V1 amount)
+    embedErr :: UnknownHdAccount -> WalletLayer.RedeemAdaError
+    embedErr = WalletLayer.RedeemAdaError . Kernel.RedeemAdaUnknownAccountId

wallet-new/src/Cardano/Wallet/Kernel/CoinSelection/FromGeneric.hs

@@ -37,7 +37,7 @@ import           Data.Typeable (TypeRep, typeRep)
 import           Pos.Binary.Class (LengthOf, Range (..), SizeOverride (..),
                      encode, szSimplify, szWithCtx, toLazyByteString)
 import qualified Pos.Chain.Txp as Core
-import qualified Pos.Client.Txp.Util as Core
+import qualified Pos.Client.Txp.Util as CTxp
 import           Pos.Core (AddrAttributes, Coin (..), TxSizeLinear,
                      calculateTxSizeLinear)
 import qualified Pos.Core as Core
@@ -198,7 +198,7 @@ mkStdTx :: Monad m
         -> m (Either e Core.TxAux)
 mkStdTx pm shuffle hdwSigners inps outs change = do
     allOuts <- shuffle $ foldl' (flip NE.cons) outs change
-    return $ Core.makeMPubKeyTxAddrs pm hdwSigners (fmap repack inps) allOuts
+    return $ CTxp.makeMPubKeyTxAddrs pm hdwSigners (fmap repack inps) allOuts
   where
     -- Repack a utxo-derived tuple into a format suitable for
     -- 'TxOwnedInputs'.

wallet-new/src/Cardano/Wallet/Kernel/DB/AcidState.hs

@@ -535,6 +535,12 @@ instance Buildable NewPendingError where
     build (NewPendingFailed npf) =
         bprint ("NewPendingFailed " % build) npf
 
+instance Buildable NewForeignError where
+    build (NewForeignUnknown unknownAccount) =
+        bprint ("NewForeignUnknown " % build) unknownAccount
+    build (NewForeignFailed npf) =
+        bprint ("NewForeignFailed " % build) npf
+
 {-------------------------------------------------------------------------------
   Arbitrary
 -------------------------------------------------------------------------------}

wallet-new/src/Cardano/Wallet/Kernel/NodeStateAdaptor.hs

@@ -27,6 +27,7 @@ module Cardano.Wallet.Kernel.NodeStateAdaptor (
   , compileInfo
   , getNtpStatus
     -- * Non-mockable
+  , filterUtxo
   , mostRecentMainBlock
   , triggerShutdown
   , waitForUpdate
@@ -43,6 +44,8 @@ import           Universum
 import           Control.Lens (lens)
 import           Control.Monad.IO.Unlift (MonadUnliftIO, UnliftIO (UnliftIO),
                      askUnliftIO, unliftIO, withUnliftIO)
+import           Data.Conduit (mapOutputMaybe, runConduitRes, (.|))
+import qualified Data.Conduit.List as Conduit
 import           Data.SafeCopy (base, deriveSafeCopy)
 import           Data.Time.Units (Millisecond)
 import           Formatting (bprint, build, sformat, shown, (%))
@@ -63,12 +66,14 @@ import           Pos.Core.Configuration (HasConfiguration, genesisHash,
                      protocolConstants)
 import           Pos.Core.Slotting (EpochIndex (..), HasSlottingVar (..),
                      LocalSlotIndex (..), MonadSlots (..), SlotId (..))
+import           Pos.Core.Txp (TxIn, TxOutAux)
 import qualified Pos.DB.Block as DB
 import           Pos.DB.BlockIndex (getTipHeader)
 import           Pos.DB.Class (MonadDBRead (..), getBlock)
 import           Pos.DB.GState.Lock (StateLock, withStateLockNoMetrics)
 import           Pos.DB.Rocks.Functions (dbGetDefault, dbIterSourceDefault)
 import           Pos.DB.Rocks.Types (NodeDBs)
+import           Pos.DB.Txp.Utxo (utxoSource)
 import           Pos.DB.Update (UpdateContext, getAdoptedBVData,
                      ucDownloadedUpdate)
 import           Pos.Infra.Shutdown.Class (HasShutdownContext (..))
@@ -401,6 +406,11 @@ defaultGetNextEpochSlotDuration = Slotting.getNextEpochSlotDuration
   Non-mockable functinos
 -------------------------------------------------------------------------------}
 
+filterUtxo :: (NodeConstraints, MonadCatch m, MonadUnliftIO m)
+           => ((TxIn, TxOutAux) -> Maybe a) -> WithNodeState m [a]
+filterUtxo p = runConduitRes $ mapOutputMaybe p utxoSource
+                            .| Conduit.fold (flip (:)) []
+
 triggerShutdown :: MonadIO m => WithNodeState m ()
 triggerShutdown = Shutdown.triggerShutdown
 

wallet-new/src/Cardano/Wallet/Kernel/Transactions.hs

@@ -2,11 +2,13 @@
 module Cardano.Wallet.Kernel.Transactions (
       pay
     , estimateFees
+    , redeemAda
     -- * Errors
     , NewTransactionError(..)
     , SignTransactionError(..)
     , PaymentError(..)
     , EstimateFeesError(..)
+    , RedeemAdaError(..)
     , cardanoFee
     -- * Internal & testing use only
     , newTransaction
@@ -32,12 +34,14 @@ import           Formatting (bprint, build, sformat, (%))
 import qualified Formatting.Buildable
 
 import           Pos.Chain.Txp (Utxo)
+import qualified Pos.Client.Txp.Util as CTxp
 import           Pos.Core (Address, Coin, unsafeIntegerToCoin, unsafeSubCoin)
 import qualified Pos.Core as Core
 import           Pos.Core.Txp (Tx (..), TxAux (..), TxId, TxIn (..), TxOut (..),
                      TxOutAux (..))
-import           Pos.Crypto (EncryptedSecretKey, PassPhrase, SafeSigner (..),
-                     ShouldCheckPassphrase (..), hash)
+import           Pos.Crypto (EncryptedSecretKey, PassPhrase, RedeemSecretKey,
+                     SafeSigner (..), ShouldCheckPassphrase (..), hash,
+                     redeemToPublic)
 
 import qualified Cardano.Wallet.Kernel.Addresses as Kernel
 import           Cardano.Wallet.Kernel.CoinSelection.FromGeneric
@@ -47,7 +51,8 @@ import           Cardano.Wallet.Kernel.CoinSelection.FromGeneric
 import qualified Cardano.Wallet.Kernel.CoinSelection.FromGeneric as CoinSelection
 import           Cardano.Wallet.Kernel.CoinSelection.Generic
                      (CoinSelHardErr (..))
-import           Cardano.Wallet.Kernel.DB.AcidState (DB, NewPendingError)
+import           Cardano.Wallet.Kernel.DB.AcidState (DB, NewForeignError,
+                     NewPendingError)
 import           Cardano.Wallet.Kernel.DB.HdWallet
 import qualified Cardano.Wallet.Kernel.DB.HdWallet as HD
 import           Cardano.Wallet.Kernel.DB.InDb
@@ -56,8 +61,8 @@ import           Cardano.Wallet.Kernel.DB.TxMeta.Types
 import           Cardano.Wallet.Kernel.Internal (ActiveWallet (..),
                      walletKeystore, walletNode)
 import qualified Cardano.Wallet.Kernel.Keystore as Keystore
-import           Cardano.Wallet.Kernel.NodeStateAdaptor (getMaxTxSize)
-import           Cardano.Wallet.Kernel.Pending (newPending)
+import qualified Cardano.Wallet.Kernel.NodeStateAdaptor as Node
+import           Cardano.Wallet.Kernel.Pending (newForeign, newPending)
 import           Cardano.Wallet.Kernel.Read (getWalletSnapshot)
 import           Cardano.Wallet.Kernel.Types (AccountId (..),
                      RawResolvedTx (..), WalletId (..))
@@ -173,7 +178,7 @@ newTransaction :: ActiveWallet
                -> IO (Either NewTransactionError (TxAux, TxMeta, Utxo))
 newTransaction ActiveWallet{..} spendingPassword options accountId payees = runExceptT $ do
     initialEnv <- liftIO $ newEnvironment
-    maxTxSize  <- liftIO $ getMaxTxSize (walletPassive ^. walletNode)
+    maxTxSize  <- liftIO $ Node.getMaxTxSize (walletPassive ^. walletNode)
     let maxInputs = estimateMaxTxInputs dummyAddrAttrSize dummyTxAttrSize maxTxSize
 
     -- STEP 0: Get available UTxO
@@ -413,3 +418,113 @@ cardanoFee inputs outputs = Core.mkCoin $
     estimateCardanoFee linearFeePolicy inputs (toList $ fmap Core.getCoin outputs)
     where
       linearFeePolicy = Core.TxSizeLinear (Core.Coeff 155381) (Core.Coeff 43.946)
+
+{-------------------------------------------------------------------------------
+  Ada redemption
+
+  Old wallet layer implemention lives in "Pos.Wallet.Web.Methods.Redeem".
+-------------------------------------------------------------------------------}
+
+data RedeemAdaError =
+    -- | Unknown account
+    --
+    -- NOTE: The Daedalus frontend requires users to create an account before
+    -- they can redeem Ada.
+    RedeemAdaUnknownAccountId UnknownHdAccount
+
+    -- | We failed to translate the redeem key to a valid Cardano address
+  | RedeemAdaErrorCreateAddressFailed Kernel.CreateAddressError
+
+    -- | There are no UTxO available at the redeem address
+    --
+    -- This probably means that the voucher has already been redeemed, but it
+    -- /could/ also mean that there was never any voucher at this address.
+  | RedeemAdaNotAvailable Address
+
+    -- | There are multiple outputs available at this address
+    --
+    -- This really should not happen at all. If this happens, we are running
+    -- in a test setup with an invalid genesis block.
+  | RedeemAdaMultipleOutputs Address
+
+    -- | We were unable to submit the transaction
+    --
+    -- If this error happens, it almost certainly indicates a bug.
+  | RedeemAdaNewForeignFailed NewForeignError
+
+instance Buildable RedeemAdaError where
+    build (RedeemAdaUnknownAccountId err) =
+      bprint ("RedeemAdaUnknownAccountId " % build) err
+    build (RedeemAdaErrorCreateAddressFailed err) =
+      bprint ("RedeemAdaErrorCreateAddressFailed " % build) err
+    build (RedeemAdaNotAvailable addr) =
+      bprint ("RedeemAdaNotAvailable " % build) addr
+    build (RedeemAdaMultipleOutputs addr) =
+      bprint ("RedeemAdaMultipleOutputs " % build) addr
+    build (RedeemAdaNewForeignFailed err) =
+      bprint ("RedeemAdaNewForeignFailed " % build) err
+
+-- | Redeem Ada voucher
+--
+-- NOTE: The account must already exist, it is /not/ created implicitly if it
+-- does not yet exist.
+redeemAda :: ActiveWallet
+          -> HdAccountId      -- ^ Account ID
+          -> PassPhrase       -- ^ Spending password
+          -> RedeemSecretKey  -- ^ Redemption key
+          -> IO (Either RedeemAdaError (Tx, TxMeta))
+redeemAda w@ActiveWallet{..} accId pw rsk = runExceptT $ do
+    snapshot   <- liftIO $ getWalletSnapshot walletPassive
+    _accExists <- withExceptT RedeemAdaUnknownAccountId $ exceptT $
+                    lookupHdAccountId snapshot accId
+    changeAddr <- withExceptT RedeemAdaErrorCreateAddressFailed $ ExceptT $ liftIO $
+                    Kernel.createAddress
+                      pw
+                      (AccountIdHdRnd accId)
+                      walletPassive
+    (tx, meta) <- mkTx changeAddr
+    withExceptT RedeemAdaNewForeignFailed $ ExceptT $ liftIO $
+      newForeign
+        w
+        accId
+        tx
+        meta
+    return (taTx tx, meta)
+  where
+    redeemAddr :: Address
+    redeemAddr = Core.makeRedeemAddress $ redeemToPublic rsk
+
+    mkTx :: Address -> ExceptT RedeemAdaError IO (TxAux, TxMeta)
+    mkTx output = do
+        now  <- liftIO $ Core.getCurrentTimestamp
+        utxo <- liftIO $
+                  Node.withNodeState (walletPassive ^. walletNode) $ \_lock ->
+                    Node.filterUtxo isOutput
+        (inp@(TxInUtxo inHash inIx), coin) <-
+          case utxo of
+            [i]   -> return i
+            []    -> throwError $ RedeemAdaNotAvailable    redeemAddr
+            _:_:_ -> throwError $ RedeemAdaMultipleOutputs redeemAddr
+        let out    = TxOutAux $ TxOut output coin
+            txAux  = CTxp.makeRedemptionTx
+                       walletProtocolMagic
+                       rsk
+                       (inp :| [])
+                       (out :| [])
+            txMeta = TxMeta {
+                _txMetaId         = hash (taTx txAux)
+              , _txMetaAmount     = coin
+              , _txMetaInputs     = (inHash, inIx, redeemAddr, coin) :| []
+              , _txMetaOutputs    = (output, coin) :| []
+              , _txMetaCreationAt = now
+              , _txMetaIsLocal    = False -- input does not belong to wallet
+              , _txMetaIsOutgoing = False -- increases wallet's balance
+              , _txMetaWalletId   = _fromDb $ getHdRootId (accId ^. hdAccountIdParent)
+              , _txMetaAccountIx  = getHdAccountIx (accId ^. hdAccountIdIx)
+              }
+        return (txAux, txMeta)
+      where
+        isOutput :: (TxIn, TxOutAux) -> Maybe (TxIn, Coin)
+        isOutput (inp, TxOutAux (TxOut addr coin)) = do
+            guard $ addr == redeemAddr
+            return (inp, coin)

wallet-new/src/Cardano/Wallet/WalletLayer.hs

@@ -54,6 +54,7 @@ import qualified Cardano.Wallet.Kernel.Transactions as Kernel
 import qualified Cardano.Wallet.Kernel.Wallets as Kernel
 import           Cardano.Wallet.WalletLayer.ExecutionTimeLimit
                      (TimeExecutionLimit)
+import           Cardano.Wallet.WalletLayer.Kernel.Conv (InvalidRedemptionCode)
 
 ------------------------------------------------------------
 -- Errors when manipulating wallets
@@ -434,7 +435,7 @@ data ActiveWalletLayer m = ActiveWalletLayer {
                    -> m (Either EstimateFeesError Coin)
 
       -- | Redeem ada
-    , redeemAda :: Redemption -> m (Either RedeemAdaError Tx)
+    , redeemAda :: Redemption -> m (Either RedeemAdaError (Tx, TxMeta))
 
       -- | Node info
       --
@@ -494,13 +495,20 @@ instance Arbitrary EstimateFeesError where
                       , EstimateFeesTimeLimitReached <$> arbitrary
                       ]
 
--- | TODO: Will need to be extended
-data RedeemAdaError = RedeemAdaError
+data RedeemAdaError =
+    RedeemAdaError Kernel.RedeemAdaError
+  | RedeemAdaWalletIdDecodingFailed Text
+  | RedeemAdaInvalidRedemptionCode InvalidRedemptionCode
 
 instance Show RedeemAdaError where
     show = formatToString build
 
 instance Exception RedeemAdaError
 
 instance Buildable RedeemAdaError where
-    build RedeemAdaError = "RedeemAdaError"
+    build (RedeemAdaError err) =
+        bprint ("RedeemAdaError " % build) err
+    build (RedeemAdaWalletIdDecodingFailed txt) =
+        bprint ("RedeemAdaWalletIdDecodingFailed " % build) txt
+    build (RedeemAdaInvalidRedemptionCode txt) =
+        bprint ("RedeemAdaInvalidRedemptionCode " % build) txt