{-# 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 IO AuthEnv -> (AuthEnv -> IO Auth) -> IO Auth
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \AuthEnv
env -> IO Auth -> IO Auth
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Auth -> IO Auth) -> IO Auth -> IO Auth
forall a b. (a -> b) -> a -> b
$
    case AuthEnv -> Maybe ISO8601
expiration AuthEnv
env of
      Maybe ISO8601
Nothing -> Auth -> IO Auth
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AuthEnv -> Auth
Auth AuthEnv
env)
      Just ISO8601
x -> do
        IORef AuthEnv
r <- AuthEnv -> IO (IORef AuthEnv)
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

        Auth -> IO Auth
forall a. a -> IO a
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 (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
        ThreadId
s <- IO ThreadId
Concurrent.myThreadId
        Weak (IORef AuthEnv)
w <- IORef AuthEnv -> IO () -> IO (Weak (IORef AuthEnv))
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 <- ISO8601 -> UTCTime -> Int
forall {a} {a :: Format}. Integral a => Time a -> UTCTime -> a
diff ISO8601
x (UTCTime -> Int) -> IO UTCTime -> IO Int
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000000
      Int -> IO ()
Concurrent.threadDelay (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$
        if Int
untilExpiry Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
fiveMinutes
          then Int
untilExpiry Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
fiveMinutes
          else Int
untilExpiry Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2

      Either HttpException AuthEnv
env <- IO AuthEnv -> IO (Either HttpException AuthEnv)
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 -> ThreadId -> AuthError -> IO ()
forall e. Exception e => ThreadId -> e -> IO ()
Exception.throwTo ThreadId
p (HttpException -> AuthError
RetrievalError HttpException
e)
        Right AuthEnv
a -> do
          Maybe (IORef AuthEnv)
mr <- Weak (IORef AuthEnv) -> IO (Maybe (IORef AuthEnv))
forall v. Weak v -> IO (Maybe v)
Weak.deRefWeak Weak (IORef AuthEnv)
w
          case Maybe (IORef AuthEnv)
mr of
            Maybe (IORef AuthEnv)
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            Just IORef AuthEnv
r -> do
              IORef AuthEnv -> AuthEnv -> IO ()
forall a. IORef a -> a -> IO ()
IORef.atomicWriteIORef IORef AuthEnv
r AuthEnv
a
              IO () -> (ISO8601 -> IO ()) -> Maybe ISO8601 -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall a. a -> IO a
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 (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ if a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0 then a
n else a
1
      where
        n :: a
n = NominalDiffTime -> a
forall b. Integral b => NominalDiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (UTCTime -> UTCTime -> NominalDiffTime
Time.diffUTCTime UTCTime
x UTCTime
y) a -> a -> a
forall a. Num a => a -> a -> a
- a
60
        picoToMicro :: a -> a
picoToMicro = (a -> a -> a
forall a. Num a => a -> a -> a
* a
1000000)