zgo-backend/test/Spec.hs

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