{-# 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 Data.Time import Data.Time.Calendar import Data.Time.Clock import Data.Time.Clock.POSIX import Database.MongoDB import Item 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 User import Web.Scotty 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 "zToZGoTx" $ do it "converts ZecWallet tx to ZGo tx" $ do let t = ZcashTx "someId" 0.5 50000000 1602000 18732456 False 20 "ZGO::5d3d4494-51c0-432d-8495-050419957aea\nReply-To:\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e" zToZGoTx t `shouldBe` ZGoTx Nothing "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e" "5d3d4494-51c0-432d-8495-050419957aea" 20 18732456 0.5 "someId" "ZGO::5d3d4494-51c0-432d-8495-050419957aea\nReply-To:\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e" it "converts YWallet tx to ZGo tx" $ do let t = ZcashTx "someId" 0.5 50000000 1602000 18732456 False 20 "fjbMSG\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e\nZGO::5d3d4494-51c0-432d-8495-050419957aea" zToZGoTx t `shouldBe` ZGoTx Nothing "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e" "5d3d4494-51c0-432d-8495-050419957aea" 20 18732456 0.5 "someId" "fjbMSG\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e\nZGO::5d3d4494-51c0-432d-8495-050419957aea" it "converts ZecWallet payment tx to ZGo tx" $ do let t = ZcashTx "someId" 0.5 50000000 1602000 18732456 False 20 "ZGOp::5d3d4494-51c0-432d-8495-050419957aea\nReply-To:\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e" zToZGoTx t `shouldBe` ZGoTx Nothing "" "5d3d4494-51c0-432d-8495-050419957aea" 20 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 20 "fjbMSG\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e\nZGOp::5d3d4494-51c0-432d-8495-050419957aea" zToZGoTx t `shouldBe` ZGoTx Nothing "" "5d3d4494-51c0-432d-8495-050419957aea" 20 18732456 0.5 "someId" "fjbMSG\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e\nZGOp::5d3d4494-51c0-432d-8495-050419957aea" describe "PIN generator" $ do it "should give a 7 digit" $ do length (T.unpack (unsafePerformIO (generatePin 1010))) `shouldBe` 7 describe "API endpoints" $ do beforeAll_ (startAPI loadedConfig) $ do describe "Price endpoint" $ do it "returns a price for an existing currency" $ do req <- testGet "/api/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 "/api/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" [] res <- httpJSON req getResponseStatus (res :: Response A.Value) `shouldBe` ok200 describe "blockheight endpoint" $ do xit "returns a block number" $ do req <- testGet "/api/blockheight" [] res <- httpJSON req height (getResponseBody (res :: Response Block)) `shouldSatisfy` \x -> x > 1600000 describe "xero config endpoint" $ do it "returns the config" $ do req <- testGet "/api/xero" [] res <- httpJSON req getResponseStatus (res :: Response A.Value) `shouldBe` ok200 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 204 when no user" $ do req <- testGet "/api/user" [("session", Just "suchafak-euui-dican-eve-nbelieveitca")] res <- httpLBS req getResponseStatus res `shouldBe` noContent204 it "validate with correct pin" $ do req <- testPost "/api/validateuser" [ ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd") , ("pin", Just "1234567") ] res <- httpLBS req getResponseStatus res `shouldBe` accepted202 it "deletes user by id" $ do req <- testDelete "/api/user/" "6272a90f2b05a74cf1000001" res <- httpLBS req getResponseStatus res `shouldBe` ok200 describe "Owner endpoint" $ do prop "add owner" testOwnerAdd it "return owner by address" $ do req <- testGet "/api/owner" [ ( "address" , Just "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e") ] res <- httpJSON req getResponseStatus (res :: Response A.Value) `shouldBe` ok200 it "return owner by id" $ do req <- testGet "/api/ownerid" [("id", Just "627ad3492b05a76be3000001")] res <- httpLBS req getResponseStatus res `shouldBe` ok200 describe "Order endpoint" $ do prop "upsert order" testOrderAdd 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 id" $ do req <- testGet "/api/order/627ab3ea2b05a76be3000000" [] res <- httpJSON req getResponseStatus (res :: Response A.Value) `shouldBe` ok200 it "get order with wrong id" $ do req <- testGet "/api/order/6273hrb" [] res <- httpLBS req getResponseStatus res `shouldBe` noContent204 it "get all orders for owner" $ do req <- testGet "/api/allorders" [("address", Just "Zaddy")] res <- httpJSON req getResponseStatus (res :: Response A.Value) `shouldBe` ok200 it "delete order by id" $ do req <- testDelete "/api/order/" "627ab3ea2b05a76be3000000" res <- httpLBS req getResponseStatus res `shouldBe` ok200 describe "Item endpoint" $ do prop "add item" testItemAdd it "get items" $ do req <- testGet "/api/items" [("address", Just "Zaddy")] res <- httpJSON req getResponseStatus (res :: Response A.Value) `shouldBe` ok200 it "delete item" $ do req <- testDelete "/api/item/" "627d7ba92b05a76be3000003" res <- httpLBS req getResponseStatus res `shouldBe` ok200 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 "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 it "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 = maybe Nothing 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")) "Zaddy" "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd" myTs False "usd" 102.0 0 0 [] False "" "" let ordTest = val myOrder case ordTest of Doc oT -> access p master "test" (insert_ "orders" oT) _ <- 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 let myToken = XeroToken Nothing "Zaddy" "superFakeToken123" 1800 "anotherSuperFakeToken" (UTCTime (fromGregorian 2022 9 16) (secondsToDiffTime 0)) (UTCTime (fromGregorian 2022 9 16) (secondsToDiffTime 0)) _ <- access p master "test" $ upsertToken myToken t <- access p master "test" $ findToken "Zaddy" let t1 = (cast' . Doc) =<< t case t1 of Nothing -> True `shouldBe` False Just t2 -> t_address t2 `shouldBe` "Zaddy" 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) xit "owners are marked as paid" $ \p -> do 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 ]) 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" =: ("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" 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 "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e" "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 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 -> IO Request testDelete endpoint par = do let user = "user" let pwd = "superSecret" let testRequest = setRequestPort 3000 $ setRequestBasicAuth user pwd $ setRequestMethod "DELETE" $ setRequestPath (B.append endpoint par) defaultRequest return testRequest 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 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 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 startAPI :: Config -> IO () startAPI config = do putStrLn "Starting test server ..." pipe <- connect $ host "127.0.0.1" c <- access pipe master "zgo" (auth "zgo" "zcashrules") let appRoutes = routes pipe config _ <- forkIO (scotty 3000 appRoutes) let myUser = User (Just (read "6272a90f2b05a74cf1000001" :: ObjectId)) "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e" "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd" 1613487 "1234567" False _ <- access pipe master "test" (insert_ "users" [ "address" =: uaddress myUser , "_id" =: u_id myUser , "session" =: usession myUser , "blocktime" =: ublocktime myUser , "pin" =: upin myUser , "validated" =: uvalidated myUser ]) 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" False False False (UTCTime (fromGregorian 2022 4 16) (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) _ <- access pipe master "test" (Database.MongoDB.delete (select [] "orders")) myTs <- liftIO getCurrentTime let myOrder = ZGoOrder (Just (read "627ab3ea2b05a76be3000000")) "Zaddy" "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd" myTs False "usd" 102.0 0 0 [] False "" "" let ordTest = val myOrder case ordTest of Doc oT -> access pipe master "test" (insert_ "orders" oT) 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) 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 ZGoOrder i a s ts c cur p t tZ l pd eI <$> 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 XeroToken i a t e r aD <$> arbitrary