Tests for adding UVK

src/ZGoBackend.hs

@@ -1244,7 +1244,10 @@ routes pipe config = do
                   else status forbidden403
               else case decodeUfvk (C.pack q) of
                      Nothing -> status badRequest400
-                     Just fvk ->
+                     Just fvk -> do
+                       if isValidUnifiedAddress $
+                          C.pack . T.unpack $ uaddress u'
+                         then do
                            if matchOrchardAddress
                                 (C.pack q)
                                 (C.pack . T.unpack $ uaddress u')
@@ -1255,7 +1258,24 @@ routes pipe config = do
                                  Nothing -> status badRequest400
                                  Just o' -> do
                                    unless (oviewkey o' /= "") $ do
-                                 liftAndCatchIO $ run (upsertViewingKey o' q)
+                                     liftAndCatchIO $
+                                       run (upsertViewingKey o' q)
+                                     status created201
+                             else status forbidden403
+                         else do
+                           if matchSaplingAddress
+                                (s_key fvk)
+                                (bytes . decodeBech32 . 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
+                                     liftAndCatchIO $
+                                       run (upsertViewingKey o' q)
                                      status created201
                              else status forbidden403
     --Get items associated with the given address

test/Spec.hs

@@ -691,6 +691,8 @@ main = do
                 "zxviews1qdjagrrpqqqqpq8es75mlu6rref0qyrstchf8dxzeygtsejwfqu8ckhwl2qj5m8am7lmupxk3vkvdjm8pawjpmesjfapvsqw96pa46c2z0kk7letrxf7mkltwz54fwpxc7kc79mm5kce3rwn5ssl009zwsra2spppwgrx25s9k5hq65f69l4jz2tjmqgy0pl49qmtaj3nudk6wglwe2hpa327hydlchtyq9av6wjd6hu68e04ahwk9a9n2kt0kj3nj99nue65awtu5cwwcpjs"
           let vk2 =
                 "zxviews1qdjagrrpqqqqpq8es75mlufakef0qyrstchf8dxzeygtsejwfqu8ckhwl2qj5m8am7lmupxk3vkvdjm8pawjpmesjfapvsqw96pa46c2z0kk7letrxf7mkltwz54fwpxc7kc79mm5kce3rwn5ssl009zwsra2spppwgrx25s9k5hq65f69l4jz2tjmqgy0pl49qmtaj3nudk6wglwe2hpa327hydlchtyq9av6wjd6hu68e04ahwk9a9n2kt0kj3nj99nue65awtu5cwwcpjs"
+          let vk3 =
+                "uview1u833rp8yykd7h4druwht6xp6k8krle45fx8hqsw6vzw63n24atxpcatws82z092kryazuu6d7rayyut8m36wm4wpjy2z8r9hj48fx5pf49gw4sjrq8503qpz3vqj5hg0vg9vsqeasg5qjuyh94uyfm7v76udqcm2m0wfc25hcyqswcn56xxduq3xkgxkr0l73cjy88fdvf90eq5fda9g6x7yv7d0uckpevxg6540wc76xrc4axxvlt03ptaa2a0rektglmdy68656f3uzcdgqqyu0t7wk5cvwghyyvgqc0rp3vgu5ye4nd236ml57rjh083a2755qemf6dk6pw0qrnfm7246s8eg2hhzkzpf9h73chhng7xhmyem2sjh8rs2m9nhfcslsgenm"
           it "returns 401 with bad session" $ do
             req <-
               testPostJson "/api/ownervk" $
@@ -731,7 +733,7 @@ main = do
                 [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
                 req
             getResponseStatus res `shouldBe` badRequest400
-          it "succeeds with correct key" $ do
+          it "succeeds with correct Sapling key" $ do
             req <-
               testPostJson "/api/ownervk" $
               A.object ["payload" A..= (vk1 :: String)]
@@ -741,6 +743,26 @@ main = do
                 [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
                 req
             getResponseStatus res `shouldBe` created201
+          it "succeeds with correct Unified key and UA" $ do
+            req <-
+              testPostJson "/api/ownervk" $
+              A.object ["payload" A..= (vk3 :: String)]
+            res <-
+              httpLBS $
+              setRequestQueryString
+                [("session", Just "35bfb9c2-9ad2-4fe5-daad-99d63b8dcdaa")]
+                req
+            getResponseStatus res `shouldBe` created201
+          xit "succeeds with correct Unified key and Sapling address" $ do
+            req <-
+              testPostJson "/api/ownervk" $
+              A.object ["payload" A..= (vk3 :: String)]
+            res <-
+              httpLBS $
+              setRequestQueryString
+                [("session", Just "35bfb9c2-a92d-4fe5-daad-99d63b8dcdaa")]
+                req
+            getResponseStatus res `shouldBe` created201
     around handleDb $
       describe "Database actions" $ do
         describe "authentication" $ do
@@ -1179,8 +1201,25 @@ startAPI config = do
           1613487
           "8ea140fbb30615d6cae383c4f62f3ad9afb10b804f63138d5b53990bd56e0162"
           True
+  let myUser3 =
+        User
+          (Just (read "6272a90f2b05a74cf1500003" :: ObjectId))
+          "u15hjz9v46azzmdept050heh8795qxzwy2pykg097lg69jpk4qzah90cj2q4amq0c07gta60x8qgw00qewcy3hg9kv9h6zjkh3jc66vr40u6uu2dxmqkqhypud95vm0gq7y5ga7c8psdqgthsrwvgd676a2pavpcd4euwwapgackxa3qhvga0wnl0k6vncskxlq94vqwjd7zepy3qd5jh"
+          "35bfb9c2-9ad2-4fe5-daad-99d63b8dcdaa"
+          1613487
+          "8ea140fbb30615d6cae383c4f62f3ad9afb10b804f63138d5b53990bd56e0162"
+          True
+  let myUser4 =
+        User
+          (Just (read "6272a90f2b05a74cf7500003" :: ObjectId))
+          "zs1fau9x305eztcdm5f08q9uc4hmvvjpjrgjcwcj0mjwhd83pdj0j92rxwqp6zkjmz3e49ej4xrcc8"
+          "35bfb9c2-a92d-4fe5-daad-99d63b8dcdaa"
+          1613487
+          "8ea140fbb30615d6cae383c4f62f3ad9afb10b804f63138d5b53990bd56e0162"
+          True
   let userList =
-        map unwrapDoc $ filter filterDocs $ val <$> [myUser, myUser1, myUser2]
+        map unwrapDoc $
+        filter filterDocs $ val <$> [myUser, myUser1, myUser2, myUser3, myUser4]
   _ <- access pipe master "test" (insertAll_ "users" userList)
   let myOwner =
         Owner
@@ -1236,6 +1275,60 @@ startAPI config = do
           False
           ""
           ""
+  let myOwner2 =
+        Owner
+          (Just (read "627ad3492b05a76be3700008"))
+          "u15hjz9v46azzmdept050heh8795qxzwy2pykg097lg69jpk4qzah90cj2q4amq0c07gta60x8qgw00qewcy3hg9kv9h6zjkh3jc66vr40u6uu2dxmqkqhypud95vm0gq7y5ga7c8psdqgthsrwvgd676a2pavpcd4euwwapgackxa3qhvga0wnl0k6vncskxlq94vqwjd7zepy3qd5jh"
+          "Test shop 3"
+          "usd"
+          False
+          0
+          False
+          0
+          "Roxy"
+          "Foo"
+          "roxy@zgo.cash"
+          "1 Main St"
+          "Mpls"
+          "Minnesota"
+          "55401"
+          ""
+          "missyfoo.io"
+          "United States"
+          True
+          False
+          False
+          (UTCTime (fromGregorian 2024 8 6) (secondsToDiffTime 0))
+          False
+          ""
+          ""
+  let myOwner3 =
+        Owner
+          (Just (read "627ad3492b05a76be3750008"))
+          "zs1fau9x305eztcdm5f08q9uc4hmvvjpjrgjcwcj0mjwhd83pdj0j92rxwqp6zkjmz3e49ej4xrcc8"
+          "Test shop 4"
+          "usd"
+          False
+          0
+          False
+          0
+          "Roxy"
+          "Foo"
+          "roxy@zgo.cash"
+          "1 Main St"
+          "Mpls"
+          "Minnesota"
+          "55401"
+          ""
+          "missyfoo.io"
+          "United States"
+          True
+          False
+          False
+          (UTCTime (fromGregorian 2024 8 6) (secondsToDiffTime 0))
+          False
+          ""
+          ""
   _ <- access pipe master "test" (Database.MongoDB.delete (select [] "owners"))
   let o = val myOwner
   case o of
@@ -1245,6 +1338,14 @@ startAPI config = do
   case o1 of
     Doc d1 -> access pipe master "test" (insert_ "owners" d1)
     _ -> fail "Couldn't save Owner1 in DB"
+  let o2 = val myOwner2
+  case o2 of
+    Doc d2 -> access pipe master "test" (insert_ "owners" d2)
+    _ -> fail "Couldn't save Owner2 in DB"
+  let o3 = val myOwner3
+  case o3 of
+    Doc d3 -> access pipe master "test" (insert_ "owners" d3)
+    _ -> fail "Couldn't save Owner2 in DB"
   _ <- access pipe master "test" (Database.MongoDB.delete (select [] "orders"))
   myTs <- liftIO getCurrentTime
   let myOrder =