{-# OPTIONS_GHC -Wall #-}
module Stripe.Scotty
( requireSig, requireSig_eitherMode
, hasValidSig, getSig, getSigText
) where
import qualified Data.Aeson
import qualified Data.Aeson.Key
import qualified Data.Aeson.KeyMap
import Control.Monad (when, (>=>))
import Control.Monad.IO.Class (MonadIO)
import qualified Data.ByteString
import qualified Data.ByteString.Lazy
import qualified Network.HTTP.Types.Status
import qualified Web.Scotty.Trans as Scotty
import qualified Stripe.Concepts as Stripe
import qualified Stripe.Signature as Stripe
import qualified Data.Text
import qualified Data.Text.Lazy
import qualified Data.Text.Lazy.Builder
requireSig
:: (MonadIO m, Scotty.ScottyError e) =>
Stripe.WebhookSecretKey
-> Scotty.ActionT e m Data.ByteString.ByteString
requireSig :: forall (m :: * -> *) e.
(MonadIO m, ScottyError e) =>
WebhookSecretKey -> ActionT e m ByteString
requireSig WebhookSecretKey
secret =
do
ByteString
body <- forall (m :: * -> *) e.
(MonadIO m, ScottyError e) =>
ActionT e m ByteString
getBody
Bool
okay <- forall (m :: * -> *) e.
(Monad m, ScottyError e) =>
WebhookSecretKey -> ByteString -> ActionT e m Bool
hasValidSig WebhookSecretKey
secret ByteString
body
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
okay) forall (m :: * -> *) e a. (Monad m, ScottyError e) => ActionT e m a
invalidSigAction
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
body
requireSig_eitherMode
:: (MonadIO m, Scotty.ScottyError e) =>
Stripe.BothModes (Maybe Stripe.WebhookSecretKey)
-> Scotty.ActionT e m (Stripe.Mode, Data.Aeson.Value)
requireSig_eitherMode :: forall (m :: * -> *) e.
(MonadIO m, ScottyError e) =>
BothModes (Maybe WebhookSecretKey) -> ActionT e m (Mode, Value)
requireSig_eitherMode BothModes (Maybe WebhookSecretKey)
secrets =
do
ByteString
body <- forall (m :: * -> *) e.
(MonadIO m, ScottyError e) =>
ActionT e m ByteString
getBody
Value
value <- forall (m :: * -> *) e.
(Monad m, ScottyError e) =>
ByteString -> ActionT e m Value
parseBody ByteString
body
Mode
mode <- forall (m :: * -> *) e.
(Monad m, ScottyError e) =>
Value -> ActionT e m Mode
getMode Value
value
WebhookSecretKey
secret <- forall (m :: * -> *) e.
(Monad m, ScottyError e) =>
Mode
-> BothModes (Maybe WebhookSecretKey)
-> ActionT e m WebhookSecretKey
chooseSecret Mode
mode BothModes (Maybe WebhookSecretKey)
secrets
Bool
okay <- forall (m :: * -> *) e.
(Monad m, ScottyError e) =>
WebhookSecretKey -> ByteString -> ActionT e m Bool
hasValidSig WebhookSecretKey
secret ByteString
body
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
okay) forall (m :: * -> *) e a. (Monad m, ScottyError e) => ActionT e m a
invalidSigAction
forall (m :: * -> *) a. Monad m => a -> m a
return (Mode
mode, Value
value)
getBody :: (MonadIO m, Scotty.ScottyError e) =>
Scotty.ActionT e m Data.ByteString.ByteString
getBody :: forall (m :: * -> *) e.
(MonadIO m, ScottyError e) =>
ActionT e m ByteString
getBody = ByteString -> ByteString
Data.ByteString.Lazy.toStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
ActionT e m ByteString
Scotty.body
invalidSigAction :: (Monad m, Scotty.ScottyError e) => Scotty.ActionT e m a
invalidSigAction :: forall (m :: * -> *) e a. (Monad m, ScottyError e) => ActionT e m a
invalidSigAction =
do
forall (m :: * -> *) e. Monad m => Status -> ActionT e m ()
Scotty.status Status
Network.HTTP.Types.Status.forbidden403
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
Scotty.text (String -> Text
Data.Text.Lazy.pack String
"Invalid Stripe signature")
forall e (m :: * -> *) a. (ScottyError e, Monad m) => ActionT e m a
Scotty.finish
missingKeyAction :: (Monad m, Scotty.ScottyError e) =>
Stripe.Mode -> Scotty.ActionT e m a
missingKeyAction :: forall (m :: * -> *) e a.
(Monad m, ScottyError e) =>
Mode -> ActionT e m a
missingKeyAction Mode
mode =
do
forall (m :: * -> *) e. Monad m => Status -> ActionT e m ()
Scotty.status Status
Network.HTTP.Types.Status.internalServerError500
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
Scotty.text Text
message
forall e (m :: * -> *) a. (ScottyError e, Monad m) => ActionT e m a
Scotty.finish
where
message :: Text
message =
Builder -> Text
Data.Text.Lazy.Builder.toLazyText forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap String -> Builder
Data.Text.Lazy.Builder.fromString
[ String
"Configuration error: No webhook secret for "
, case Mode
mode of
Mode
Stripe.LiveMode -> String
"live"
Mode
Stripe.TestMode -> String
"test"
, String
" mode."
]
chooseSecret
:: (Monad m, Scotty.ScottyError e) =>
Stripe.Mode
-> Stripe.BothModes (Maybe Stripe.WebhookSecretKey)
-> Scotty.ActionT e m Stripe.WebhookSecretKey
chooseSecret :: forall (m :: * -> *) e.
(Monad m, ScottyError e) =>
Mode
-> BothModes (Maybe WebhookSecretKey)
-> ActionT e m WebhookSecretKey
chooseSecret Mode
mode BothModes (Maybe WebhookSecretKey)
secrets =
case forall a. Mode -> BothModes a -> a
Stripe.applyMode Mode
mode BothModes (Maybe WebhookSecretKey)
secrets of
Just WebhookSecretKey
x -> forall (m :: * -> *) a. Monad m => a -> m a
return WebhookSecretKey
x
Maybe WebhookSecretKey
Nothing -> forall (m :: * -> *) e a.
(Monad m, ScottyError e) =>
Mode -> ActionT e m a
missingKeyAction Mode
mode
parseBody
:: (Monad m, Scotty.ScottyError e) =>
Data.ByteString.ByteString
-> Scotty.ActionT e m Data.Aeson.Value
parseBody :: forall (m :: * -> *) e.
(Monad m, ScottyError e) =>
ByteString -> ActionT e m Value
parseBody ByteString
bs =
case forall a. FromJSON a => ByteString -> Either String a
Data.Aeson.eitherDecode (ByteString -> ByteString
Data.ByteString.Lazy.fromStrict ByteString
bs) of
Left String
x ->
do
forall (m :: * -> *) e. Monad m => Status -> ActionT e m ()
Scotty.status Status
Network.HTTP.Types.Status.badRequest400
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
Scotty.text (String -> Text
Data.Text.Lazy.pack String
x)
forall e (m :: * -> *) a. (ScottyError e, Monad m) => ActionT e m a
Scotty.finish
Right Value
x ->
forall (m :: * -> *) a. Monad m => a -> m a
return Value
x
getMode :: (Monad m, Scotty.ScottyError e) =>
Data.Aeson.Value -> Scotty.ActionT e m Stripe.Mode
getMode :: forall (m :: * -> *) e.
(Monad m, ScottyError e) =>
Value -> ActionT e m Mode
getMode Value
val =
case (String -> Value -> Maybe Value
aesonAttr String
"livemode" forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Value -> Maybe Bool
aesonBool) Value
val of
Maybe Bool
Nothing ->
do
forall (m :: * -> *) e. Monad m => Status -> ActionT e m ()
Scotty.status Status
Network.HTTP.Types.Status.badRequest400
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
Scotty.text (String -> Text
Data.Text.Lazy.pack
String
"Webhook attribute \"livemode\" is missing.")
forall e (m :: * -> *) a. (ScottyError e, Monad m) => ActionT e m a
Scotty.finish
Just Bool
livemode ->
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Mode
Stripe.isLiveMode' Bool
livemode)
hasValidSig
:: (Monad m, Scotty.ScottyError e) =>
Stripe.WebhookSecretKey
-> Data.ByteString.ByteString
-> Scotty.ActionT e m Bool
hasValidSig :: forall (m :: * -> *) e.
(Monad m, ScottyError e) =>
WebhookSecretKey -> ByteString -> ActionT e m Bool
hasValidSig WebhookSecretKey
secret ByteString
body =
do
Maybe Sig
sigMaybe <- forall (m :: * -> *) e.
(Monad m, ScottyError e) =>
ActionT e m (Maybe Sig)
getSig
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
case Maybe Sig
sigMaybe of
Maybe Sig
Nothing -> Bool
False
Just Sig
sig -> Sig -> WebhookSecretKey -> ByteString -> Bool
Stripe.isSigValid Sig
sig WebhookSecretKey
secret ByteString
body
getSigText :: (Monad m, Scotty.ScottyError e) =>
Scotty.ActionT e m (Maybe Data.Text.Text)
getSigText :: forall (m :: * -> *) e.
(Monad m, ScottyError e) =>
ActionT e m (Maybe Text)
getSigText =
do
Maybe Text
x <- forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m (Maybe Text)
Scotty.header (String -> Text
Data.Text.Lazy.pack String
"Stripe-Signature")
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Text
Data.Text.Lazy.toStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
x)
getSig :: (Monad m, Scotty.ScottyError e) =>
Scotty.ActionT e m (Maybe Stripe.Sig)
getSig :: forall (m :: * -> *) e.
(Monad m, ScottyError e) =>
ActionT e m (Maybe Sig)
getSig =
do
Maybe Text
x <- forall (m :: * -> *) e.
(Monad m, ScottyError e) =>
ActionT e m (Maybe Text)
getSigText
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Sig
Stripe.parseSig)
aesonAttr :: String -> Data.Aeson.Value -> Maybe Data.Aeson.Value
aesonAttr :: String -> Value -> Maybe Value
aesonAttr String
x = Value -> Maybe Object
aesonObject forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall v. Key -> KeyMap v -> Maybe v
Data.Aeson.KeyMap.lookup (String -> Key
Data.Aeson.Key.fromString String
x)
aesonObject :: Data.Aeson.Value -> Maybe Data.Aeson.Object
aesonObject :: Value -> Maybe Object
aesonObject (Data.Aeson.Object Object
x) = forall a. a -> Maybe a
Just Object
x
aesonObject Value
_ = forall a. Maybe a
Nothing
aesonBool :: Data.Aeson.Value -> Maybe Bool
aesonBool :: Value -> Maybe Bool
aesonBool (Data.Aeson.Bool Bool
x) = forall a. a -> Maybe a
Just Bool
x
aesonBool Value
_ = forall a. Maybe a
Nothing