performJob ::
     BackoffPolicy
  -> TVar [Int]
  -> Int
  -> (b -> (Maybe Int, IO (Result a b)))
  -> Maybe Int
  -> IO (Result a b)
  -> IO a
performJob policy@BackoffPolicy{initialDelayMilliseconds, maxExponent}
  throttledT jobId mkNextJob timeout job =
    join . atomically $ do
      throttled <- readTVar throttledT
      case throttled of
        [] -> return tryJob -- full speed ahead.
        first:_ | first == jobId ->
          -- we are first in line
          return (untilSuccess 0 timeout job `finally` pop)
        _ ->
          -- we must wait
          retry
  where
    tryJob = do
      result <- job
      case result of
        Ok val -> return val
        HitLimit limitResponse -> do
          atomically $ modifyTVar throttledT (++ [jobId])
          uncurry (performJob policy throttledT jobId mkNextJob) $
            mkNextJob limitResponse

    untilSuccess collisions timeout' job' = do
      case timeout' of
        Nothing -> threadDelay (time initialDelayMilliseconds collisions)
        Just milliseconds -> threadDelay (1000 * milliseconds)
      result <- job'
      case result of
        Ok val -> return val
        HitLimit limitResponse ->
          uncurry (untilSuccess $ newExponent collisions)
            (mkNextJob limitResponse)

    newExponent collisions
      | collisions >= maxExponent = collisions
        -- don't go crazy with the backoff exponent.
      | otherwise = collisions + 1

    pop = atomically $ modifyTVar throttledT (delete jobId)
performJob ::
     BackoffPolicy
  -> TVar [Int]
  -> Int
  -> (b -> (Maybe Int, IO (Result a b)))
  -> Maybe Int
  -> IO (Result a b)
  -> IO a
performJob policy@BackoffPolicy{initialDelayMilliseconds, maxExponent}
  throttledT jobId mkNextJob timeout job =
    join . atomically $ do
      throttled <- readTVar throttledT
      case throttled of
        [] -> return tryJob -- full speed ahead.
        first:_ | first == jobId ->
          -- we are first in line
          return (untilSuccess 0 timeout job `finally` pop)
        _ ->
          -- we must wait
          retry
  where
    tryJob = do
      result <- job
      case result of
        Ok val -> return val
        HitLimit limitResponse -> do
          atomically $ modifyTVar throttledT (++ [jobId])
          uncurry (performJob policy throttledT jobId mkNextJob) $
            mkNextJob limitResponse

    untilSuccess collisions timeout' job' = do
      case timeout' of
        Nothing -> threadDelay (time initialDelayMilliseconds collisions)
        Just milliseconds -> threadDelay (1000 * milliseconds)
      result <- job'
      case result of
        Ok val -> return val
        HitLimit limitResponse ->
          uncurry (untilSuccess $ newExponent collisions)
            (mkNextJob limitResponse)

    newExponent collisions
      | collisions >= maxExponent = collisions
        -- don't go crazy with the backoff exponent.
      | otherwise = collisions + 1

    pop = atomically $ modifyTVar throttledT (delete jobId)
performJob policy@BackoffPolicy{initialDelayMilliseconds, maxExponent}
  throttledT jobId mkNextJob timeout job =
    join . atomically $ do
      throttled <- readTVar throttledT
      case throttled of
        [] -> return tryJob -- full speed ahead.
        first:_ | first == jobId ->
          -- we are first in line
          return (untilSuccess 0 timeout job `finally` pop)
        _ ->
          -- we must wait
          retry
  where
    tryJob = do
      result <- job
      case result of
        Ok val -> return val
        HitLimit limitResponse -> do
          atomically $ modifyTVar throttledT (++ [jobId])
          uncurry (performJob policy throttledT jobId mkNextJob) $
            mkNextJob limitResponse

    untilSuccess collisions timeout' job' = do
      case timeout' of
        Nothing -> threadDelay (time initialDelayMilliseconds collisions)
        Just milliseconds -> threadDelay (1000 * milliseconds)
      result <- job'
      case result of
        Ok val -> return val
        HitLimit limitResponse ->
          uncurry (untilSuccess $ newExponent collisions)
            (mkNextJob limitResponse)

    newExponent collisions
      | collisions >= maxExponent = collisions
        -- don't go crazy with the backoff exponent.
      | otherwise = collisions + 1

    pop = atomically $ modifyTVar throttledT (delete jobId)