Test.hs

module Network.Nakadi.Config.Test where

import           ClassyPrelude
import           Control.Lens         ((<&>))
import           Control.Retry
import qualified Data.ByteString.Lazy as LB
import           Network.HTTP.Client
import           Network.Nakadi
import           System.IO.Unsafe
import           Test.Tasty
import           Test.Tasty.HUnit

testConfig :: TestTree
testConfig = testGroup "Config"
  [ testCase "Use Custom HttpBackend" testCustomHttpBackend ]

{-# NOINLINE requestsExecuted #-}
requestsExecuted :: TVar [Request]
requestsExecuted = unsafePerformIO . newTVarIO $ []

dummyHttpLbs :: Request -> IO (Response LB.ByteString)
dummyHttpLbs req = do
  atomically $ modifyTVar requestsExecuted (req :)
  throwIO (HttpExceptionRequest req ResponseTimeout)

dummyResponseOpen :: Request -> Manager -> IO (Response (IO ByteString))
dummyResponseOpen req _manager = do
  atomically $ modifyTVar requestsExecuted (req :)
  throwIO (HttpExceptionRequest req ResponseTimeout)

dummyResponseClose :: Response BodyReader -> IO ()
dummyResponseClose _response = return ()

dummyHttpBackend :: HttpBackend
dummyHttpBackend = HttpBackend dummyHttpLbs dummyResponseOpen dummyResponseClose

testCustomHttpBackend :: Assertion
testCustomHttpBackend = do
  let trivialRetryPolicy = limitRetries 0
  conf <- newConfig Nothing defaultRequest
          <&> setHttpBackend dummyHttpBackend
          <&> setRetryPolicy trivialRetryPolicy
  res0 <- try $ registryPartitionStrategies conf -- This should use httpLbs
  case res0 of
    Left (HttpExceptionRequest _ ResponseTimeout) -> return ()
    _ -> assertFailure "Expected ResponseTimeout exception from dummy HttpBackend"
  requests <- atomically . readTVar $ requestsExecuted
  1 @=? length requests