Add Signing module with mkStdTx

cardano-wallet.cabal

@@ -53,12 +53,13 @@ library
     , http-types
     , memory
     , servant
-    , servant-server
     , servant-client
     , servant-client-core
+    , servant-server
     , text
     , time
     , transformers
+    , vector
   hs-source-dirs:
       src
   exposed-modules:
@@ -81,6 +82,7 @@ library
       Cardano.Wallet.Primitive.AddressDiscovery
       Cardano.Wallet.Primitive.Mnemonic
       Cardano.Wallet.Primitive.Model
+      Cardano.Wallet.Primitive.Signing
       Cardano.Wallet.Primitive.Types
       Data.Quantity
       Data.Text.Class

src/Cardano/Wallet.hs

@@ -37,7 +37,11 @@ import Prelude
 import Cardano.Wallet.Binary
     ( encodeSignedTx, toByteString )
 import Cardano.Wallet.CoinSelection
-    ( CoinSelection (..), CoinSelectionError (..), CoinSelectionOptions )
+    ( CoinSelection (..)
+    , CoinSelectionError (..)
+    , CoinSelectionOptions
+    , shuffle
+    )
 import Cardano.Wallet.DB
     ( DBLayer
     , ErrNoSuchWallet (..)
@@ -58,9 +62,16 @@ import Cardano.Wallet.Primitive.AddressDerivation
     , publicKey
     )
 import Cardano.Wallet.Primitive.AddressDiscovery
-    ( AddressPoolGap, SeqState (..), mkAddressPool )
+    ( AddressPoolGap
+    , SeqState (..)
+    , emptyPendingIxs
+    , generateChangeOutput
+    , mkAddressPool
+    )
 import Cardano.Wallet.Primitive.Model
     ( Wallet, applyBlocks, availableUTxO, currentTip, getState, initWallet )
+import Cardano.Wallet.Primitive.Signing
+    ( SignTxError, mkStdTx )
 import Cardano.Wallet.Primitive.Types
     ( Block (..)
     , BlockHeader (..)
@@ -91,6 +102,8 @@ import Control.Monad.Trans.Except
     ( ExceptT, runExceptT, throwE, withExceptT )
 import Control.Monad.Trans.Maybe
     ( MaybeT (..), maybeToExceptT )
+import Control.Monad.Trans.State
+    ( runState, state )
 import Data.Functor
     ( ($>) )
 import Data.List.NonEmpty
@@ -180,7 +193,7 @@ data ErrCreateUnsignedTx
 -- | Errors occuring when signing a transaction
 data ErrSignTx
     = ErrSignTxNoSuchWallet ErrNoSuchWallet
-    | ErrSignTx
+    | ErrSignTx SignTxError
 
 -- | Errors occuring when submitting a signed transaction to the network
 data ErrSubmitTx = forall a. NetworkError a
@@ -214,6 +227,7 @@ mkWalletLayer db network = WalletLayer
         let checkpoint = initWallet $ SeqState
                 { externalPool = extPool
                 , internalPool = intPool
+                , pendingChangeIxs = emptyPendingIxs
                 }
         now <- liftIO getCurrentTime
         let metadata = WalletMetadata
@@ -252,11 +266,18 @@ mkWalletLayer db network = WalletLayer
         withExceptT NetworkError $ postTx network signed
 
     , signTx = \wid rootXPrv password (CoinSelection ins outs chgs) -> do
+        -- TODO: This is untested
         (w, _) <- withExceptT ErrSignTxNoSuchWallet $ _readWallet wid
-        maybe
-            (throwE ErrSignTx)
-            return
-            (mkStdTx (getState w) rootXPrv password ins outs chgs)
+
+        let (changeOuts, _newState) = runState
+                (mapM (state . generateChangeOutput) chgs)
+                (getState w)
+
+        allShuffledOuts <- liftIO $ shuffle (outs ++ changeOuts)
+
+        case mkStdTx (getState w) (rootXPrv, password) ins allShuffledOuts of
+            Right a -> return a
+            Left e -> throwE $ ErrSignTx e
     }
   where
     _readWallet
@@ -337,8 +358,6 @@ mkWalletLayer db network = WalletLayer
             DB.putTxHistory db (PrimaryKey wid) txs
             DB.putWalletMeta db (PrimaryKey wid) meta'
 
-    mkStdTx = error "TODO: mkStdTx not implemented yet"
-
 {-------------------------------------------------------------------------------
                                  Helpers
 -------------------------------------------------------------------------------}

src/Cardano/Wallet/CoinSelection.hs

@@ -18,19 +18,31 @@ module Cardano.Wallet.CoinSelection
       CoinSelectionOptions (..)
     , CoinSelectionError(..)
     , CoinSelection(..)
+
+    -- * Helpers
+    , shuffle
     ) where
 
 import Prelude
 
 import Cardano.Wallet.Primitive.Types
     ( Coin (..), TxIn, TxOut (..) )
+import Control.Monad
+    ( forM_ )
+import Crypto.Number.Generate
+    ( generateBetween )
+import Data.Vector.Mutable
+    ( IOVector )
 import Data.Word
     ( Word64 )
 import Fmt
     ( Buildable (..), blockListF, blockListF', listF, nameF )
 import GHC.Generics
     ( Generic )
 
+import qualified Data.Vector as V
+import qualified Data.Vector.Mutable as MV
+
 {-------------------------------------------------------------------------------
                                 Coin Selection
 -------------------------------------------------------------------------------}
@@ -84,3 +96,32 @@ instance Buildable CoinSelection where
         <> nameF "change" (listF chngs)
       where
         inpsF (txin, txout) = build txin <> " (~ " <> build txout <> ")"
+
+{-------------------------------------------------------------------------------
+                                   Helpers
+-------------------------------------------------------------------------------}
+
+-- | Shuffles a list of elements.
+--
+-- >>> shuffle (outputs coinSel)
+-- [...]
+--
+shuffle :: [a] -> IO [a]
+shuffle = modifyInPlace $ \v -> do
+    let (lo, hi) = (0, MV.length v - 1)
+    forM_ [lo .. hi] $ \i -> do
+      j <- fromInteger <$> generateBetween (fromIntegral lo) (fromIntegral hi)
+      swapElems v i j
+  where
+    swapElems :: IOVector a -> Int -> Int -> IO ()
+    swapElems v i j = do
+        x <- MV.read v i
+        y <- MV.read v j
+        MV.write v i y
+        MV.write v j x
+
+    modifyInPlace :: forall a. (IOVector a -> IO ()) -> [a] -> IO [a]
+    modifyInPlace f xs = do
+        v' <- V.thaw $ V.fromList xs
+        f v'
+        V.toList <$> V.freeze v'

src/Cardano/Wallet/Primitive/AddressDerivation.hs

@@ -25,6 +25,7 @@ module Cardano.Wallet.Primitive.AddressDerivation
     -- * Polymorphic / General Purpose Types
     -- $use
       Key
+    , getKey
     , Depth (..)
     , Index
     , getIndex
@@ -132,7 +133,7 @@ import qualified Data.Text.Encoding as T
 -- let accountPubKey = Key 'AccountK XPub
 -- let addressPubKey = Key 'AddressK XPub
 -- @
-newtype Key (level :: Depth) key = Key key
+newtype Key (level :: Depth) key = Key { getKey :: key }
     deriving stock (Generic, Show, Eq)
 
 instance (NFData key) => NFData (Key level key)