{-# LANGUAGE NamedFieldPuns #-}

-- | Actions that can be performed on certain Stack management events
--
-- For example, to invoke a Lambda whose name is found in the deploying Stack's
-- outputs after it's been deployed:
--
-- @
-- Actions:
--   - on: PostDeploy
--     run:
--       InvokeLambdaByStackOutput: OnDeployFunction
-- @
module Stackctl.Action
  ( Action
  , newAction
  , ActionOn (..)
  , ActionRun (..)
  , runActions
  ) where

import Stackctl.Prelude hiding (on)

import Data.Aeson
import Data.List (find)
import Stackctl.AWS
import Stackctl.AWS.Lambda

data Action = Action
  { Action -> ActionOn
on :: ActionOn
  , Action -> ActionRun
run :: ActionRun
  }
  deriving stock (Action -> Action -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Action -> Action -> Bool
$c/= :: Action -> Action -> Bool
== :: Action -> Action -> Bool
$c== :: Action -> Action -> Bool
Eq, Int -> Action -> ShowS
[Action] -> ShowS
Action -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Action] -> ShowS
$cshowList :: [Action] -> ShowS
show :: Action -> String
$cshow :: Action -> String
showsPrec :: Int -> Action -> ShowS
$cshowsPrec :: Int -> Action -> ShowS
Show, forall x. Rep Action x -> Action
forall x. Action -> Rep Action x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Action x -> Action
$cfrom :: forall x. Action -> Rep Action x
Generic)
  deriving anyclass (Value -> Parser [Action]
Value -> Parser Action
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Action]
$cparseJSONList :: Value -> Parser [Action]
parseJSON :: Value -> Parser Action
$cparseJSON :: Value -> Parser Action
FromJSON, [Action] -> Encoding
[Action] -> Value
Action -> Encoding
Action -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Action] -> Encoding
$ctoEncodingList :: [Action] -> Encoding
toJSONList :: [Action] -> Value
$ctoJSONList :: [Action] -> Value
toEncoding :: Action -> Encoding
$ctoEncoding :: Action -> Encoding
toJSON :: Action -> Value
$ctoJSON :: Action -> Value
ToJSON)

newAction :: ActionOn -> ActionRun -> Action
newAction :: ActionOn -> ActionRun -> Action
newAction = ActionOn -> ActionRun -> Action
Action

data ActionOn = PostDeploy
  deriving stock (ActionOn -> ActionOn -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActionOn -> ActionOn -> Bool
$c/= :: ActionOn -> ActionOn -> Bool
== :: ActionOn -> ActionOn -> Bool
$c== :: ActionOn -> ActionOn -> Bool
Eq, Int -> ActionOn -> ShowS
[ActionOn] -> ShowS
ActionOn -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActionOn] -> ShowS
$cshowList :: [ActionOn] -> ShowS
show :: ActionOn -> String
$cshow :: ActionOn -> String
showsPrec :: Int -> ActionOn -> ShowS
$cshowsPrec :: Int -> ActionOn -> ShowS
Show, forall x. Rep ActionOn x -> ActionOn
forall x. ActionOn -> Rep ActionOn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ActionOn x -> ActionOn
$cfrom :: forall x. ActionOn -> Rep ActionOn x
Generic)

instance FromJSON ActionOn where
  parseJSON :: Value -> Parser ActionOn
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"ActionOn" forall a b. (a -> b) -> a -> b
$ \case
    Text
"PostDeploy" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ActionOn
PostDeploy
    Text
x ->
      forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Invalid ActionOn: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Text
x forall a. Semigroup a => a -> a -> a
<> String
", must be one of [PostDeploy]"

instance ToJSON ActionOn where
  toJSON :: ActionOn -> Value
toJSON = \case
    ActionOn
PostDeploy -> forall a. ToJSON a => a -> Value
toJSON @Text Text
"PostDeploy"
  toEncoding :: ActionOn -> Encoding
toEncoding = \case
    ActionOn
PostDeploy -> forall a. ToJSON a => a -> Encoding
toEncoding @Text Text
"PostDeploy"

data ActionRun
  = InvokeLambdaByStackOutput Text
  | InvokeLambdaByName Text
  deriving stock (ActionRun -> ActionRun -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActionRun -> ActionRun -> Bool
$c/= :: ActionRun -> ActionRun -> Bool
== :: ActionRun -> ActionRun -> Bool
$c== :: ActionRun -> ActionRun -> Bool
Eq, Int -> ActionRun -> ShowS
[ActionRun] -> ShowS
ActionRun -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActionRun] -> ShowS
$cshowList :: [ActionRun] -> ShowS
show :: ActionRun -> String
$cshow :: ActionRun -> String
showsPrec :: Int -> ActionRun -> ShowS
$cshowsPrec :: Int -> ActionRun -> ShowS
Show)

instance FromJSON ActionRun where
  parseJSON :: Value -> Parser ActionRun
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ActionRun" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    (Text -> ActionRun
InvokeLambdaByStackOutput forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"InvokeLambdaByStackOutput")
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> ActionRun
InvokeLambdaByName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"InvokeLambdaByName")

instance ToJSON ActionRun where
  toJSON :: ActionRun -> Value
toJSON =
    [Pair] -> Value
object forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      InvokeLambdaByStackOutput Text
name -> [Key
"InvokeLambdaByStackOutput" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
name]
      InvokeLambdaByName Text
name -> [Key
"InvokeLambdaByName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
name]
  toEncoding :: ActionRun -> Encoding
toEncoding =
    Series -> Encoding
pairs forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      InvokeLambdaByStackOutput Text
name -> Key
"InvokeLambdaByStackOutput" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
name
      InvokeLambdaByName Text
name -> Key
"InvokeLambdaByName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
name

data ActionFailure
  = NoSuchOutput
  | InvokeLambdaFailure
  deriving stock (Int -> ActionFailure -> ShowS
[ActionFailure] -> ShowS
ActionFailure -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActionFailure] -> ShowS
$cshowList :: [ActionFailure] -> ShowS
show :: ActionFailure -> String
$cshow :: ActionFailure -> String
showsPrec :: Int -> ActionFailure -> ShowS
$cshowsPrec :: Int -> ActionFailure -> ShowS
Show)
  deriving anyclass (Show ActionFailure
Typeable ActionFailure
SomeException -> Maybe ActionFailure
ActionFailure -> String
ActionFailure -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: ActionFailure -> String
$cdisplayException :: ActionFailure -> String
fromException :: SomeException -> Maybe ActionFailure
$cfromException :: SomeException -> Maybe ActionFailure
toException :: ActionFailure -> SomeException
$ctoException :: ActionFailure -> SomeException
Exception)

runActions
  :: (MonadResource m, MonadLogger m, MonadReader env m, HasAwsEnv env)
  => StackName
  -> ActionOn
  -> [Action]
  -> m ()
runActions :: forall (m :: * -> *) env.
(MonadResource m, MonadLogger m, MonadReader env m,
 HasAwsEnv env) =>
StackName -> ActionOn -> [Action] -> m ()
runActions StackName
stackName ActionOn
on =
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall (m :: * -> *) env.
(MonadResource m, MonadLogger m, MonadReader env m,
 HasAwsEnv env) =>
StackName -> Action -> m ()
runAction StackName
stackName) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Action -> ActionOn -> Bool
`shouldRunOn` ActionOn
on)

shouldRunOn :: Action -> ActionOn -> Bool
shouldRunOn :: Action -> ActionOn -> Bool
shouldRunOn Action {ActionOn
on :: ActionOn
on :: Action -> ActionOn
on} ActionOn
on' = ActionOn
on forall a. Eq a => a -> a -> Bool
== ActionOn
on'

runAction
  :: (MonadResource m, MonadLogger m, MonadReader env m, HasAwsEnv env)
  => StackName
  -> Action
  -> m ()
runAction :: forall (m :: * -> *) env.
(MonadResource m, MonadLogger m, MonadReader env m,
 HasAwsEnv env) =>
StackName -> Action -> m ()
runAction StackName
stackName Action {ActionOn
on :: ActionOn
on :: Action -> ActionOn
on, ActionRun
run :: ActionRun
run :: Action -> ActionRun
run} = do
  forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logInfo forall a b. (a -> b) -> a -> b
$ Text
"Running action" Text -> [SeriesElem] -> Message
:# [Key
"on" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ActionOn
on, Key
"run" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ActionRun
run]

  case ActionRun
run of
    InvokeLambdaByStackOutput Text
outputName -> do
      [Output]
outputs <- forall (m :: * -> *) env.
(MonadResource m, MonadReader env m, HasAwsEnv env) =>
StackName -> m [Output]
awsCloudFormationDescribeStackOutputs StackName
stackName
      case Text -> [Output] -> Maybe Text
findOutputValue Text
outputName [Output]
outputs of
        Maybe Text
Nothing -> do
          forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logError
            forall a b. (a -> b) -> a -> b
$ Text
"Output not found"
            Text -> [SeriesElem] -> Message
:# [ Key
"stackName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= StackName
stackName
               , Key
"desiredOutput" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
outputName
               , Key
"availableOutputs" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a b. (a -> b) -> [a] -> [b]
map (forall s a. s -> Getting a s a -> a
^. Lens' Output (Maybe Text)
output_outputKey) [Output]
outputs
               ]
          forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO ActionFailure
NoSuchOutput
        Just Text
name -> Text -> m ()
invoke Text
name
    InvokeLambdaByName Text
name -> Text -> m ()
invoke Text
name
 where
  invoke :: Text -> m ()
invoke Text
name = do
    LambdaInvokeResult
result <- forall (m :: * -> *) env a.
(MonadResource m, MonadLogger m, MonadReader env m, HasAwsEnv env,
 ToJSON a) =>
Text -> a -> m LambdaInvokeResult
awsLambdaInvoke Text
name Value
payload
    forall (m :: * -> *). MonadLogger m => LambdaInvokeResult -> m ()
logLambdaInvocationResult LambdaInvokeResult
result
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (LambdaInvokeResult -> Bool
isLambdaInvocationSuccess LambdaInvokeResult
result) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO ActionFailure
InvokeLambdaFailure

  payload :: Value
payload = [Pair] -> Value
object [Key
"stack" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= StackName
stackName, Key
"event" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ActionOn
on]

findOutputValue :: Text -> [Output] -> Maybe Text
findOutputValue :: Text -> [Output] -> Maybe Text
findOutputValue Text
name =
  forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Output (Maybe Text)
output_outputValue forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Text
name) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Output (Maybe Text)
output_outputKey)