{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE NamedFieldPuns #-}

-- |
-- Module      : AWS.Lambda.Events.EventBridge.Detail.SSM.ParameterStoreChange
-- Description : Data types for AWS Systems Manager Parameter Store Change events.
-- License     : BSD3
-- Stability   : stable
module AWS.Lambda.Events.EventBridge.Detail.SSM.ParameterStoreChange
  ( ParameterStoreChange (..),
    Operation (.., Create, Update, Delete, LabelParameterVersion),
    Type (..),
  )
where

import Data.Aeson
  ( FromJSON (..),
    ToJSON (..),
    object,
    pairs,
    withObject,
    withText,
    (.:),
    (.:?),
    (.=),
  )
import qualified Data.Aeson as Aeson
import Data.Aeson.Encoding (text)
import Data.Text (Text)
import GHC.Generics (Generic)

-- | A @Parameter Store Change@ event from Amazon EventBridge. This
-- structure corresponds to the contents of the @"detail"@ field of an
-- EventBridge event, so a full payload from EventBridge can be parsed
-- into a @'AWS.Lambda.Events.EventBridge'' ParameterStoreChange@.
--
-- Sample event payloads are provided in the
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/monitoring-systems-manager-event-examples.html#SSM-Parameter-Store-event-types AWS Systems Manager User Guide>.
data ParameterStoreChange = ParameterStoreChange
  { ParameterStoreChange -> Operation
operation :: Operation,
    ParameterStoreChange -> Text
name :: Text,
    ParameterStoreChange -> Type
type_ :: Type,
    ParameterStoreChange -> Maybe Text
description :: Maybe Text
  }
  deriving (ParameterStoreChange -> ParameterStoreChange -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParameterStoreChange -> ParameterStoreChange -> Bool
$c/= :: ParameterStoreChange -> ParameterStoreChange -> Bool
== :: ParameterStoreChange -> ParameterStoreChange -> Bool
$c== :: ParameterStoreChange -> ParameterStoreChange -> Bool
Eq, Int -> ParameterStoreChange -> ShowS
[ParameterStoreChange] -> ShowS
ParameterStoreChange -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParameterStoreChange] -> ShowS
$cshowList :: [ParameterStoreChange] -> ShowS
show :: ParameterStoreChange -> String
$cshow :: ParameterStoreChange -> String
showsPrec :: Int -> ParameterStoreChange -> ShowS
$cshowsPrec :: Int -> ParameterStoreChange -> ShowS
Show, forall x. Rep ParameterStoreChange x -> ParameterStoreChange
forall x. ParameterStoreChange -> Rep ParameterStoreChange x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ParameterStoreChange x -> ParameterStoreChange
$cfrom :: forall x. ParameterStoreChange -> Rep ParameterStoreChange x
Generic)

instance FromJSON ParameterStoreChange where
  parseJSON :: Value -> Parser ParameterStoreChange
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ParameterStoreChange" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Operation
operation <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"operation"
    Text
name <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    Type
type_ <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
    Maybe Text
description <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description"

    pure
      ParameterStoreChange
        { Operation
operation :: Operation
$sel:operation:ParameterStoreChange :: Operation
operation,
          Text
name :: Text
$sel:name:ParameterStoreChange :: Text
name,
          Type
type_ :: Type
$sel:type_:ParameterStoreChange :: Type
type_,
          Maybe Text
description :: Maybe Text
$sel:description:ParameterStoreChange :: Maybe Text
description
        }

instance ToJSON ParameterStoreChange where
  toJSON :: ParameterStoreChange -> Value
toJSON ParameterStoreChange
change =
    [Pair] -> Value
object
      [ Key
"operation" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ParameterStoreChange -> Operation
operation ParameterStoreChange
change,
        Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ParameterStoreChange -> Text
name ParameterStoreChange
change,
        Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ParameterStoreChange -> Type
type_ ParameterStoreChange
change,
        Key
"description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ParameterStoreChange -> Maybe Text
description ParameterStoreChange
change
      ]

  toEncoding :: ParameterStoreChange -> Encoding
toEncoding ParameterStoreChange
change =
    Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$
      forall a. Monoid a => [a] -> a
mconcat
        [ Key
"operation" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ParameterStoreChange -> Operation
operation ParameterStoreChange
change,
          Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ParameterStoreChange -> Text
name ParameterStoreChange
change,
          Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ParameterStoreChange -> Type
type_ ParameterStoreChange
change,
          Key
"description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ParameterStoreChange -> Maybe Text
description ParameterStoreChange
change
        ]

-- | AWS provides no schema for the @"operation"@ field, so we provide
-- a newtype wrapper and pattern synonyms which we think are complete,
-- based on AWS documentation.
newtype Operation = Operation Text deriving (Operation -> Operation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Operation -> Operation -> Bool
$c/= :: Operation -> Operation -> Bool
== :: Operation -> Operation -> Bool
$c== :: Operation -> Operation -> Bool
Eq, Int -> Operation -> ShowS
[Operation] -> ShowS
Operation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Operation] -> ShowS
$cshowList :: [Operation] -> ShowS
show :: Operation -> String
$cshow :: Operation -> String
showsPrec :: Int -> Operation -> ShowS
$cshowsPrec :: Int -> Operation -> ShowS
Show, forall x. Rep Operation x -> Operation
forall x. Operation -> Rep Operation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Operation x -> Operation
$cfrom :: forall x. Operation -> Rep Operation x
Generic)

pattern Create :: Operation
pattern $bCreate :: Operation
$mCreate :: forall {r}. Operation -> ((# #) -> r) -> ((# #) -> r) -> r
Create = Operation "Create"

pattern Update :: Operation
pattern $bUpdate :: Operation
$mUpdate :: forall {r}. Operation -> ((# #) -> r) -> ((# #) -> r) -> r
Update = Operation "Update"

pattern Delete :: Operation
pattern $bDelete :: Operation
$mDelete :: forall {r}. Operation -> ((# #) -> r) -> ((# #) -> r) -> r
Delete = Operation "Delete"

pattern LabelParameterVersion :: Operation
pattern $bLabelParameterVersion :: Operation
$mLabelParameterVersion :: forall {r}. Operation -> ((# #) -> r) -> ((# #) -> r) -> r
LabelParameterVersion = Operation "LabelParameterVersion"

{-# COMPLETE Create, Update, Delete, LabelParameterVersion #-}

instance FromJSON Operation where
  parseJSON :: Value -> Parser Operation
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Operation" forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Operation
Operation

instance ToJSON Operation where
  toJSON :: Operation -> Value
toJSON (Operation Text
op) = Text -> Value
Aeson.String Text
op
  toEncoding :: Operation -> Encoding
toEncoding (Operation Text
op) = forall a. Text -> Encoding' a
text Text
op

-- | AWS provides no schema for the @"type"@ field, but these are the
-- only three types of parameters you can create in Parameter Store.
data Type = String | StringList | SecureString
  deriving (Type -> Type -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c== :: Type -> Type -> Bool
Eq, Eq Type
Type -> Type -> Bool
Type -> Type -> Ordering
Type -> Type -> Type
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 :: Type -> Type -> Type
$cmin :: Type -> Type -> Type
max :: Type -> Type -> Type
$cmax :: Type -> Type -> Type
>= :: Type -> Type -> Bool
$c>= :: Type -> Type -> Bool
> :: Type -> Type -> Bool
$c> :: Type -> Type -> Bool
<= :: Type -> Type -> Bool
$c<= :: Type -> Type -> Bool
< :: Type -> Type -> Bool
$c< :: Type -> Type -> Bool
compare :: Type -> Type -> Ordering
$ccompare :: Type -> Type -> Ordering
Ord, Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type] -> ShowS
$cshowList :: [Type] -> ShowS
show :: Type -> String
$cshow :: Type -> String
showsPrec :: Int -> Type -> ShowS
$cshowsPrec :: Int -> Type -> ShowS
Show, Int -> Type
Type -> Int
Type -> [Type]
Type -> Type
Type -> Type -> [Type]
Type -> Type -> Type -> [Type]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Type -> Type -> Type -> [Type]
$cenumFromThenTo :: Type -> Type -> Type -> [Type]
enumFromTo :: Type -> Type -> [Type]
$cenumFromTo :: Type -> Type -> [Type]
enumFromThen :: Type -> Type -> [Type]
$cenumFromThen :: Type -> Type -> [Type]
enumFrom :: Type -> [Type]
$cenumFrom :: Type -> [Type]
fromEnum :: Type -> Int
$cfromEnum :: Type -> Int
toEnum :: Int -> Type
$ctoEnum :: Int -> Type
pred :: Type -> Type
$cpred :: Type -> Type
succ :: Type -> Type
$csucc :: Type -> Type
Enum, Type
forall a. a -> a -> Bounded a
maxBound :: Type
$cmaxBound :: Type
minBound :: Type
$cminBound :: Type
Bounded, forall x. Rep Type x -> Type
forall x. Type -> Rep Type x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Type x -> Type
$cfrom :: forall x. Type -> Rep Type x
Generic)

instance FromJSON Type where
  parseJSON :: Value -> Parser Type
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Type" forall a b. (a -> b) -> a -> b
$ \case
    Text
"String" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
String
    Text
"StringList" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
StringList
    Text
"SecureString" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
SecureString
    Text
t -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unrecognised type: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
t

instance ToJSON Type where
  toJSON :: Type -> Value
toJSON =
    Text -> Value
Aeson.String forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      Type
String -> Text
"String"
      Type
StringList -> Text
"StringList"
      Type
SecureString -> Text
"SecureString"

  toEncoding :: Type -> Encoding
toEncoding =
    forall a. Text -> Encoding' a
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      Type
String -> Text
"String"
      Type
StringList -> Text
"StringList"
      Type
SecureString -> Text
"SecureString"