feat: implement importvk

app/Server.hs

@@ -57,7 +57,7 @@ main = do
       case bc of
         Left e1 -> throwIO e1
         Right chainInfo -> do
-          x <- runStderrLoggingT $ initDb dbFilePath
+          x <- runNoLoggingT $ initDb dbFilePath
           case x of
             Left e2 -> throwIO $ userError e2
             Right x' -> do
@@ -77,7 +77,7 @@ main = do
                           zebraPort
                           (zgb_net chainInfo)
                       threadDelay 90000000
-                  putStrLn "Zenith RPC Server 0.8.0.0-beta"
+                  putStrLn "Zenith RPC Server 0.9.0.0-beta"
                   putStrLn "------------------------------"
                   putStrLn $
                     "Connected to " ++

src/Zenith/CLI.hs

@@ -2242,7 +2242,7 @@ runZenithTUI config = do
       case bc of
         Left e1 -> throwIO e1
         Right chainInfo -> do
-          x <- runStderrLoggingT $ initDb dbFilePath
+          x <- runNoLoggingT $ initDb dbFilePath
           _ <- upgradeQrTable pool
           _ <- runNoLoggingT $ upgradeAccountTable pool
           case x of

src/Zenith/Core.hs

@@ -35,7 +35,9 @@ import Haskoin.Crypto.Keys (XPrvKey(..))
 import Lens.Micro ((&), (.~), (^.), set)
 import ZcashHaskell.Keys
 import ZcashHaskell.Orchard
-  ( decryptOrchardActionFvk
+  ( decodeUfvk
+  , decodeUivk
+  , decryptOrchardActionFvk
   , decryptOrchardActionIvk
   , decryptOrchardActionSK
   , encodeUnifiedAddress
@@ -347,9 +349,22 @@ importViewingKey ::
   -> ZcashNet -- ^ the network the wallet is on
   -> ValidVk -- ^ viewing key
   -> Int -- ^ birthday height
-  -> IO (Either T.Text ())
+  -> IO (Either T.Text Int64)
 importViewingKey pool name znet vk bh = do
   minBh <- getMinBirthdayHeight pool $ ZcashNetDB znet
+  let checkNet =
+        case znet of
+          MainNet ->
+            case vk of
+              FullVk fvk -> net fvk == 1
+              IncomingVk ivk -> i_net ivk == 1
+          TestNet ->
+            case vk of
+              FullVk fvk -> net fvk == 2
+              IncomingVk ivk -> i_net ivk == 2
+          RegTestNet -> False
+  if checkNet
+    then do
       when (bh < minBh) $ do
         clearWalletTransactions pool
         clearWalletData pool
@@ -379,7 +394,7 @@ importViewingKey pool name znet vk bh = do
               FullViewKey
           case acc of
             Nothing -> return $ Left "Failed to save VK account"
-        Just _ -> return $ Right ()
+            Just acc' -> return $ Right $ fromSqlKey (entityKey acc')
         IncomingVk ivk -> do
           acc1 <-
             saveAccount pool $
@@ -395,7 +410,17 @@ importViewingKey pool name znet vk bh = do
               IncomingViewKey
           case acc1 of
             Nothing -> return $ Left "Failed to save VK account"
-        Just _ -> return $ Right ()
+            Just acc1' -> return $ Right $ fromSqlKey $ entityKey acc1'
+    else return $ Left "Viewing key is not for the current network"
+
+parseVK :: T.Text -> Maybe ValidVk
+parseVK input =
+  case decodeUfvk (E.encodeUtf8 input) of
+    Just fvk -> Just $ FullVk fvk
+    Nothing ->
+      case decodeUivk (E.encodeUtf8 input) of
+        Just ivk -> Just $ IncomingVk ivk
+        Nothing -> Nothing
 
 -- * Wallet
 -- | Find the Sapling notes that match the given spending key

src/Zenith/DB.hs

@@ -448,7 +448,7 @@ orchToZcashNoteAPI pool n = do
 -- | Initializes the database
 initDb ::
      T.Text -- ^ The database path to check
-  -> LoggingT IO (Either String Bool)
+  -> NoLoggingT IO (Either String Bool)
 initDb dbName = do
   x <-
     liftIO
@@ -523,7 +523,7 @@ initDb dbName = do
               upsert (ZenithSchema 1 "Viewing Keys") []
           return $ Right False
 
-migrateTables :: ConnectionPool -> [Int] -> LoggingT IO ()
+migrateTables :: ConnectionPool -> [Int] -> NoLoggingT IO ()
 migrateTables pool versions = do
   unless (1 `elem` versions) $ do
     logDebugN "Making version 1 changes"

src/Zenith/GUI.hs

@@ -2632,7 +2632,7 @@ runZenithGUI config = do
           case bc of
             Left e1 -> throwIO e1
             Right chainInfo -> do
-              x <- runStderrLoggingT $ initDb dbFilePath
+              x <- runNoLoggingT $ initDb dbFilePath
               _ <- upgradeQrTable pool
               _ <- runNoLoggingT $ upgradeAccountTable pool
               case x of

src/Zenith/RPC.hs

@@ -57,6 +57,8 @@ import Zenith.Core
   , createCustomWalletAddress
   , createZcashAccount
   , deshieldNotes
+  , importViewingKey
+  , parseVK
   , prepareTxV2
   , shieldTransparentNotes
   , syncWallet
@@ -136,6 +138,7 @@ data ZenithMethod
   | DeshieldFunds
   | GetFVK
   | GetIVK
+  | ImportVK
   | UnknownMethod
   deriving (Eq, Prelude.Show)
 
@@ -155,6 +158,7 @@ instance ToJSON ZenithMethod where
   toJSON DeshieldFunds = Data.Aeson.String "deshieldfunds"
   toJSON GetFVK = Data.Aeson.String "getfullvk"
   toJSON GetIVK = Data.Aeson.String "getincomingvk"
+  toJSON ImportVK = Data.Aeson.String "importvk"
   toJSON UnknownMethod = Data.Aeson.Null
 
 instance FromJSON ZenithMethod where
@@ -175,6 +179,7 @@ instance FromJSON ZenithMethod where
       "deshieldfunds" -> pure DeshieldFunds
       "getfullvk" -> pure GetFVK
       "getincomingvk" -> pure GetIVK
+      "importvk" -> pure ImportVK
       _ -> pure UnknownMethod
 
 data ZenithParams
@@ -193,6 +198,7 @@ data ZenithParams
   | ShieldNotesParams !Int
   | DeshieldParams !Int !Scientific
   | ViewingKeyParams !Int
+  | ImportVkParams !T.Text !T.Text !Int
   deriving (Eq, Prelude.Show)
 
 instance ToJSON ZenithParams where
@@ -221,6 +227,9 @@ instance ToJSON ZenithParams where
   toJSON (DeshieldParams i s) =
     Data.Aeson.Array $ V.fromList [jsonNumber i, Data.Aeson.Number s]
   toJSON (ViewingKeyParams i) = Data.Aeson.Array $ V.fromList [jsonNumber i]
+  toJSON (ImportVkParams n k b) =
+    Data.Aeson.Array $
+    V.fromList [Data.Aeson.String n, Data.Aeson.String k, jsonNumber b]
 
 data ZenithResponse
   = InfoResponse !T.Text !ZenithInfo
@@ -567,6 +576,18 @@ instance FromJSON RpcCall where
                   pure $ RpcCall v i GetIVK (ViewingKeyParams x)
                 else pure $ RpcCall v i GetIVK BadParams
             _anyOther -> pure $ RpcCall v i GetIVK BadParams
+        ImportVK -> do
+          p <- obj .: "params"
+          case p of
+            Array a ->
+              if V.length a == 3
+                then do
+                  x <- parseJSON $ a V.! 0
+                  y <- parseJSON $ a V.! 1
+                  z <- parseJSON $ a V.! 2
+                  pure $ RpcCall v i ImportVK (ImportVkParams x y z)
+                else pure $ RpcCall v i ImportVK BadParams
+            _anyOther -> pure $ RpcCall v i ImportVK BadParams
 
 type ZenithRPC
   = "status" :> Get '[ JSON] Value :<|> BasicAuth "zenith-realm" Bool :> ReqBody
@@ -1142,6 +1163,21 @@ zenithServer state = getinfo :<|> handleRPC
                   ErrorResponse (callId req) (-32006) "Account does not exist."
             _anyOtherParams ->
               return $ ErrorResponse (callId req) (-32602) "Invalid params"
+        ImportVK -> do
+          case parameters req of
+            ImportVkParams n k b -> do
+              let dbPath = w_dbPath state
+              let znet = w_network state
+              pool <- liftIO $ runNoLoggingT $ initPool dbPath
+              case parseVK k of
+                Nothing -> return $ invalidVkError $ callId req
+                Just vk -> do
+                  res <- liftIO $ importViewingKey pool n znet vk b
+                  case res of
+                    Left e -> return $ ErrorResponse (callId req) (-32010) e
+                    Right x -> return $ NewItemResponse (callId req) x
+            _anyOtherParams ->
+              return $ ErrorResponse (callId req) (-32602) "Invalid params"
 
 authenticate :: Config -> BasicAuthCheck Bool
 authenticate config = BasicAuthCheck check

src/Zenith/Scanner.hs

@@ -78,7 +78,7 @@ rescanZebra host port dbFilePath = do
       pool1 <- runNoLoggingT $ initPool dbFilePath
       {-pool2 <- runNoLoggingT $ initPool dbFilePath-}
       {-pool3 <- runNoLoggingT $ initPool dbFilePath-}
-      _ <- runStderrLoggingT $ initDb dbFilePath
+      _ <- runNoLoggingT $ initDb dbFilePath
       upgradeQrTable pool1
       clearWalletTransactions pool1
       clearWalletData pool1
@@ -217,7 +217,7 @@ clearSync config = do
   case bc of
     Left e1 -> throwIO e1
     Right chainInfo -> do
-      x <- runStderrLoggingT $ initDb dbPath
+      x <- runNoLoggingT $ initDb dbPath
       _ <- upgradeQrTable pool
       _ <- runNoLoggingT $ upgradeAccountTable pool
       case x of

test/ServerSpec.hs

@@ -38,7 +38,8 @@ import Zenith.RPC
   , zenithServer
   )
 import Zenith.Types
-  ( Config(..)
+  ( AccountType(..)
+  , Config(..)
   , PrivacyPolicy(..)
   , ProposedNote(..)
   , ValidAddressAPI(..)
@@ -307,7 +308,9 @@ main = do
                 Left e -> assertFailure e
                 Right r ->
                   r `shouldBe`
-                  AccountListResponse "zh" [ZcashAccountAPI 1 1 "Personal"]
+                  AccountListResponse
+                    "zh"
+                    [ZcashAccountAPI 1 1 "Personal" Local]
         describe "Addresses" $ do
           describe "listaddresses" $ do
             it "bad credentials" $ do
@@ -832,6 +835,57 @@ main = do
                   Left e -> assertFailure e
                   Right (ViewingKeyResponse i c) -> c `shouldNotBe` ""
                   Right x -> assertFailure $ show x
+          describe "Importing" $ do
+            it "bad credentials" $ do
+              res <-
+                makeZenithCall
+                  "127.0.0.1"
+                  nodePort
+                  "baduser"
+                  "idontknow"
+                  ImportVK
+                  BlankParams
+              res `shouldBe` Left "Invalid credentials"
+            describe "correct credentials" $ do
+              it "no parameters" $ do
+                res <-
+                  makeZenithCall
+                    "127.0.0.1"
+                    nodePort
+                    nodeUser
+                    nodePwd
+                    ImportVK
+                    BlankParams
+                case res of
+                  Left e -> assertFailure e
+                  Right (ErrorResponse i c m) -> c `shouldBe` (-32602)
+              it "correct params" $ do
+                res <-
+                  makeZenithCall
+                    "127.0.0.1"
+                    nodePort
+                    nodeUser
+                    nodePwd
+                    ImportVK
+                    (ImportVkParams
+                       "OldWallet"
+                       "uviewtest1jna46ql5qns5rlg99jgs6mhf0j9tk8zxvqsm472scgvmj0vs0rqv2kvdf626gftx7dgn2tltyf0s200gvjlsdvz5celpue9wxxw78txswqmayxc3pfrt5fs5frvr3ep0jrjg8euahqzc63yx9sy4z8lql4ev6q3asptl9rhsfzzrup2g5slwnlvy3dgft44jw3l08xtzypjmsrwxskgnp5s03xlc2kg5520a25pa6fdjxhzutam4wkwr6mh4zeq3qndpks8dk0y90y7gucgsp0j5k2xnhh90m3krk5glz4794dj93pf59h85dqms6337f85ccvpxhays94kvsj2hyjsltf52tygqs8y0vp2yf39drxl687the6xkp8nxkfffc3kqlkhw53t5plplde0vk9rwv340ys04gg48fs0pxfp35rvt2f2pvxjmgmln6lp5k2yzkm0r87k89p6xqv68a6uyfpsauswh9fsckfqey02pjedz5gs934qa"
+                       3249286)
+                case res of
+                  Left e -> assertFailure e
+                  Right (NewItemResponse i k) -> k `shouldSatisfy` (> 0)
+              it "list wallets" $ do
+                res <-
+                  makeZenithCall
+                    "127.0.0.1"
+                    nodePort
+                    nodeUser
+                    nodePwd
+                    ListWallets
+                    BlankParams
+                case res of
+                  Left e -> assertFailure e
+                  Right (WalletListResponse i k) -> length k `shouldBe` 2
 
 startAPI :: Config -> IO ()
 startAPI config = do
@@ -850,7 +904,7 @@ startAPI config = do
       case bc of
         Left e1 -> throwIO e1
         Right chainInfo -> do
-          x <- initDb "test.db"
+          x <- runNoLoggingT $ initDb "test.db"
           case x of
             Left e2 -> throwIO $ userError e2
             Right x' -> do