{-# OPTIONS_GHC -Wall #-}
module Stripe.Scotty
( requireSig, requireSig_eitherMode
, hasValidSig, getSig, getSigText
) where
import qualified Data.Aeson
import Control.Monad (when, (>=>))
import qualified Data.ByteString
import qualified Data.ByteString.Lazy
import qualified Network.HTTP.Types.Status
import qualified Web.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
import qualified Data.HashMap.Strict
requireSig
:: Stripe.WebhookSecretKey
-> Web.Scotty.ActionM Data.ByteString.ByteString
requireSig :: WebhookSecretKey -> ActionM ByteString
requireSig WebhookSecretKey
secret =
do
ByteString
body <- ActionM ByteString
getBody
Bool
okay <- WebhookSecretKey -> ByteString -> ActionM Bool
hasValidSig WebhookSecretKey
secret ByteString
body
Bool -> ActionT Text IO () -> ActionT Text IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
okay) ActionT Text IO ()
forall a. ActionM a
invalidSigAction
ByteString -> ActionM ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
body
requireSig_eitherMode
:: Stripe.BothModes (Maybe Stripe.WebhookSecretKey)
-> Web.Scotty.ActionM (Stripe.Mode, Data.Aeson.Value)
requireSig_eitherMode :: BothModes (Maybe WebhookSecretKey) -> ActionM (Mode, Value)
requireSig_eitherMode BothModes (Maybe WebhookSecretKey)
secrets =
do
ByteString
body <- ActionM ByteString
getBody
Value
value <- ByteString -> ActionM Value
parseBody ByteString
body
Mode
mode <- Value -> ActionM Mode
getMode Value
value
WebhookSecretKey
secret <- Mode
-> BothModes (Maybe WebhookSecretKey) -> ActionM WebhookSecretKey
chooseSecret Mode
mode BothModes (Maybe WebhookSecretKey)
secrets
Bool
okay <- WebhookSecretKey -> ByteString -> ActionM Bool
hasValidSig WebhookSecretKey
secret ByteString
body
Bool -> ActionT Text IO () -> ActionT Text IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
okay) ActionT Text IO ()
forall a. ActionM a
invalidSigAction
(Mode, Value) -> ActionM (Mode, Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Mode
mode, Value
value)
getBody :: Web.Scotty.ActionM Data.ByteString.ByteString
getBody :: ActionM ByteString
getBody = ByteString -> ByteString
Data.ByteString.Lazy.toStrict (ByteString -> ByteString)
-> ActionT Text IO ByteString -> ActionM ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Text IO ByteString
Web.Scotty.body
invalidSigAction :: Web.Scotty.ActionM a
invalidSigAction :: ActionM a
invalidSigAction =
do
Status -> ActionT Text IO ()
Web.Scotty.status Status
Network.HTTP.Types.Status.forbidden403
Text -> ActionT Text IO ()
Web.Scotty.text (String -> Text
Data.Text.Lazy.pack String
"Invalid Stripe signature")
ActionM a
forall a. ActionM a
Web.Scotty.finish
missingKeyAction :: Stripe.Mode -> Web.Scotty.ActionM a
missingKeyAction :: Mode -> ActionM a
missingKeyAction Mode
mode =
do
Status -> ActionT Text IO ()
Web.Scotty.status Status
Network.HTTP.Types.Status.internalServerError500
Text -> ActionT Text IO ()
Web.Scotty.text Text
message
ActionM a
forall a. ActionM a
Web.Scotty.finish
where
message :: Text
message =
Builder -> Text
Data.Text.Lazy.Builder.toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$
(String -> Builder) -> [String] -> Builder
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
:: Stripe.Mode
-> Stripe.BothModes (Maybe Stripe.WebhookSecretKey)
-> Web.Scotty.ActionM Stripe.WebhookSecretKey
chooseSecret :: Mode
-> BothModes (Maybe WebhookSecretKey) -> ActionM WebhookSecretKey
chooseSecret Mode
mode BothModes (Maybe WebhookSecretKey)
secrets =
case Mode
-> BothModes (Maybe WebhookSecretKey) -> Maybe WebhookSecretKey
forall a. Mode -> BothModes a -> a
Stripe.applyMode Mode
mode BothModes (Maybe WebhookSecretKey)
secrets of
Just WebhookSecretKey
x -> WebhookSecretKey -> ActionM WebhookSecretKey
forall (m :: * -> *) a. Monad m => a -> m a
return WebhookSecretKey
x
Maybe WebhookSecretKey
Nothing -> Mode -> ActionM WebhookSecretKey
forall a. Mode -> ActionM a
missingKeyAction Mode
mode
parseBody
:: Data.ByteString.ByteString
-> Web.Scotty.ActionM Data.Aeson.Value
parseBody :: ByteString -> ActionM Value
parseBody ByteString
bs =
case ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
Data.Aeson.eitherDecode (ByteString -> ByteString
Data.ByteString.Lazy.fromStrict ByteString
bs) of
Left String
x ->
do
Status -> ActionT Text IO ()
Web.Scotty.status Status
Network.HTTP.Types.Status.badRequest400
Text -> ActionT Text IO ()
Web.Scotty.text (String -> Text
Data.Text.Lazy.pack String
x)
ActionM Value
forall a. ActionM a
Web.Scotty.finish
Right Value
x ->
Value -> ActionM Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
x
getMode :: Data.Aeson.Value -> Web.Scotty.ActionM Stripe.Mode
getMode :: Value -> ActionM Mode
getMode Value
val =
case (String -> Value -> Maybe Value
aesonAttr String
"livemode" (Value -> Maybe Value)
-> (Value -> Maybe Bool) -> Value -> Maybe Bool
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
Status -> ActionT Text IO ()
Web.Scotty.status Status
Network.HTTP.Types.Status.badRequest400
Text -> ActionT Text IO ()
Web.Scotty.text (String -> Text
Data.Text.Lazy.pack
String
"Webhook attribute \"livemode\" is missing.")
ActionM Mode
forall a. ActionM a
Web.Scotty.finish
Just Bool
livemode ->
Mode -> ActionM Mode
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Mode
Stripe.isLiveMode' Bool
livemode)
hasValidSig
:: Stripe.WebhookSecretKey
-> Data.ByteString.ByteString
-> Web.Scotty.ActionM Bool
hasValidSig :: WebhookSecretKey -> ByteString -> ActionM Bool
hasValidSig WebhookSecretKey
secret ByteString
body =
do
Maybe Sig
sigMaybe <- ActionM (Maybe Sig)
getSig
Bool -> ActionM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> ActionM Bool) -> Bool -> ActionM Bool
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 :: Web.Scotty.ActionM (Maybe Data.Text.Text)
getSigText :: ActionM (Maybe Text)
getSigText =
do
Maybe Text
x <- Text -> ActionM (Maybe Text)
Web.Scotty.header (String -> Text
Data.Text.Lazy.pack String
"Stripe-Signature")
Maybe Text -> ActionM (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Text
Data.Text.Lazy.toStrict (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
x)
getSig :: Web.Scotty.ActionM (Maybe Stripe.Sig)
getSig :: ActionM (Maybe Sig)
getSig =
do
Maybe Text
x <- ActionM (Maybe Text)
getSigText
Maybe Sig -> ActionM (Maybe Sig)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text
x Maybe Text -> (Text -> Maybe Sig) -> Maybe Sig
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 (Value -> Maybe Object)
-> (Object -> Maybe Value) -> Value -> Maybe Value
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Data.HashMap.Strict.lookup (String -> Text
Data.Text.pack String
x)
aesonObject :: Data.Aeson.Value -> Maybe Data.Aeson.Object
aesonObject :: Value -> Maybe Object
aesonObject (Data.Aeson.Object Object
x) = Object -> Maybe Object
forall a. a -> Maybe a
Just Object
x
aesonObject Value
_ = Maybe Object
forall a. Maybe a
Nothing
aesonBool :: Data.Aeson.Value -> Maybe Bool
aesonBool :: Value -> Maybe Bool
aesonBool (Data.Aeson.Bool Bool
x) = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
x
aesonBool Value
_ = Maybe Bool
forall a. Maybe a
Nothing