feat: getoperationstatus RPC method

2024-09-04 13:10:09 -05:00 · 2024-09-04 13:10:09 -05:00 · 35dce186fd
commit 35dce186fd
parent bd3d9e8067
7 changed files with 203 additions and 8 deletions
--- a/CHANGELOG.md
+++ b/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

--- a/src/Zenith/DB.hs
+++ b/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)
--- a/src/Zenith/RPC.hs
+++ b/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
--- a/src/Zenith/Types.hs
+++ b/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
--- a/test/ServerSpec.hs
+++ b/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)
--- a/zenith-openrpc.json
+++ b/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."}
        }
      }
    },
--- a/zenith.cabal
+++ b/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