Verify.hs

module Amazon.SNS.Verify
  ( verifySNSMessage
  , verifySNSMessageEither
  , verifySNSMessageJSON
  , verifySNSMessageJSONEither
  , SNSNotificationValidationError (..)
  ) where

import Amazon.SNS.Verify.Prelude

import Amazon.SNS.Verify.Payload
import Amazon.SNS.Verify.Validate
import Control.Error (hoistEither, runExceptT)
import Data.Aeson (FromJSON, Value, eitherDecode)
import Data.Aeson.Types (Result (Error, Success), fromJSON)
import Data.Bifunctor (first)
import Data.ByteString.Lazy (fromStrict)
import Data.Text.Encoding (encodeUtf8)

-- | Decode and verify an SNS message as JSON
--
-- The same as 'verifySNSMessage', but decodes the message as `JSON`.
verifySNSMessageJSON :: (FromJSON a, MonadIO m) => Value -> m a
verifySNSMessageJSON = unTryIO id <=< verifySNSMessageJSONEither

verifySNSMessageJSONEither
  :: (FromJSON a, MonadIO m)
  => Value
  -> m (Either SNSNotificationValidationError a)
verifySNSMessageJSONEither value =
  join
    . traverse (first BadJSONParse . eitherDecode . fromStrict . encodeUtf8)
    <$> verifySNSMessageEither value

-- | Decode and verify an SNS message
--
-- This function follows the process outlined in the following:
--
-- <https://docs.aws.amazon.com/sns/latest/dg/sns-verify-signature-of-message.html>
--
-- A `JSON` payload is:
--
-- 1. Parsed as an SNS message type 'Notification', `SubscriptionConfirmation`,
--    or `UnsubscribeConfirmation`.
-- 2. Verified against its signature.
-- 3. And in the case of subscription events responded to.
verifySNSMessage :: MonadIO m => Value -> m Text
verifySNSMessage = unTryIO id <=< verifySNSMessageEither

verifySNSMessageEither
  :: MonadIO m => Value -> m (Either SNSNotificationValidationError Text)
verifySNSMessageEither value = runExceptT $ do
  payload <- hoistEither $ parseSNSPayload value
  verified <- hoistEither =<< validateSnsMessage payload
  hoistEither =<< handleSubscription verified

parseSNSPayload :: Value -> Either SNSNotificationValidationError SNSPayload
parseSNSPayload = first BadJSONParse . fromResult . fromJSON

fromResult :: Result a -> Either String a
fromResult = \case
  Success a -> Right a
  Error str -> Left str