zgo-backend/test/Spec.hs

{-# 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!"