Implement new endpoint for viewing keys

Mantis Issue 28
2023-06-15 19:40:58 -05:00 · 2023-06-15 19:40:58 -05:00 · 9f64683474
parent 353c91204a
commit 9f64683474
7 changed files with 116 additions and 0 deletions
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@ -9,6 +9,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 ### Added

 - New JSON serialization for WooTokens.
+- New `/api/ownervk` endpoint to save viewing keys
+- Use of `zcash-haskell` library to validate Sapling viewing keys

 ### Changed

--- a/package.yaml
+++ b/package.yaml
@ -62,6 +62,7 @@ library:
  - crypto-rng
  - megaparsec
  - uuid
+  - zcash-haskell

 executables:
  zgo-backend-exe:
--- a/src/Owner.hs
+++ b/src/Owner.hs
@ -441,6 +441,10 @@ updateOwnerSettings os =
      ]
    ]

+upsertViewingKey :: Owner -> String -> Action IO ()
+upsertViewingKey o vk =
+  modify (select ["_id" =: o_id o] "owners") ["$set" =: ["viewKey" =: vk]]
+
 -- | Type for a pro session
 data ZGoProSession =
  ZGoProSession
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@ -66,6 +66,7 @@ import Web.Scotty
 import WooCommerce
 import Xero
 import ZGoTx
+import ZcashHaskell.Sapling

 -- Models for API objects
 -- | A type to model Zcash RPC calls
@ -1055,6 +1056,42 @@ routes pipe config = do
            liftAndCatchIO $ run $ updateOwnerSettings q
            status accepted202
          else status noContent204
+  post "/api/ownervk" $ do
+    s <- param "session"
+    u <- liftAndCatchIO $ run (findUser s)
+    o <- jsonData
+    let q = payload (o :: Payload String)
+    case cast' . Doc =<< u of
+      Nothing -> status unauthorized401
+      Just u' -> do
+        if isValidSaplingViewingKey $ C.pack q
+          then if matchSaplingAddress
+                    (C.pack q)
+                    (C.pack . T.unpack $ uaddress u')
+                 then do
+                   owner <- liftAndCatchIO $ run (findOwner $ uaddress u')
+                   case cast' . Doc =<< owner of
+                     Nothing -> status badRequest400
+                     Just o' -> do
+                       unless (oviewkey o' /= "") $ do
+                         vkInfo <-
+                           liftAndCatchIO $
+                           makeZcashCall
+                             nodeUser
+                             nodePwd
+                             "z_importviewingkey"
+                             [Data.Aeson.String (T.strip . T.pack $ q), "no"]
+                         let content =
+                               getResponseBody vkInfo :: RpcResponse Object
+                         if isNothing (err content)
+                           then do
+                             _ <- liftAndCatchIO $ run (upsertViewingKey o' q)
+                             status created201
+                           else do
+                             text $ L.pack . show $ err content
+                             status badRequest400
+                 else status forbidden403
+          else status badRequest400
    --Get items associated with the given address
  get "/api/items" $ do
    session <- param "session"
--- a/stack.yaml
+++ b/stack.yaml
@ -44,6 +44,16 @@ packages:
 extra-deps:
  - git: https://github.com/reach-sh/haskell-hexstring.git
    commit: 085c16fb21b9f856a435a3faab980e7e0b319341
+  - git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
+    commit: fef3d3af35a09db718cddb8fc9166b2d2691a744
+  - git: https://git.vergara.tech/Vergara_Tech/haskell-foreign-rust.git
+    commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05
+  - git: https://github.com/well-typed/borsh.git
+    commit: d2fcfa159e0a844b1ec5e8ed3e232d4b380fa831
+  - aeson-2.1.2.1@sha256:5b8d62a60963a925c4d123a46e42a8e235a32188522c9f119f64ac228c2612a7,6359
+  - vector-0.13.0.0@sha256:fa5cac81a17a5af388716792e8b99c24b3b66770086756d0d8b23f8272a0244c,9112
+  - generically-0.1.1
+  - vector-algorithms-0.9.0.1
  - blake3-0.2@sha256:d1146b9a51ccfbb0532780778b6d016a614e3d44c05d8c1923dde9a8be869045,2448
  - crypto-rng-0.3.0.1@sha256:04f4ae75943ecad8b794950985054130f272d65a588b6b6528f56df0bfedc4dc,1565
 # Override default flag values for local packages and extra-deps
--- a/stack.yaml.lock
+++ b/stack.yaml.lock
@ -15,6 +15,67 @@ packages:
  original:
    commit: 085c16fb21b9f856a435a3faab980e7e0b319341
    git: https://github.com/reach-sh/haskell-hexstring.git
+- completed:
+    commit: fef3d3af35a09db718cddb8fc9166b2d2691a744
+    git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
+    name: zcash-haskell
+    pantry-tree:
+      sha256: ec7782cf2646da17548d59af0ea98dcbaac1b6c2176258c696a7f508db6dbc21
+      size: 1126
+    version: 0.1.0
+  original:
+    commit: fef3d3af35a09db718cddb8fc9166b2d2691a744
+    git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
+- completed:
+    commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05
+    git: https://git.vergara.tech/Vergara_Tech/haskell-foreign-rust.git
+    name: foreign-rust
+    pantry-tree:
+      sha256: be2f6fc0fab58a90fec657bdb6bd0ccf0810c7dccfe95c78b85e174fae227e42
+      size: 2315
+    version: 0.1.0
+  original:
+    commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05
+    git: https://git.vergara.tech/Vergara_Tech/haskell-foreign-rust.git
+- completed:
+    commit: d2fcfa159e0a844b1ec5e8ed3e232d4b380fa831
+    git: https://github.com/well-typed/borsh.git
+    name: borsh
+    pantry-tree:
+      sha256: 8335925f495a5a653fcb74b6b8bb18cd0b6b7fe7099a1686108704e6ab82f47b
+      size: 2268
+    version: 0.3.0
+  original:
+    commit: d2fcfa159e0a844b1ec5e8ed3e232d4b380fa831
+    git: https://github.com/well-typed/borsh.git
+- completed:
+    hackage: aeson-2.1.2.1@sha256:5b8d62a60963a925c4d123a46e42a8e235a32188522c9f119f64ac228c2612a7,6359
+    pantry-tree:
+      sha256: 58d33beedd6e0ff79920c636d8a4295deb684b6e97c9b1ca94d3c780958d6302
+      size: 82465
+  original:
+    hackage: aeson-2.1.2.1@sha256:5b8d62a60963a925c4d123a46e42a8e235a32188522c9f119f64ac228c2612a7,6359
+- completed:
+    hackage: vector-0.13.0.0@sha256:fa5cac81a17a5af388716792e8b99c24b3b66770086756d0d8b23f8272a0244c,9112
+    pantry-tree:
+      sha256: d2461d28022c8c0a91da08b579b1bff478f617102d2f5ef596cc5b28d14b8b6a
+      size: 4092
+  original:
+    hackage: vector-0.13.0.0@sha256:fa5cac81a17a5af388716792e8b99c24b3b66770086756d0d8b23f8272a0244c,9112
+- completed:
+    hackage: generically-0.1.1@sha256:2b9b5efb6eea2fb65377565d53d85b0ccc5b37404fba4bef1d60277caa877e5e,1155
+    pantry-tree:
+      sha256: 98a8fe89d516d3752a9cc0af22cfa652f098cc6613da080762b63aa1d596e56d
+      size: 233
+  original:
+    hackage: generically-0.1.1
+- completed:
+    hackage: vector-algorithms-0.9.0.1@sha256:f3e5c6695529a94edf762117cafd91c989cb642ad3f8ca4014dbb13c8f6c2a20,3826
+    pantry-tree:
+      sha256: aef389e57ae6020e5da719bee40aaf6cccf1c4d1e7743a85d30c9d8c25d170a0
+      size: 1510
+  original:
+    hackage: vector-algorithms-0.9.0.1
 - completed:
    hackage: blake3-0.2@sha256:d1146b9a51ccfbb0532780778b6d016a614e3d44c05d8c1923dde9a8be869045,2448
    pantry-tree:
--- a/zgo-backend.cabal
+++ b/zgo-backend.cabal
@ -78,6 +78,7 @@ library
    , wai-cors
    , wai-extra
    , warp-tls
+    , zcash-haskell
  default-language: Haskell2010

 executable zgo-backend-exe