1522 lines
56 KiB
Haskell
1522 lines
56 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Spec where
|
|
|
|
import Config
|
|
import Control.Concurrent (forkIO, threadDelay)
|
|
import Control.Exception (bracket)
|
|
import Control.Monad.IO.Class
|
|
import qualified Data.Aeson as A
|
|
import qualified Data.ByteString as B
|
|
import Data.Configurator
|
|
import Data.Either
|
|
import Data.Maybe
|
|
import Data.SecureMem
|
|
import qualified Data.Text as T
|
|
import qualified Data.Text.Encoding as E
|
|
import Data.Time
|
|
import Data.Time.Calendar
|
|
import Data.Time.Clock
|
|
import Data.Time.Clock.POSIX
|
|
import qualified Data.UUID as U
|
|
import Database.MongoDB
|
|
import Item
|
|
import LangComponent
|
|
import Network.HTTP.Simple
|
|
import Network.HTTP.Types.Status
|
|
import Order
|
|
import Owner
|
|
import Payment
|
|
import System.IO.Unsafe
|
|
import Test.Hspec
|
|
import Test.Hspec.Expectations.Json
|
|
import Test.Hspec.QuickCheck
|
|
import Test.QuickCheck
|
|
import Test.QuickCheck.Gen
|
|
import Test.QuickCheck.Monadic
|
|
import Text.Megaparsec
|
|
import User
|
|
import Web.Scotty
|
|
import WooCommerce
|
|
import Xero
|
|
import ZGoBackend
|
|
import ZGoTx
|
|
|
|
main :: IO ()
|
|
main = do
|
|
putStrLn "Reading config..."
|
|
loadedConfig <- loadZGoConfig "zgotest.cfg"
|
|
hspec $ do
|
|
describe "Helper functions" $ do
|
|
describe "decodeHexText" $ do
|
|
it "converts to readable text" $ do
|
|
decodeHexText
|
|
"5a474f3a3a35643364343439342d353163302d343332642d383439352d3035303431393935376165610a5265706c792d546f3a0a7a733177366e6b616d65617a633567756a6d363933353073796c35773874677679617068756d73337077386579747a7935796d303878376476736b6d796b6b61746d777275636d67763365723865" `shouldBe`
|
|
"ZGO::5d3d4494-51c0-432d-8495-050419957aea\nReply-To:\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
|
|
describe "hex strings" $ do
|
|
prop "encoding and decoding are inverse" $ \x ->
|
|
(decodeHexText . encodeHexText) x == x
|
|
describe "Memo parsers" $
|
|
--prop "memo parsing" testMemoParser
|
|
do
|
|
it "parse ZecWallet memo - Sapling" $ do
|
|
let m =
|
|
runParser
|
|
pZGoMemo
|
|
"Zecwalllet memo"
|
|
"ZGO::5d3d4494-51c0-432d-8495-050419957aea\nReply-To:\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
|
|
case m of
|
|
Left e -> putStrLn $ errorBundlePretty e
|
|
Right m' ->
|
|
m_session m' `shouldBe`
|
|
U.fromString "5d3d4494-51c0-432d-8495-050419957aea"
|
|
it "parse YWallet memo - Sapling" $ do
|
|
let m =
|
|
runParser
|
|
pZGoMemo
|
|
"Ywallet memo"
|
|
"\128737MSG\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e\n\nZGO::ad8477d3-4fdd-4c97-90b2-76630b5f77e1"
|
|
case m of
|
|
Left e -> putStrLn $ errorBundlePretty e
|
|
Right m' ->
|
|
m_session m' `shouldBe`
|
|
U.fromString "ad8477d3-4fdd-4c97-90b2-76630b5f77e1"
|
|
it "parse Zingo memo - Sapling" $ do
|
|
let m =
|
|
runParser
|
|
pZGoMemo
|
|
"Zingo memo"
|
|
"ZGO::5d3d4494-51c0-432d-8495-050419957aea\nReply to:\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
|
|
case m of
|
|
Left e -> putStrLn $ errorBundlePretty e
|
|
Right m' ->
|
|
m_session m' `shouldBe`
|
|
U.fromString "5d3d4494-51c0-432d-8495-050419957aea"
|
|
it "parse ZecWallet memo - Orchard" $ do
|
|
let m =
|
|
runParser
|
|
pZGoMemo
|
|
"Zecwalllet memo"
|
|
"ZGO::5d3d4494-51c0-432d-8495-050419957aea\nReply-To:\nu17n7hpwaujyq7ux8f9jpyymtnk5urw7pyrf60smp5mawy7jgz325hfvz3jn3zsfya8yxryf9q7ldk8nu8df0emra5wne28zq9d9nm2pu4x6qwjha565av9aze0xgujgslz74ufkj0c0cylqwjyrh9msjfh7jzal6d3qzrnhkkqy3pqm8j63y07jxj7txqeac982778rmt64f32aum94x"
|
|
case m of
|
|
Left e -> putStrLn $ errorBundlePretty e
|
|
Right m' ->
|
|
m_address m' `shouldBe`
|
|
Just
|
|
"u17n7hpwaujyq7ux8f9jpyymtnk5urw7pyrf60smp5mawy7jgz325hfvz3jn3zsfya8yxryf9q7ldk8nu8df0emra5wne28zq9d9nm2pu4x6qwjha565av9aze0xgujgslz74ufkj0c0cylqwjyrh9msjfh7jzal6d3qzrnhkkqy3pqm8j63y07jxj7txqeac982778rmt64f32aum94x"
|
|
it "parse YWallet memo - Orchard" $ do
|
|
let m =
|
|
runParser
|
|
pZGoMemo
|
|
"Ywallet memo"
|
|
"\128737MSG\nu17n7hpwaujyq7ux8f9jpyymtnk5urw7pyrf60smp5mawy7jgz325hfvz3jn3zsfya8yxryf9q7ldk8nu8df0emra5wne28zq9d9nm2pu4x6qwjha565av9aze0xgujgslz74ufkj0c0cylqwjyrh9msjfh7jzal6d3qzrnhkkqy3pqm8j63y07jxj7txqeac982778rmt64f32aum94x\n\nZGO::ad8477d3-4fdd-4c97-90b2-76630b5f77e1"
|
|
case m of
|
|
Left e -> putStrLn $ errorBundlePretty e
|
|
Right m' ->
|
|
m_address m' `shouldBe`
|
|
Just
|
|
"u17n7hpwaujyq7ux8f9jpyymtnk5urw7pyrf60smp5mawy7jgz325hfvz3jn3zsfya8yxryf9q7ldk8nu8df0emra5wne28zq9d9nm2pu4x6qwjha565av9aze0xgujgslz74ufkj0c0cylqwjyrh9msjfh7jzal6d3qzrnhkkqy3pqm8j63y07jxj7txqeac982778rmt64f32aum94x"
|
|
it "parse Zingo memo - Orchard" $ do
|
|
let m =
|
|
runParser
|
|
pZGoMemo
|
|
"Zingo memo"
|
|
"ZGO::5d3d4494-51c0-432d-8495-050419957aea\nReply to:\nu17n7hpwaujyq7ux8f9jpyymtnk5urw7pyrf60smp5mawy7jgz325hfvz3jn3zsfya8yxryf9q7ldk8nu8df0emra5wne28zq9d9nm2pu4x6qwjha565av9aze0xgujgslz74ufkj0c0cylqwjyrh9msjfh7jzal6d3qzrnhkkqy3pqm8j63y07jxj7txqeac982778rmt64f32aum94x"
|
|
case m of
|
|
Left e -> putStrLn $ errorBundlePretty e
|
|
Right m' ->
|
|
m_address m' `shouldBe`
|
|
Just
|
|
"u17n7hpwaujyq7ux8f9jpyymtnk5urw7pyrf60smp5mawy7jgz325hfvz3jn3zsfya8yxryf9q7ldk8nu8df0emra5wne28zq9d9nm2pu4x6qwjha565av9aze0xgujgslz74ufkj0c0cylqwjyrh9msjfh7jzal6d3qzrnhkkqy3pqm8j63y07jxj7txqeac982778rmt64f32aum94x"
|
|
describe "PIN generator" $ do
|
|
it "should give a 7 digit" $ do
|
|
pin <- generatePin
|
|
length pin `shouldBe` 7
|
|
describe "API endpoints" $ do
|
|
beforeAll_ (startAPI loadedConfig) $ do
|
|
describe "Validate user session" $ do
|
|
it "validate with correct pin" $ do
|
|
req <-
|
|
testPost
|
|
"/validateuser"
|
|
[ ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")
|
|
, ("pin", Just "1234567")
|
|
]
|
|
res <- httpLBS req
|
|
getResponseStatus res `shouldBe` accepted202
|
|
describe "Price endpoint" $ do
|
|
it "returns a price for an existing currency" $ do
|
|
req <- testGet "/price" [("currency", Just "usd")]
|
|
res <- httpJSON req
|
|
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
|
|
it "returns 204 when the currency is not supported" $ do
|
|
req <- testGet "/price" [("currency", Just "jpy")]
|
|
res <- httpLBS req
|
|
getResponseStatus res `shouldBe` noContent204
|
|
describe "Countries endpoint" $ do
|
|
it "returns a list of countries" $ do
|
|
req <-
|
|
testGet
|
|
"/api/countries"
|
|
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
|
res <- httpJSON req
|
|
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
|
|
it "returns 401 with invalid session" $ do
|
|
req <-
|
|
testGet
|
|
"/api/countries"
|
|
[("session", Just "fake-id-string-283that0")]
|
|
res <- httpLBS req
|
|
getResponseStatus res `shouldBe` unauthorized401
|
|
describe "blockheight endpoint" $ do
|
|
it "returns a block number" $ do
|
|
req <-
|
|
testGet
|
|
"/blockheight"
|
|
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
|
res <- httpJSON req
|
|
height (getResponseBody (res :: Response Block)) `shouldSatisfy` \x ->
|
|
x > 1600000
|
|
describe "Xero endpoints" $ do
|
|
describe "xero" $ do
|
|
it "returns the xero config" $ do
|
|
req <-
|
|
testGet
|
|
"/api/xero"
|
|
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
|
res <- httpJSON req
|
|
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
|
|
it "returns 401 with invalid session" $ do
|
|
req <-
|
|
testGet "/api/xero" [("session", Just "fnelrkgnlyebrlvns82949")]
|
|
res <- httpLBS req
|
|
getResponseStatus res `shouldBe` unauthorized401
|
|
describe "xeroaccount" $ do
|
|
it "returns the account code" $ do
|
|
req <-
|
|
testGet
|
|
"/api/xeroaccount"
|
|
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
|
res <- httpJSON req
|
|
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
|
|
it "reading returns 401 with invalid session" $ do
|
|
req <-
|
|
testGet
|
|
"/api/xeroaccount"
|
|
[("session", Just "fnelrkgnlyebrlvns82949")]
|
|
res <- httpLBS req
|
|
getResponseStatus res `shouldBe` unauthorized401
|
|
it "setting returns 401 with invalid session" $ do
|
|
req <-
|
|
testPost
|
|
"/api/xeroaccount"
|
|
[("session", Just "fnelrkgnlyebrlvns82949")]
|
|
res <- httpLBS req
|
|
getResponseStatus res `shouldBe` unauthorized401
|
|
it "setting succeeds with valid session" $ do
|
|
req <-
|
|
testPost
|
|
"/api/xeroaccount"
|
|
[ ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")
|
|
, ("code", Just "ZEC")
|
|
]
|
|
res <- httpLBS req
|
|
getResponseStatus res `shouldBe` accepted202
|
|
describe "User endpoint" $ do
|
|
it "returns a user for a session" $ do
|
|
req <-
|
|
testGet
|
|
"/api/user"
|
|
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
|
res <- httpJSON req
|
|
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
|
|
it "returns 401 when user doesn't exist" $ do
|
|
req <-
|
|
testGet
|
|
"/api/user"
|
|
[("session", Just "suchafak-euui-dican-eve-nbelieveitca")]
|
|
res <- httpLBS req
|
|
getResponseStatus res `shouldBe` unauthorized401
|
|
describe "delete" $ do
|
|
it "returns 401 when session is invalid" $ do
|
|
req <-
|
|
testDelete
|
|
"/api/user/"
|
|
"6272a90f2b05a74cf1000005"
|
|
[("session", Just "suchafak-euui-dican-eve-nbelieveitca")]
|
|
res <- httpLBS req
|
|
getResponseStatus res `shouldBe` unauthorized401
|
|
it "returns 403 when user and session don't match" $ do
|
|
req <-
|
|
testDelete
|
|
"/api/user/"
|
|
"6272a90f2b05a74cf1000005"
|
|
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
|
res <- httpLBS req
|
|
getResponseStatus res `shouldBe` forbidden403
|
|
it "returns 400 when user is invalid" $ do
|
|
req <-
|
|
testDelete
|
|
"/api/user/"
|
|
"000000000000000000000000"
|
|
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
|
res <- httpLBS req
|
|
getResponseStatus res `shouldBe` badRequest400
|
|
it "deletes user by id" $ do
|
|
req <-
|
|
testDelete
|
|
"/api/user/"
|
|
"6272a90f2b05a74cf1000003"
|
|
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdaa")]
|
|
res <- httpLBS req
|
|
getResponseStatus res `shouldBe` ok200
|
|
describe "Owner endpoint" $
|
|
--prop "add owner" testOwnerAdd
|
|
do
|
|
it "return owner by address" $ do
|
|
req <-
|
|
testGet
|
|
"/api/owner"
|
|
[ ( "address"
|
|
, Just
|
|
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e")
|
|
, ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")
|
|
]
|
|
res <- httpJSON req
|
|
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
|
|
it "owner by address returns 401 with bad session" $ do
|
|
req <-
|
|
testGet
|
|
"/api/owner"
|
|
[ ( "address"
|
|
, Just
|
|
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e")
|
|
, ("session", Just "3fake94j-rbal-jeber-nvlke-4bal8dcdcd")
|
|
]
|
|
res <- httpLBS req
|
|
getResponseStatus res `shouldBe` unauthorized401
|
|
it "return owner by id" $ do
|
|
req <-
|
|
testGet
|
|
"/ownerid"
|
|
[ ("id", Just "627ad3492b05a76be3000001")
|
|
, ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")
|
|
]
|
|
res <- httpLBS req
|
|
getResponseStatus res `shouldBe` ok200
|
|
describe "Order endpoints" $
|
|
--prop "upsert order" testOrderAdd
|
|
do
|
|
it "adding order with bad session fails with 401" $ do
|
|
myTs <- liftIO getCurrentTime
|
|
let testOrder =
|
|
ZGoOrder
|
|
(Just (read "627ab3ea2b05a76be3000011"))
|
|
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
|
|
"35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
|
|
myTs
|
|
False
|
|
"usd"
|
|
102.0
|
|
0
|
|
0
|
|
[]
|
|
False
|
|
""
|
|
""
|
|
"testToken4321"
|
|
req <-
|
|
testPostJson "/api/order" $
|
|
A.object ["payload" A..= A.toJSON testOrder]
|
|
res <-
|
|
httpLBS $
|
|
setRequestQueryString
|
|
[("session", Just "35bfb9c2-9ad2-fake-adda-99d63b8dcdcd")]
|
|
req
|
|
getResponseStatus res `shouldBe` unauthorized401
|
|
it "adding order with mismatched session fails with 403" $ do
|
|
myTs <- liftIO getCurrentTime
|
|
let testOrder =
|
|
ZGoOrder
|
|
(Just (read "627ab3ea2b05a76be3000011"))
|
|
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
|
|
"35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
|
|
myTs
|
|
False
|
|
"usd"
|
|
102.0
|
|
0
|
|
0
|
|
[]
|
|
False
|
|
""
|
|
""
|
|
"testToken4321"
|
|
req <-
|
|
testPostJson "/api/order" $
|
|
A.object ["payload" A..= A.toJSON testOrder]
|
|
res <-
|
|
httpLBS $
|
|
setRequestQueryString
|
|
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dfake")]
|
|
req
|
|
getResponseStatus res `shouldBe` forbidden403
|
|
it "adding order with correct session succeeds" $ do
|
|
myTs <- liftIO getCurrentTime
|
|
let testOrder =
|
|
ZGoOrder
|
|
(Just (read "627ab3ea2b05a76be3000011"))
|
|
"zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
|
|
"35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
|
|
myTs
|
|
False
|
|
"usd"
|
|
102.0
|
|
0
|
|
0
|
|
[]
|
|
False
|
|
""
|
|
""
|
|
"testToken4321"
|
|
req <-
|
|
testPostJson "/api/order" $
|
|
A.object ["payload" A..= A.toJSON testOrder]
|
|
res <-
|
|
httpLBS $
|
|
setRequestQueryString
|
|
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
|
req
|
|
getResponseStatus res `shouldBe` created201
|
|
it "get order by session" $ do
|
|
req <-
|
|
testGet
|
|
"/api/order"
|
|
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
|
res <- httpJSON req
|
|
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
|
|
it "get order by session fails with bad session" $ do
|
|
req <-
|
|
testGet
|
|
"/api/order"
|
|
[("session", Just "35bfb9c2-9ad2-4fe5-fake-99d63b8dcdcd")]
|
|
res <- httpLBS req
|
|
getResponseStatus res `shouldBe` unauthorized401
|
|
it "get order by id" $ do
|
|
req <-
|
|
testGet
|
|
"/order/627ab3ea2b05a76be3000000"
|
|
[("token", Just "testToken1234")]
|
|
res <- httpJSON req
|
|
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
|
|
it "get order with invalid id fails with 400" $ do
|
|
req <- testGet "/order/6273hrb" [("token", Just "testToken1234")]
|
|
res <- httpLBS req
|
|
getResponseStatus res `shouldBe` badRequest400
|
|
it "get order by id fails with bad token" $ do
|
|
req <-
|
|
testGet
|
|
"/order/627ab3ea2b05a76be3000000"
|
|
[("token", Just "wrongToken1234")]
|
|
res <- httpLBS req
|
|
getResponseStatus res `shouldBe` forbidden403
|
|
it "get all orders for owner" $ do
|
|
req <-
|
|
testGet
|
|
"/api/allorders"
|
|
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
|
res <- httpJSON req
|
|
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
|
|
it "get all orders for owner fails with bad session" $ do
|
|
req <-
|
|
testGet
|
|
"/api/allorders"
|
|
[("session", Just "35bfb9c2-9ad2-4fe5-fake-99d63b8dcdcd")]
|
|
res <- httpLBS req
|
|
getResponseStatus res `shouldBe` unauthorized401
|
|
it "delete order by id fails with mismatched session" $ do
|
|
req <-
|
|
testDelete
|
|
"/api/order/"
|
|
"627ab3ea2b05a76be3000000"
|
|
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dfake")]
|
|
res <- httpLBS req
|
|
getResponseStatus res `shouldBe` forbidden403
|
|
it "delete order by id fails with bad session" $ do
|
|
req <-
|
|
testDelete
|
|
"/api/order/"
|
|
"627ab3ea2b05a76be3000000"
|
|
[("session", Just "35bfb9c2-9ad2-4fe5-fake-99d63b8dcdcd")]
|
|
res <- httpLBS req
|
|
getResponseStatus res `shouldBe` unauthorized401
|
|
it "delete order by id" $ do
|
|
req <-
|
|
testDelete
|
|
"/api/order/"
|
|
"627ab3ea2b05a76be3000000"
|
|
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
|
res <- httpLBS req
|
|
getResponseStatus res `shouldBe` ok200
|
|
describe "Item endpoint" $ do
|
|
it "adding item with bad session fails" $ do
|
|
let item =
|
|
Item
|
|
Nothing
|
|
"Table"
|
|
"Oak"
|
|
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
|
|
499.99
|
|
req <-
|
|
testPostJson "/api/item" $ A.object ["payload" A..= A.toJSON item]
|
|
res <-
|
|
httpLBS $
|
|
setRequestQueryString
|
|
[("session", Just "35bfb9c2-9ad2-fake-adda-99d63b8dcdcd")]
|
|
req
|
|
getResponseStatus res `shouldBe` unauthorized401
|
|
it "adding item with good session succeeds" $ do
|
|
let item =
|
|
Item
|
|
(Just (read "627d7ba92b05a76be3000013"))
|
|
"Table"
|
|
"Oak"
|
|
"zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
|
|
499.99
|
|
req <-
|
|
testPostJson "/api/item" $ A.object ["payload" A..= A.toJSON item]
|
|
res <-
|
|
httpLBS $
|
|
setRequestQueryString
|
|
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
|
req
|
|
getResponseStatus res `shouldBe` created201
|
|
it "get items with valid session succeeds" $ do
|
|
req <-
|
|
testGet
|
|
"/api/items"
|
|
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
|
res <- httpJSON req
|
|
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
|
|
it "get items with invalid session returns 401" $ do
|
|
req <-
|
|
testGet
|
|
"/api/items"
|
|
[("session", Just "35bfb9c2-9ad2-4fe5-fake-99d63b8dcdcd")]
|
|
res <- httpLBS req
|
|
getResponseStatus res `shouldBe` unauthorized401
|
|
describe "delete item" $ do
|
|
it "returns 401 with invalid session and item ID" $ do
|
|
req <-
|
|
testDelete
|
|
"/api/item/"
|
|
"627d7ba92b05a76be3000003"
|
|
[("session", Just "35bfb9c2-9ad2-fake-adda-99d63b8dcdcd")]
|
|
res <- httpLBS req
|
|
getResponseStatus res `shouldBe` unauthorized401
|
|
it "returns 403 when item ID doesn't belong to session" $ do
|
|
req <-
|
|
testDelete
|
|
"/api/item/"
|
|
"627d7ba92b05a76be3000003"
|
|
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
|
res <- httpLBS req
|
|
getResponseStatus res `shouldBe` forbidden403
|
|
it "succeeds with valid session and item ID" $ do
|
|
req <-
|
|
testDelete
|
|
"/api/item/"
|
|
"627d7ba92b05a76be3000013"
|
|
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
|
res <- httpLBS req
|
|
getResponseStatus res `shouldBe` ok200
|
|
describe "WooCommerce endpoints" $ do
|
|
it "generate token with invalid session gives 401" $ do
|
|
req <-
|
|
testPost
|
|
"/api/wootoken"
|
|
[ ("ownerid", Just "627ad3492b05a76be3000001")
|
|
, ("session", Just "35bfb9c2-9ad2-fake-adda-99d63b8dcdcd")
|
|
]
|
|
res <- httpLBS req
|
|
getResponseStatus res `shouldBe` unauthorized401
|
|
it "generate token with mismatched session gives 403" $ do
|
|
req <-
|
|
testPost
|
|
"/api/wootoken"
|
|
[ ("ownerid", Just "627ad3492b05a76be3000001")
|
|
, ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dfake")
|
|
]
|
|
res <- httpLBS req
|
|
getResponseStatus res `shouldBe` forbidden403
|
|
it "generate token with valid session succeeds" $ do
|
|
req <-
|
|
testPost
|
|
"/api/wootoken"
|
|
[ ("ownerid", Just "627ad3492b05a76be3000001")
|
|
, ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")
|
|
]
|
|
res <- httpLBS req
|
|
getResponseStatus res `shouldBe` accepted202
|
|
it "read token gives 401 with bad session" $ do
|
|
req <-
|
|
testGet
|
|
"/api/wootoken"
|
|
[("session", Just "35bfb9c2-9ad2-4fe5-fake-99d63b8dcdcd")]
|
|
res <- httpLBS req
|
|
getResponseStatus res `shouldBe` unauthorized401
|
|
it "read token succeeds with valid session" $ do
|
|
req <-
|
|
testGet
|
|
"/api/wootoken"
|
|
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
|
res <- httpJSON req
|
|
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
|
|
it "authenticate with incorrect owner" $ do
|
|
req <-
|
|
testPublicGet
|
|
"/auth"
|
|
[ ("ownerid", Just "62cca13f5530331e2a900001")
|
|
, ( "token"
|
|
, Just
|
|
"0c1702c16c7bd7e075b8bb129b24888a5cc2181fa1eb4ce9190cfcb625ecf0ee")
|
|
, ("siteurl", Just "aHR0cHM6Ly93d3cudGVjcHJvdmFsLmNvbS8")
|
|
]
|
|
res <- httpJSON req
|
|
getResponseStatus (res :: Response A.Value) `shouldBe` accepted202
|
|
it "authenticate with incorrect token" $ do
|
|
req <-
|
|
testPublicGet
|
|
"/auth"
|
|
[ ("ownerid", Just "627ad3492b05a76be3000001")
|
|
, ("token", Just "89bd9d8d69a674e0f467cc8796000000")
|
|
, ("siteurl", Just "aHR0cHM6Ly93d3cudGVjcHJvdmFsLmNvbS8")
|
|
]
|
|
res <- httpJSON req
|
|
getResponseStatus (res :: Response A.Value) `shouldBe` accepted202
|
|
it "authenticate with correct token" $ do
|
|
req1 <-
|
|
testGet
|
|
"/api/wootoken"
|
|
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
|
res1 <- httpJSON req1
|
|
let tk = getResponseBody (res1 :: Response WooToken)
|
|
req <-
|
|
testPublicGet
|
|
"/auth"
|
|
[ ("ownerid", Just "627ad3492b05a76be3000001")
|
|
, ("token", Just $ (E.encodeUtf8 . w_token) tk)
|
|
, ("siteurl", Just "aHR0cHM6Ly93d3cudGVjcHJvdmFsLmNvbS8")
|
|
]
|
|
res <- httpJSON req
|
|
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
|
|
it "authenticate with correct token on existing shop" $ do
|
|
req <-
|
|
testPublicGet
|
|
"/auth"
|
|
[ ("ownerid", Just "627ad3492b05a76be3000001")
|
|
, ( "token"
|
|
, Just
|
|
"0c1702c16c7bd7e075b8bb129b24888a5cc2181fa1eb4ce9190cfcb625ecf0ee")
|
|
, ("siteurl", Just "aHR0cHM6Ly93d3cuZ29vZ2xlLmNvbS8")
|
|
]
|
|
res <- httpJSON req
|
|
getResponseStatus (res :: Response A.Value) `shouldBe` accepted202
|
|
it "request order creation" $ do
|
|
req1 <-
|
|
testGet
|
|
"/api/wootoken"
|
|
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
|
res1 <- httpJSON req1
|
|
let tk = getResponseBody (res1 :: Response WooToken)
|
|
req <-
|
|
testPublicGet
|
|
"/woopayment"
|
|
[ ("ownerid", Just "627ad3492b05a76be3000001")
|
|
, ("token", Just $ (E.encodeUtf8 . w_token) tk)
|
|
, ("siteurl", Just "aHR0cHM6Ly93d3cudGVjcHJvdmFsLmNvbS8")
|
|
, ("order_id", Just "1234")
|
|
, ("currency", Just "usd")
|
|
, ("amount", Just "100.0")
|
|
, ("date", Just "2022-12-01")
|
|
, ("orderkey", Just "wc_order_m7qiJ1dNrGDYE")
|
|
]
|
|
res <- httpJSON req
|
|
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
|
|
describe "Language endpoint" $ do
|
|
it "existing component" $ do
|
|
req <-
|
|
testGet
|
|
"/api/getlang"
|
|
[ ("lang", Just "en-US")
|
|
, ("component", Just "login")
|
|
, ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")
|
|
]
|
|
res <- httpJSON req
|
|
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
|
|
it "existing component with bad session" $ do
|
|
req <-
|
|
testGet
|
|
"/api/getlang"
|
|
[ ("lang", Just "en-US")
|
|
, ("component", Just "login")
|
|
, ("session", Just "35bfb9c2-fake-4fe5-adda-99d63b8dcdcd")
|
|
]
|
|
res <- httpLBS req
|
|
getResponseStatus res `shouldBe` unauthorized401
|
|
it "wrong component" $ do
|
|
req <-
|
|
testGet
|
|
"/api/getlang"
|
|
[ ("lang", Just "en-US")
|
|
, ("component", Just "test")
|
|
, ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")
|
|
]
|
|
res <- httpLBS req
|
|
getResponseStatus res `shouldBe` noContent204
|
|
it "wrong language" $ do
|
|
req <-
|
|
testGet
|
|
"/api/getlang"
|
|
[ ("lang", Just "fr-FR")
|
|
, ("component", Just "login")
|
|
, ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")
|
|
]
|
|
res <- httpLBS req
|
|
getResponseStatus res `shouldBe` noContent204
|
|
describe "Viewing Key endpoint" $ do
|
|
let vk0 =
|
|
"zxviews1qwrw0jlxqqqqpqr9faepwqpgj09f0ee55mfwl60eumv6duk5pwncntweah0xdlhqrwre2fgmgersah9atx92z6pmxec8t32mpz59t47yuplkcdcaw3873aalv7e59xhwv846g9q9qjy0ypc68ceypg6pux490dr4snsc4m482l57rvnzj2lsh4f3dv6mltc75z72pypkx0dchwpumdwfuajstfhwulv30kjt5l0x7juwe523ufwz2xleplxf37gk2pfh59gmdjr4zsql4ga9p"
|
|
let vk1 =
|
|
"zxviews1qdjagrrpqqqqpq8es75mlu6rref0qyrstchf8dxzeygtsejwfqu8ckhwl2qj5m8am7lmupxk3vkvdjm8pawjpmesjfapvsqw96pa46c2z0kk7letrxf7mkltwz54fwpxc7kc79mm5kce3rwn5ssl009zwsra2spppwgrx25s9k5hq65f69l4jz2tjmqgy0pl49qmtaj3nudk6wglwe2hpa327hydlchtyq9av6wjd6hu68e04ahwk9a9n2kt0kj3nj99nue65awtu5cwwcpjs"
|
|
let vk2 =
|
|
"zxviews1qdjagrrpqqqqpq8es75mlufakef0qyrstchf8dxzeygtsejwfqu8ckhwl2qj5m8am7lmupxk3vkvdjm8pawjpmesjfapvsqw96pa46c2z0kk7letrxf7mkltwz54fwpxc7kc79mm5kce3rwn5ssl009zwsra2spppwgrx25s9k5hq65f69l4jz2tjmqgy0pl49qmtaj3nudk6wglwe2hpa327hydlchtyq9av6wjd6hu68e04ahwk9a9n2kt0kj3nj99nue65awtu5cwwcpjs"
|
|
let vk3 =
|
|
"uview1u833rp8yykd7h4druwht6xp6k8krle45fx8hqsw6vzw63n24atxpcatws82z092kryazuu6d7rayyut8m36wm4wpjy2z8r9hj48fx5pf49gw4sjrq8503qpz3vqj5hg0vg9vsqeasg5qjuyh94uyfm7v76udqcm2m0wfc25hcyqswcn56xxduq3xkgxkr0l73cjy88fdvf90eq5fda9g6x7yv7d0uckpevxg6540wc76xrc4axxvlt03ptaa2a0rektglmdy68656f3uzcdgqqyu0t7wk5cvwghyyvgqc0rp3vgu5ye4nd236ml57rjh083a2755qemf6dk6pw0qrnfm7246s8eg2hhzkzpf9h73chhng7xhmyem2sjh8rs2m9nhfcslsgenm"
|
|
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 Sapling 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
|
|
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
|
|
it "should succeed with good creds" $ \p -> do
|
|
r <- liftIO $ access p master "zgo" (auth "zgo" "zcashrules")
|
|
r `shouldBe` True
|
|
it "should fail with bad creds" $ \p -> do
|
|
r <- liftIO $ access p master "zgo" (auth "user" "pwd")
|
|
r `shouldBe` False
|
|
describe "ZGo Pro sessions" $ do
|
|
it "find in DB" $ \p -> do
|
|
doc <-
|
|
access p master "test" $
|
|
findProSession
|
|
"zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
|
|
doc `shouldNotBe` Nothing
|
|
it "upsert to DB" $ const pending
|
|
describe "Zcash prices" $ do
|
|
it "should update" $ \p -> do
|
|
doc <- access p master "test" $ findPrice "usd"
|
|
case doc of
|
|
Nothing -> True `shouldBe` False
|
|
Just d -> do
|
|
let q = parseZGoPrice d
|
|
case q of
|
|
Nothing -> True `shouldBe` False
|
|
Just r -> do
|
|
let t1 = ZGoBackend.timestamp r
|
|
_ <- checkZcashPrices p "test"
|
|
doc2 <- access p master "test" $ findPrice "usd"
|
|
case doc2 of
|
|
Nothing -> True `shouldBe` False
|
|
Just d2 -> do
|
|
let q2 = parseZGoPrice d2
|
|
case q2 of
|
|
Nothing -> True `shouldBe` False
|
|
Just r2 -> do
|
|
let t2 = ZGoBackend.timestamp r2
|
|
t2 `shouldSatisfy` (t1 <)
|
|
describe "user is" $ do
|
|
xit "validated" $ \p -> do
|
|
t <-
|
|
access p master "test" $
|
|
findOne (select ["validated" =: False] "users")
|
|
case t of
|
|
Nothing -> True `shouldBe` False
|
|
Just r -> do
|
|
let s = parseUserBson r
|
|
case s of
|
|
Nothing -> True `shouldBe` False
|
|
Just z -> do
|
|
_ <- access p master "test" $ validateUser (usession z)
|
|
q <-
|
|
access p master "test" $
|
|
findOne
|
|
(select
|
|
["validated" =: True, "session" =: usession z]
|
|
"users")
|
|
isNothing q `shouldBe` False
|
|
it "deleted" $ \p -> do
|
|
t <- access p master "test" $ findOne (select [] "users")
|
|
let s = parseUserBson =<< t
|
|
let userId = u_id =<< s
|
|
let idString = maybe "" show userId
|
|
_ <- access p master "test" $ deleteUser idString
|
|
q <-
|
|
access p master "test" $
|
|
findOne (select ["_id" =: userId] "users")
|
|
isNothing q `shouldBe` True
|
|
describe "Orders" $ do
|
|
it "marked as paid" $ \p -> do
|
|
myTs <- liftIO getCurrentTime
|
|
let myOrder =
|
|
ZGoOrder
|
|
(Just (read "627ab3ea2b05a76be3000001"))
|
|
"zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
|
|
"35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
|
|
myTs
|
|
False
|
|
"usd"
|
|
102.0
|
|
0
|
|
0
|
|
[]
|
|
False
|
|
""
|
|
""
|
|
"testToken1234"
|
|
let ordTest = val myOrder
|
|
case ordTest of
|
|
Doc oT -> access p master "test" (insert_ "orders" oT)
|
|
_ -> fail "Couldn't save Order in DB"
|
|
_ <-
|
|
access p master "test" $
|
|
markOrderPaid ("627ab3ea2b05a76be3000001", 0)
|
|
o <-
|
|
access p master "test" $ findOrderById "627ab3ea2b05a76be3000001"
|
|
let o1 = (cast' . Doc) =<< o
|
|
case o1 of
|
|
Nothing -> True `shouldBe` False
|
|
Just o2 -> qpaid o2 `shouldBe` True
|
|
describe "Xero data" $ do
|
|
it "token is saved" $ \p -> do
|
|
t <-
|
|
access p master "test" $
|
|
findToken
|
|
"zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
|
|
let t1 = (cast' . Doc) =<< t
|
|
case t1 of
|
|
Nothing -> True `shouldBe` False
|
|
Just t2 ->
|
|
t_address t2 `shouldBe`
|
|
"zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
|
|
it "code is saved" $ \p -> do
|
|
_ <-
|
|
access p master "test" $
|
|
addAccCode
|
|
"zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
|
|
"ZEC"
|
|
t <-
|
|
access p master "test" $
|
|
findToken
|
|
"zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
|
|
let t1 = (cast' . Doc) =<< t
|
|
case t1 of
|
|
Nothing -> True `shouldBe` False
|
|
Just t2 -> t_code t2 `shouldBe` "ZEC"
|
|
describe "Zcash transactions" $ do
|
|
xit "logins are added to db" $ \p -> do
|
|
_ <-
|
|
access p master "test" (Database.MongoDB.delete (select [] "txs"))
|
|
_ <- scanZcash' loadedConfig p
|
|
threadDelay 1000000
|
|
t <- access p master "test" $ findOne (select [] "txs")
|
|
let s = parseZGoTxBson =<< t
|
|
let conf = maybe 0 confirmations s
|
|
conf `shouldSatisfy` (> 0)
|
|
xit "payments are added to db" $ \p -> do
|
|
_ <-
|
|
access
|
|
p
|
|
master
|
|
"test"
|
|
(Database.MongoDB.delete (select [] "payments"))
|
|
_ <- scanZcash' loadedConfig p
|
|
threadDelay 1000000
|
|
t <- access p master "test" $ findOne (select [] "payments")
|
|
let s = (cast' . Doc) =<< t
|
|
let payDelta = maybe 0 pdelta s
|
|
payDelta `shouldSatisfy` (> 0)
|
|
it "owners are marked as paid" $ \p -> do
|
|
let myUser =
|
|
User
|
|
(Just (read "6272a90f2b05a74cf1000002" :: ObjectId))
|
|
"zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
|
|
"35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcb"
|
|
1613487
|
|
"1234567"
|
|
True
|
|
_ <-
|
|
access
|
|
p
|
|
master
|
|
"test"
|
|
(insert_
|
|
"users"
|
|
[ "address" =: uaddress myUser
|
|
, "_id" =: u_id myUser
|
|
, "session" =: usession myUser
|
|
, "blocktime" =: ublocktime myUser
|
|
, "pin" =: upin myUser
|
|
, "validated" =: uvalidated myUser
|
|
])
|
|
tstamp <- getCurrentTime
|
|
let myPay =
|
|
Payment
|
|
Nothing
|
|
86400
|
|
False
|
|
""
|
|
"35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcb"
|
|
((round . utcTimeToPOSIXSeconds) tstamp)
|
|
0.005
|
|
"myrandom123tx464id"
|
|
"coolest memo ever!"
|
|
let parsedPay = val myPay
|
|
case parsedPay of
|
|
Doc d -> do
|
|
_ <- access p master "test" (insert_ "payments" d)
|
|
_ <- checkPayments p "test"
|
|
threadDelay 1000000
|
|
t <-
|
|
access p master "test" $
|
|
findOne
|
|
(select
|
|
[ "address" =:
|
|
("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"
|
|
xit "owners are expired" $ \p -> do
|
|
_ <- expireOwners p "test"
|
|
now <- getCurrentTime
|
|
res <-
|
|
access
|
|
p
|
|
master
|
|
"test"
|
|
(rest =<<
|
|
find
|
|
(select
|
|
["expiration" =: ["$lt" =: now], "paid" =: True]
|
|
"owners"))
|
|
res `shouldBe` []
|
|
xit "login txs are converted to users" $ \p -> do
|
|
let myTx =
|
|
ZGoTx
|
|
Nothing
|
|
"zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
|
|
"35bfb9c2-9ad2-4fe5-adda-99d63b8dcdca"
|
|
3
|
|
1613487
|
|
0.00000001
|
|
"abcdef"
|
|
"Super Memo"
|
|
_ <-
|
|
access
|
|
p
|
|
master
|
|
"test"
|
|
(Database.MongoDB.delete (select [] "users"))
|
|
_ <- access p master "test" (insert_ "txs" (encodeZGoTxBson myTx))
|
|
_ <- updateLogins p loadedConfig
|
|
threadDelay 1000000
|
|
t <- access p master "test" $ findOne (select [] "users")
|
|
case t of
|
|
Nothing -> True `shouldBe` False
|
|
Just r -> do
|
|
let s = parseUserBson r
|
|
case s of
|
|
Nothing -> True `shouldBe` False
|
|
Just z -> length (T.unpack (usession z)) `shouldSatisfy` (> 0)
|
|
|
|
testGet :: B.ByteString -> [(B.ByteString, Maybe B.ByteString)] -> IO Request
|
|
testGet endpoint body = do
|
|
let user = "user"
|
|
let pwd = "superSecret"
|
|
let testRequest =
|
|
setRequestQueryString body $
|
|
setRequestPort 3000 $
|
|
setRequestBasicAuth user pwd $
|
|
setRequestMethod "GET" $ setRequestPath endpoint defaultRequest
|
|
return testRequest
|
|
|
|
testPublicGet ::
|
|
B.ByteString -> [(B.ByteString, Maybe B.ByteString)] -> IO Request
|
|
testPublicGet endpoint body = do
|
|
let testRequest =
|
|
setRequestQueryString body $
|
|
setRequestPort 3000 $
|
|
setRequestMethod "GET" $ setRequestPath endpoint defaultRequest
|
|
return testRequest
|
|
|
|
testPost :: B.ByteString -> [(B.ByteString, Maybe B.ByteString)] -> IO Request
|
|
testPost endpoint body = do
|
|
let user = "user"
|
|
let pwd = "superSecret"
|
|
let testRequest =
|
|
setRequestQueryString body $
|
|
setRequestPort 3000 $
|
|
setRequestBasicAuth user pwd $
|
|
setRequestMethod "POST" $ setRequestPath endpoint defaultRequest
|
|
return testRequest
|
|
|
|
testPostJson :: B.ByteString -> A.Value -> IO Request
|
|
testPostJson endpoint body = do
|
|
let user = "user"
|
|
let pwd = "superSecret"
|
|
let testRequest =
|
|
setRequestBodyJSON body $
|
|
setRequestPort 3000 $
|
|
setRequestBasicAuth user pwd $
|
|
setRequestMethod "POST" $ setRequestPath endpoint defaultRequest
|
|
return testRequest
|
|
|
|
testDelete ::
|
|
B.ByteString
|
|
-> B.ByteString
|
|
-> [(B.ByteString, Maybe B.ByteString)]
|
|
-> IO Request
|
|
testDelete endpoint par body = do
|
|
let user = "user"
|
|
let pwd = "superSecret"
|
|
let testRequest =
|
|
setRequestQueryString body $
|
|
setRequestPort 3000 $
|
|
setRequestBasicAuth user pwd $
|
|
setRequestMethod "DELETE" $
|
|
setRequestPath (B.append endpoint par) defaultRequest
|
|
return testRequest
|
|
|
|
testMemoParser :: T.Text -> T.Text -> T.Text -> Property
|
|
testMemoParser t1 t2 t3 =
|
|
monadicIO $ do
|
|
let res =
|
|
runParser pZGoMemo "Parser test" $
|
|
t1 <>
|
|
" zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e " <>
|
|
t2 <> " ZGO::5d3d4494-51c0-432d-8495-050419957aea " <> t3
|
|
case res of
|
|
Left e -> assert False `debug` errorBundlePretty e
|
|
Right zm ->
|
|
assert $
|
|
U.fromString "5d3d4494-51c0-432d-8495-050419957aea" == m_session zm &&
|
|
Just
|
|
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e" ==
|
|
m_address zm
|
|
|
|
testOwnerAdd :: Owner -> Property
|
|
testOwnerAdd o =
|
|
monadicIO $ do
|
|
req <-
|
|
run $ testPostJson "/api/owner" (A.object ["payload" A..= A.toJSON o]) --`debug` show o
|
|
res <- httpLBS req
|
|
if opayconf o
|
|
then assert $ getResponseStatus res == internalServerError500
|
|
else assert $ getResponseStatus res == created201
|
|
|
|
testOrderAdd :: ZGoOrder -> Property
|
|
testOrderAdd o =
|
|
monadicIO $ do
|
|
req <-
|
|
run $ testPostJson "/api/order" (A.object ["payload" A..= A.toJSON o])
|
|
res <-
|
|
httpLBS $
|
|
setRequestQueryString
|
|
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
|
req
|
|
assert $ getResponseStatus res == created201
|
|
|
|
testItemAdd :: Item -> Property
|
|
testItemAdd i = do
|
|
monadicIO $ do
|
|
req <- run $ testPostJson "/api/item" (A.object ["payload" A..= A.toJSON i])
|
|
res <-
|
|
httpLBS $
|
|
setRequestQueryString
|
|
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
|
req
|
|
assert $ getResponseStatus res == created201
|
|
|
|
-- | Open the MongoDB connection
|
|
openDbConnection :: IO Pipe
|
|
openDbConnection = do
|
|
pipe <- connect $ host "127.0.0.1"
|
|
access pipe master "zgo" (auth "zgo" "zcashrules")
|
|
return pipe
|
|
|
|
-- | Close the MongoDB pipe
|
|
closeDbConnection :: Pipe -> IO ()
|
|
closeDbConnection = close
|
|
|
|
-- | DB handling function
|
|
handleDb :: (Pipe -> Expectation) -> IO ()
|
|
handleDb = bracket openDbConnection closeDbConnection
|
|
|
|
filterDocs :: Value -> Bool
|
|
filterDocs (Doc v) = True
|
|
filterDocs _ = False
|
|
|
|
unwrapDoc :: Value -> Document
|
|
unwrapDoc (Doc v) = v
|
|
unwrapDoc _ = []
|
|
|
|
startAPI :: Config -> IO ()
|
|
startAPI config = do
|
|
putStrLn "Starting test server ..."
|
|
pipe <- connect $ host $ c_dbHost config
|
|
c <- access pipe master "zgo" (auth (c_dbUser config) (c_dbPassword config))
|
|
let appRoutes = routes pipe config
|
|
_ <- forkIO (scotty 3000 appRoutes)
|
|
_ <-
|
|
access
|
|
pipe
|
|
master
|
|
(c_dbName config)
|
|
(Database.MongoDB.delete (select [] "wootokens"))
|
|
_ <-
|
|
access
|
|
pipe
|
|
master
|
|
(c_dbName config)
|
|
(Database.MongoDB.delete (select [] "users"))
|
|
_ <-
|
|
access
|
|
pipe
|
|
master
|
|
(c_dbName config)
|
|
(Database.MongoDB.delete (select [] "items"))
|
|
_ <-
|
|
access
|
|
pipe
|
|
master
|
|
(c_dbName config)
|
|
(Database.MongoDB.delete (select [] "orders"))
|
|
_ <-
|
|
access
|
|
pipe
|
|
master
|
|
(c_dbName config)
|
|
(Database.MongoDB.delete (select [] "xerotokens"))
|
|
let myUser =
|
|
User
|
|
(Just (read "6272a90f2b05a74cf1000001" :: ObjectId))
|
|
"zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
|
|
"35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
|
|
1613487
|
|
"8ea140fbb30615d6cae383c4f62f3ad9afb10b804f63138d5b53990bd56e0162"
|
|
False
|
|
let myUser1 =
|
|
User
|
|
(Just (read "6272a90f2b05a74cf1000003" :: ObjectId))
|
|
"zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
|
|
"35bfb9c2-9ad2-4fe5-adda-99d63b8dcdaa"
|
|
1613487
|
|
"8ea140fbb30615d6cae383c4f62f3ad9afb10b804f63138d5b53990bd56e0162"
|
|
True
|
|
let myUser2 =
|
|
User
|
|
(Just (read "6272a90f2b05a74cf1000005" :: ObjectId))
|
|
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3fake"
|
|
"35bfb9c2-9ad2-4fe5-adda-99d63b8dfake"
|
|
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, myUser3, myUser4]
|
|
_ <- access pipe master "test" (insertAll_ "users" userList)
|
|
let myOwner =
|
|
Owner
|
|
(Just (read "627ad3492b05a76be3000001"))
|
|
"zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
|
|
"Test shop"
|
|
"usd"
|
|
False
|
|
0
|
|
False
|
|
0
|
|
"Bubba"
|
|
"Gibou"
|
|
"bubba@zgo.cash"
|
|
"1 Main St"
|
|
"Mpls"
|
|
"Minnesota"
|
|
"55401"
|
|
""
|
|
"bubbarocks.io"
|
|
"United States"
|
|
True
|
|
False
|
|
False
|
|
(UTCTime (fromGregorian 2023 2 6) (secondsToDiffTime 0))
|
|
False
|
|
""
|
|
""
|
|
False
|
|
let myOwner1 =
|
|
Owner
|
|
(Just (read "627ad3492b05a76be3000008"))
|
|
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3fake"
|
|
"Test shop 2"
|
|
"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 2023 8 6) (secondsToDiffTime 0))
|
|
False
|
|
""
|
|
""
|
|
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
|
|
""
|
|
""
|
|
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
|
|
""
|
|
""
|
|
False
|
|
_ <- access pipe master "test" (Database.MongoDB.delete (select [] "owners"))
|
|
let o = val myOwner
|
|
case o of
|
|
Doc d -> access pipe master "test" (insert_ "owners" d)
|
|
_ -> fail "Couldn't save Owner in DB"
|
|
let o1 = val myOwner1
|
|
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 =
|
|
ZGoOrder
|
|
(Just (read "627ab3ea2b05a76be3000000"))
|
|
"zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
|
|
"35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
|
|
myTs
|
|
False
|
|
"usd"
|
|
102.0
|
|
0
|
|
0
|
|
[]
|
|
False
|
|
""
|
|
""
|
|
"testToken1234"
|
|
let ordTest = val myOrder
|
|
case ordTest of
|
|
Doc oT -> access pipe master "test" (insert_ "orders" oT)
|
|
_ -> fail "Couldn't save Order in DB"
|
|
let myItem1 =
|
|
Item
|
|
(Just (read "627d7ba92b05a76be3000003"))
|
|
"Chair"
|
|
"Made of wood"
|
|
"Zaddy"
|
|
101.99
|
|
let itemTest = val myItem1
|
|
case itemTest of
|
|
Doc iT -> access pipe master "test" (insert_ "items" iT)
|
|
_ -> fail "Couldn't save test Item in DB"
|
|
let proSession1 =
|
|
ZGoProSession
|
|
Nothing
|
|
"zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
|
|
myTs
|
|
False
|
|
let proSessionTest = val proSession1
|
|
case proSessionTest of
|
|
Doc pS1 -> access pipe master "test" (insert_ "prosessions" pS1)
|
|
_ -> fail "Couldn't save test ZGoProSession in DB"
|
|
let myToken =
|
|
XeroToken
|
|
Nothing
|
|
"zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
|
|
"superFakeToken123"
|
|
1800
|
|
"anotherSuperFakeToken"
|
|
(UTCTime (fromGregorian 2022 9 16) (secondsToDiffTime 0))
|
|
(UTCTime (fromGregorian 2022 9 16) (secondsToDiffTime 0))
|
|
""
|
|
_ <- access pipe master "test" $ upsertToken myToken
|
|
--let myWooToken =
|
|
--WooToken
|
|
--Nothing
|
|
--(read "627ad3492b05a76be3000001")
|
|
--"89bd9d8d69a674e0f467cc8796ed151a"
|
|
--Nothing
|
|
--let wooTest = val myWooToken
|
|
--case wooTest of
|
|
--Doc wT -> access pipe master "test" (insert_ "wootokens" wT)
|
|
--_ -> fail "Couldn't save test WooToken in DB"
|
|
threadDelay 1000000
|
|
putStrLn "Test server is up!"
|
|
|
|
--QuickCheck instances
|
|
instance Arbitrary ZGoOrder where
|
|
arbitrary = do
|
|
i <- arbitrary
|
|
a <- arbitrary
|
|
s <- arbitrary
|
|
ts <- arbitrary
|
|
c <- arbitrary
|
|
cur <- arbitrary
|
|
p <- arbitrary
|
|
t <- arbitrary
|
|
tZ <- arbitrary
|
|
l <- arbitrary
|
|
pd <- arbitrary
|
|
eI <- arbitrary
|
|
sc <- arbitrary
|
|
ZGoOrder i a s ts c cur p t tZ l pd eI sc <$> arbitrary
|
|
|
|
instance Arbitrary LineItem where
|
|
arbitrary = do
|
|
i <- arbitrary
|
|
q <- arbitrary
|
|
LineItem i q <$> arbitrary
|
|
|
|
instance Arbitrary ObjectId where
|
|
arbitrary = do
|
|
x <- arbitrary
|
|
Oid x <$> arbitrary
|
|
|
|
instance Arbitrary Owner where
|
|
arbitrary = do
|
|
i <- arbitrary
|
|
a <- arbitrary
|
|
n <- arbitrary
|
|
c <- arbitrary
|
|
t <- arbitrary
|
|
tV <- arbitrary
|
|
v <- arbitrary
|
|
vV <- arbitrary
|
|
f <- arbitrary
|
|
l <- arbitrary
|
|
e <- arbitrary
|
|
s <- arbitrary
|
|
ct <- arbitrary
|
|
st <- arbitrary
|
|
p <- arbitrary
|
|
ph <- arbitrary
|
|
w <- arbitrary
|
|
co <- arbitrary
|
|
paid <- arbitrary
|
|
zats <- arbitrary
|
|
inv <- arbitrary
|
|
exp <- arbitrary
|
|
payconf <- arbitrary
|
|
vk <- arbitrary
|
|
cT <- arbitrary
|
|
Owner
|
|
i
|
|
a
|
|
n
|
|
c
|
|
t
|
|
tV
|
|
v
|
|
vV
|
|
f
|
|
l
|
|
e
|
|
s
|
|
ct
|
|
st
|
|
p
|
|
ph
|
|
w
|
|
co
|
|
paid
|
|
zats
|
|
inv
|
|
exp
|
|
payconf
|
|
vk
|
|
cT <$>
|
|
arbitrary
|
|
|
|
instance Arbitrary Item where
|
|
arbitrary = do
|
|
i <- arbitrary
|
|
n <- arbitrary
|
|
d <- arbitrary
|
|
o <- arbitrary
|
|
Item i n d o <$> arbitrary
|
|
|
|
instance Arbitrary XeroToken where
|
|
arbitrary = do
|
|
i <- arbitrary
|
|
a <- arbitrary
|
|
t <- arbitrary
|
|
e <- arbitrary
|
|
r <- arbitrary
|
|
aD <- arbitrary
|
|
dt <- arbitrary
|
|
XeroToken i a t e r aD dt <$> arbitrary
|