module Amazon.SNS.Verify.Payload
  ( SNSPayload(..)
  , SNSType(..)
  , SNSNotification(..)
  , SNSSubscription(..)
  ) where

import Amazon.SNS.Verify.Prelude

import Data.Aeson
  ( FromJSON
  , defaultOptions
  , fieldLabelModifier
  , genericParseJSON
  , parseJSON
  , withObject
  , (.:)
  )
import GHC.Generics (Generic)

data SNSPayload = SNSPayload
  { SNSPayload -> Text
snsMessage :: Text
  , SNSPayload -> Text
snsMessageId :: Text
  , SNSPayload -> Text
snsTimestamp :: Text
  , SNSPayload -> Text
snsTopicArn :: Text
  , SNSPayload -> Text
snsType :: Text
  , SNSPayload -> Text
snsSignatureVersion :: Text
  , SNSPayload -> Text
snsSignature :: Text
  , SNSPayload -> Text
snsSigningCertURL :: Text
  , SNSPayload -> SNSType
snsTypePayload :: SNSType
  }

instance FromJSON SNSPayload where
  parseJSON :: Value -> Parser SNSPayload
parseJSON Value
v = Value -> Parser SNSPayload
parse Value
v
   where
    parse :: Value -> Parser SNSPayload
parse = String
-> (Object -> Parser SNSPayload) -> Value -> Parser SNSPayload
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SNSPayload" ((Object -> Parser SNSPayload) -> Value -> Parser SNSPayload)
-> (Object -> Parser SNSPayload) -> Value -> Parser SNSPayload
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      Text
payloadType <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"Type"
      Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> SNSType
-> SNSPayload
SNSPayload
        (Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> SNSType
 -> SNSPayload)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> SNSType
      -> SNSPayload)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o
        Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"Message"
        Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> SNSType
   -> SNSPayload)
-> Parser Text
-> Parser
     (Text
      -> Text -> Text -> Text -> Text -> Text -> SNSType -> SNSPayload)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
        Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"MessageId"
        Parser
  (Text
   -> Text -> Text -> Text -> Text -> Text -> SNSType -> SNSPayload)
-> Parser Text
-> Parser
     (Text -> Text -> Text -> Text -> Text -> SNSType -> SNSPayload)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
        Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"Timestamp"
        Parser
  (Text -> Text -> Text -> Text -> Text -> SNSType -> SNSPayload)
-> Parser Text
-> Parser (Text -> Text -> Text -> Text -> SNSType -> SNSPayload)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
        Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"TopicArn"
        Parser (Text -> Text -> Text -> Text -> SNSType -> SNSPayload)
-> Parser Text
-> Parser (Text -> Text -> Text -> SNSType -> SNSPayload)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
payloadType
        Parser (Text -> Text -> Text -> SNSType -> SNSPayload)
-> Parser Text -> Parser (Text -> Text -> SNSType -> SNSPayload)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
        Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"SignatureVersion"
        Parser (Text -> Text -> SNSType -> SNSPayload)
-> Parser Text -> Parser (Text -> SNSType -> SNSPayload)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
        Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"Signature"
        Parser (Text -> SNSType -> SNSPayload)
-> Parser Text -> Parser (SNSType -> SNSPayload)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
        Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"SigningCertURL"
        Parser (SNSType -> SNSPayload)
-> Parser SNSType -> Parser SNSPayload
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Parser SNSType
parseType Text
payloadType
    parseType :: Text -> Parser SNSType
parseType = \case
      Text
"SubscriptionConfirmation" -> SNSSubscription -> SNSType
SubscriptionConfirmation (SNSSubscription -> SNSType)
-> Parser SNSSubscription -> Parser SNSType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser SNSSubscription
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
      Text
"UnsubscribeConfirmation" -> SNSSubscription -> SNSType
UnsubscribeConfirmation (SNSSubscription -> SNSType)
-> Parser SNSSubscription -> Parser SNSType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser SNSSubscription
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
      Text
"Notification" -> SNSNotification -> SNSType
Notification (SNSNotification -> SNSType)
-> Parser SNSNotification -> Parser SNSType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser SNSNotification
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
      Text
msg -> String -> Parser SNSType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser SNSType) -> String -> Parser SNSType
forall a b. (a -> b) -> a -> b
$ String
"Unknown message type " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
msg

data SNSType
  = Notification SNSNotification
  | SubscriptionConfirmation SNSSubscription
  | UnsubscribeConfirmation SNSSubscription

newtype SNSNotification = SNSNotification
  { SNSNotification -> Maybe Text
snsSubject :: Maybe Text
  }
  deriving stock (Int -> SNSNotification -> String -> String
[SNSNotification] -> String -> String
SNSNotification -> String
(Int -> SNSNotification -> String -> String)
-> (SNSNotification -> String)
-> ([SNSNotification] -> String -> String)
-> Show SNSNotification
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SNSNotification] -> String -> String
$cshowList :: [SNSNotification] -> String -> String
show :: SNSNotification -> String
$cshow :: SNSNotification -> String
showsPrec :: Int -> SNSNotification -> String -> String
$cshowsPrec :: Int -> SNSNotification -> String -> String
Show, SNSNotification -> SNSNotification -> Bool
(SNSNotification -> SNSNotification -> Bool)
-> (SNSNotification -> SNSNotification -> Bool)
-> Eq SNSNotification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SNSNotification -> SNSNotification -> Bool
$c/= :: SNSNotification -> SNSNotification -> Bool
== :: SNSNotification -> SNSNotification -> Bool
$c== :: SNSNotification -> SNSNotification -> Bool
Eq, (forall x. SNSNotification -> Rep SNSNotification x)
-> (forall x. Rep SNSNotification x -> SNSNotification)
-> Generic SNSNotification
forall x. Rep SNSNotification x -> SNSNotification
forall x. SNSNotification -> Rep SNSNotification x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SNSNotification x -> SNSNotification
$cfrom :: forall x. SNSNotification -> Rep SNSNotification x
Generic)

instance FromJSON SNSNotification where
  parseJSON :: Value -> Parser SNSNotification
parseJSON = Options -> Value -> Parser SNSNotification
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser SNSNotification)
-> Options -> Value -> Parser SNSNotification
forall a b. (a -> b) -> a -> b
$ Options
defaultOptions { fieldLabelModifier :: String -> String
fieldLabelModifier = Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
3 }

data SNSSubscription = SNSSubscription
  { SNSSubscription -> Text
snsToken :: Text
  , SNSSubscription -> Text
snsSubscribeURL :: Text
  }
  deriving stock (Int -> SNSSubscription -> String -> String
[SNSSubscription] -> String -> String
SNSSubscription -> String
(Int -> SNSSubscription -> String -> String)
-> (SNSSubscription -> String)
-> ([SNSSubscription] -> String -> String)
-> Show SNSSubscription
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SNSSubscription] -> String -> String
$cshowList :: [SNSSubscription] -> String -> String
show :: SNSSubscription -> String
$cshow :: SNSSubscription -> String
showsPrec :: Int -> SNSSubscription -> String -> String
$cshowsPrec :: Int -> SNSSubscription -> String -> String
Show, SNSSubscription -> SNSSubscription -> Bool
(SNSSubscription -> SNSSubscription -> Bool)
-> (SNSSubscription -> SNSSubscription -> Bool)
-> Eq SNSSubscription
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SNSSubscription -> SNSSubscription -> Bool
$c/= :: SNSSubscription -> SNSSubscription -> Bool
== :: SNSSubscription -> SNSSubscription -> Bool
$c== :: SNSSubscription -> SNSSubscription -> Bool
Eq, (forall x. SNSSubscription -> Rep SNSSubscription x)
-> (forall x. Rep SNSSubscription x -> SNSSubscription)
-> Generic SNSSubscription
forall x. Rep SNSSubscription x -> SNSSubscription
forall x. SNSSubscription -> Rep SNSSubscription x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SNSSubscription x -> SNSSubscription
$cfrom :: forall x. SNSSubscription -> Rep SNSSubscription x
Generic)

instance FromJSON SNSSubscription where
  parseJSON :: Value -> Parser SNSSubscription
parseJSON = Options -> Value -> Parser SNSSubscription
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser SNSSubscription)
-> Options -> Value -> Parser SNSSubscription
forall a b. (a -> b) -> a -> b
$ Options
defaultOptions { fieldLabelModifier :: String -> String
fieldLabelModifier = Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
3 }