module Stackctl.AWS.Core
  ( AwsEnv
  , HasAwsEnv (..)
  , awsEnvDiscover
  , awsWithAuth
  , awsSimple
  , awsSend
  , awsPaginate
  , awsAwait
  , awsAssumeRole

    -- * Modifiers on 'AwsEnv'
  , awsWithin
  , awsTimeout
  , awsSilently

    -- * 'Amazonka' extensions
  , AccountId (..)

    -- * Error-handling
  , handlingServiceError
  , formatServiceError

    -- * 'Amazonka'/'ResourceT' re-exports
  , Region (..)
  , FromText (..)
  , ToText (..)
  , MonadResource
  ) where

import Stackctl.Prelude hiding (timeout)

import Amazonka hiding (LogLevel (..))
import qualified Amazonka as AWS
import Amazonka.Auth.Keys (fromSession)
import Amazonka.Data.Text (FromText (..), ToText (..))
import Amazonka.Env (env_auth, env_logger, env_region)
import Amazonka.STS.AssumeRole
import Conduit (ConduitM)
import Control.Monad.Logger (defaultLoc, toLogStr)
import Control.Monad.Trans.Resource (MonadResource)
import Stackctl.AWS.Orphans ()
import UnliftIO.Exception.Lens (handling)

newtype AwsEnv = AwsEnv
  { AwsEnv -> Env
unAwsEnv :: Env
  }

unL :: Lens' AwsEnv Env
unL :: Lens' AwsEnv Env
unL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens AwsEnv -> Env
unAwsEnv forall a b. (a -> b) -> a -> b
$ \AwsEnv
x Env
y -> AwsEnv
x {unAwsEnv :: Env
unAwsEnv = Env
y}

awsEnvDiscover :: MonadLoggerIO m => m AwsEnv
awsEnvDiscover :: forall (m :: * -> *). MonadLoggerIO m => m AwsEnv
awsEnvDiscover = do
  Env
env <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => (EnvNoAuth -> m Env) -> m Env
newEnv forall (m :: * -> *) (withAuth :: * -> *).
(MonadCatch m, MonadIO m, Foldable withAuth) =>
Env' withAuth -> m Env
discover
  Env -> AwsEnv
AwsEnv forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadLoggerIO m => Env -> m Env
configureLogging Env
env

configureLogging :: MonadLoggerIO m => Env -> m Env
configureLogging :: forall (m :: * -> *). MonadLoggerIO m => Env -> m Env
configureLogging Env
env = do
  Loc -> Text -> LogLevel -> LogStr -> IO ()
loggerIO <- forall (m :: * -> *).
MonadLoggerIO m =>
m (Loc -> Text -> LogLevel -> LogStr -> IO ())
askLoggerIO

  let logger :: LogLevel -> ByteStringBuilder -> IO ()
logger LogLevel
level = do
        Loc -> Text -> LogLevel -> LogStr -> IO ()
loggerIO
          Loc
defaultLoc -- TODO: there may be a way to get a CallStack/Loc
          Text
"Amazonka"
          ( case LogLevel
level of
              LogLevel
AWS.Info -> LogLevel
LevelInfo
              LogLevel
AWS.Error -> LogLevel
LevelError
              LogLevel
AWS.Debug -> LogLevel
LevelDebug
              LogLevel
AWS.Trace -> Text -> LogLevel
LevelOther Text
"trace"
          )
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall msg. ToLogStr msg => msg -> LogStr
toLogStr
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Env
env forall a b. a -> (a -> b) -> b
& forall (withAuth :: * -> *).
Lens' (Env' withAuth) (LogLevel -> ByteStringBuilder -> IO ())
env_logger forall s t a b. ASetter s t a b -> b -> s -> t
.~ LogLevel -> ByteStringBuilder -> IO ()
logger

class HasAwsEnv env where
  awsEnvL :: Lens' env AwsEnv

instance HasAwsEnv AwsEnv where
  awsEnvL :: Lens' AwsEnv AwsEnv
awsEnvL = forall a. a -> a
id

awsWithAuth
  :: (MonadIO m, MonadReader env m, HasAwsEnv env) => (AuthEnv -> m a) -> m a
awsWithAuth :: forall (m :: * -> *) env a.
(MonadIO m, MonadReader env m, HasAwsEnv env) =>
(AuthEnv -> m a) -> m a
awsWithAuth AuthEnv -> m a
f = do
  Auth
auth <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasAwsEnv env => Lens' env AwsEnv
awsEnvL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' AwsEnv Env
unL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (withAuth :: * -> *) (withAuth' :: * -> *).
Lens
  (Env' withAuth) (Env' withAuth') (withAuth Auth) (withAuth' Auth)
env_auth forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. (s -> a) -> SimpleGetter s a
to forall a. Identity a -> a
runIdentity
  forall (m :: * -> *) a.
MonadIO m =>
Auth -> (AuthEnv -> m a) -> m a
withAuth Auth
auth AuthEnv -> m a
f

awsSimple
  :: ( MonadResource m
     , MonadReader env m
     , HasAwsEnv env
     , AWSRequest a
     , Typeable a
     , Typeable (AWSResponse a)
     )
  => Text
  -> a
  -> (AWSResponse a -> Maybe b)
  -> m b
awsSimple :: forall (m :: * -> *) env a b.
(MonadResource m, MonadReader env m, HasAwsEnv env, AWSRequest a,
 Typeable a, Typeable (AWSResponse a)) =>
Text -> a -> (AWSResponse a -> Maybe b) -> m b
awsSimple Text
name a
req AWSResponse a -> Maybe b
post = do
  AWSResponse a
resp <- forall (m :: * -> *) env a.
(MonadResource m, MonadReader env m, HasAwsEnv env, AWSRequest a,
 Typeable a, Typeable (AWSResponse a)) =>
a -> m (AWSResponse a)
awsSend a
req
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString String
err) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ AWSResponse a -> Maybe b
post AWSResponse a
resp
 where
  err :: String
err = Text -> String
unpack Text
name forall a. Semigroup a => a -> a -> a
<> String
" successful, but processing the response failed"

awsSend
  :: ( MonadResource m
     , MonadReader env m
     , HasAwsEnv env
     , AWSRequest a
     , Typeable a
     , Typeable (AWSResponse a)
     )
  => a
  -> m (AWSResponse a)
awsSend :: forall (m :: * -> *) env a.
(MonadResource m, MonadReader env m, HasAwsEnv env, AWSRequest a,
 Typeable a, Typeable (AWSResponse a)) =>
a -> m (AWSResponse a)
awsSend a
req = do
  AwsEnv Env
env <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasAwsEnv env => Lens' env AwsEnv
awsEnvL
  forall (m :: * -> *) a.
(MonadResource m, AWSRequest a, Typeable a,
 Typeable (AWSResponse a)) =>
Env -> a -> m (AWSResponse a)
send Env
env a
req

awsPaginate
  :: ( MonadResource m
     , MonadReader env m
     , HasAwsEnv env
     , AWSPager a
     , Typeable a
     , Typeable (AWSResponse a)
     )
  => a
  -> ConduitM () (AWSResponse a) m ()
awsPaginate :: forall (m :: * -> *) env a.
(MonadResource m, MonadReader env m, HasAwsEnv env, AWSPager a,
 Typeable a, Typeable (AWSResponse a)) =>
a -> ConduitM () (AWSResponse a) m ()
awsPaginate a
req = do
  AwsEnv Env
env <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasAwsEnv env => Lens' env AwsEnv
awsEnvL
  forall (m :: * -> *) a.
(MonadResource m, AWSPager a, Typeable a,
 Typeable (AWSResponse a)) =>
Env -> a -> ConduitM () (AWSResponse a) m (Either Error ())
paginateEither Env
env a
req forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadIO m => Either Error a -> m a
hoistEither

hoistEither :: MonadIO m => Either Error a -> m a
hoistEither :: forall (m :: * -> *) a. MonadIO m => Either Error a -> m a
hoistEither = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO) forall (f :: * -> *) a. Applicative f => a -> f a
pure

awsAwait
  :: ( MonadResource m
     , MonadReader env m
     , HasAwsEnv env
     , AWSRequest a
     , Typeable a
     )
  => Wait a
  -> a
  -> m Accept
awsAwait :: forall (m :: * -> *) env a.
(MonadResource m, MonadReader env m, HasAwsEnv env, AWSRequest a,
 Typeable a) =>
Wait a -> a -> m Accept
awsAwait Wait a
w a
req = do
  AwsEnv Env
env <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasAwsEnv env => Lens' env AwsEnv
awsEnvL
  forall (m :: * -> *) a.
(MonadResource m, AWSRequest a, Typeable a) =>
Env -> Wait a -> a -> m Accept
await Env
env Wait a
w a
req

awsAssumeRole
  :: (MonadResource m, MonadReader env m, HasAwsEnv env)
  => Text
  -- ^ Role ARN
  -> Text
  -- ^ Session name
  -> m a
  -- ^ Action to run as the assumed role
  -> m a
awsAssumeRole :: forall (m :: * -> *) env a.
(MonadResource m, MonadReader env m, HasAwsEnv env) =>
Text -> Text -> m a -> m a
awsAssumeRole Text
role Text
sessionName m a
f = do
  let req :: AssumeRole
req = Text -> Text -> AssumeRole
newAssumeRole Text
role Text
sessionName

  Env -> Env
assumeEnv <- forall (m :: * -> *) env a b.
(MonadResource m, MonadReader env m, HasAwsEnv env, AWSRequest a,
 Typeable a, Typeable (AWSResponse a)) =>
Text -> a -> (AWSResponse a -> Maybe b) -> m b
awsSimple Text
"sts:AssumeRole" AssumeRole
req forall a b. (a -> b) -> a -> b
$ \AWSResponse AssumeRole
resp -> do
    let creds :: AuthEnv
creds = AWSResponse AssumeRole
resp forall s a. s -> Getting a s a -> a
^. Lens' AssumeRoleResponse AuthEnv
assumeRoleResponse_credentials
    Sensitive SessionToken
token <- AuthEnv
creds forall s a. s -> Getting a s a -> a
^. Lens' AuthEnv (Maybe (Sensitive SessionToken))
authEnv_sessionToken

    let
      accessKeyId :: AccessKey
accessKeyId = AuthEnv
creds forall s a. s -> Getting a s a -> a
^. Lens' AuthEnv AccessKey
authEnv_accessKeyId
      secretAccessKey :: SecretKey
secretAccessKey = AuthEnv
creds forall s a. s -> Getting a s a -> a
^. Lens' AuthEnv (Sensitive SecretKey)
authEnv_secretAccessKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Iso' (Sensitive a) a
_Sensitive

    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (withAuth :: * -> *).
AccessKey -> SecretKey -> SessionToken -> Env' withAuth -> Env
fromSession AccessKey
accessKeyId SecretKey
secretAccessKey forall a b. (a -> b) -> a -> b
$ Sensitive SessionToken
token forall s a. s -> Getting a s a -> a
^. forall a. Iso' (Sensitive a) a
_Sensitive

  forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (forall env. HasAwsEnv env => Lens' env AwsEnv
awsEnvL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' AwsEnv Env
unL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Env -> Env
assumeEnv) m a
f

awsWithin :: (MonadReader env m, HasAwsEnv env) => Region -> m a -> m a
awsWithin :: forall env (m :: * -> *) a.
(MonadReader env m, HasAwsEnv env) =>
Region -> m a -> m a
awsWithin Region
r = forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local forall a b. (a -> b) -> a -> b
$ forall env. HasAwsEnv env => Lens' env AwsEnv
awsEnvL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' AwsEnv Env
unL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (withAuth :: * -> *). Lens' (Env' withAuth) Region
env_region forall s t a b. ASetter s t a b -> b -> s -> t
.~ Region
r

awsTimeout :: (MonadReader env m, HasAwsEnv env) => Seconds -> m a -> m a
awsTimeout :: forall env (m :: * -> *) a.
(MonadReader env m, HasAwsEnv env) =>
Seconds -> m a -> m a
awsTimeout Seconds
t = forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local forall a b. (a -> b) -> a -> b
$ forall env. HasAwsEnv env => Lens' env AwsEnv
awsEnvL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' AwsEnv Env
unL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall (withAuth :: * -> *).
Seconds -> Env' withAuth -> Env' withAuth
globalTimeout Seconds
t

awsSilently :: (MonadReader env m, HasAwsEnv env) => m a -> m a
awsSilently :: forall env (m :: * -> *) a.
(MonadReader env m, HasAwsEnv env) =>
m a -> m a
awsSilently = forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local forall a b. (a -> b) -> a -> b
$ forall env. HasAwsEnv env => Lens' env AwsEnv
awsEnvL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' AwsEnv Env
unL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (withAuth :: * -> *).
Lens' (Env' withAuth) (LogLevel -> ByteStringBuilder -> IO ())
env_logger forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall {f :: * -> *} {p} {p}. Applicative f => p -> p -> f ()
noop
 where
  noop :: p -> p -> f ()
noop p
_level p
_msg = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

newtype AccountId = AccountId
  { AccountId -> Text
unAccountId :: Text
  }
  deriving newtype (AccountId -> AccountId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccountId -> AccountId -> Bool
$c/= :: AccountId -> AccountId -> Bool
== :: AccountId -> AccountId -> Bool
$c== :: AccountId -> AccountId -> Bool
Eq, Eq AccountId
AccountId -> AccountId -> Bool
AccountId -> AccountId -> Ordering
AccountId -> AccountId -> AccountId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AccountId -> AccountId -> AccountId
$cmin :: AccountId -> AccountId -> AccountId
max :: AccountId -> AccountId -> AccountId
$cmax :: AccountId -> AccountId -> AccountId
>= :: AccountId -> AccountId -> Bool
$c>= :: AccountId -> AccountId -> Bool
> :: AccountId -> AccountId -> Bool
$c> :: AccountId -> AccountId -> Bool
<= :: AccountId -> AccountId -> Bool
$c<= :: AccountId -> AccountId -> Bool
< :: AccountId -> AccountId -> Bool
$c< :: AccountId -> AccountId -> Bool
compare :: AccountId -> AccountId -> Ordering
$ccompare :: AccountId -> AccountId -> Ordering
Ord, Int -> AccountId -> ShowS
[AccountId] -> ShowS
AccountId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccountId] -> ShowS
$cshowList :: [AccountId] -> ShowS
show :: AccountId -> String
$cshow :: AccountId -> String
showsPrec :: Int -> AccountId -> ShowS
$cshowsPrec :: Int -> AccountId -> ShowS
Show, [AccountId] -> Encoding
[AccountId] -> Value
AccountId -> Encoding
AccountId -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [AccountId] -> Encoding
$ctoEncodingList :: [AccountId] -> Encoding
toJSONList :: [AccountId] -> Value
$ctoJSONList :: [AccountId] -> Value
toEncoding :: AccountId -> Encoding
$ctoEncoding :: AccountId -> Encoding
toJSON :: AccountId -> Value
$ctoJSON :: AccountId -> Value
ToJSON)

-- | Handle 'ServiceError', log it and 'exitFailure'
--
-- This is useful at the top-level of the app, where we'd be crashing anyway. It
-- makes things more readable and easier to debug.
handlingServiceError :: (MonadUnliftIO m, MonadLogger m) => m a -> m a
handlingServiceError :: forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLogger m) =>
m a -> m a
handlingServiceError =
  forall (m :: * -> *) a r.
MonadUnliftIO m =>
Getting (First a) SomeException a -> (a -> m r) -> m r -> m r
handling forall a. AsError a => Prism' a ServiceError
_ServiceError forall a b. (a -> b) -> a -> b
$ \ServiceError
e -> do
    forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logError
      forall a b. (a -> b) -> a -> b
$ Text
"Exiting due to AWS Service error"
      Text -> [SeriesElem] -> Message
:# [ Key
"code" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToText a => a -> Text
toText (ServiceError
e forall s a. s -> Getting a s a -> a
^. Lens' ServiceError ErrorCode
serviceError_code)
         , Key
"message" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ToText a => a -> Text
toText (ServiceError
e forall s a. s -> Getting a s a -> a
^. Lens' ServiceError (Maybe ErrorMessage)
serviceError_message)
         , Key
"requestId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ToText a => a -> Text
toText (ServiceError
e forall s a. s -> Getting a s a -> a
^. Lens' ServiceError (Maybe RequestId)
serviceError_requestId)
         ]
    forall (m :: * -> *) a. MonadIO m => m a
exitFailure

formatServiceError :: ServiceError -> Text
formatServiceError :: ServiceError -> Text
formatServiceError ServiceError
e =
  forall a. Monoid a => [a] -> a
mconcat
    [ forall a. ToText a => a -> Text
toText forall a b. (a -> b) -> a -> b
$ ServiceError
e forall s a. s -> Getting a s a -> a
^. Lens' ServiceError ErrorCode
serviceError_code
    , forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ((Text
": " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToText a => a -> Text
toText) forall a b. (a -> b) -> a -> b
$ ServiceError
e forall s a. s -> Getting a s a -> a
^. Lens' ServiceError (Maybe ErrorMessage)
serviceError_message
    , forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ((Text
"\nRequest Id: " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToText a => a -> Text
toText) forall a b. (a -> b) -> a -> b
$ ServiceError
e forall s a. s -> Getting a s a -> a
^. Lens' ServiceError (Maybe RequestId)
serviceError_requestId
    ]