module Stripe.Webhook.Verify
( verifyStripeSignature
, WebhookSecret, VerificationResult(..)
)
where
import Crypto.Hash.Algorithms
import Crypto.MAC.HMAC
import Data.Bifunctor
import Data.ByteArray.Encoding
import Data.Time
import Data.Time.Clock.POSIX
import Safe
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
type WebhookSecret = BS.ByteString
data VerificationResult
= VOk UTCTime
| VFailed
| VInvalidSignature
deriving (Int -> VerificationResult -> ShowS
[VerificationResult] -> ShowS
VerificationResult -> String
(Int -> VerificationResult -> ShowS)
-> (VerificationResult -> String)
-> ([VerificationResult] -> ShowS)
-> Show VerificationResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VerificationResult] -> ShowS
$cshowList :: [VerificationResult] -> ShowS
show :: VerificationResult -> String
$cshow :: VerificationResult -> String
showsPrec :: Int -> VerificationResult -> ShowS
$cshowsPrec :: Int -> VerificationResult -> ShowS
Show, VerificationResult -> VerificationResult -> Bool
(VerificationResult -> VerificationResult -> Bool)
-> (VerificationResult -> VerificationResult -> Bool)
-> Eq VerificationResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VerificationResult -> VerificationResult -> Bool
$c/= :: VerificationResult -> VerificationResult -> Bool
== :: VerificationResult -> VerificationResult -> Bool
$c== :: VerificationResult -> VerificationResult -> Bool
Eq)
verifyStripeSignature ::
WebhookSecret
-> BS.ByteString
-> BS.ByteString
-> VerificationResult
verifyStripeSignature :: WebhookSecret
-> WebhookSecret -> WebhookSecret -> VerificationResult
verifyStripeSignature WebhookSecret
secret WebhookSecret
sig WebhookSecret
rawBody =
let sigMap :: [(WebhookSecret, WebhookSecret)]
sigMap = (WebhookSecret -> (WebhookSecret, WebhookSecret))
-> [WebhookSecret] -> [(WebhookSecret, WebhookSecret)]
forall a b. (a -> b) -> [a] -> [b]
map ((WebhookSecret -> WebhookSecret)
-> (WebhookSecret, WebhookSecret) -> (WebhookSecret, WebhookSecret)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Int -> WebhookSecret -> WebhookSecret
BS.drop Int
1) ((WebhookSecret, WebhookSecret) -> (WebhookSecret, WebhookSecret))
-> (WebhookSecret -> (WebhookSecret, WebhookSecret))
-> WebhookSecret
-> (WebhookSecret, WebhookSecret)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> WebhookSecret -> (WebhookSecret, WebhookSecret)
BSC.break (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=')) ([WebhookSecret] -> [(WebhookSecret, WebhookSecret)])
-> (WebhookSecret -> [WebhookSecret])
-> WebhookSecret
-> [(WebhookSecret, WebhookSecret)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> WebhookSecret -> [WebhookSecret]
BSC.split Char
',' (WebhookSecret -> [(WebhookSecret, WebhookSecret)])
-> WebhookSecret -> [(WebhookSecret, WebhookSecret)]
forall a b. (a -> b) -> a -> b
$ WebhookSecret
sig
needed :: Maybe (WebhookSecret, UTCTime, WebhookSecret)
needed =
do WebhookSecret
t <- WebhookSecret
-> [(WebhookSecret, WebhookSecret)] -> Maybe WebhookSecret
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup WebhookSecret
"t" [(WebhookSecret, WebhookSecret)]
sigMap
(Int
parsedTime :: Int) <- String -> Maybe Int
forall a. Read a => String -> Maybe a
readMay (WebhookSecret -> String
BSC.unpack WebhookSecret
t)
WebhookSecret
v1 <- WebhookSecret
-> [(WebhookSecret, WebhookSecret)] -> Maybe WebhookSecret
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup WebhookSecret
"v1" [(WebhookSecret, WebhookSecret)]
sigMap
(WebhookSecret, UTCTime, WebhookSecret)
-> Maybe (WebhookSecret, UTCTime, WebhookSecret)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WebhookSecret
t, POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime) -> POSIXTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ Int -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
parsedTime, WebhookSecret
v1)
in case Maybe (WebhookSecret, UTCTime, WebhookSecret)
needed of
Maybe (WebhookSecret, UTCTime, WebhookSecret)
Nothing -> VerificationResult
VInvalidSignature
Just (WebhookSecret
rawTime, UTCTime
time, WebhookSecret
v1) ->
let payload :: WebhookSecret
payload = WebhookSecret
rawTime WebhookSecret -> WebhookSecret -> WebhookSecret
forall a. Semigroup a => a -> a -> a
<> Char -> WebhookSecret
BSC.singleton Char
'.' WebhookSecret -> WebhookSecret -> WebhookSecret
forall a. Semigroup a => a -> a -> a
<> WebhookSecret
rawBody
computedSig :: HMAC SHA256
computedSig :: HMAC SHA256
computedSig = WebhookSecret -> WebhookSecret -> HMAC SHA256
forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
hmac WebhookSecret
secret WebhookSecret
payload
hexSig :: WebhookSecret
hexSig = Base -> HMAC SHA256 -> WebhookSecret
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
convertToBase Base
Base16 HMAC SHA256
computedSig
in if WebhookSecret
hexSig WebhookSecret -> WebhookSecret -> Bool
forall a. Eq a => a -> a -> Bool
== WebhookSecret
v1
then UTCTime -> VerificationResult
VOk UTCTime
time
else VerificationResult
VFailed