--
-- MinIO Haskell SDK, (C) 2017-2023 MinIO, Inc.
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
--     http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.
--

module Network.Minio.Credentials
  ( CredentialValue (..),
    credentialValueText,
    STSCredentialProvider (..),
    AccessKey (..),
    SecretKey (..),
    SessionToken (..),
    ExpiryTime (..),
    STSCredentialStore,
    initSTSCredential,
    getSTSCredential,
    Creds (..),
    getCredential,
    Endpoint,

    -- * STS Assume Role
    defaultSTSAssumeRoleOptions,
    STSAssumeRole (..),
    STSAssumeRoleOptions (..),
  )
where

import Data.Time (diffUTCTime, getCurrentTime)
import qualified Network.HTTP.Client as NC
import Network.Minio.Credentials.AssumeRole
import Network.Minio.Credentials.Types
import qualified UnliftIO.MVar as M

data STSCredentialStore = STSCredentialStore
  { STSCredentialStore -> MVar (CredentialValue, ExpiryTime)
cachedCredentials :: M.MVar (CredentialValue, ExpiryTime),
    STSCredentialStore
-> Endpoint -> Manager -> IO (CredentialValue, ExpiryTime)
refreshAction :: Endpoint -> NC.Manager -> IO (CredentialValue, ExpiryTime)
  }

initSTSCredential :: (STSCredentialProvider p) => p -> IO STSCredentialStore
initSTSCredential :: forall p. STSCredentialProvider p => p -> IO STSCredentialStore
initSTSCredential p
p = do
  let action :: Endpoint -> Manager -> IO (CredentialValue, ExpiryTime)
action = forall p.
STSCredentialProvider p =>
p -> Endpoint -> Manager -> IO (CredentialValue, ExpiryTime)
retrieveSTSCredentials p
p
  -- start with dummy credential, so that refresh happens for first request.
  UTCTime
now <- IO UTCTime
getCurrentTime
  MVar (CredentialValue, ExpiryTime)
mvar <- forall (m :: * -> *) a. MonadIO m => a -> m (MVar a)
M.newMVar (AccessKey -> SecretKey -> Maybe SessionToken -> CredentialValue
CredentialValue forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty, coerce :: forall a b. Coercible a b => a -> b
coerce UTCTime
now)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    STSCredentialStore
      { cachedCredentials :: MVar (CredentialValue, ExpiryTime)
cachedCredentials = MVar (CredentialValue, ExpiryTime)
mvar,
        refreshAction :: Endpoint -> Manager -> IO (CredentialValue, ExpiryTime)
refreshAction = Endpoint -> Manager -> IO (CredentialValue, ExpiryTime)
action
      }

getSTSCredential :: STSCredentialStore -> Endpoint -> NC.Manager -> IO (CredentialValue, Bool)
getSTSCredential :: STSCredentialStore
-> Endpoint -> Manager -> IO (CredentialValue, Bool)
getSTSCredential STSCredentialStore
store Endpoint
ep Manager
mgr = forall (m :: * -> *) a b.
MonadUnliftIO m =>
MVar a -> (a -> m (a, b)) -> m b
M.modifyMVar (STSCredentialStore -> MVar (CredentialValue, ExpiryTime)
cachedCredentials STSCredentialStore
store) forall a b. (a -> b) -> a -> b
$ \cc :: (CredentialValue, ExpiryTime)
cc@(CredentialValue
v, ExpiryTime
expiry) -> do
  UTCTime
now <- IO UTCTime
getCurrentTime
  if UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
now (coerce :: forall a b. Coercible a b => a -> b
coerce ExpiryTime
expiry) forall a. Ord a => a -> a -> Bool
> NominalDiffTime
0
    then do
      (CredentialValue, ExpiryTime)
res <- STSCredentialStore
-> Endpoint -> Manager -> IO (CredentialValue, ExpiryTime)
refreshAction STSCredentialStore
store Endpoint
ep Manager
mgr
      forall (m :: * -> *) a. Monad m => a -> m a
return ((CredentialValue, ExpiryTime)
res, (forall a b. (a, b) -> a
fst (CredentialValue, ExpiryTime)
res, Bool
True))
    else forall (m :: * -> *) a. Monad m => a -> m a
return ((CredentialValue, ExpiryTime)
cc, (CredentialValue
v, Bool
False))

data Creds
  = CredsStatic CredentialValue
  | CredsSTS STSCredentialStore

getCredential :: Creds -> Endpoint -> NC.Manager -> IO CredentialValue
getCredential :: Creds -> Endpoint -> Manager -> IO CredentialValue
getCredential (CredsStatic CredentialValue
v) Endpoint
_ Manager
_ = forall (m :: * -> *) a. Monad m => a -> m a
return CredentialValue
v
getCredential (CredsSTS STSCredentialStore
s) Endpoint
ep Manager
mgr = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STSCredentialStore
-> Endpoint -> Manager -> IO (CredentialValue, Bool)
getSTSCredential STSCredentialStore
s Endpoint
ep Manager
mgr