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

-- | Your webhook secret, can be obtained from the Stripe dashboard. Format: @whsec_<redacted>@
type WebhookSecret = BS.ByteString

-- | Output of the webhook signature verification
data VerificationResult
  = VOk UTCTime
  -- ^ Signature verification successful, check the time against the current time and reject /too old/ requests.
  | VFailed
  -- ^ Signature verification failed. Check that your 'WebhookSecret' is correct.
  | VInvalidSignature
  -- ^ Invalid signature. Verify that you are passing the raw contents of the @stripe-signature@ header.
  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)

-- | Verify the @stripe-signature@ header
verifyStripeSignature ::
  WebhookSecret
  -- ^ Your webhook secret
  -> BS.ByteString
  -- ^ Value of the @stripe-signature@ header
  -> BS.ByteString
  -- ^ Raw request body received from Stripe
  -> 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