{-# 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_session m' `shouldBe` U.fromString "5d3d4494-51c0-432d-8495-050419957aea" 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_session m' `shouldBe` U.fromString "ad8477d3-4fdd-4c97-90b2-76630b5f77e1" 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_session m' `shouldBe` U.fromString "5d3d4494-51c0-432d-8495-050419957aea" 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" it "returns 401 with bad session" $ do req <- testPostJson "/api/ownervk" $ A.object ["payload" A..= (vk0 :: String)] res <- httpLBS $ setRequestQueryString [("session", Just "35bfb9c2-9ad2-4fe5-fake-99d63b8dcdcd")] req getResponseStatus res `shouldBe` unauthorized401 it "returns 403 with mismatched session" $ do req <- testPostJson "/api/ownervk" $ A.object ["payload" A..= (vk0 :: String)] res <- httpLBS $ setRequestQueryString [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")] req getResponseStatus res `shouldBe` forbidden403 it "returns 400 with malformed key" $ do req <- testPostJson "/api/ownervk" $ A.object ["payload" A..= (vk2 :: String)] res <- httpLBS $ setRequestQueryString [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")] req getResponseStatus res `shouldBe` badRequest400 it "returns 400 with non-key valid bech32" $ do req <- testPostJson "/api/ownervk" $ A.object ["payload" A..= ("bech321qqqsyrhqy2a" :: String)] res <- httpLBS $ setRequestQueryString [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")] req getResponseStatus res `shouldBe` badRequest400 it "succeeds with correct key" $ do req <- testPostJson "/api/ownervk" $ A.object ["payload" A..= (vk1 :: String)] res <- httpLBS $ setRequestQueryString [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")] req getResponseStatus res `shouldBe` created201 around handleDb $ describe "Database actions" $ do describe "authentication" $ do 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 userList = map unwrapDoc $ filter filterDocs $ val <$> [myUser, myUser1, myUser2] _ <- 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 "" "" 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 "" "" _ <- 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" _ <- 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 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 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