Vergara_Tech/zgo-backend
Vergara_Tech/zgo-backend
2
1
Fork 0
Code Issues Pull requests Projects Releases 4 Packages Wiki Activity

Add tests for new viewing key endpoint

Browse source
This commit is contained in:
Rene Vergara 2023-06-16 10:22:38 -05:00
parent 9f64683474
commit 05d0042a60
Signed by: pitmutt
GPG key ID: 65122AD495A7F5B2
4 changed files with 118 additions and 49 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
package.yaml
View file

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

72
src/ZGoBackend.hs
View file

@ -67,6 +67,8 @@ import WooCommerce
import Xero import Xero
import ZGoTx import ZGoTx
import ZcashHaskell.Sapling import ZcashHaskell.Sapling
import ZcashHaskell.Types (RawData(..))
import ZcashHaskell.Utils (decodeBech32)
-- Models for API objects -- Models for API objects
-- | A type to model Zcash RPC calls -- | A type to model Zcash RPC calls
@ -1061,37 +1063,45 @@ routes pipe config = do
u <- liftAndCatchIO $ run (findUser s) u <- liftAndCatchIO $ run (findUser s)
o <- jsonData o <- jsonData
let q = payload (o :: Payload String) let q = payload (o :: Payload String)
case cast' . Doc =<< u of let qRaw = decodeBech32 $ C.pack q
Nothing -> status unauthorized401 if hrp qRaw == "fail"
Just u' -> do then status badRequest400
if isValidSaplingViewingKey $ C.pack q else do
then if matchSaplingAddress let qBytes = bytes qRaw
(C.pack q) case cast' . Doc =<< u of
(C.pack . T.unpack $ uaddress u') Nothing -> status unauthorized401
then do Just u' -> do
owner <- liftAndCatchIO $ run (findOwner $ uaddress u') if isValidSaplingViewingKey qBytes
case cast' . Doc =<< owner of then if matchSaplingAddress
Nothing -> status badRequest400 qBytes
Just o' -> do (bytes . decodeBech32 . C.pack . T.unpack $ uaddress u')
unless (oviewkey o' /= "") $ do then do
vkInfo <- owner <- liftAndCatchIO $ run (findOwner $ uaddress u')
liftAndCatchIO $ case cast' . Doc =<< owner of
makeZcashCall Nothing -> status badRequest400
nodeUser Just o' -> do
nodePwd unless (oviewkey o' /= "") $ do
"z_importviewingkey" vkInfo <-
[Data.Aeson.String (T.strip . T.pack $ q), "no"] liftAndCatchIO $
let content = makeZcashCall
getResponseBody vkInfo :: RpcResponse Object nodeUser
if isNothing (err content) nodePwd
then do "z_importviewingkey"
_ <- liftAndCatchIO $ run (upsertViewingKey o' q) [ Data.Aeson.String (T.strip . T.pack $ q)
status created201 , "no"
else do ]
text $ L.pack . show $ err content let content =
status badRequest400 getResponseBody vkInfo :: RpcResponse Object
else status forbidden403 if isNothing (err content)
else status badRequest400 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 items associated with the given address
get "/api/items" $ do get "/api/items" $ do
session <- param "session" session <- param "session"

93
test/Spec.hs
View file

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

1
zgo-backend.cabal
View file

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