diff --git a/haskoin-wallet.cabal b/haskoin-wallet.cabal index cb54b9b1..22680253 100644 --- a/haskoin-wallet.cabal +++ b/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 diff --git a/package.yaml b/package.yaml index e7928f72..da00b279 100644 --- a/package.yaml +++ b/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 diff --git a/src/Haskoin/Wallet/Commands.hs b/src/Haskoin/Wallet/Commands.hs index 8082a74d..8d188812 100644 --- a/src/Haskoin/Wallet/Commands.hs +++ b/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 diff --git a/src/Haskoin/Wallet/FileIO.hs b/src/Haskoin/Wallet/FileIO.hs index 79dabeb5..ef17acbf 100644 --- a/src/Haskoin/Wallet/FileIO.hs +++ b/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)) diff --git a/src/Haskoin/Wallet/Parser.hs b/src/Haskoin/Wallet/Parser.hs index cc1c718a..04ba01e7 100644 --- a/src/Haskoin/Wallet/Parser.hs +++ b/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 diff --git a/src/Haskoin/Wallet/PrettyPrinter.hs b/src/Haskoin/Wallet/PrettyPrinter.hs index 4f92462f..686294de 100644 --- a/src/Haskoin/Wallet/PrettyPrinter.hs +++ b/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 diff --git a/src/Haskoin/Wallet/Signing.hs b/src/Haskoin/Wallet/Signing.hs index d045b760..9f3a45da 100644 --- a/src/Haskoin/Wallet/Signing.hs +++ b/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