CHANGELOG.md

@@ -19,6 +19,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 - `getnewwallet` RPC method
 - `getnewaccount` RPC method
 - `getnewaddress` RPC method
+- `getoperationstatus` RPC method
 
 ### Changed
 

src/Zenith/DB.hs

@@ -30,6 +30,8 @@ import Data.Maybe (catMaybes, fromJust, isJust)
 import Data.Pool (Pool)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as TE
+import Data.Time.Clock (UTCTime, getCurrentTime)
+import qualified Data.UUID as U
 import Data.Word
 import Database.Esqueleto.Experimental
 import qualified Database.Persist.Sqlite as PS
@@ -87,6 +89,8 @@ import Zenith.Types
   , ZcashNoteAPI(..)
   , ZcashPool(..)
   , ZcashWalletAPI(..)
+  , ZenithStatus(..)
+  , ZenithUuid(..)
   )
 
 share
@@ -272,6 +276,14 @@ share
     abaddress T.Text
     UniqueABA abaddress
     deriving Show Eq
+  Operation json
+    uuid ZenithUuid
+    start UTCTime
+    end UTCTime Maybe
+    status ZenithStatus
+    result T.Text Maybe
+    UniqueOp uuid
+    deriving Show Eq
     |]
 
 -- ** Type conversions
@@ -2059,3 +2071,37 @@ deleteAdrsFromAB pool ia = do
 
 rmdups :: Ord a => [a] -> [a]
 rmdups = map head . group . sort
+
+-- * Zenith Operations
+-- | Get an operation by UUID
+getOperation :: ConnectionPool -> U.UUID -> IO (Maybe (Entity Operation))
+getOperation pool uid = do
+  runNoLoggingT $
+    PS.retryOnBusy $
+    flip PS.runSqlPool pool $ do
+      selectOne $ do
+        ops <- from $ table @Operation
+        where_ (ops ^. OperationUuid ==. val (ZenithUuid uid))
+        pure ops
+
+-- | Save an operation
+saveOperation :: ConnectionPool -> Operation -> IO (Maybe (Key Operation))
+saveOperation pool op = do
+  runNoLoggingT $ PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUnique op
+
+-- | Finalize an operation with either a successful result or an error
+finalizeOperation ::
+     ConnectionPool -> Key Operation -> ZenithStatus -> T.Text -> IO ()
+finalizeOperation pool op status result = do
+  tstamp <- getCurrentTime
+  runNoLoggingT $
+    PS.retryOnBusy $
+    flip PS.runSqlPool pool $
+    update $ \ops -> do
+      set
+        ops
+        [ OperationEnd =. val (Just tstamp)
+        , OperationStatus =. val status
+        , OperationResult =. val (Just result)
+        ]
+      where_ (ops ^. OperationId ==. val op)

src/Zenith/RPC.hs

@@ -19,8 +19,14 @@ import Data.Int
 import Data.Scientific (floatingOrInteger)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as E
+import qualified Data.UUID as U
 import qualified Data.Vector as V
-import Database.Esqueleto.Experimental (entityKey, fromSqlKey, toSqlKey)
+import Database.Esqueleto.Experimental
+  ( entityKey
+  , entityVal
+  , fromSqlKey
+  , toSqlKey
+  )
 import Servant
 import Text.Read (readMaybe)
 import ZcashHaskell.Keys (generateWalletSeedPhrase)
@@ -28,7 +34,8 @@ import ZcashHaskell.Orchard (parseAddress)
 import ZcashHaskell.Types (RpcError(..), Scope(..), ZcashNet(..))
 import Zenith.Core (createCustomWalletAddress, createZcashAccount)
 import Zenith.DB
-  ( ZcashAccount(..)
+  ( Operation(..)
+  , ZcashAccount(..)
   , ZcashWallet(..)
   , findNotesByAddress
   , getAccountById
@@ -38,6 +45,7 @@ import Zenith.DB
   , getExternalAddresses
   , getMaxAccount
   , getMaxAddress
+  , getOperation
   , getPoolBalance
   , getUnconfPoolBalance
   , getWalletNotes
@@ -60,6 +68,7 @@ import Zenith.Types
   , ZcashNetDB(..)
   , ZcashNoteAPI(..)
   , ZcashWalletAPI(..)
+  , ZenithUuid(..)
   )
 import Zenith.Utils (jsonNumber)
 
@@ -73,6 +82,7 @@ data ZenithMethod
   | GetNewWallet
   | GetNewAccount
   | GetNewAddress
+  | GetOperationStatus
   | UnknownMethod
   deriving (Eq, Prelude.Show)
 
@@ -86,6 +96,7 @@ instance ToJSON ZenithMethod where
   toJSON GetNewWallet = Data.Aeson.String "getnewwallet"
   toJSON GetNewAccount = Data.Aeson.String "getnewaccount"
   toJSON GetNewAddress = Data.Aeson.String "getnewaddress"
+  toJSON GetOperationStatus = Data.Aeson.String "getoperationstatus"
   toJSON UnknownMethod = Data.Aeson.Null
 
 instance FromJSON ZenithMethod where
@@ -100,6 +111,7 @@ instance FromJSON ZenithMethod where
       "getnewwallet" -> pure GetNewWallet
       "getnewaccount" -> pure GetNewAccount
       "getnewaddress" -> pure GetNewAddress
+      "getoperationstatus" -> pure GetOperationStatus
       _ -> pure UnknownMethod
 
 data ZenithParams
@@ -112,6 +124,7 @@ data ZenithParams
   | NameParams !T.Text
   | NameIdParams !T.Text !Int
   | NewAddrParams !Int !T.Text !Bool !Bool
+  | OpParams !ZenithUuid
   | TestParams !T.Text
   deriving (Eq, Prelude.Show)
 
@@ -133,6 +146,8 @@ instance ToJSON ZenithParams where
     [jsonNumber a, Data.Aeson.String n] <>
     [Data.Aeson.String "ExcludeSapling" | s] <>
     [Data.Aeson.String "ExcludeTransparent" | t]
+  toJSON (OpParams i) =
+    Data.Aeson.Array $ V.fromList [Data.Aeson.String $ U.toText $ getUuid i]
 
 data ZenithResponse
   = InfoResponse !T.Text !ZenithInfo
@@ -143,6 +158,7 @@ data ZenithResponse
   | BalanceResponse !T.Text !AccountBalance !AccountBalance
   | NewItemResponse !T.Text !Int64
   | NewAddrResponse !T.Text !ZcashAddressAPI
+  | OpResponse !T.Text !Operation
   | ErrorResponse !T.Text !Double !T.Text
   deriving (Eq, Prelude.Show)
 
@@ -162,6 +178,7 @@ instance ToJSON ZenithResponse where
     packRpcResponse i $ object ["confirmed" .= c, "unconfirmed" .= u]
   toJSON (NewItemResponse i ix) = packRpcResponse i ix
   toJSON (NewAddrResponse i a) = packRpcResponse i a
+  toJSON (OpResponse i u) = packRpcResponse i u
 
 instance FromJSON ZenithResponse where
   parseJSON =
@@ -183,6 +200,7 @@ instance FromJSON ZenithResponse where
                       v <- k .:? "version"
                       v5 <- k .:? "unconfirmed"
                       v6 <- k .:? "ua"
+                      v7 <- k .:? "uuid"
                       case (v :: Maybe String) of
                         Just _v' -> do
                           k1 <- parseJSON r1
@@ -199,7 +217,12 @@ instance FromJSON ZenithResponse where
                                 Just _v6' -> do
                                   k7 <- parseJSON r1
                                   pure $ NewAddrResponse i k7
-                                Nothing -> fail "Unknown object"
+                                Nothing ->
+                                  case (v7 :: Maybe U.UUID) of
+                                    Just _v7' -> do
+                                      k8 <- parseJSON r1
+                                      pure $ OpResponse i k8
+                                    Nothing -> fail "Unknown object"
                     Array n -> do
                       if V.null n
                         then fail "Malformed JSON"
@@ -379,6 +402,20 @@ instance FromJSON RpcCall where
                   pure $ RpcCall v i GetNewAddress (NewAddrParams x y sap tr)
                 else pure $ RpcCall v i GetNewAddress BadParams
             _anyOther -> pure $ RpcCall v i GetNewAddress BadParams
+        GetOperationStatus -> do
+          p <- obj .: "params"
+          case p of
+            Array a ->
+              if V.length a == 1
+                then do
+                  x <- parseJSON $ a V.! 0
+                  case U.fromText x of
+                    Just u -> do
+                      pure $
+                        RpcCall v i GetOperationStatus (OpParams $ ZenithUuid u)
+                    Nothing -> pure $ RpcCall v i GetOperationStatus BadParams
+                else pure $ RpcCall v i GetOperationStatus BadParams
+            _anyOther -> pure $ RpcCall v i GetOperationStatus BadParams
 
 type ZenithRPC
   = "status" :> Get '[ JSON] Value :<|> BasicAuth "zenith-realm" Bool :> ReqBody
@@ -631,6 +668,20 @@ zenithServer state = getinfo :<|> handleRPC
                   ErrorResponse (callId req) (-32006) "Account does not exist."
             _anyOtherParams ->
               return $ ErrorResponse (callId req) (-32602) "Invalid params"
+        GetOperationStatus ->
+          case parameters req of
+            OpParams u -> do
+              let dbPath = w_dbPath state
+              pool <- liftIO $ runNoLoggingT $ initPool dbPath
+              op <- liftIO $ getOperation pool $ getUuid u
+              case op of
+                Just o -> do
+                  return $ OpResponse (callId req) $ entityVal o
+                Nothing ->
+                  return $
+                  ErrorResponse (callId req) (-32009) "Operation ID not found"
+            _anyOtherParams ->
+              return $ ErrorResponse (callId req) (-32602) "Invalid params"
 
 authenticate :: Config -> BasicAuthCheck Bool
 authenticate config = BasicAuthCheck check

src/Zenith/Types.hs

@@ -14,19 +14,18 @@ import Data.Aeson.TH (deriveJSON)
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Base64 as B64
 import qualified Data.ByteString.Char8 as C
-import Data.Char (toLower)
 import Data.HexString
 import Data.Int (Int64)
 import Data.Maybe (fromMaybe)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as E
 import Data.Text.Encoding.Error (lenientDecode)
+import qualified Data.UUID as U
 import Database.Persist.TH
 import GHC.Generics
 import ZcashHaskell.Types
   ( OrchardSpendingKey(..)
   , Phrase(..)
-  , RpcError(..)
   , Rseed(..)
   , SaplingSpendingKey(..)
   , Scope(..)
@@ -130,6 +129,12 @@ instance FromJSON ZcashPool where
       "orchard" -> return Orchard
       _ -> fail "Not a known Zcash pool"
 
+newtype ZenithUuid = ZenithUuid
+  { getUuid :: U.UUID
+  } deriving newtype (Show, Eq, Read, ToJSON, FromJSON)
+
+derivePersistField "ZenithUuid"
+
 -- ** API types
 data ZcashWalletAPI = ZcashWalletAPI
   { zw_index :: !Int
@@ -183,6 +188,16 @@ data AccountBalance = AccountBalance
 
 $(deriveJSON defaultOptions {fieldLabelModifier = drop 4} ''AccountBalance)
 
+data ZenithStatus
+  = Processing
+  | Failed
+  | Successful
+  deriving (Eq, Prelude.Show, Read)
+
+$(deriveJSON defaultOptions ''ZenithStatus)
+
+derivePersistField "ZenithStatus"
+
 -- ** `zebrad`
 -- | Type for modeling the tree state response
 data ZebraTreeInfo = ZebraTreeInfo

test/ServerSpec.hs

@@ -3,11 +3,15 @@
 import Control.Concurrent (forkIO, threadDelay)
 import Control.Exception (SomeException, throwIO, try)
 import Control.Monad (when)
+import Control.Monad.Logger (runNoLoggingT)
 import Data.Aeson
 import qualified Data.ByteString as BS
 import Data.Configurator
+import Data.Maybe (fromMaybe)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as E
+import Data.Time.Clock (getCurrentTime)
+import qualified Data.UUID as U
 import Network.HTTP.Simple
 import Network.Wai.Handler.Warp (run)
 import Servant
@@ -21,7 +25,7 @@ import ZcashHaskell.Types
   , ZebraGetInfo(..)
   )
 import Zenith.Core (checkBlockChain, checkZebra)
-import Zenith.DB (initDb)
+import Zenith.DB (Operation(..), initDb, initPool, saveOperation)
 import Zenith.RPC
   ( RpcCall(..)
   , State(..)
@@ -38,6 +42,8 @@ import Zenith.Types
   , ZcashAccountAPI(..)
   , ZcashAddressAPI(..)
   , ZcashWalletAPI(..)
+  , ZenithStatus(..)
+  , ZenithUuid(..)
   )
 
 main :: IO ()
@@ -505,6 +511,67 @@ main = do
                 case res of
                   Left e -> assertFailure e
                   Right (ErrorResponse i c m) -> c `shouldBe` (-32006)
+        describe "Operations" $ do
+          describe "getoperationstatus" $ do
+            it "bad credentials" $ do
+              res <-
+                makeZenithCall
+                  "127.0.0.1"
+                  nodePort
+                  "baduser"
+                  "idontknow"
+                  GetOperationStatus
+                  BlankParams
+              res `shouldBe` Left "Invalid credentials"
+            describe "correct credentials" $ do
+              it "invalid ID" $ do
+                res <-
+                  makeZenithCall
+                    "127.0.0.1"
+                    nodePort
+                    nodeUser
+                    nodePwd
+                    GetOperationStatus
+                    (NameParams "badId")
+                case res of
+                  Left e -> assertFailure e
+                  Right (ErrorResponse i c m) -> c `shouldBe` (-32602)
+              it "valid ID" $ do
+                res <-
+                  makeZenithCall
+                    "127.0.0.1"
+                    nodePort
+                    nodeUser
+                    nodePwd
+                    GetOperationStatus
+                    (OpParams
+                       (ZenithUuid $
+                        fromMaybe U.nil $
+                        U.fromText "bd2aa95a-db51-4cc4-9fea-0f9cf79003a4"))
+                case res of
+                  Left e -> assertFailure e
+                  Right (OpResponse i o) ->
+                    operationUuid o `shouldBe`
+                    (ZenithUuid $
+                     fromMaybe U.nil $
+                     U.fromText "bd2aa95a-db51-4cc4-9fea-0f9cf79003a4")
+                  Right _ -> assertFailure "unexpected response"
+              it "valid ID not found" $ do
+                res <-
+                  makeZenithCall
+                    "127.0.0.1"
+                    nodePort
+                    nodeUser
+                    nodePwd
+                    GetOperationStatus
+                    (OpParams
+                       (ZenithUuid $
+                        fromMaybe U.nil $
+                        U.fromText "bd2aa95a-db51-4cc4-9fea-0f9cf79003a5"))
+                case res of
+                  Left e -> assertFailure e
+                  Right (ErrorResponse i c m) -> c `shouldBe` (-32009)
+                  Right _ -> assertFailure "unexpected response"
 
 startAPI :: Config -> IO ()
 startAPI config = do
@@ -527,6 +594,19 @@ startAPI config = do
           case x of
             Left e2 -> throwIO $ userError e2
             Right x' -> do
+              pool <- runNoLoggingT $ initPool "test.db"
+              ts <- getCurrentTime
+              y <-
+                saveOperation
+                  pool
+                  (Operation
+                     (ZenithUuid $
+                      fromMaybe U.nil $
+                      U.fromText "bd2aa95a-db51-4cc4-9fea-0f9cf79003a4")
+                     ts
+                     Nothing
+                     Processing
+                     Nothing)
               let myState =
                     State
                       (zgb_net chainInfo)

zenith-openrpc.json

@@ -606,7 +606,7 @@
       "name": "getoperationstatus",
       "summary": "Get the status of a Zenith operation",
       "description": "Get the status of the given operation",
-      "tags": [{"$ref": "#/components/tags/wip"}, {"$ref": "#/components/tags/draft"}],
+      "tags": [],
       "params": [{ "$ref": "#/components/contentDescriptors/OperationId"}],
       "paramStructure": "by-position",
       "result": {
@@ -755,7 +755,7 @@
           "start": {"type": "string", "description": "The date and time the operation started"},
           "end": {"type": ["string", "null"], "description": "The date and time the operation ended. If the operation is still running, this field is null"},
           "status": {"type": "string", "enum": ["Processing", "Failed", "Successful"], "description": "If the operation has started it will show Processing, once it completes it will show Failed or Successful depending on the outcome"},
-          "result": {"type": "string", "description": "For a succesful transaction operation, the transaction ID. For failed operations, the error message"}
+          "result": {"type": ["string", "null"], "description": "For a succesful transaction operation, the transaction ID. For failed operations, the error message. For pending operations, this field is null."}
         }
       }
     },

zenith.cabal

@@ -87,6 +87,7 @@ library
     , text
     , text-show
     , time
+    , uuid
     , vector
     , vty
     , vty-crossplatform
@@ -173,6 +174,7 @@ test-suite zenithserver-tests
     , sort
     , text
     , time
+    , uuid
     , http-conduit
     , persistent
     , persistent-sqlite