src/Zenith/RPC.hs

@@ -13,10 +13,10 @@
 module Zenith.RPC where
 
 import Control.Concurrent (forkIO)
-import Control.Exception (try)
-import Control.Monad (unless, when)
+import Control.Exception (SomeException(..), try)
+import Control.Monad (unless)
 import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Logger (runFileLoggingT, runNoLoggingT, runStderrLoggingT)
+import Control.Monad.Logger (runNoLoggingT, runStderrLoggingT)
 import Data.Aeson
 import qualified Data.HexString as H
 import Data.Int
@@ -36,7 +36,7 @@ import Database.Esqueleto.Experimental
   )
 import Servant
 import Text.Read (readMaybe)
-import ZcashHaskell.Keys (generateWalletSeedPhrase)
+import ZcashHaskell.Keys (deriveUfvk, deriveUivk, generateWalletSeedPhrase)
 import ZcashHaskell.Orchard (parseAddress)
 import ZcashHaskell.Types
   ( BlockResponse(..)
@@ -98,9 +98,12 @@ import Zenith.Types
   ( AccountBalance(..)
   , Config(..)
   , HexStringDB(..)
+  , OrchardSpendingKeyDB(..)
   , PhraseDB(..)
   , PrivacyPolicy(..)
   , ProposedNote(..)
+  , SaplingSpendingKeyDB(..)
+  , TransparentSpendingKeyDB(..)
   , ZcashAccountAPI(..)
   , ZcashAddressAPI(..)
   , ZcashNetDB(..)
@@ -125,6 +128,7 @@ data ZenithMethod
   | SendMany
   | ShieldNotes
   | DeshieldFunds
+  | GetFVK
   | UnknownMethod
   deriving (Eq, Prelude.Show)
 
@@ -142,6 +146,7 @@ instance ToJSON ZenithMethod where
   toJSON SendMany = Data.Aeson.String "sendmany"
   toJSON ShieldNotes = Data.Aeson.String "shieldnotes"
   toJSON DeshieldFunds = Data.Aeson.String "deshieldfunds"
+  toJSON GetFVK = Data.Aeson.String "getfullvk"
   toJSON UnknownMethod = Data.Aeson.Null
 
 instance FromJSON ZenithMethod where
@@ -160,6 +165,7 @@ instance FromJSON ZenithMethod where
       "sendmany" -> pure SendMany
       "shieldnotes" -> pure ShieldNotes
       "deshieldfunds" -> pure DeshieldFunds
+      "getfullvk" -> pure GetFVK
       _ -> pure UnknownMethod
 
 data ZenithParams
@@ -177,6 +183,7 @@ data ZenithParams
   | TestParams !T.Text
   | ShieldNotesParams !Int
   | DeshieldParams !Int !Scientific
+  | ViewingKeyParams !Int
   deriving (Eq, Prelude.Show)
 
 instance ToJSON ZenithParams where
@@ -204,6 +211,7 @@ instance ToJSON ZenithParams where
   toJSON (ShieldNotesParams i) = Data.Aeson.Array $ V.fromList [jsonNumber i]
   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]
 
 data ZenithResponse
   = InfoResponse !T.Text !ZenithInfo
@@ -217,6 +225,7 @@ data ZenithResponse
   | OpResponse !T.Text !Operation
   | SendResponse !T.Text !U.UUID
   | MultiOpResponse !T.Text ![T.Text]
+  | ViewingKeyResponse !T.Text !T.Text
   | ErrorResponse !T.Text !Double !T.Text
   deriving (Eq, Prelude.Show)
 
@@ -239,6 +248,7 @@ instance ToJSON ZenithResponse where
   toJSON (OpResponse i u) = packRpcResponse i u
   toJSON (SendResponse i o) = packRpcResponse i o
   toJSON (MultiOpResponse i o) = packRpcResponse i o
+  toJSON (ViewingKeyResponse i k) = packRpcResponse i k
 
 instance FromJSON ZenithResponse where
   parseJSON =
@@ -323,7 +333,7 @@ instance FromJSON ZenithResponse where
                         Right k' -> pure $ NewItemResponse i k'
                     String s -> do
                       case U.fromText s of
-                        Nothing -> fail "Unknown value"
+                        Nothing -> pure $ ViewingKeyResponse i s
                         Just u -> pure $ SendResponse i u
                     _anyOther -> fail "Malformed JSON"
             Just e1 -> pure $ ErrorResponse i (ecode e1) (emessage e1)
@@ -528,6 +538,16 @@ instance FromJSON RpcCall where
                   pure $ RpcCall v i DeshieldFunds (DeshieldParams x y)
                 else pure $ RpcCall v i DeshieldFunds BadParams
             _anyOther -> pure $ RpcCall v i DeshieldFunds BadParams
+        GetFVK -> do
+          p <- obj .: "params"
+          case p of
+            Array a ->
+              if V.length a == 1
+                then do
+                  x <- parseJSON $ a V.! 0
+                  pure $ RpcCall v i GetFVK (ViewingKeyParams x)
+                else pure $ RpcCall v i GetFVK BadParams
+            _anyOther -> pure $ RpcCall v i GetFVK BadParams
 
 type ZenithRPC
   = "status" :> Get '[ JSON] Value :<|> BasicAuth "zenith-realm" Bool :> ReqBody
@@ -1041,6 +1061,34 @@ zenithServer state = getinfo :<|> handleRPC
                             "Account does not exist."
             _anyOtherParams ->
               return $ ErrorResponse (callId req) (-32602) "Invalid params"
+        GetFVK -> do
+          case parameters req of
+            ViewingKeyParams aid -> do
+              let dbPath = w_dbPath state
+              let net = w_network state
+              pool <- liftIO $ runNoLoggingT $ initPool dbPath
+              acc <- liftIO $ getAccountById pool $ toSqlKey $ fromIntegral aid
+              case acc of
+                Just acc' -> do
+                  fvk <-
+                    liftIO $
+                    try
+                      (deriveUfvk
+                         net
+                         (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc')
+                         (getSapSK $ zcashAccountSapSpendKey $ entityVal acc')
+                         (getTranSK $ zcashAccountTPrivateKey $ entityVal acc')) :: Handler
+                      (Either SomeException T.Text)
+                  case fvk of
+                    Left _ ->
+                      return $
+                      ErrorResponse (callId req) (-32010) "Internal Error"
+                    Right fvk' -> return $ ViewingKeyResponse (callId req) fvk'
+                Nothing ->
+                  return $
+                  ErrorResponse (callId req) (-32006) "Account does not exist."
+            _anyOtherParams ->
+              return $ ErrorResponse (callId req) (-32602) "Invalid params"
 
 authenticate :: Config -> BasicAuthCheck Bool
 authenticate config = BasicAuthCheck check

test/ServerSpec.hs

@@ -724,6 +724,56 @@ main = do
               case res of
                 Left e -> assertFailure e
                 Right (MultiOpResponse i c) -> c `shouldNotBe` []
+        describe "Viewing Keys" $ do
+          describe "Full" $ do
+            it "bad credentials" $ do
+              res <-
+                makeZenithCall
+                  "127.0.0.1"
+                  nodePort
+                  "baduser"
+                  "idontknow"
+                  GetFVK
+                  BlankParams
+              res `shouldBe` Left "Invalid credentials"
+            describe "correct credentials" $ do
+              it "no parameters" $ do
+                res <-
+                  makeZenithCall
+                    "127.0.0.1"
+                    nodePort
+                    nodeUser
+                    nodePwd
+                    GetFVK
+                    BlankParams
+                case res of
+                  Left e -> assertFailure e
+                  Right (ErrorResponse i c m) -> c `shouldBe` (-32602)
+              it "invalid account" $ do
+                res <-
+                  makeZenithCall
+                    "127.0.0.1"
+                    nodePort
+                    nodeUser
+                    nodePwd
+                    GetFVK
+                    (ViewingKeyParams 27)
+                case res of
+                  Left e -> assertFailure e
+                  Right (ErrorResponse i c m) -> c `shouldBe` (-32006)
+              it "valid account" $ do
+                res <-
+                  makeZenithCall
+                    "127.0.0.1"
+                    nodePort
+                    nodeUser
+                    nodePwd
+                    GetFVK
+                    (ViewingKeyParams 1)
+                case res of
+                  Left e -> assertFailure e
+                  Right (ViewingKeyResponse i c) -> c `shouldNotBe` ""
+                  Right x -> assertFailure $ show x
 
 startAPI :: Config -> IO ()
 startAPI config = do