content: {- SPDX-FileCopyrightText: 2021 Serokell <https://serokell.io>
   -
   - SPDX-License-Identifier: MPL-2.0
   -}
  
  module Test.Xrefcheck.TimeoutSpec where
  
  import Universum hiding ((.~))
  
  import Control.Lens ((.~))
  import Data.CaseInsensitive qualified as CI
  import Data.Set qualified as S
  import Network.HTTP.Types (ok200, tooManyRequests429)
  import Network.HTTP.Types.Header (HeaderName, hRetryAfter)
  import Network.Wai qualified as Web
  import Test.Tasty (TestTree, testGroup)
  import Test.Tasty.HUnit (testCase)
  import Time (Second, Time, sec, threadDelay)
  import Web.Scotty qualified as Web
  
  import Test.Xrefcheck.UtilRequests
  import Xrefcheck.Config
  import Xrefcheck.Progress
  import Xrefcheck.Verify
  
  -- Here all the delays are doubled because we call sites
  -- with HEAD first and then GET methods.
  test_timeout :: TestTree
  test_timeout = testGroup "Timeout tests"
    [ testCase "Succeeds on one timeout if there were no 429 responses and no retries allowed" $
        timeoutTestCase [Delay] True
          (cNetworkingL . ncMaxTimeoutRetriesL .~ 0)
    , testCase "Returns an error on two timeouts if there were no 429 responses" $
        timeoutTestCase [Delay, Delay] False
          (cNetworkingL . ncMaxTimeoutRetriesL .~ 2)
    , testCase "Returns an error if there were 429 but no timeouts allowed" $
        timeoutTestCase [Respond429, Delay, Delay] False
          (cNetworkingL . ncMaxTimeoutRetriesL .~ 0)
    , testCase "Succeeds if there were 429 and one timeout allowed" $
        timeoutTestCase [Respond429, Delay, Delay] True
          (cNetworkingL . ncMaxTimeoutRetriesL .~ 1)
    , testCase "Fails on second timeout if there were 429 and one timeout allowed" $
        timeoutTestCase [Respond429, Delay, Delay, Delay, Delay] False
          (cNetworkingL . ncMaxTimeoutRetriesL .~ 1)
    , testCase "Fails on maximum allowed errors achieved (mixed errors)" $
        timeoutTestCase [Respond429, Delay, Delay, Respond429, Delay, Delay] False $ \c -> c
          & cNetworkingL . ncMaxTimeoutRetriesL .~ 3
          & cNetworkingL . ncMaxRetriesL .~ 3
    , testCase "Fails on timeout if another domain returned 429" $ do
        setRef <- newIORef S.empty
        checkMultipleLinksWithServer
          (5000, mockTimeout (sec 0.4) [Respond429, Ok, Delay, Delay])
          setRef
          [ VerifyLinkTestEntry
              { vlteConfigModifier = \c -> c
                  & cNetworkingL . ncMaxRetriesL .~ 1
                  & setAllowedTimeout
              , vlteLink = "http://127.0.0.1:5000/timeout"
              , vlteExpectedProgress = mkProgressWithOneTask True
              , vlteExpectationErrors = VerifyResult []
              }
          , VerifyLinkTestEntry
              { vlteConfigModifier = \c -> c
                  & cNetworkingL . ncMaxTimeoutRetriesL .~ 0
                  & setAllowedTimeout
              , vlteLink = "http://localhost:5000/timeout"
              , vlteExpectedProgress = mkProgressWithOneTask False
              , vlteExpectationErrors = VerifyResult
                [ ExternalHttpTimeout (Just $ DomainName "localhost")
                ]
              }
          ]
    , testCase "Succeeds on timeout if another path of this domain returned 429" $ do
        setRef <- newIORef S.empty
        checkMultipleLinksWithServer
          (5000, mockTimeout (sec 0.4) [Respond429, Ok, Delay, Delay])
          setRef
          [ VerifyLinkTestEntry
              { vlteConfigModifier = \c -> c
                  & cNetworkingL . ncMaxRetriesL .~ 1
                  & setAllowedTimeout
              , vlteLink = "http://127.0.0.1:5000/timeout"
              , vlteExpectedProgress = mkProgressWithOneTask True
              , vlteExpectationErrors = VerifyResult []
              }
          , VerifyLinkTestEntry
              { vlteConfigModifier = \c -> c
                  & cNetworkingL . ncMaxTimeoutRetriesL .~ 1
                  & setAllowedTimeout
              , vlteLink = "http://127.0.0.1:5000/timeoutother"
              , vlteExpectedProgress = mkProgressWithOneTask True
              , vlteExpectationErrors = VerifyResult []
              }
          ]
    ]
    where
      setAllowedTimeout = cNetworkingL . ncExternalRefCheckTimeoutL .~ (sec 0.25)
  
      mkProgressWithOneTask shouldSucceed = report "" $ initProgress 1
        where
          report =
            if shouldSucceed
            then reportSuccess
            else reportError
  
      timeoutTestCase mockResponses shouldSucceed configModifier = do
        let prog = mkProgressWithOneTask shouldSucceed
        setRef <- newIORef S.empty
        checkLinkAndProgressWithServer
          (\c -> c
            & setAllowedTimeout
            & configModifier)
          setRef
          (5000, mockTimeout (sec 0.4) mockResponses)
          "http://127.0.0.1:5000/timeout" prog $
            VerifyResult $
              [ExternalHttpTimeout $ Just (DomainName "127.0.0.1") | not shouldSucceed]
  
      -- When called for the first (N-1) times, waits for specified
      -- amount of seconds and returns an arbitrary result.
      -- When called N time returns the result immediately.
      mockTimeout :: Time Second -> [MockTimeoutBehaviour] -> IO Web.Application
      mockTimeout timeout behList = do
        ref <- newIORef @_ behList
        Web.scottyApp $ do
          Web.matchAny "/timeout" $ handler ref
          Web.matchAny "/timeoutother" $ handler ref
        where
          handler ref = do
            mbCurrentAction <- atomicModifyIORef' ref $ \case
              b : bs -> (bs, Just b)
              [] -> ([], Nothing)
            case mbCurrentAction of
              Nothing -> Web.status ok200
              Just Ok -> Web.status ok200
              Just Delay -> do
                threadDelay timeout
                Web.status ok200
              Just Respond429 -> do
                setHeader hRetryAfter "1"
                Web.status tooManyRequests429
  
      setHeader :: HeaderName -> Text -> Web.ActionM ()
      setHeader hdr value = Web.setHeader (decodeUtf8 (CI.original hdr)) (fromStrict value)
  
  data MockTimeoutBehaviour = Respond429 | Delay | Ok
  