Test.hs

{-# LANGUAGE ScopedTypeVariables #-}

module Network.Nakadi.Connection.Test where

import           ClassyPrelude
import           Network.HTTP.Client      (HttpException (..),
                                           HttpExceptionContent (..),
                                           Request (..), parseRequest,
                                           responseTimeoutMicro)
import           Network.HTTP.Types
import           Network.Nakadi
import qualified Network.Wai              as Wai
import           Network.Wai.Handler.Warp
import           System.IO.Unsafe
import           Test.Tasty
import           Test.Tasty.HUnit
import           UnliftIO.Concurrent

testConnection :: TestTree
testConnection = testGroup "Connection"
  [ testCase "SimpleRetry" testSimpleRetry
  , testCase "ResponseTimeout Success" testResponseTimeoutSuccess
  , testCase "ResponseTimeout Fail" testResponseTimeoutFail
  ]

{-# NOINLINE requestCounter #-}
requestCounter :: TVar Int
requestCounter = unsafePerformIO $ newTVarIO 0

testServerRetryPort :: Port
testServerRetryPort = 5001

testServerResponseTimeoutPort :: Port
testServerResponseTimeoutPort = 5002

{-# NOINLINE testServerRequest #-}
testServerRequest :: Request
testServerRequest = unsafePerformIO $ parseRequest "http://localhost"

testServerRetryApp ::
  Int
  -> Wai.Request
  -> (Wai.Response -> IO Wai.ResponseReceived)
  -> IO Wai.ResponseReceived
testServerRetryApp noOfFailures req respond =
  case Wai.rawPathInfo req of
    "/event-types" -> do
      reqIdx <- atomically $ do
        modifyTVar requestCounter (+ 1)
        readTVar requestCounter
      let response = if reqIdx <= noOfFailures
                     then Wai.responseLBS status503 [] ""
                     else Wai.responseLBS status200 [] "[]"
      respond response
    _ ->
      respond $ Wai.responseLBS status404 [] ""

testServerResponseTimeoutApp ::
  Wai.Request
  -> (Wai.Response -> IO Wai.ResponseReceived)
  -> IO Wai.ResponseReceived
testServerResponseTimeoutApp req respond =
  case Wai.rawPathInfo req of
    "/event-types" -> do
      threadDelay (4 * 10^6) -- Wait for 4s
      respond $ Wai.responseLBS status200 [] "[]"
    _ ->
      respond $ Wai.responseLBS status404 [] ""

testSimpleRetry :: Assertion
testSimpleRetry = do
  let conf = newConfigIO testServerRequest { port = testServerRetryPort } :: ConfigIO
  withAsync (run testServerRetryPort (testServerRetryApp 1)) $ \_serverHandle -> do
    events <- runNakadiT conf eventTypesList
    [] @=? events

testResponseTimeoutSuccess :: Assertion
testResponseTimeoutSuccess = do
  let rspTimeout = responseTimeoutMicro (5 * 10^6) -- Accept delay of 5s
      request = testServerRequest { port = testServerResponseTimeoutPort
                                  , responseTimeout = rspTimeout }
      conf    = newConfigIO request :: ConfigIO
  withAsync (run testServerResponseTimeoutPort testServerResponseTimeoutApp) $ \_serverHandle -> do
    events <- runNakadiT conf eventTypesList
    [] @=? events

testResponseTimeoutFail :: Assertion
testResponseTimeoutFail = do
  res <- try $ do
    let rspTimeout = responseTimeoutMicro (3 * 10^6) -- Accept delay of 3s
        request = testServerRequest { port = testServerResponseTimeoutPort
                                    , responseTimeout = rspTimeout }
        conf    = newConfigIO request :: ConfigIO
    withAsync (run testServerResponseTimeoutPort testServerResponseTimeoutApp) $ \_serverHandle ->
      runNakadiT conf eventTypesList
  case res of
    Left (HttpExceptionRequest _request ResponseTimeout) -> return ()
    _ -> assertFailure "Expected HttpExceptionRequest with content ResponseTimeout"