Add tests for new viewing key endpoint

package.yaml

@@ -164,3 +164,4 @@ tests:
     - scotty
     - megaparsec
     - uuid
+    - zcash-haskell

src/ZGoBackend.hs

@@ -67,6 +67,8 @@ import WooCommerce
 import Xero
 import ZGoTx
 import ZcashHaskell.Sapling
+import ZcashHaskell.Types (RawData(..))
+import ZcashHaskell.Utils (decodeBech32)
 
 -- Models for API objects
 -- | A type to model Zcash RPC calls
@@ -1061,13 +1063,18 @@ routes pipe config = do
     u <- liftAndCatchIO $ run (findUser s)
     o <- jsonData
     let q = payload (o :: Payload String)
+    let qRaw = decodeBech32 $ C.pack q
+    if hrp qRaw == "fail"
+      then status badRequest400
+      else do
+        let qBytes = bytes qRaw
         case cast' . Doc =<< u of
           Nothing -> status unauthorized401
           Just u' -> do
-        if isValidSaplingViewingKey $ C.pack q
+            if isValidSaplingViewingKey qBytes
               then if matchSaplingAddress
-                    (C.pack q)
+                        qBytes
-                    (C.pack . T.unpack $ uaddress u')
+                        (bytes . decodeBech32 . C.pack . T.unpack $ uaddress u')
                      then do
                        owner <- liftAndCatchIO $ run (findOwner $ uaddress u')
                        case cast' . Doc =<< owner of
@@ -1080,12 +1087,15 @@ routes pipe config = do
                                  nodeUser
                                  nodePwd
                                  "z_importviewingkey"
-                             [Data.Aeson.String (T.strip . T.pack $ q), "no"]
+                                 [ 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)
+                                 _ <-
+                                   liftAndCatchIO $ run (upsertViewingKey o' q)
                                  status created201
                                else do
                                  text $ L.pack . show $ err content

test/Spec.hs

@@ -403,7 +403,7 @@ main = do
             let testOrder =
                   ZGoOrder
                     (Just (read "627ab3ea2b05a76be3000011"))
-                    "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
+                    "zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
                     "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
                     myTs
                     False
@@ -518,7 +518,7 @@ main = do
                     (Just (read "627d7ba92b05a76be3000013"))
                     "Table"
                     "Oak"
-                    "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
+                    "zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
                     499.99
             req <-
               testPostJson "/api/item" $ A.object ["payload" A..= A.toJSON item]
@@ -721,6 +721,63 @@ main = do
                 ]
             res <- httpLBS req
             getResponseStatus res `shouldBe` noContent204
+        describe "Viewing Key endpoint" $ do
+          let vk0 =
+                "zxviews1qwrw0jlxqqqqpqr9faepwqpgj09f0ee55mfwl60eumv6duk5pwncntweah0xdlhqrwre2fgmgersah9atx92z6pmxec8t32mpz59t47yuplkcdcaw3873aalv7e59xhwv846g9q9qjy0ypc68ceypg6pux490dr4snsc4m482l57rvnzj2lsh4f3dv6mltc75z72pypkx0dchwpumdwfuajstfhwulv30kjt5l0x7juwe523ufwz2xleplxf37gk2pfh59gmdjr4zsql4ga9p"
+          let vk1 =
+                "zxviews1qdjagrrpqqqqpq8es75mlu6rref0qyrstchf8dxzeygtsejwfqu8ckhwl2qj5m8am7lmupxk3vkvdjm8pawjpmesjfapvsqw96pa46c2z0kk7letrxf7mkltwz54fwpxc7kc79mm5kce3rwn5ssl009zwsra2spppwgrx25s9k5hq65f69l4jz2tjmqgy0pl49qmtaj3nudk6wglwe2hpa327hydlchtyq9av6wjd6hu68e04ahwk9a9n2kt0kj3nj99nue65awtu5cwwcpjs"
+          let vk2 =
+                "zxviews1qdjagrrpqqqqpq8es75mlufakef0qyrstchf8dxzeygtsejwfqu8ckhwl2qj5m8am7lmupxk3vkvdjm8pawjpmesjfapvsqw96pa46c2z0kk7letrxf7mkltwz54fwpxc7kc79mm5kce3rwn5ssl009zwsra2spppwgrx25s9k5hq65f69l4jz2tjmqgy0pl49qmtaj3nudk6wglwe2hpa327hydlchtyq9av6wjd6hu68e04ahwk9a9n2kt0kj3nj99nue65awtu5cwwcpjs"
+          it "returns 401 with bad session" $ do
+            req <-
+              testPostJson "/api/ownervk" $
+              A.object ["payload" A..= (vk0 :: String)]
+            res <-
+              httpLBS $
+              setRequestQueryString
+                [("session", Just "35bfb9c2-9ad2-4fe5-fake-99d63b8dcdcd")]
+                req
+            getResponseStatus res `shouldBe` unauthorized401
+          it "returns 403 with mismatched session" $ do
+            req <-
+              testPostJson "/api/ownervk" $
+              A.object ["payload" A..= (vk0 :: String)]
+            res <-
+              httpLBS $
+              setRequestQueryString
+                [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
+                req
+            getResponseStatus res `shouldBe` forbidden403
+          it "returns 400 with malformed key" $ do
+            req <-
+              testPostJson "/api/ownervk" $
+              A.object ["payload" A..= (vk2 :: String)]
+            res <-
+              httpLBS $
+              setRequestQueryString
+                [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
+                req
+            getResponseStatus res `shouldBe` badRequest400
+          it "returns 400 with non-key valid bech32" $ do
+            req <-
+              testPostJson "/api/ownervk" $
+              A.object ["payload" A..= ("bech321qqqsyrhqy2a" :: String)]
+            res <-
+              httpLBS $
+              setRequestQueryString
+                [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
+                req
+            getResponseStatus res `shouldBe` badRequest400
+          it "succeeds with correct key" $ do
+            req <-
+              testPostJson "/api/ownervk" $
+              A.object ["payload" A..= (vk1 :: String)]
+            res <-
+              httpLBS $
+              setRequestQueryString
+                [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
+                req
+            getResponseStatus res `shouldBe` created201
     around handleDb $
       describe "Database actions" $ do
         describe "authentication" $ do
@@ -735,7 +792,7 @@ main = do
             doc <-
               access p master "test" $
               findProSession
-                "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
+                "zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
             doc `shouldNotBe` Nothing
           it "upsert to DB" $ const pending
         describe "Zcash prices" $ do
@@ -796,7 +853,7 @@ main = do
             let myOrder =
                   ZGoOrder
                     (Just (read "627ab3ea2b05a76be3000001"))
-                    "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
+                    "zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
                     "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
                     myTs
                     False
@@ -827,23 +884,23 @@ main = do
             t <-
               access p master "test" $
               findToken
-                "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
+                "zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
             let t1 = (cast' . Doc) =<< t
             case t1 of
               Nothing -> True `shouldBe` False
               Just t2 ->
                 t_address t2 `shouldBe`
-                "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
+                "zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
           it "code is saved" $ \p -> do
             _ <-
               access p master "test" $
               addAccCode
-                "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
+                "zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
                 "ZEC"
             t <-
               access p master "test" $
               findToken
-                "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
+                "zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
             let t1 = (cast' . Doc) =<< t
             case t1 of
               Nothing -> True `shouldBe` False
@@ -875,7 +932,7 @@ main = do
             let myUser =
                   User
                     (Just (read "6272a90f2b05a74cf1000002" :: ObjectId))
-                    "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
+                    "zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
                     "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcb"
                     1613487
                     "1234567"
@@ -917,13 +974,13 @@ main = do
                   findOne
                     (select
                        [ "address" =:
-                         ("zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e" :: T.Text)
+                         ("zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4" :: T.Text)
                        ]
                        "owners")
                 let s = (cast' . Doc) =<< t
                 let ownerPaid = maybe False opaid s
                 ownerPaid `shouldBe` True
-              _ -> True `shouldBe` False `debug` "Failed parsing payment"
+              _ -> True `shouldBe` False --`debug` "Failed parsing payment"
           xit "owners are expired" $ \p -> do
             _ <- expireOwners p "test"
             now <- getCurrentTime
@@ -942,7 +999,7 @@ main = do
             let myTx =
                   ZGoTx
                     Nothing
-                    "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
+                    "zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
                     "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdca"
                     3
                     1613487
@@ -1115,7 +1172,7 @@ startAPI config = do
   let myUser =
         User
           (Just (read "6272a90f2b05a74cf1000001" :: ObjectId))
-          "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
+          "zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
           "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
           1613487
           "8ea140fbb30615d6cae383c4f62f3ad9afb10b804f63138d5b53990bd56e0162"
@@ -1123,7 +1180,7 @@ startAPI config = do
   let myUser1 =
         User
           (Just (read "6272a90f2b05a74cf1000003" :: ObjectId))
-          "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
+          "zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
           "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdaa"
           1613487
           "8ea140fbb30615d6cae383c4f62f3ad9afb10b804f63138d5b53990bd56e0162"
@@ -1142,7 +1199,7 @@ startAPI config = do
   let myOwner =
         Owner
           (Just (read "627ad3492b05a76be3000001"))
-          "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
+          "zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
           "Test shop"
           "usd"
           False
@@ -1207,7 +1264,7 @@ startAPI config = do
   let myOrder =
         ZGoOrder
           (Just (read "627ab3ea2b05a76be3000000"))
-          "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
+          "zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
           "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
           myTs
           False
@@ -1238,7 +1295,7 @@ startAPI config = do
   let proSession1 =
         ZGoProSession
           Nothing
-          "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
+          "zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
           myTs
           False
   let proSessionTest = val proSession1
@@ -1248,7 +1305,7 @@ startAPI config = do
   let myToken =
         XeroToken
           Nothing
-          "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
+          "zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
           "superFakeToken123"
           1800
           "anotherSuperFakeToken"

zgo-backend.cabal

@@ -183,5 +183,6 @@ test-suite zgo-backend-test
     , text
     , time
     , uuid
+    , zcash-haskell
     , zgo-backend
   default-language: Haskell2010