{-# LANGUAGE OverloadedStrings #-}

module AWS.Credentials (Credentials, accessKey, secretKey, newCredentials, lookupCredentials) where

import Data.Aeson (FromJSON (..), Value (..), (.:))
import qualified Data.Text as T
import System.Environment (lookupEnv)

{- | AWS Security credentials comprising of an access key ID and a secret key.
 Temporary security tokens are not supported
-}
data Credentials = MkCredentials
    { Credentials -> Text
accessKey :: !T.Text
    , Credentials -> Text
secretKey :: !T.Text
    }

newCredentials ::
    -- | Access Key
    T.Text ->
    -- | Secret Key
    T.Text ->
    Credentials
newCredentials :: Text -> Text -> Credentials
newCredentials = Text -> Text -> Credentials
MkCredentials

{- | Use the provided environment variables to create
 `Credentials`
-}
lookupCredentials ::
    -- | Access Key environment variable
    String ->
    -- | Secret Key environment variable
    String ->
    IO (Maybe Credentials)
lookupCredentials :: String -> String -> IO (Maybe Credentials)
lookupCredentials String
akVar String
skVar = do
    Maybe Text
ak <- (String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (Maybe String -> Maybe Text)
-> IO (Maybe String) -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
lookupEnv String
akVar
    Maybe Text
sk <- (String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (Maybe String -> Maybe Text)
-> IO (Maybe String) -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
lookupEnv String
skVar
    Maybe Credentials -> IO (Maybe Credentials)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Credentials -> IO (Maybe Credentials))
-> Maybe Credentials -> IO (Maybe Credentials)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Credentials
MkCredentials (Text -> Text -> Credentials)
-> Maybe Text -> Maybe (Text -> Credentials)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
ak Maybe (Text -> Credentials) -> Maybe Text -> Maybe Credentials
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text
sk

instance FromJSON Credentials where
    parseJSON :: Value -> Parser Credentials
parseJSON (Object Object
o) =
        Text -> Text -> Credentials
MkCredentials
            (Text -> Text -> Credentials)
-> Parser Text -> Parser (Text -> Credentials)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"access-key"
            Parser (Text -> Credentials) -> Parser Text -> Parser Credentials
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"secret-key"
    parseJSON Value
_ = String -> Parser Credentials
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not a Credentials"