Add deleteacc comand and --minconf option (#12)

* Add a `deleteacc` command for deleting an account
* The next valid account index is now the smallest unused index
* Add a --minconf option for specifying the minimum number of confirmations to spend a coin
* Improvements to the database versioning

haskoin-wallet.cabal

@@ -4,10 +4,10 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 4bb858871f870eb2ff6dddfbd5b1f9cf53c343d39a7ba088967ddebba5e447c1
+-- hash: 2ec0da93b80b2107f12d7fb8b7665dbb95d3f5c0943c10e5271cc9376342487a
 
 name:           haskoin-wallet
-version:        0.9.0
+version:        0.9.1
 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
@@ -63,6 +63,7 @@ library
     , random >=1.1
     , raw-strings-qq >=1.1
     , secp256k1-haskell >=1.1.0
+    , split >=0.2.3.5
     , string-conversions >=0.4.0.1
     , text >=1.2.4.0
     , time >=1.12.2
@@ -81,6 +82,7 @@ library
       Haskoin.Wallet.FileIO
       Haskoin.Wallet.Main
       Haskoin.Wallet.Migration
+      Haskoin.Wallet.Migration.SemVersion
       Haskoin.Wallet.Migration.V0_9_0
       Haskoin.Wallet.Parser
       Haskoin.Wallet.PrettyPrinter
@@ -115,7 +117,7 @@ executable hw
     , haskeline >=0.7.5.0
     , haskoin-core >=1.0.4
     , haskoin-store-data >=1.2.2
-    , haskoin-wallet ==0.9.0
+    , haskoin-wallet ==0.9.1
     , http-types >=0.12.3
     , lens >=4.18.1
     , lens-aeson >=1.1
@@ -128,6 +130,7 @@ executable hw
     , random >=1.1
     , raw-strings-qq >=1.1
     , secp256k1-haskell >=1.1.0
+    , split >=0.2.3.5
     , string-conversions >=0.4.0.1
     , text >=1.2.4.0
     , time >=1.12.2
@@ -148,6 +151,7 @@ test-suite spec
       Haskoin.Wallet.EntropySpec
       Haskoin.Wallet.SigningSpec
       Haskoin.Wallet.TestUtils
+      Haskoin.Wallet.VersionSpec
       Paths_haskoin_wallet
   hs-source-dirs:
       test
@@ -173,7 +177,7 @@ test-suite spec
     , haskeline >=0.7.5.0
     , haskoin-core >=1.0.4
     , haskoin-store-data >=1.2.2
-    , haskoin-wallet ==0.9.0
+    , haskoin-wallet ==0.9.1
     , hspec >=2.7.1
     , http-types >=0.12.3
     , lens >=4.18.1
@@ -187,6 +191,7 @@ test-suite spec
     , random >=1.1
     , raw-strings-qq >=1.1
     , secp256k1-haskell >=1.1.0
+    , split >=0.2.3.5
     , string-conversions >=0.4.0.1
     , text >=1.2.4.0
     , time >=1.12.2

package.yaml

@@ -1,5 +1,5 @@
 name: haskoin-wallet
-version: &version 0.9.0
+version: &version 0.9.1
 synopsis: Lightweight command-line wallet for Bitcoin and Bitcoin Cash
 description: !
   haskoin-wallet (hw) is a lightweight Bitcoin wallet using BIP39 mnemonics and
@@ -52,6 +52,7 @@ dependencies:
   random: ">= 1.1"
   raw-strings-qq: ">= 1.1"
   secp256k1-haskell: ">= 1.1.0"
+  split: ">= 0.2.3.5"
   string-conversions: ">= 0.4.0.1"
   text: ">= 1.2.4.0"
   time: ">= 1.12.2"

src/Haskoin/Wallet/Commands.hs

@@ -32,6 +32,7 @@ import Haskoin.Wallet.FileIO
 import Haskoin.Wallet.Parser
 import Haskoin.Wallet.Signing
 import Haskoin.Wallet.TxInfo
+import Haskoin.Wallet.Migration.SemVersion
 import Haskoin.Wallet.Util
 import Numeric.Natural (Natural)
 import qualified System.Console.Haskeline as Haskeline
@@ -50,7 +51,7 @@ data Response
   | ResponseAccount
       { responseAccount :: !DBAccount
       }
-  | ResponseTestAcc
+  | ResponseAccResult
       { responseAccount :: !DBAccount,
         responseResult :: !Bool,
         responseText :: !Text
@@ -125,9 +126,9 @@ instance MarshalJSON Ctx Response where
           [ "type" .= Json.String "account",
             "account" .= a
           ]
-      ResponseTestAcc a b t ->
+      ResponseAccResult a b t ->
         object
-          [ "type" .= Json.String "testacc",
+          [ "type" .= Json.String "accresult",
             "account" .= a,
             "result" .= b,
             "text" .= t
@@ -223,8 +224,8 @@ instance MarshalJSON Ctx Response where
         "account" ->
           ResponseAccount
             <$> o .: "account"
-        "testacc" ->
-          ResponseTestAcc
+        "accresult" ->
+          ResponseAccResult
             <$> o .: "account"
             <*> o .: "result"
             <*> o .: "text"
@@ -314,16 +315,19 @@ commandResponse ctx cfg unit cmd =
     CommandTestAcc nameM s -> cmdTestAcc ctx cfg nameM s
     CommandRenameAcc old new -> cmdRenameAcc cfg old new
     CommandAccounts nameM -> cmdAccounts cfg nameM
+    CommandSyncAcc nameM full -> cmdSyncAcc ctx cfg nameM full
+    CommandDeleteAcc name net deriv -> cmdDeleteAcc cfg name net deriv
     -- Address management
     CommandReceive nameM labM -> cmdReceive ctx cfg nameM labM
     CommandAddrs nameM p -> cmdAddrs cfg nameM p
     CommandLabel nameM i l -> cmdLabel cfg nameM i l
     -- Transaction management
     CommandTxs nameM p -> cmdTxs ctx cfg nameM p
-    CommandPrepareTx rcpts nameM fee dust rcptPay o ->
-      cmdPrepareTx ctx cfg rcpts nameM unit fee dust rcptPay o
+    CommandPrepareTx rcpts nameM fee dust rcptPay minConf o ->
+      cmdPrepareTx ctx cfg rcpts nameM unit fee dust rcptPay minConf o
     CommandPendingTxs nameM p -> cmdPendingTxs ctx cfg nameM p
     CommandSignTx nameM h i o s -> cmdSignTx ctx cfg nameM h i o s
+    CommandSendTx h -> cmdSendTx ctx cfg h
     CommandDeleteTx h -> cmdDeleteTx ctx cfg h
     CommandCoins nameM p -> cmdCoins cfg nameM p
     -- Import/export commands
@@ -332,13 +336,10 @@ commandResponse ctx cfg unit cmd =
     CommandReviewTx nameM file -> cmdReviewTx ctx cfg nameM file
     CommandExportTx h f -> cmdExportTx cfg h f
     CommandImportTx nameM file -> cmdImportTx ctx cfg nameM file
-    -- Online commands
-    CommandSendTx h -> cmdSendTx ctx cfg h
-    CommandSyncAcc nameM full -> cmdSyncAcc ctx cfg nameM full
-    CommandDiscoverAcc nameM -> cmdDiscoverAccount ctx cfg nameM
     -- Backup and Restore
     CommandBackup f -> cmdBackup ctx cfg f
     CommandRestore f -> cmdRestore ctx cfg f
+    CommandDiscoverAcc nameM -> cmdDiscoverAccount ctx cfg nameM
     -- Utilities
     CommandVersion -> cmdVersion cfg
     CommandPrepareSweep nameM prvKey st outputM f d ->
@@ -382,14 +383,14 @@ cmdTestAcc ctx cfg nameM splitMnemIn =
     return $
       if deriveXPubKey ctx xPrvKey == xPubKey
         then
-          ResponseTestAcc
+          ResponseAccResult
             { responseAccount = acc,
               responseResult = True,
               responseText =
                 "The mnemonic and passphrase matched the account"
             }
         else
-          ResponseTestAcc
+          ResponseAccResult
             { responseAccount = acc,
               responseResult = False,
               responseText =
@@ -422,6 +423,21 @@ cmdRenameAcc cfg oldName newName =
     acc <- renameAccount oldName newName
     return $ ResponseAccount acc
 
+cmdDeleteAcc :: Config -> Text -> Network -> HardPath -> IO Response
+cmdDeleteAcc cfg name net path =
+  runDBResponse cfg $ do
+    (accId, acc) <- getAccountByName $ Just name
+    unless (accountNetwork acc == net) $
+      throwError "The network of the account to delete did not match"
+    accPath <- liftMaybe "HardPath" $ parseHard $ cs $ dBAccountDerivation acc
+    unless (path == accPath) $
+      throwError
+        "The full derivation path of the account to delete did not match"
+    lift $ deleteAccount accId
+    return $
+      ResponseAccResult acc True $
+        "The account " <> name <> " has been deleted"
+
 cmdAccounts :: Config -> Maybe Text -> IO Response
 cmdAccounts cfg nameM =
   runDBResponse cfg $ do
@@ -470,16 +486,17 @@ cmdPrepareTx ::
   Natural ->
   Natural ->
   Bool ->
+  Natural ->
   Maybe FilePath ->
   IO Response
-cmdPrepareTx ctx cfg rcpTxt nameM unit feeByte dust rcptPay fileM =
+cmdPrepareTx ctx cfg rcpTxt nameM unit feeByte dust rcptPay minConf fileM =
   runDBResponse cfg $ do
     (accId, acc) <- getAccountByName nameM
     let net = accountNetwork acc
         pub = accountXPubKey ctx acc
     rcpts <- liftEither $ mapM (toRecipient net) rcpTxt
     gen <- liftIO initStdGen
-    signDat <- buildTxSignData net ctx cfg gen accId rcpts feeByte dust rcptPay
+    signDat <- buildTxSignData net ctx cfg gen accId rcpts feeByte dust rcptPay minConf
     txInfo <- liftEither $ parseTxSignData net ctx pub signDat
     txInfoL <- lift $ fillTxInfoLabels net txInfo
     for_ fileM checkPathFree
@@ -629,6 +646,7 @@ cmdSendTx ctx cfg nosigH =
             "The server returned the wrong TxHash: "
               <> cs (txHashToHex netTxId)
         _ <- lift $ setPendingTxOnline nosigH
+        lift $ insertRawTx signedTx
         return $ ResponseTx acc $ setTxInfoOnline txInfoL
       _ -> throwError "The nosigHash does not exist in the wallet"
 
@@ -680,7 +698,7 @@ cmdVersion :: Config -> IO Response
 cmdVersion cfg = do
   runDBResponse cfg $ do
     dbv <- lift getVersion
-    return $ ResponseVersion versionString dbv
+    return $ ResponseVersion currentVersionStr (cs $ verString dbv)
 
 prepareSweep ::
   Ctx ->

src/Haskoin/Wallet/Config.hs

@@ -12,7 +12,6 @@ import Control.Monad.Except
 import Control.Monad.Reader (MonadIO (..))
 import Data.Aeson
 import Data.Default
-import Data.String (IsString)
 import Data.String.Conversions (cs)
 import Data.Text (Text)
 import Haskoin
@@ -23,14 +22,6 @@ import Haskoin.Wallet.Util
 import Numeric.Natural (Natural)
 import qualified System.Directory as D
 
--- | Version of Haskoin Wallet package.
-versionString :: (IsString a) => a
-#ifdef CURRENT_PACKAGE_VERSION
-versionString = CURRENT_PACKAGE_VERSION
-#else
-versionString = error "No version string"
-#endif
-
 hwDataDirectory :: IO FilePath
 hwDataDirectory = do
   dir <- D.getAppUserDataDirectory "hw"

src/Haskoin/Wallet/Database.hs

@@ -51,6 +51,7 @@ import Haskoin
 import qualified Haskoin.Store.Data as Store
 import Haskoin.Wallet.Config
 import Haskoin.Wallet.FileIO
+import Haskoin.Wallet.Migration.SemVersion
 import Haskoin.Wallet.TxInfo
 import Haskoin.Wallet.Util (Page (Page), textToAddrE)
 import Numeric.Natural (Natural)
@@ -180,17 +181,19 @@ globalMigration = void $ runMigrationQuiet migrateAll
 
 {- Meta -}
 
-setVersion :: (MonadUnliftIO m) => Text -> DB m ()
-setVersion txt = do
+-- Database versions use major.minor only. Patch versions are ignored.
+setVersion :: (MonadUnliftIO m) => SemVersion -> DB m ()
+setVersion semVer = do
   verM <- selectOne $ from return
+  let verTxt = cs $ verString $ toMinor semVer
   case verM of
-    Nothing -> P.insert_ $ DBVersion txt
-    Just (Entity k _) -> P.update k [DBVersionVersion P.=. txt]
+    Nothing -> P.insert_ $ DBVersion verTxt
+    Just (Entity k _) -> P.update k [DBVersionVersion P.=. verTxt]
 
-getVersion :: (MonadUnliftIO m) => DB m Text
+getVersion :: (MonadUnliftIO m) => DB m SemVersion
 getVersion = do
   resM <- selectOne . from $ \v -> return $ v ^. DBVersionVersion
-  return $ unValue $ fromJust resM
+  return $ parseSemVersion . cs . unValue $ fromJust resM
 
 updateBest ::
   (MonadUnliftIO m) => Network -> BlockHash -> BlockHeight -> DB m ()
@@ -298,13 +301,16 @@ accountXPubKey ctx acc =
 nextAccountDeriv :: (MonadUnliftIO m) => Fingerprint -> Network -> DB m Natural
 nextAccountDeriv walletFP net = do
   let walletId = DBWalletKey $ fingerprintToText walletFP
-  dM <-
-    selectOne . from $ \a -> do
+  idxs <-
+    select . from $ \a -> do
       where_ $
         a ^. DBAccountNetwork ==. val (cs net.name)
           &&. a ^. DBAccountWallet ==. val walletId
-      return $ max_ $ a ^. DBAccountIndex
-  return $ joinMaybe 0 ((+ 1) . fromIntegral) dM
+      return $ a ^. DBAccountIndex
+  return $ smallestUnused $ fromIntegral . unValue <$> idxs
+
+smallestUnused :: [Natural] -> Natural
+smallestUnused xs = fromJust $ find (not . (`elem` xs)) [0 ..]
 
 existsAccount :: (MonadUnliftIO m) => Text -> DB m Bool
 existsAccount name = P.existsBy $ UniqueName name
@@ -359,6 +365,26 @@ insertAccount net ctx walletFP name xpub = do
           key <- lift $ P.insert account
           return (key, account)
 
+deleteAccount :: (MonadUnliftIO m) => DBAccountId -> DB m ()
+deleteAccount accId@(DBAccountKey accWallet accDeriv) = do
+  delete . from $ \a ->
+    where_ $
+      a ^. DBAddressAccountWallet ==. val accWallet
+        &&. a ^. DBAddressAccountDerivation ==. val accDeriv
+  delete . from $ \t ->
+    where_ $
+      t ^. DBTxInfoAccountWallet ==. val accWallet
+        &&. t ^. DBTxInfoAccountDerivation ==. val accDeriv
+  delete . from $ \c ->
+    where_ $
+      c ^. DBCoinAccountWallet ==. val accWallet
+        &&. c ^. DBCoinAccountDerivation ==. val accDeriv
+  delete . from $ \p ->
+    where_ $
+      p ^. DBPendingTxAccountWallet ==. val accWallet
+        &&. p ^. DBPendingTxAccountDerivation ==. val accDeriv
+  P.delete accId
+
 -- When a name is provided, get that account or throw an error if it doesn't
 -- exist. When no name is provided, return the account only if there is one
 -- account.
@@ -384,7 +410,10 @@ getAccountById accId = liftMaybe "Invalid account" =<< lift (P.get accId)
 
 getAccounts :: (MonadUnliftIO m) => DB m [(DBAccountId, DBAccount)]
 getAccounts =
-  (go <$>) <$> P.selectList [] [P.Asc DBAccountCreated]
+  (go <$>)
+    <$> P.selectList
+      []
+      [P.Asc DBAccountWallet, P.Asc DBAccountNetwork, P.Asc DBAccountIndex]
   where
     go a = (entityKey a, entityVal a)
 
@@ -1007,16 +1036,24 @@ coinPage net (DBAccountKey wallet accDeriv) (Page lim off) = do
 
 -- Spendable coins must be confirmed and not locked
 getSpendableCoins ::
-  (MonadUnliftIO m) => DBAccountId -> ExceptT String (DB m) [Store.Unspent]
-getSpendableCoins (DBAccountKey wallet accDeriv) = do
+  (MonadUnliftIO m) =>
+  Network ->
+  DBAccountId ->
+  Natural ->
+  ExceptT String (DB m) [Store.Unspent]
+getSpendableCoins net (DBAccountKey wallet accDeriv) minConf = do
+  bestM <- lift $ getBest net
   coins <- lift . select . from $ \c -> do
     where_ $
       c ^. DBCoinAccountWallet ==. val wallet
         &&. c ^. DBCoinAccountDerivation ==. val accDeriv
-        &&. c ^. DBCoinConfirmed ==. val True
         &&. c ^. DBCoinLocked ==. val False
     return c
-  let bss = dBCoinBlob . entityVal <$> coins
+  let f c = do
+        ref <- liftEither $ S.decode $ dBCoinBlockRef c
+        return $ getConfirmations (snd <$> bestM) ref >= minConf
+  spendableCoins <- filterM (f . entityVal) coins
+  let bss = dBCoinBlob . entityVal <$> spendableCoins
   mapM (liftEither . S.decode) bss
 
 insertCoin ::