306 lines
12 KiB
Haskell
306 lines
12 KiB
Haskell
{-# 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.Maybe
|
|
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 "returns a user for a session" $ do
|
|
req <-
|
|
testGet
|
|
"/api/user"
|
|
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdca")]
|
|
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-99d63b8dcdca")
|
|
, ("pin", Just "5989845")
|
|
]
|
|
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
|
|
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)
|
|
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")
|
|
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" $ deleteUser (u_id z)
|
|
q <-
|
|
access p master "test" $
|
|
findOne
|
|
(select ["_id" =: (read (u_id z) :: ObjectId)] "users")
|
|
isNothing q `shouldBe` True
|
|
|
|
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
|
|
|
|
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 4000 $
|
|
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 4000 $
|
|
setRequestBasicAuth user pwd $
|
|
setRequestMethod "DELETE" $
|
|
setRequestPath (B.append endpoint par) 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!"
|