Sweep transactions now sweep directly from private keys (#10)

* Sweep transactions no longer need addresses. They can sweep the private keys directly.
* Sweep transaction output amounts are no longer randomized. 
* Improve the output of the command-line pretty printer

haskoin-wallet.cabal

@@ -4,10 +4,10 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 76af62b27fc56cea5da6e5657f63f55b7f1ba2458df076077aa939af1f2d6aae
+-- hash: 60ebec3c20572cfb0344f54196b16af1b9bb2ae7e956d1196b1841b0ea792acd
 
 name:           haskoin-wallet
-version:        0.8.2
+version:        0.8.3
 synopsis:       Lightweight command-line wallet for Bitcoin and Bitcoin Cash
 description:    haskoin-wallet (hw) is a lightweight Bitcoin wallet using BIP39 mnemonics and
                 BIP44 account structure. It requires a full blockchain index such as
@@ -112,7 +112,7 @@ executable hw
     , haskeline >=0.7.5.0
     , haskoin-core >=1.0.4
     , haskoin-store-data >=1.2.2
-    , haskoin-wallet ==0.8.2
+    , haskoin-wallet ==0.8.3
     , http-types >=0.12.3
     , lens >=4.18.1
     , lens-aeson >=1.1
@@ -170,7 +170,7 @@ test-suite spec
     , haskeline >=0.7.5.0
     , haskoin-core >=1.0.4
     , haskoin-store-data >=1.2.2
-    , haskoin-wallet ==0.8.2
+    , haskoin-wallet ==0.8.3
     , hspec >=2.7.1
     , http-types >=0.12.3
     , lens >=4.18.1

package.yaml

@@ -1,5 +1,5 @@
 name: haskoin-wallet
-version: &version 0.8.2
+version: &version 0.8.3
 synopsis: Lightweight command-line wallet for Bitcoin and Bitcoin Cash
 description: !
   haskoin-wallet (hw) is a lightweight Bitcoin wallet using BIP39 mnemonics and

src/Haskoin/Wallet/Commands.hs

@@ -333,8 +333,8 @@ commandResponse ctx cfg unit cmd =
     CommandDiscoverAcc nameM -> cmdDiscoverAccount ctx cfg nameM
     -- Utilities
     CommandVersion -> cmdVersion
-    CommandPrepareSweep nameM sf fileM st outputM f d ->
-      prepareSweep ctx cfg nameM sf fileM st outputM f d
+    CommandPrepareSweep nameM prvKey st outputM f d ->
+      prepareSweep ctx cfg nameM prvKey st outputM f d
     CommandSignSweep nameM h i o k -> signSweep ctx cfg nameM h i o k
     CommandRollDice n -> rollDice n
 
@@ -825,27 +825,21 @@ prepareSweep ::
   Ctx ->
   Config ->
   Maybe Text ->
-  [Text] ->
-  Maybe FilePath ->
+  FilePath ->
   [Text] ->
   Maybe FilePath ->
   Natural ->
   Natural ->
   IO Response
-prepareSweep ctx cfg nameM sweepFromT sweepFromFileM sweepToT outputM feeByte dust =
+prepareSweep ctx cfg nameM prvKeyFile sweepToT outputM feeByte dust =
   runDB cfg $ do
     (accId, acc) <- getAccountByName nameM
     let net = accountNetwork acc
         pub = accountXPubKey ctx acc
-    sweepFromArg <- liftEither $ mapM (textToAddrE net) sweepFromT
+    secKeys <- parseSecKeysFile net <$> liftIO (readFileWords prvKeyFile)
     sweepTo <- liftEither $ mapM (textToAddrE net) sweepToT
-    addrsFile <-
-      case sweepFromFileM of
-        Just file -> parseAddrsFile net <$> liftIO (readFileWords file)
-        _ -> return []
-    let sweepFrom = sweepFromArg <> addrsFile
     checkHealth ctx net cfg
-    tsd <- buildSweepSignData net ctx cfg accId sweepFrom sweepTo feeByte dust
+    tsd <- buildSweepSignData net ctx cfg accId secKeys sweepTo feeByte dust
     info <- liftEither $ parseTxSignData net ctx pub tsd
     for_ outputM checkPathFree
     nosigHash <- importPendingTx net ctx accId tsd

src/Haskoin/Wallet/FileIO.hs

@@ -12,7 +12,7 @@ import Control.Monad.Reader (MonadIO (..))
 import Data.Aeson
 import Data.Aeson.Types (parseEither)
 import qualified Data.ByteString.Char8 as C8
-import Data.Maybe (fromMaybe, mapMaybe)
+import Data.Maybe (mapMaybe)
 import qualified Data.Serialize as S
 import Data.String.Conversions (cs)
 import Data.Text (Text)
@@ -110,12 +110,6 @@ readFileWords fp = do
   strContents <- IO.readFile fp
   return $ removeComments $ Text.words <$> Text.lines (cs strContents)
 
-parseAddrsFile :: Network -> [[Text]] -> [Address]
-parseAddrsFile net =
-  withParser $ \w -> eitherToMaybe $ textToAddrE net $ strip "addr=" w
-  where
-    strip p w = fromMaybe w $ Text.stripPrefix p w
-
 parseSecKeysFile :: Network -> [[Text]] -> [SecKey]
 parseSecKeysFile net =
   withParser $ \w -> (.key) <$> (fromWif net w <|> fromMiniKey (cs w))

src/Haskoin/Wallet/Parser.hs

@@ -113,8 +113,7 @@ data Command
   | CommandVersion
   | CommandPrepareSweep
       { commandMaybeAcc :: !(Maybe Text),
-        commandSweepFrom :: ![Text],
-        commandSweepFileMaybe :: !(Maybe FilePath),
+        commandSecKeyPath :: !FilePath,
         commandSweepTo :: ![Text],
         commandOutputFileMaybe :: !(Maybe FilePath),
         commandFeeByte :: !Natural,
@@ -879,8 +878,7 @@ prepareSweepParser = do
   let cmd =
         CommandPrepareSweep
           <$> accountOption
-          <*> many sweepFromOption -- many: not optional
-          <*> addressFileOption
+          <*> prvKeyFileOption
           <*> some sweepToOption -- some: optional
           <*> outputFileMaybeOption
           <*> feeOption
@@ -889,13 +887,11 @@ prepareSweepParser = do
     progDesc "Prepare a transaction to sweep funds"
       <> footer
         [r|
-`preparesweep` will prepare a transaction that sweeps the funds available in the
-given --sweepfrom addresses and sends them to the --sweepto addresses. The
-typical use case for this command is to migrate an old wallet to a new mnemonic.
-The addresses can also be parsed from a --addrfile. The best way to pass
-multiple addresses on the command line is with the shorthand -w ADDR1 -w ADDR2
-for --sweepfrom addresses and -t ADDR1 -t ADDR2 for --sweepto addresses. You
-can generate addresses to sweep to with the `receive` command.
+`preparesweep` will prepare a transaction that sweeps the funds of the given
+private keys. The private keys are passed in a file and can be in WIF or minikey
+format. The typical use case for this command is to migrate an old wallet to a
+new mnemonic. You can send the funds to 1 or multiple addresses. You can use the
+shorthand format -t ADDR1 -t ADDR2 to specify the --sweepto addresses.
 |]
 
 sweepFromOption :: Parser Text

src/Haskoin/Wallet/PrettyPrinter.hs

@@ -9,6 +9,7 @@
 
 module Haskoin.Wallet.PrettyPrinter where
 
+import Control.Arrow ((&&&))
 import Control.Monad
 import Data.List (intersperse)
 import Data.Map.Strict (Map)
@@ -151,6 +152,13 @@ formatLabel =
       SetColor Foreground Vivid White
     ]
 
+formatDeriv :: String -> Printer
+formatDeriv =
+  PText
+    [ SetItalicized True,
+      SetColor Foreground Vivid Yellow
+    ]
+
 formatMnemonic :: Bool -> String -> Printer
 formatMnemonic split =
   PText
@@ -258,7 +266,7 @@ accountPrinter unit acc =
   vcat
     [ keyPrinter 8 "Account" <> formatAccount (cs $ dBAccountName acc),
       mconcat [keyPrinter 8 "Wallet", formatValue $ cs fp],
-      mconcat [keyPrinter 8 "Deriv", formatValue deriv],
+      mconcat [keyPrinter 8 "Deriv", formatDeriv deriv],
       mconcat [keyPrinter 8 "Network", formatValue net],
       mconcat
         [keyPrinter 8 "External", formatValue $ show $ dBAccountExternal acc],
@@ -323,15 +331,17 @@ txInfoPrinter ::
   Integer ->
   Natural ->
   Natural ->
+  Map Address MyInputs ->
   Map Address MyOutputs ->
   Map Address Natural ->
   Printer ->
   Printer
-txInfoPrinter net unit tType amount feeN feeByteN myOutputs otherOutputs custom =
+txInfoPrinter net unit tType amount feeN feeByteN myInputs myOutputs otherOutputs custom =
   vcat
     [ formatTitle (block 9 title) <> text ": " <> total,
       custom,
       fee,
+      internal,
       debit,
       credit
     ]
@@ -343,34 +353,64 @@ txInfoPrinter net unit tType amount feeN feeByteN myOutputs otherOutputs custom
         TxCredit -> "Credit"
     total = integerAmountPrinter unit amount
     fee = keyPrinter 9 "Fee" <> feePrinter unit feeN feeByteN
+    internal
+      | tType /= TxInternal = mempty
+      | otherwise =
+          vcat $
+            [formatKey "From addresses:"]
+              <> ( nest 2 . addrPrinter True
+                     <$> Map.assocs
+                       ( Map.map
+                           (myInputsValue &&& (Just . myInputsPath))
+                           myInputs
+                       )
+                 )
+              <> [formatKey "To addresses:"]
+              <> ( nest 2
+                     . addrPrinter True
+                     <$> Map.assocs
+                       ( Map.map
+                           (myOutputsValue &&& (Just . myOutputsPath))
+                           myOutputs
+                       )
+                 )
     debit
       | tType /= TxDebit = mempty
       | otherwise =
           vcat $
             [formatKey "Sending to addresses:"]
-              <> (nest 2 . addrPrinter False <$> Map.assocs otherOutputs)
+              <> ( nest 2 . addrPrinter False
+                     <$> Map.assocs
+                       ( Map.map
+                           (id &&& const Nothing)
+                           otherOutputs
+                       )
+                 )
     credit
       | tType /= TxCredit = mempty
       | otherwise =
           vcat $
             [formatKey "My credited addresses:"]
               <> ( nest 2 . addrPrinter True
-                     <$> Map.assocs (Map.map myOutputsValue myOutputs)
+                     <$> Map.assocs
+                       ( Map.map
+                           (myOutputsValue &&& (Just . myOutputsPath))
+                           myOutputs
+                       )
                  )
-    addrPrinter isCredit (a, v) =
-      formatAddress isCredit (parseAddr net a)
-        <> text ":"
-          <+> if isCredit
-            then
-              integerAmountPrinterWith
-                formatPosAmount
-                unit
-                (fromIntegral v)
-            else
-              integerAmountPrinterWith
-                formatZeroAmount
-                unit
-                (fromIntegral v)
+    addrPrinter isMine (a, (v, pathM)) =
+      vcat
+        [ formatAddress isMine (parseAddr net a)
+            <> text ":"
+              <+> if isMine
+                then integerAmountPrinterWith formatPosAmount unit (fromIntegral v)
+                else integerAmountPrinterWith formatZeroAmount unit (fromIntegral v),
+          case pathM of
+            Just p ->
+              nest 2 $
+                formatKey "Path:" <+> formatDeriv (pathToStr p)
+            _ -> mempty
+        ]
 
 parseAddr :: Network -> Address -> String
 parseAddr net = cs . fromMaybe "Invalid Address" . addrToText net
@@ -386,6 +426,7 @@ noSigTxInfoPrinter net unit ns =
         txInfoAmount
         txInfoFee
         txInfoFeeByte
+        txInfoMyInputs
         txInfoMyOutputs
         txInfoOtherOutputs
         $ vcat
@@ -410,6 +451,7 @@ noSigTxInfoPrinter net unit ns =
         unsignedTxInfoAmount
         unsignedTxInfoFee
         unsignedTxInfoFeeByte
+        unsignedTxInfoMyInputs
         unsignedTxInfoMyOutputs
         unsignedTxInfoOtherOutputs
         $ vcat
@@ -498,6 +540,7 @@ prettyPrinter unit =
               txInfoAmount
               txInfoFee
               txInfoFeeByte
+              txInfoMyInputs
               txInfoMyOutputs
               txInfoOtherOutputs
               $ vcat
@@ -525,7 +568,7 @@ prettyPrinter unit =
             nest 2 $
               formatKey "Freed internal addresses:" <+> formatValue (show a)
           ]
-    ResponseCoins _ [] -> 
+    ResponseCoins _ [] ->
       renderIO $ text "There are no coins in the account"
     ResponseCoins acc coins -> do
       let net = accountNetwork acc

src/Haskoin/Wallet/Signing.hs

@@ -167,7 +167,7 @@ signTxWithKeys ::
 signTxWithKeys net ctx tsd@(TxSignData tx _ _ _ signed) publicKey secKeys = do
   when signed $ Left "The transaction is already signed"
   when (null secKeys) $ Left "There are no private keys to sign"
-  txInfoU <- parseTxSignData net ctx publicKey tsd 
+  txInfoU <- parseTxSignData net ctx publicKey tsd
   -- signing
   let myInputs = unsignedTxInfoMyInputs txInfoU
       othInputs = unsignedTxInfoOtherInputs txInfoU
@@ -207,16 +207,18 @@ buildSweepSignData ::
   Ctx ->
   Config ->
   DBAccountId ->
-  [Address] ->
+  [SecKey] ->
   [Address] ->
   Natural ->
   Natural ->
   ExceptT String (DB m) TxSignData
-buildSweepSignData net ctx cfg accId sweepFrom sweepTo feeByte dust
-  | null sweepFrom = throwError "No addresses to sweep from"
+buildSweepSignData net ctx cfg accId prvKeys sweepTo feeByte dust
+  | null prvKeys = throwError "No private keys to sweep from"
   | null sweepTo = throwError "No addresses to sweep to"
   | otherwise = do
       let host = apiHost net cfg
+      -- Generate the addresses to sweep from
+      let sweepFrom = nub $ concatMap (genPossibleAddrs net ctx) prvKeys
       -- Get the unspent coins of the sweepFrom addresses
       Store.SerialList coins <-
         liftExcept . apiBatch ctx (configCoinBatch cfg) host $
@@ -237,6 +239,26 @@ buildSweepSignData net ctx cfg accId sweepFrom sweepTo feeByte dust
       outDerivs <- rights <$> lift (mapM (getAddrDeriv net accId) sweepTo)
       return $ TxSignData tx depTxs (nub inDerivs) (nub outDerivs) False
 
+genPossibleAddrs :: Network -> Ctx -> SecKey -> [Address]
+genPossibleAddrs net ctx k
+  | net `elem` [btc, btcTest, btcRegTest] =
+    [ pubKeyAddr ctx pc,
+      pubKeyAddr ctx pu,
+      pubKeyWitnessAddr ctx pc,
+      pubKeyWitnessAddr ctx pu,
+      pubKeyCompatWitnessAddr ctx pc,
+      pubKeyCompatWitnessAddr ctx pu
+    ]
+  | otherwise =
+    [ pubKeyAddr ctx pc,
+      pubKeyAddr ctx pu
+    ]
+  where
+    c = wrapSecKey False k :: PrivateKey -- Compressed
+    u = wrapSecKey True k :: PrivateKey -- Uncompressed
+    pc = derivePublicKey ctx c
+    pu = derivePublicKey ctx u
+
 buildSweepTx ::
   Network ->
   Ctx ->
@@ -254,14 +276,12 @@ buildSweepTx net ctx gen coins sweepTo feeByte dust =
         fee = guessTxFee (fromIntegral feeByte) (length sweepTo) (length coins)
     when (coinsTot < fee) $
       throwError "Could not find a sweep solution: fee is too large"
-    rdmAmntsM <-
-      randomSplitIn
-        (coinsTot - fee) -- will not overflow
-        (fromIntegral $ length sweepTo)
-        (fromIntegral $ dust + 1)
-    rdmAmnts <- lift $ maybeToEither "Could not find a sweep solution" rdmAmntsM
+    let (q, r) = (coinsTot - fee) `quotRem` fromIntegral (length sweepTo)
+        amnts = (q+r):repeat q
+    when (q <= fromIntegral dust) $
+      throwError "Outputs are smaller than the dust value"
     addrsT <- lift $ mapM (maybeToEither "Addr" . addrToText net) rdmSweepTo
-    lift $ buildAddrTx net ctx rdmOutpoints (zip addrsT rdmAmnts)
+    lift $ buildAddrTx net ctx rdmOutpoints (zip addrsT amnts)
 
 -- Utilities --
 
@@ -281,12 +301,3 @@ randomShuffle xs = do
     (as, e : bs) -> (e :) <$> randomShuffle (as <> bs)
     _ -> error "randomShuffle"
 
--- Split the number a into n parts of minimum value d
-randomSplitIn ::
-  (Random a, Num a, Ord a, MonadState StdGen m) => a -> a -> a -> m (Maybe [a])
-randomSplitIn a n d
-  | a < n * d = return Nothing
-  | n == 1 = return $ Just [a]
-  | otherwise = do
-      randPart <- randomRange d (a - d * (n - 1))
-      ((randPart :) <$>) <$> randomSplitIn (a - randPart) (n - 1) d