zgo-backend/test/Spec.hs

1348 lines
50 KiB
Haskell
Raw Normal View History

2022-04-30 12:59:49 +00:00
{-# LANGUAGE OverloadedStrings #-}
2022-04-22 16:15:23 +00:00
module Spec where
import Config
2022-04-30 12:59:49 +00:00
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
2022-05-24 15:20:10 +00:00
import Data.Configurator
2022-04-30 12:59:49 +00:00
import Data.Either
import Data.Maybe
2022-04-30 12:59:49 +00:00
import Data.SecureMem
import qualified Data.Text as T
2023-06-12 20:48:23 +00:00
import qualified Data.Text.Encoding as E
2022-05-17 17:47:27 +00:00
import Data.Time
import Data.Time.Calendar
2022-05-11 20:04:46 +00:00
import Data.Time.Clock
2022-05-24 15:20:10 +00:00
import Data.Time.Clock.POSIX
2023-05-17 14:44:25 +00:00
import qualified Data.UUID as U
2022-04-30 12:59:49 +00:00
import Database.MongoDB
2022-05-17 17:47:27 +00:00
import Item
2023-02-02 21:14:28 +00:00
import LangComponent
2022-04-30 12:59:49 +00:00
import Network.HTTP.Simple
import Network.HTTP.Types.Status
2022-05-11 20:04:46 +00:00
import Order
import Owner
2022-05-17 17:47:27 +00:00
import Payment
2022-04-30 12:59:49 +00:00
import System.IO.Unsafe
2022-04-22 16:15:23 +00:00
import Test.Hspec
2022-04-30 12:59:49 +00:00
import Test.Hspec.Expectations.Json
import Test.Hspec.QuickCheck
2022-04-22 16:15:23 +00:00
import Test.QuickCheck
2022-04-30 12:59:49 +00:00
import Test.QuickCheck.Gen
2022-05-11 20:04:46 +00:00
import Test.QuickCheck.Monadic
2023-05-17 14:44:25 +00:00
import Text.Megaparsec
2022-05-11 20:04:46 +00:00
import User
2022-05-24 15:20:10 +00:00
import Web.Scotty
2022-11-14 21:56:30 +00:00
import WooCommerce
2022-08-11 22:30:24 +00:00
import Xero
2022-04-22 16:15:23 +00:00
import ZGoBackend
2022-05-11 20:04:46 +00:00
import ZGoTx
2022-04-22 16:15:23 +00:00
main :: IO ()
2022-05-24 15:20:10 +00:00
main = do
putStrLn "Reading config..."
loadedConfig <- loadZGoConfig "zgotest.cfg"
2022-04-22 16:15:23 +00:00
hspec $ do
2022-04-30 12:59:49 +00:00
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 ->
2022-07-07 15:56:33 +00:00
(decodeHexText . encodeHexText) x == x
2023-05-17 14:44:25 +00:00
describe "zToZGoTx" $
--prop "memo parsing" testMemoParser
do
it "parse ZecWallet memo" $ 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" $ 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"
2022-08-29 16:23:48 +00:00
it "converts ZecWallet tx to ZGo tx" $ do
2022-04-30 12:59:49 +00:00
let t =
ZcashTx
"someId"
0.5
50000000
1602000
18732456
False
2022-08-29 20:35:24 +00:00
5
2022-04-30 12:59:49 +00:00
"ZGO::5d3d4494-51c0-432d-8495-050419957aea\nReply-To:\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
zToZGoTx t `shouldBe`
ZGoTx
2022-05-17 17:47:27 +00:00
Nothing
2022-04-30 12:59:49 +00:00
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
"5d3d4494-51c0-432d-8495-050419957aea"
2022-08-29 20:35:24 +00:00
5
2022-04-30 12:59:49 +00:00
18732456
0.5
"someId"
"ZGO::5d3d4494-51c0-432d-8495-050419957aea\nReply-To:\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
2022-08-29 16:23:48 +00:00
it "converts YWallet tx to ZGo tx" $ do
let t =
ZcashTx
"someId"
0.5
50000000
1602000
18732456
False
2022-08-29 20:35:24 +00:00
5
"\128737MSG\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e\n\nZGO::ad8477d3-4fdd-4c97-90b2-76630b5f77e1"
2022-08-29 16:23:48 +00:00
zToZGoTx t `shouldBe`
ZGoTx
Nothing
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
2022-08-29 20:35:24 +00:00
"ad8477d3-4fdd-4c97-90b2-76630b5f77e1"
5
2022-08-29 16:23:48 +00:00
18732456
0.5
"someId"
2022-08-29 20:35:24 +00:00
"\128737MSG\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e\n\nZGO::ad8477d3-4fdd-4c97-90b2-76630b5f77e1"
2022-08-29 16:23:48 +00:00
it "converts ZecWallet payment tx to ZGo tx" $ do
let t =
ZcashTx
"someId"
0.5
50000000
1602000
18732456
False
2022-08-29 20:35:24 +00:00
5
2022-08-29 16:23:48 +00:00
"ZGOp::5d3d4494-51c0-432d-8495-050419957aea\nReply-To:\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
zToZGoTx t `shouldBe`
ZGoTx
Nothing
""
"5d3d4494-51c0-432d-8495-050419957aea"
2022-08-29 20:35:24 +00:00
5
2022-08-29 16:23:48 +00:00
18732456
0.5
"someId"
"ZGOp::5d3d4494-51c0-432d-8495-050419957aea\nReply-To:\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
it "converts YWallet payment tx to ZGo tx" $ do
let t =
ZcashTx
"someId"
0.5
50000000
1602000
18732456
False
2022-08-29 20:35:24 +00:00
5
"\128737MSG\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e\n\nZGOp::ad8477d3-4fdd-4c97-90b2-76630b5f77e1"
2022-08-29 16:23:48 +00:00
zToZGoTx t `shouldBe`
ZGoTx
Nothing
""
2022-08-29 20:35:24 +00:00
"ad8477d3-4fdd-4c97-90b2-76630b5f77e1"
5
2022-08-29 16:23:48 +00:00
18732456
0.5
"someId"
2022-08-29 20:35:24 +00:00
"\128737MSG\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e\n\nZGOp::ad8477d3-4fdd-4c97-90b2-76630b5f77e1"
2022-04-30 12:59:49 +00:00
describe "PIN generator" $ do
it "should give a 7 digit" $ do
2023-02-02 21:14:28 +00:00
pin <- generatePin
length pin `shouldBe` 7
2022-04-30 12:59:49 +00:00
describe "API endpoints" $ do
beforeAll_ (startAPI loadedConfig) $ do
2023-05-08 16:21:09 +00:00
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
2022-04-30 12:59:49 +00:00
describe "Price endpoint" $ do
it "returns a price for an existing currency" $ do
2023-05-17 14:44:25 +00:00
req <- testGet "/price" [("currency", Just "usd")]
2022-04-30 12:59:49 +00:00
res <- httpJSON req
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
it "returns 204 when the currency is not supported" $ do
2023-05-17 14:44:25 +00:00
req <- testGet "/price" [("currency", Just "jpy")]
2022-04-30 12:59:49 +00:00
res <- httpLBS req
getResponseStatus res `shouldBe` noContent204
describe "Countries endpoint" $ do
it "returns a list of countries" $ do
2023-05-08 16:21:09 +00:00
req <-
testGet
"/api/countries"
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
2022-04-30 12:59:49 +00:00
res <- httpJSON req
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
2023-05-08 16:21:09 +00:00
it "returns 401 with invalid session" $ do
req <-
testGet
"/api/countries"
[("session", Just "fake-id-string-283that0")]
res <- httpLBS req
getResponseStatus res `shouldBe` unauthorized401
2022-04-30 12:59:49 +00:00
describe "blockheight endpoint" $ do
2022-11-14 21:56:30 +00:00
it "returns a block number" $ do
2023-05-08 16:21:09 +00:00
req <-
testGet
2023-05-17 14:44:25 +00:00
"/blockheight"
2023-05-08 16:21:09 +00:00
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
2022-04-30 12:59:49 +00:00
res <- httpJSON req
height (getResponseBody (res :: Response Block)) `shouldSatisfy` \x ->
x > 1600000
2023-05-08 16:21:09 +00:00
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"
2023-06-09 15:51:42 +00:00
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
2023-05-08 16:21:09 +00:00
res <- httpJSON req
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
2023-06-09 15:51:42 +00:00
it "reading returns 401 with invalid session" $ do
2023-05-08 16:21:09 +00:00
req <-
testGet
"/api/xeroaccount"
[("session", Just "fnelrkgnlyebrlvns82949")]
res <- httpLBS req
getResponseStatus res `shouldBe` unauthorized401
2023-06-09 15:51:42 +00:00
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
2022-04-30 12:59:49 +00:00
describe "User endpoint" $ do
it "returns a user for a session" $ do
req <-
testGet
"/api/user"
2023-02-02 21:14:28 +00:00
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
res <- httpJSON req
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
2023-05-08 16:21:09 +00:00
it "returns 401 when user doesn't exist" $ do
req <-
testGet
"/api/user"
[("session", Just "suchafak-euui-dican-eve-nbelieveitca")]
res <- httpLBS req
2023-05-08 16:21:09 +00:00
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"
2023-06-09 15:51:42 +00:00
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdaa")]
res <- httpLBS req
getResponseStatus res `shouldBe` ok200
2023-05-08 16:21:09 +00:00
describe "Owner endpoint" $
--prop "add owner" testOwnerAdd
do
2022-08-16 20:54:15 +00:00
it "return owner by address" $ do
2022-05-11 20:04:46 +00:00
req <-
testGet
"/api/owner"
[ ( "address"
, Just
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e")
2023-05-08 16:21:09 +00:00
, ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")
2022-05-11 20:04:46 +00:00
]
res <- httpJSON req
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
2023-05-08 16:21:09 +00:00
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
2022-08-16 20:54:15 +00:00
it "return owner by id" $ do
req <-
2023-05-08 16:21:09 +00:00
testGet
"/api/ownerid"
[ ("id", Just "627ad3492b05a76be3000001")
, ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")
]
2022-08-16 20:54:15 +00:00
res <- httpLBS req
getResponseStatus res `shouldBe` ok200
2023-06-01 19:59:50 +00:00
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
""
""
2023-06-05 12:47:51 +00:00
"testToken4321"
2023-06-01 19:59:50 +00:00
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
""
""
2023-06-05 12:47:51 +00:00
"testToken4321"
2023-06-01 19:59:50 +00:00
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"))
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
"35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
myTs
False
"usd"
102.0
0
0
[]
False
""
""
2023-06-05 12:47:51 +00:00
"testToken4321"
2023-06-01 19:59:50 +00:00
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
2022-05-11 20:04:46 +00:00
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
2023-06-01 19:59:50 +00:00
it "get order by session fails with bad session" $ do
2023-05-08 16:21:09 +00:00
req <-
testGet
"/api/order"
[("session", Just "35bfb9c2-9ad2-4fe5-fake-99d63b8dcdcd")]
res <- httpLBS req
getResponseStatus res `shouldBe` unauthorized401
2022-05-11 20:04:46 +00:00
it "get order by id" $ do
2023-06-05 12:47:51 +00:00
req <-
testGet
"/order/627ab3ea2b05a76be3000000"
[("token", Just "testToken1234")]
2022-05-11 20:04:46 +00:00
res <- httpJSON req
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
2023-06-01 19:59:50 +00:00
it "get order with invalid id fails with 400" $ do
2023-06-05 12:47:51 +00:00
req <- testGet "/order/6273hrb" [("token", Just "testToken1234")]
2022-05-24 15:20:10 +00:00
res <- httpLBS req
2023-06-01 19:59:50 +00:00
getResponseStatus res `shouldBe` badRequest400
it "get order by id fails with bad token" $ do
2023-06-05 12:47:51 +00:00
req <-
testGet
"/order/627ab3ea2b05a76be3000000"
[("token", Just "wrongToken1234")]
2023-05-08 16:21:09 +00:00
res <- httpLBS req
2023-06-05 12:47:51 +00:00
getResponseStatus res `shouldBe` forbidden403
2022-05-12 19:59:29 +00:00
it "get all orders for owner" $ do
2023-05-08 16:21:09 +00:00
req <-
testGet
"/api/allorders"
2023-06-05 12:47:51 +00:00
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
2022-05-12 19:59:29 +00:00
res <- httpJSON req
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
2023-05-08 16:21:09 +00:00
it "get all orders for owner fails with bad session" $ do
req <-
testGet
"/api/allorders"
2023-06-05 12:47:51 +00:00
[("session", Just "35bfb9c2-9ad2-4fe5-fake-99d63b8dcdcd")]
2023-05-08 16:21:09 +00:00
res <- httpLBS req
getResponseStatus res `shouldBe` unauthorized401
2023-06-05 12:47:51 +00:00
it "delete order by id fails with mismatched session" $ do
2023-05-08 16:21:09 +00:00
req <-
testDelete
"/api/order/"
"627ab3ea2b05a76be3000000"
2023-06-05 12:47:51 +00:00
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dfake")]
2022-05-11 20:04:46 +00:00
res <- httpLBS req
2023-06-05 12:47:51 +00:00
getResponseStatus res `shouldBe` forbidden403
2023-05-08 16:21:09 +00:00
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
2023-06-05 12:47:51 +00:00
it "delete order by id" $ do
2023-06-01 19:59:50 +00:00
req <-
testDelete
"/api/order/"
"627ab3ea2b05a76be3000000"
2023-06-05 12:47:51 +00:00
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
2023-06-01 19:59:50 +00:00
res <- httpLBS req
2023-06-05 12:47:51 +00:00
getResponseStatus res `shouldBe` ok200
2022-05-12 19:59:29 +00:00
describe "Item endpoint" $ do
2023-05-26 19:04:35 +00:00
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"
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
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
2023-05-08 16:21:09 +00:00
req <-
testGet
"/api/items"
2023-05-26 19:04:35 +00:00
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
2022-05-17 17:47:27 +00:00
res <- httpJSON req
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
2023-05-26 19:04:35 +00:00
it "get items with invalid session returns 401" $ do
2023-05-08 16:21:09 +00:00
req <-
2023-05-26 19:04:35 +00:00
testGet
"/api/items"
[("session", Just "35bfb9c2-9ad2-4fe5-fake-99d63b8dcdcd")]
2022-05-17 17:47:27 +00:00
res <- httpLBS req
2023-05-26 19:04:35 +00:00
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
2022-11-14 21:56:30 +00:00
describe "WooCommerce endpoints" $ do
2023-06-09 15:51:42 +00:00
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"
2023-05-08 16:21:09 +00:00
[ ("ownerid", Just "627ad3492b05a76be3000001")
, ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")
]
res <- httpLBS req
getResponseStatus res `shouldBe` accepted202
2023-06-12 20:48:23 +00:00
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
2022-11-14 21:56:30 +00:00
it "authenticate with incorrect owner" $ do
req <-
2022-12-01 20:36:06 +00:00
testPublicGet
"/auth"
2022-11-14 21:56:30 +00:00
[ ("ownerid", Just "62cca13f5530331e2a900001")
2023-02-02 21:14:28 +00:00
, ( "token"
, Just
"0c1702c16c7bd7e075b8bb129b24888a5cc2181fa1eb4ce9190cfcb625ecf0ee")
2022-11-29 00:35:06 +00:00
, ("siteurl", Just "aHR0cHM6Ly93d3cudGVjcHJvdmFsLmNvbS8")
2022-11-14 21:56:30 +00:00
]
res <- httpJSON req
getResponseStatus (res :: Response A.Value) `shouldBe` accepted202
it "authenticate with incorrect token" $ do
req <-
2022-12-01 20:36:06 +00:00
testPublicGet
"/auth"
[ ("ownerid", Just "627ad3492b05a76be3000001")
2022-11-14 21:56:30 +00:00
, ("token", Just "89bd9d8d69a674e0f467cc8796000000")
2022-11-29 00:35:06 +00:00
, ("siteurl", Just "aHR0cHM6Ly93d3cudGVjcHJvdmFsLmNvbS8")
2022-11-14 21:56:30 +00:00
]
res <- httpJSON req
getResponseStatus (res :: Response A.Value) `shouldBe` accepted202
it "authenticate with correct token" $ do
2023-06-12 20:48:23 +00:00
req1 <-
testGet
"/api/wootoken"
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
res1 <- httpJSON req1
let tk = getResponseBody (res1 :: Response WooToken)
2022-11-14 21:56:30 +00:00
req <-
2022-12-01 20:36:06 +00:00
testPublicGet
"/auth"
[ ("ownerid", Just "627ad3492b05a76be3000001")
2023-06-12 20:48:23 +00:00
, ("token", Just $ (E.encodeUtf8 . w_token) tk)
2022-11-29 00:35:06 +00:00
, ("siteurl", Just "aHR0cHM6Ly93d3cudGVjcHJvdmFsLmNvbS8")
2022-11-14 21:56:30 +00:00
]
res <- httpJSON req
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
it "authenticate with correct token on existing shop" $ do
req <-
2022-12-01 20:36:06 +00:00
testPublicGet
"/auth"
[ ("ownerid", Just "627ad3492b05a76be3000001")
2023-02-02 21:14:28 +00:00
, ( "token"
, Just
"0c1702c16c7bd7e075b8bb129b24888a5cc2181fa1eb4ce9190cfcb625ecf0ee")
2022-11-29 00:35:06 +00:00
, ("siteurl", Just "aHR0cHM6Ly93d3cuZ29vZ2xlLmNvbS8")
2022-11-14 21:56:30 +00:00
]
res <- httpJSON req
getResponseStatus (res :: Response A.Value) `shouldBe` accepted202
2022-12-01 20:36:06 +00:00
it "request order creation" $ do
2023-06-12 20:48:23 +00:00
req1 <-
testGet
"/api/wootoken"
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
res1 <- httpJSON req1
let tk = getResponseBody (res1 :: Response WooToken)
2022-12-01 20:36:06 +00:00
req <-
testPublicGet
"/woopayment"
[ ("ownerid", Just "627ad3492b05a76be3000001")
2023-06-12 20:48:23 +00:00
, ("token", Just $ (E.encodeUtf8 . w_token) tk)
2022-12-01 20:36:06 +00:00
, ("siteurl", Just "aHR0cHM6Ly93d3cudGVjcHJvdmFsLmNvbS8")
, ("order_id", Just "1234")
, ("currency", Just "usd")
, ("amount", Just "100.0")
, ("date", Just "2022-12-01")
2022-12-13 20:01:51 +00:00
, ("orderkey", Just "wc_order_m7qiJ1dNrGDYE")
2022-12-01 20:36:06 +00:00
]
res <- httpJSON req
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
2023-02-02 21:14:28 +00:00
describe "Language endpoint" $ do
it "existing component" $ do
req <-
testGet
"/api/getlang"
2023-05-08 16:21:09 +00:00
[ ("lang", Just "en-US")
, ("component", Just "login")
, ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")
]
2023-02-02 21:14:28 +00:00
res <- httpJSON req
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
2023-05-08 16:21:09 +00:00
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
2023-02-02 21:14:28 +00:00
it "wrong component" $ do
req <-
testGet
"/api/getlang"
2023-05-08 16:21:09 +00:00
[ ("lang", Just "en-US")
, ("component", Just "test")
, ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")
]
2023-02-02 21:14:28 +00:00
res <- httpLBS req
getResponseStatus res `shouldBe` noContent204
it "wrong language" $ do
req <-
testGet
"/api/getlang"
2023-05-08 16:21:09 +00:00
[ ("lang", Just "fr-FR")
, ("component", Just "login")
, ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")
]
2023-02-02 21:14:28 +00:00
res <- httpLBS req
getResponseStatus res `shouldBe` noContent204
2022-04-30 12:59:49 +00:00
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
2023-04-11 14:58:07 +00:00
describe "ZGo Pro sessions" $ do
it "find in DB" $ \p -> do
doc <-
access p master "test" $
findProSession
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
doc `shouldNotBe` Nothing
it "upsert to DB" $ const pending
2022-04-30 12:59:49 +00:00
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 <)
2022-05-11 20:04:46 +00:00
describe "user is" $ do
2023-04-11 14:58:07 +00:00
xit "validated" $ \p -> do
2022-05-11 20:04:46 +00:00
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")
2022-05-17 19:40:19 +00:00
let s = parseUserBson =<< t
2022-11-14 21:56:30 +00:00
let userId = u_id =<< s
2022-05-17 19:40:19 +00:00
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"))
2023-06-09 15:51:42 +00:00
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
"35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
myTs
False
"usd"
102.0
0
0
[]
False
2022-08-03 19:13:33 +00:00
""
""
2023-06-05 12:47:51 +00:00
"testToken1234"
let ordTest = val myOrder
case ordTest of
Doc oT -> access p master "test" (insert_ "orders" oT)
2022-11-14 21:56:30 +00:00
_ -> fail "Couldn't save Order in DB"
_ <-
2022-08-10 15:17:47 +00:00
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
2022-08-11 22:30:24 +00:00
describe "Xero data" $ do
it "token is saved" $ \p -> do
2023-06-09 15:51:42 +00:00
t <-
access p master "test" $
findToken
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
2022-08-11 22:30:24 +00:00
let t1 = (cast' . Doc) =<< t
case t1 of
Nothing -> True `shouldBe` False
2023-06-09 15:51:42 +00:00
Just t2 ->
t_address t2 `shouldBe`
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
2022-09-06 19:01:14 +00:00
it "code is saved" $ \p -> do
2023-06-09 15:51:42 +00:00
_ <-
access p master "test" $
addAccCode
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
"ZEC"
t <-
access p master "test" $
findToken
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
2022-09-06 19:01:14 +00:00
let t1 = (cast' . Doc) =<< t
case t1 of
Nothing -> True `shouldBe` False
Just t2 -> t_code t2 `shouldBe` "ZEC"
2022-04-30 12:59:49 +00:00
describe "Zcash transactions" $ do
2022-08-10 15:17:47 +00:00
xit "logins are added to db" $ \p -> do
2022-05-24 15:20:10 +00:00
_ <-
access p master "test" (Database.MongoDB.delete (select [] "txs"))
_ <- scanZcash loadedConfig p
2022-04-30 12:59:49 +00:00
threadDelay 1000000
t <- access p master "test" $ findOne (select [] "txs")
2022-05-17 19:40:19 +00:00
let s = parseZGoTxBson =<< t
let conf = maybe 0 confirmations s
conf `shouldSatisfy` (> 0)
2023-04-11 14:58:07 +00:00
xit "payments are added to db" $ \p -> do
2022-05-24 15:20:10 +00:00
_ <-
access
p
master
"test"
(Database.MongoDB.delete (select [] "payments"))
_ <- scanZcash loadedConfig p
2022-04-30 12:59:49 +00:00
threadDelay 1000000
t <- access p master "test" $ findOne (select [] "payments")
2022-05-17 17:47:27 +00:00
let s = (cast' . Doc) =<< t
let payDelta = maybe 0 pdelta s
payDelta `shouldSatisfy` (> 0)
it "owners are marked as paid" $ \p -> do
2022-05-17 19:40:19 +00:00
let myUser =
User
(Just (read "6272a90f2b05a74cf1000002" :: ObjectId))
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
"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
])
2022-05-24 15:20:10 +00:00
tstamp <- getCurrentTime
2022-05-17 19:40:19 +00:00
let myPay =
Payment
Nothing
86400
False
""
"35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcb"
2022-05-24 15:20:10 +00:00
((round . utcTimeToPOSIXSeconds) tstamp)
2022-05-17 19:40:19 +00:00
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" =:
("zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e" :: T.Text)
]
"owners")
let s = (cast' . Doc) =<< t
let ownerPaid = maybe False opaid s
ownerPaid `shouldBe` True
_ -> True `shouldBe` False `debug` "Failed parsing payment"
2022-08-10 15:17:47 +00:00
xit "owners are expired" $ \p -> do
2022-05-17 21:30:46 +00:00
_ <- expireOwners p "test"
now <- getCurrentTime
res <-
access
p
master
"test"
(rest =<<
find
(select
["expiration" =: ["$lt" =: now], "paid" =: True]
"owners"))
res `shouldBe` []
2023-01-27 17:15:03 +00:00
xit "login txs are converted to users" $ \p -> do
2022-05-03 13:59:29 +00:00
let myTx =
ZGoTx
2022-05-17 17:47:27 +00:00
Nothing
2022-05-03 13:59:29 +00:00
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
"35bfb9c2-9ad2-4fe5-adda-99d63b8dcdca"
3
1613487
0.00000001
"abcdef"
"Super Memo"
2022-05-24 15:20:10 +00:00
_ <-
access
p
master
"test"
(Database.MongoDB.delete (select [] "users"))
2022-05-03 13:59:29 +00:00
_ <- access p master "test" (insert_ "txs" (encodeZGoTxBson myTx))
_ <- updateLogins p loadedConfig
2022-05-03 13:59:29 +00:00
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)
2022-04-30 12:59:49 +00:00
testGet :: B.ByteString -> [(B.ByteString, Maybe B.ByteString)] -> IO Request
testGet endpoint body = do
let user = "user"
let pwd = "superSecret"
let testRequest =
setRequestQueryString body $
2022-05-17 17:47:27 +00:00
setRequestPort 3000 $
2022-04-30 12:59:49 +00:00
setRequestBasicAuth user pwd $
setRequestMethod "GET" $ setRequestPath endpoint defaultRequest
return testRequest
2022-12-01 20:36:06 +00:00
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 $
2022-05-17 17:47:27 +00:00
setRequestPort 3000 $
setRequestBasicAuth user pwd $
setRequestMethod "POST" $ setRequestPath endpoint defaultRequest
return testRequest
2022-05-11 20:04:46 +00:00
testPostJson :: B.ByteString -> A.Value -> IO Request
testPostJson endpoint body = do
let user = "user"
let pwd = "superSecret"
let testRequest =
setRequestBodyJSON body $
2022-05-17 17:47:27 +00:00
setRequestPort 3000 $
2022-05-11 20:04:46 +00:00
setRequestBasicAuth user pwd $
setRequestMethod "POST" $ setRequestPath endpoint defaultRequest
return testRequest
2023-05-08 16:21:09 +00:00
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 =
2023-05-08 16:21:09 +00:00
setRequestQueryString body $
2022-05-17 17:47:27 +00:00
setRequestPort 3000 $
setRequestBasicAuth user pwd $
setRequestMethod "DELETE" $
setRequestPath (B.append endpoint par) defaultRequest
return testRequest
2023-05-17 14:44:25 +00:00
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
2023-05-26 19:04:35 +00:00
Left e -> assert False `debug` errorBundlePretty e
2023-05-17 14:44:25 +00:00
Right zm ->
assert $
U.fromString "5d3d4494-51c0-432d-8495-050419957aea" == m_session zm &&
Just
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e" ==
m_address zm
2022-05-11 20:04:46 +00:00
testOwnerAdd :: Owner -> Property
testOwnerAdd o =
monadicIO $ do
2022-05-17 17:47:27 +00:00
req <-
run $ testPostJson "/api/owner" (A.object ["payload" A..= A.toJSON o]) --`debug` show o
2022-05-11 20:04:46 +00:00
res <- httpLBS req
if opayconf o
then assert $ getResponseStatus res == internalServerError500
else assert $ getResponseStatus res == created201
2022-05-11 20:04:46 +00:00
testOrderAdd :: ZGoOrder -> Property
testOrderAdd o =
monadicIO $ do
2022-05-24 15:20:10 +00:00
req <-
run $ testPostJson "/api/order" (A.object ["payload" A..= A.toJSON o])
2023-05-08 16:21:09 +00:00
res <-
httpLBS $
setRequestQueryString
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
req
2022-05-11 20:04:46 +00:00
assert $ getResponseStatus res == created201
2022-05-17 17:47:27 +00:00
testItemAdd :: Item -> Property
testItemAdd i = do
monadicIO $ do
2022-05-24 15:20:10 +00:00
req <- run $ testPostJson "/api/item" (A.object ["payload" A..= A.toJSON i])
2023-05-08 16:21:09 +00:00
res <-
httpLBS $
setRequestQueryString
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
req
2022-05-17 17:47:27 +00:00
assert $ getResponseStatus res == created201
2022-04-30 12:59:49 +00:00
-- | 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
2022-04-30 12:59:49 +00:00
putStrLn "Starting test server ..."
pipe <- connect $ host "127.0.0.1"
c <- access pipe master "zgo" (auth "zgo" "zcashrules")
let appRoutes = routes pipe config
2022-05-24 15:20:10 +00:00
_ <- forkIO (scotty 3000 appRoutes)
2022-11-14 21:56:30 +00:00
_ <-
access pipe master "test" (Database.MongoDB.delete (select [] "wootokens"))
2023-05-08 16:21:09 +00:00
_ <- access pipe master "test" (Database.MongoDB.delete (select [] "users"))
_ <- access pipe master "test" (Database.MongoDB.delete (select [] "items"))
_ <- access pipe master "test" (Database.MongoDB.delete (select [] "orders"))
2023-06-09 15:51:42 +00:00
_ <-
access pipe master "test" (Database.MongoDB.delete (select [] "xerotokens"))
2022-05-11 20:04:46 +00:00
let myUser =
User
2022-05-17 19:40:19 +00:00
(Just (read "6272a90f2b05a74cf1000001" :: ObjectId))
2022-05-11 20:04:46 +00:00
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
"35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
1613487
2023-02-02 21:14:28 +00:00
"8ea140fbb30615d6cae383c4f62f3ad9afb10b804f63138d5b53990bd56e0162"
2022-05-11 20:04:46 +00:00
False
2023-05-08 16:21:09 +00:00
let myUser1 =
User
(Just (read "6272a90f2b05a74cf1000003" :: ObjectId))
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
2023-06-09 15:51:42 +00:00
"35bfb9c2-9ad2-4fe5-adda-99d63b8dcdaa"
2023-05-08 16:21:09 +00:00
1613487
"8ea140fbb30615d6cae383c4f62f3ad9afb10b804f63138d5b53990bd56e0162"
True
let myUser2 =
User
(Just (read "6272a90f2b05a74cf1000005" :: ObjectId))
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3fake"
"35bfb9c2-9ad2-4fe5-adda-99d63b8dfake"
1613487
"8ea140fbb30615d6cae383c4f62f3ad9afb10b804f63138d5b53990bd56e0162"
True
let userList =
map unwrapDoc $ filter filterDocs $ val <$> [myUser, myUser1, myUser2]
_ <- access pipe master "test" (insertAll_ "users" userList)
2022-05-11 20:04:46 +00:00
let myOwner =
Owner
(Just (read "627ad3492b05a76be3000001"))
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
"Test shop"
"usd"
False
0
False
0
"Bubba"
"Gibou"
"bubba@zgo.cash"
"1 Main St"
"Mpls"
"Minnesota"
"55401"
""
"bubbarocks.io"
"United States"
2022-12-01 20:36:06 +00:00
True
2022-05-11 20:04:46 +00:00
False
False
(UTCTime (fromGregorian 2023 2 6) (secondsToDiffTime 0))
False
""
""
2023-06-12 20:48:23 +00:00
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
""
""
2022-05-24 15:20:10 +00:00
_ <- access pipe master "test" (Database.MongoDB.delete (select [] "owners"))
2022-05-11 20:04:46 +00:00
let o = val myOwner
case o of
Doc d -> access pipe master "test" (insert_ "owners" d)
2022-11-14 21:56:30 +00:00
_ -> fail "Couldn't save Owner in DB"
2023-06-12 20:48:23 +00:00
let o1 = val myOwner1
case o1 of
Doc d1 -> access pipe master "test" (insert_ "owners" d1)
_ -> fail "Couldn't save Owner1 in DB"
2022-05-24 15:20:10 +00:00
_ <- access pipe master "test" (Database.MongoDB.delete (select [] "orders"))
2022-05-11 20:04:46 +00:00
myTs <- liftIO getCurrentTime
let myOrder =
ZGoOrder
(Just (read "627ab3ea2b05a76be3000000"))
2023-06-05 12:47:51 +00:00
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
2022-05-11 20:04:46 +00:00
"35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
myTs
False
"usd"
102.0
0
0
[]
2022-05-24 15:20:10 +00:00
False
2022-08-03 19:13:33 +00:00
""
""
2023-06-05 12:47:51 +00:00
"testToken1234"
2022-05-11 20:04:46 +00:00
let ordTest = val myOrder
case ordTest of
Doc oT -> access pipe master "test" (insert_ "orders" oT)
2022-11-14 21:56:30 +00:00
_ -> fail "Couldn't save Order in DB"
2022-05-17 17:47:27 +00:00
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)
2022-11-14 21:56:30 +00:00
_ -> fail "Couldn't save test Item in DB"
2023-04-11 14:58:07 +00:00
let proSession1 =
ZGoProSession
Nothing
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
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"
2023-06-09 15:51:42 +00:00
let myToken =
XeroToken
Nothing
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
"superFakeToken123"
1800
"anotherSuperFakeToken"
(UTCTime (fromGregorian 2022 9 16) (secondsToDiffTime 0))
(UTCTime (fromGregorian 2022 9 16) (secondsToDiffTime 0))
""
_ <- access pipe master "test" $ upsertToken myToken
2023-02-02 21:14:28 +00:00
--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"
2022-04-30 12:59:49 +00:00
threadDelay 1000000
putStrLn "Test server is up!"
2022-05-11 20:04:46 +00:00
--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
2022-05-24 15:20:10 +00:00
l <- arbitrary
2022-08-03 19:13:33 +00:00
pd <- arbitrary
eI <- arbitrary
2023-06-05 12:47:51 +00:00
sc <- arbitrary
ZGoOrder i a s ts c cur p t tZ l pd eI sc <$> arbitrary
2022-05-11 20:04:46 +00:00
instance Arbitrary LineItem where
arbitrary = do
i <- arbitrary
q <- arbitrary
2022-05-24 15:20:10 +00:00
LineItem i q <$> arbitrary
2022-05-11 20:04:46 +00:00
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
2022-05-17 17:47:27 +00:00
inv <- arbitrary
exp <- arbitrary
payconf <- arbitrary
2022-08-03 18:48:51 +00:00
vk <- 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 <$>
arbitrary
2022-05-17 17:47:27 +00:00
instance Arbitrary Item where
arbitrary = do
i <- arbitrary
n <- arbitrary
d <- arbitrary
o <- arbitrary
Item i n d o <$> arbitrary
2022-08-11 22:30:24 +00:00
instance Arbitrary XeroToken where
arbitrary = do
i <- arbitrary
a <- arbitrary
t <- arbitrary
e <- arbitrary
2022-08-29 16:23:48 +00:00
r <- arbitrary
aD <- arbitrary
2022-09-06 19:01:14 +00:00
dt <- arbitrary
XeroToken i a t e r aD dt <$> arbitrary