diff --git a/package.yaml b/package.yaml index 9a60c9a..60fdc9a 100644 --- a/package.yaml +++ b/package.yaml @@ -164,3 +164,4 @@ tests: - scotty - megaparsec - uuid + - zcash-haskell diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs index ac1a5bb..4f8b38a 100644 --- a/src/ZGoBackend.hs +++ b/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,37 +1063,45 @@ routes pipe config = do 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 + 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 qBytes + then if matchSaplingAddress + qBytes + (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 + 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" diff --git a/test/Spec.hs b/test/Spec.hs index ac402f4..5f17d11 100644 --- a/test/Spec.hs +++ b/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" diff --git a/zgo-backend.cabal b/zgo-backend.cabal index ab2c428..264cfbf 100644 --- a/zgo-backend.cabal +++ b/zgo-backend.cabal @@ -183,5 +183,6 @@ test-suite zgo-backend-test , text , time , uuid + , zcash-haskell , zgo-backend default-language: Haskell2010