{-# 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 secret =
do
body <- getBody
okay <- hasValidSig secret body
when (not okay) invalidSigAction
return body
requireSig_eitherMode
:: Stripe.BothModes (Maybe Stripe.WebhookSecretKey)
-> Web.Scotty.ActionM (Stripe.Mode, Data.Aeson.Value)
requireSig_eitherMode secrets =
do
body <- getBody
value <- parseBody body
mode <- getMode value
secret <- chooseSecret mode secrets
okay <- hasValidSig secret body
when (not okay) invalidSigAction
return (mode, value)
getBody :: Web.Scotty.ActionM Data.ByteString.ByteString
getBody = Data.ByteString.Lazy.toStrict <$> Web.Scotty.body
invalidSigAction :: Web.Scotty.ActionM a
invalidSigAction =
do
Web.Scotty.status Network.HTTP.Types.Status.forbidden403
Web.Scotty.text (Data.Text.Lazy.pack "Invalid Stripe signature")
Web.Scotty.finish
missingKeyAction :: Stripe.Mode -> Web.Scotty.ActionM a
missingKeyAction mode =
do
Web.Scotty.status Network.HTTP.Types.Status.internalServerError500
Web.Scotty.text message
Web.Scotty.finish
where
message =
Data.Text.Lazy.Builder.toLazyText $
foldMap Data.Text.Lazy.Builder.fromString
[ "Configuration error: No webhook secret for "
, case mode of
Stripe.LiveMode -> "live"
Stripe.TestMode -> "test"
, " mode."
]
chooseSecret
:: Stripe.Mode
-> Stripe.BothModes (Maybe Stripe.WebhookSecretKey)
-> Web.Scotty.ActionM Stripe.WebhookSecretKey
chooseSecret mode secrets =
case Stripe.applyMode mode secrets of
Just x -> return x
Nothing -> missingKeyAction mode
parseBody
:: Data.ByteString.ByteString
-> Web.Scotty.ActionM Data.Aeson.Value
parseBody bs =
case Data.Aeson.eitherDecode (Data.ByteString.Lazy.fromStrict bs) of
Left x ->
do
Web.Scotty.status Network.HTTP.Types.Status.badRequest400
Web.Scotty.text (Data.Text.Lazy.pack x)
Web.Scotty.finish
Right x ->
return x
getMode :: Data.Aeson.Value -> Web.Scotty.ActionM Stripe.Mode
getMode val =
case (aesonAttr "livemode" >=> aesonBool) val of
Nothing ->
do
Web.Scotty.status Network.HTTP.Types.Status.badRequest400
Web.Scotty.text (Data.Text.Lazy.pack
"Webhook attribute \"livemode\" is missing.")
Web.Scotty.finish
Just livemode ->
return (Stripe.isLiveMode' livemode)
hasValidSig
:: Stripe.WebhookSecretKey
-> Data.ByteString.ByteString
-> Web.Scotty.ActionM Bool
hasValidSig secret body =
do
sigMaybe <- getSig
return $
case sigMaybe of
Nothing -> False
Just sig -> Stripe.isSigValid sig secret body
getSigText :: Web.Scotty.ActionM (Maybe Data.Text.Text)
getSigText =
do
x <- Web.Scotty.header (Data.Text.Lazy.pack "Stripe-Signature")
return (Data.Text.Lazy.toStrict <$> x)
getSig :: Web.Scotty.ActionM (Maybe Stripe.Sig)
getSig =
do
x <- getSigText
return (x >>= Stripe.parseSig)
aesonAttr :: String -> Data.Aeson.Value -> Maybe Data.Aeson.Value
aesonAttr x = aesonObject >=> Data.HashMap.Strict.lookup (Data.Text.pack x)
aesonObject :: Data.Aeson.Value -> Maybe Data.Aeson.Object
aesonObject (Data.Aeson.Object x) = Just x
aesonObject _ = Nothing
aesonBool :: Data.Aeson.Value -> Maybe Bool
aesonBool (Data.Aeson.Bool x) = Just x
aesonBool _ = Nothing