{-# LANGUAGE Strict #-}

-- |
-- Module      : Amazonka.Auth.Background
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>
-- Stability   : provisional
-- Portability : non-portable (GHC extensions)
--
-- Helpers for authentication schemes which refresh themselves in the
-- background.
module Amazonka.Auth.Background where

import Amazonka.Auth.Exception
import Amazonka.Data
import Amazonka.Prelude
import Amazonka.Types
import Control.Concurrent (ThreadId)
import qualified Control.Concurrent as Concurrent
import qualified Control.Exception as Exception
import Data.IORef (IORef)
import qualified Data.IORef as IORef
import qualified Data.Time as Time
import System.Mem.Weak (Weak)
import qualified System.Mem.Weak as Weak

-- | Implements the background fetching behavior used by (among others)
-- 'fromProfileName' and 'fromContainer'. Given an 'IO' action that produces an
-- 'AuthEnv', this spawns a thread that mutates the 'IORef' returned in the
-- resulting 'Auth' to keep the temporary credentials up to date.
fetchAuthInBackground :: IO AuthEnv -> IO Auth
fetchAuthInBackground :: IO AuthEnv -> IO Auth
fetchAuthInBackground IO AuthEnv
menv =
  IO AuthEnv
menv forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \AuthEnv
env -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
    case AuthEnv -> Maybe ISO8601
expiration AuthEnv
env of
      Maybe ISO8601
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (AuthEnv -> Auth
Auth AuthEnv
env)
      Just ISO8601
x -> do
        IORef AuthEnv
r <- forall a. a -> IO (IORef a)
IORef.newIORef AuthEnv
env
        ThreadId
p <- IO ThreadId
Concurrent.myThreadId
        ThreadId
s <- IO AuthEnv -> IORef AuthEnv -> ThreadId -> ISO8601 -> IO ThreadId
timer IO AuthEnv
menv IORef AuthEnv
r ThreadId
p ISO8601
x

        forall (f :: * -> *) a. Applicative f => a -> f a
pure (ThreadId -> IORef AuthEnv -> Auth
Ref ThreadId
s IORef AuthEnv
r)
  where
    timer :: IO AuthEnv -> IORef AuthEnv -> ThreadId -> ISO8601 -> IO ThreadId
    timer :: IO AuthEnv -> IORef AuthEnv -> ThreadId -> ISO8601 -> IO ThreadId
timer IO AuthEnv
ma IORef AuthEnv
r ThreadId
p ISO8601
x =
      IO () -> IO ThreadId
Concurrent.forkIO forall a b. (a -> b) -> a -> b
$ do
        ThreadId
s <- IO ThreadId
Concurrent.myThreadId
        Weak (IORef AuthEnv)
w <- forall a. IORef a -> IO () -> IO (Weak (IORef a))
IORef.mkWeakIORef IORef AuthEnv
r (ThreadId -> IO ()
Concurrent.killThread ThreadId
s)

        IO AuthEnv -> Weak (IORef AuthEnv) -> ThreadId -> ISO8601 -> IO ()
loop IO AuthEnv
ma Weak (IORef AuthEnv)
w ThreadId
p ISO8601
x

    loop :: IO AuthEnv -> Weak (IORef AuthEnv) -> ThreadId -> ISO8601 -> IO ()
    loop :: IO AuthEnv -> Weak (IORef AuthEnv) -> ThreadId -> ISO8601 -> IO ()
loop IO AuthEnv
ma Weak (IORef AuthEnv)
w ThreadId
p ISO8601
x = do
      Int
untilExpiry <- forall {a} {a :: Format}. Integral a => Time a -> UTCTime -> a
diff ISO8601
x forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
Time.getCurrentTime
      -- Refresh the token within 5 minutes of expiry, or half its lifetime if
      -- sooner than that. This is to account for execution time of the refresh action.
      let fiveMinutes :: Int
fiveMinutes = Int
5 forall a. Num a => a -> a -> a
* Int
60 forall a. Num a => a -> a -> a
* Int
1000000
      Int -> IO ()
Concurrent.threadDelay forall a b. (a -> b) -> a -> b
$
        if Int
untilExpiry forall a. Ord a => a -> a -> Bool
> Int
fiveMinutes
          then Int
untilExpiry forall a. Num a => a -> a -> a
- Int
fiveMinutes
          else Int
untilExpiry forall a. Integral a => a -> a -> a
`div` Int
2

      Either HttpException AuthEnv
env <- forall e a. Exception e => IO a -> IO (Either e a)
Exception.try IO AuthEnv
ma
      case Either HttpException AuthEnv
env of
        Left HttpException
e -> forall e. Exception e => ThreadId -> e -> IO ()
Exception.throwTo ThreadId
p (HttpException -> AuthError
RetrievalError HttpException
e)
        Right AuthEnv
a -> do
          Maybe (IORef AuthEnv)
mr <- forall v. Weak v -> IO (Maybe v)
Weak.deRefWeak Weak (IORef AuthEnv)
w
          case Maybe (IORef AuthEnv)
mr of
            Maybe (IORef AuthEnv)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            Just IORef AuthEnv
r -> do
              forall a. IORef a -> a -> IO ()
IORef.atomicWriteIORef IORef AuthEnv
r AuthEnv
a
              forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (IO AuthEnv -> Weak (IORef AuthEnv) -> ThreadId -> ISO8601 -> IO ()
loop IO AuthEnv
ma Weak (IORef AuthEnv)
w ThreadId
p) (AuthEnv -> Maybe ISO8601
expiration AuthEnv
a)

    diff :: Time a -> UTCTime -> a
diff (Time UTCTime
x) UTCTime
y = a -> a
picoToMicro forall a b. (a -> b) -> a -> b
$ if a
n forall a. Ord a => a -> a -> Bool
> a
0 then a
n else a
1
      where
        n :: a
n = forall a b. (RealFrac a, Integral b) => a -> b
truncate (UTCTime -> UTCTime -> NominalDiffTime
Time.diffUTCTime UTCTime
x UTCTime
y) forall a. Num a => a -> a -> a
- a
60
        picoToMicro :: a -> a
picoToMicro = (forall a. Num a => a -> a -> a
* a
1000000)