{-# LANGUAGE OverloadedStrings #-} module Spec where 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.Char (isAscii) import Data.Either import Data.SecureMem import qualified Data.Text as T import Database.MongoDB import Network.HTTP.Simple import Network.HTTP.Types.Status import System.IO.Unsafe import Test.Hspec import Test.Hspec.Expectations.Json import Test.Hspec.QuickCheck import Test.QuickCheck import Test.QuickCheck.Gen import ZGoBackend passkey :: SecureMem passkey = secureMemFromByteString "superSecret" nodeAddress :: T.Text nodeAddress = "zs1xnpqd2tae9d95f8fhe4l0q7j44a5vf993m0pcnnvr56uqr4lgqlamesk5v4c5rhtvywc6lvlduy" dbUser :: T.Text dbUser = "zgo" dbPassword :: T.Text dbPassword = "zcashrules" main :: IO () main = 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) (filter isAscii x) == filter isAscii x describe "zToZGoTx" $ do it "converts zcash 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 "" "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e" "5d3d4494-51c0-432d-8495-050419957aea" 20 18732456 0.5 "someId" "ZGO::5d3d4494-51c0-432d-8495-050419957aea\nReply-To:\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e" describe "PIN generator" $ do it "should give a 7 digit" $ do length (T.unpack (unsafePerformIO generatePin)) `shouldBe` 7 describe "API endpoints" $ do beforeAll_ startAPI $ 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 it "returns a block number" $ do req <- testGet "/api/blockheight" [] res <- httpJSON req height (getResponseBody (res :: Response Block)) `shouldSatisfy` \x -> x > 1600000 describe "unconfirmed Zcash txs" $ do it "returns txs with less than 2 confirmations" $ do pending describe "User endpoint" $ do it "adds a user" $ do pending it "returns a user for a session" $ do pending it "returns 204 when no user" $ do pending it "marks user as validated" $ do pending it "deletes user by id" $ do pending describe "Owner endpoint" $ do it "add owner" $ do pending it "return owner" $ do pending describe "Order endpoint" $ do it "upsert order" $ do pending it "get order by session" $ do pending it "get order by id" $ do pending it "get all orders for owner" $ do pending 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 "Zcash transactions" $ do it "logins are added to db" $ \p -> do _ <- access p master "test" (delete (select [] "txs")) _ <- scanZcash nodeAddress p "test" threadDelay 1000000 t <- access p master "test" $ findOne (select [] "txs") case t of Nothing -> True `shouldBe` False Just r -> do let s = parseZGoTxBson r case s of Nothing -> True `shouldBe` False Just z -> confirmations z `shouldSatisfy` (> 0) it "payments are added to db" $ \p -> do _ <- access p master "test" (delete (select [] "payments")) _ <- scanZcash nodeAddress p "test" threadDelay 1000000 t <- access p master "test" $ findOne (select [] "payments") case t of Nothing -> True `shouldBe` False Just r -> do let s = parseZGoTxBson r case s of Nothing -> True `shouldBe` False Just z -> confirmations z `shouldSatisfy` (> 0) it "login txs are converted to users" $ \p -> do let myTx = ZGoTx "" "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e" "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdca" 3 1613487 0.00000001 "abcdef" "Super Memo" _ <- access p master "test" (delete (select [] "users")) _ <- access p master "test" (insert_ "txs" (encodeZGoTxBson myTx)) _ <- updateLogins nodeAddress p "test" 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 4000 $ setRequestBasicAuth user pwd $ setRequestMethod "GET" $ setRequestPath endpoint defaultRequest return testRequest -- | 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 :: IO () startAPI = do putStrLn "Starting test server ..." pipe <- connect $ host "127.0.0.1" c <- access pipe master "zgo" (auth "zgo" "zcashrules") _ <- forkIO (app pipe "test" passkey nodeAddress) threadDelay 1000000 putStrLn "Test server is up!"