-- | https://stripe.com/docs/webhooks/signatures#verify-manually
module Stripe.Signature
  ( Sig (..),
    isSigValid,
    digest,
    signedPayload,
    natBytes,
    parseSig,
  )
where

import Crypto.Hash.SHA256 qualified
import Data.ByteString (ByteString)
import Data.ByteString.Base16 qualified as Base16
import Data.List qualified
import Data.Maybe qualified
import Data.String qualified
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text
import Numeric.Natural (Natural)
import Stripe.Concepts (WebhookSecretKey (..))
import Text.Read qualified

isSigValid :: Sig -> WebhookSecretKey -> ByteString -> Bool
isSigValid :: Sig -> WebhookSecretKey -> ByteString -> Bool
isSigValid Sig
x WebhookSecretKey
secret ByteString
body =
  (ByteString -> Bool) -> [ByteString] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Data.List.any (ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
(==) ByteString
correctDigest) (Sig -> [ByteString]
sigV1 Sig
x)
  where
    correctDigest :: ByteString
correctDigest = WebhookSecretKey -> Natural -> ByteString -> ByteString
digest WebhookSecretKey
secret (Sig -> Natural
sigTime Sig
x) ByteString
body

digest :: WebhookSecretKey -> Natural -> ByteString -> ByteString
digest :: WebhookSecretKey -> Natural -> ByteString -> ByteString
digest (WebhookSecretKey ByteString
secret) Natural
time ByteString
body =
  ByteString -> ByteString -> ByteString
Crypto.Hash.SHA256.hmac ByteString
secret (Natural -> ByteString -> ByteString
signedPayload Natural
time ByteString
body)

signedPayload :: Natural -> ByteString -> ByteString
signedPayload :: Natural -> ByteString -> ByteString
signedPayload Natural
time ByteString
body =
  [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat
    [ Natural -> ByteString
natBytes Natural
time,
      String -> ByteString
encodeAscii String
".",
      ByteString
body
    ]

-- | Convert a natural number to the ASCII encoding of its decimal
-- representation.
natBytes :: Natural -> ByteString
natBytes :: Natural -> ByteString
natBytes = String -> ByteString
encodeAscii (String -> ByteString)
-> (Natural -> String) -> Natural -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Natural -> String
forall a. Show a => a -> String
show :: Natural -> String)

encodeAscii :: String -> ByteString
encodeAscii :: String -> ByteString
encodeAscii = String -> ByteString
forall a. IsString a => String -> a
Data.String.fromString

-- | The relevant bits of data extracted from the Stripe signature header.
data Sig = Sig
  { Sig -> Natural
sigTime :: Natural,
    Sig -> [ByteString]
sigV1 :: [ByteString]
  }

-- | Parse the Stripe signature header, returning 'Nothing' if parsing fails.
parseSig :: Text -> Maybe Sig
parseSig :: Text -> Maybe Sig
parseSig Text
txt =
  let parts :: [(Text, Text)]
      parts :: [(Text, Text)]
parts = Text -> [(Text, Text)]
splitSig Text
txt
   in do
        Natural
time <-
          Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
Data.List.lookup (String -> Text
Text.pack String
"t") [(Text, Text)]
parts
            Maybe Text -> (Text -> Maybe Natural) -> Maybe Natural
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Maybe Natural
readNatural (String -> Maybe Natural)
-> (Text -> String) -> Text -> Maybe Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack)

        let v1 :: [ByteString]
v1 =
              ((Text, Text) -> Maybe ByteString)
-> [(Text, Text)] -> [ByteString]
forall a b. (a -> Maybe b) -> [a] -> [b]
Data.Maybe.mapMaybe
                ( \(Text
k, Text
v) ->
                    if Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
Text.pack String
"v1"
                      then Text -> Maybe ByteString
decodeHex Text
v
                      else Maybe ByteString
forall a. Maybe a
Nothing
                )
                [(Text, Text)]
parts

        Sig -> Maybe Sig
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Sig {sigTime :: Natural
sigTime = Natural
time, sigV1 :: [ByteString]
sigV1 = [ByteString]
v1}

splitSig :: Text -> [(Text, Text)]
splitSig :: Text -> [(Text, Text)]
splitSig =
  [Maybe (Text, Text)] -> [(Text, Text)]
forall a. [Maybe a] -> [a]
Data.Maybe.catMaybes
    ([Maybe (Text, Text)] -> [(Text, Text)])
-> (Text -> [Maybe (Text, Text)]) -> Text -> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Maybe (Text, Text)) -> [Text] -> [Maybe (Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text -> Maybe (Text, Text)
split2 (String -> Text
Text.pack String
"="))
    ([Text] -> [Maybe (Text, Text)])
-> (Text -> [Text]) -> Text -> [Maybe (Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
Text.splitOn (String -> Text
Text.pack String
",")

split2 :: Text -> Text -> Maybe (Text, Text)
split2 :: Text -> Text -> Maybe (Text, Text)
split2 Text
pat Text
src =
  let (Text
x, Text
y) = HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
Text.breakOn Text
pat Text
src
      y' :: Text
y' = Int -> Text -> Text
Text.drop (Text -> Int
Text.length Text
pat) Text
y
   in if Text -> Bool
Text.null Text
y then Maybe (Text, Text)
forall a. Maybe a
Nothing else (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Text
x, Text
y')

-- | Parse a number consisting of one or more digits 0 through 9.
readNatural :: String -> Maybe Natural
readNatural :: String -> Maybe Natural
readNatural = String -> Maybe Natural
forall a. Read a => String -> Maybe a
Text.Read.readMaybe

-- | Decodes hexadecimal text as a byte string. The result is a 'Just' value iff
-- the text contains an even number of characters and consists only of the digits
-- @0@ through @9@ and letters @a@ through @f@.
decodeHex :: Text -> Maybe ByteString
decodeHex :: Text -> Maybe ByteString
decodeHex = (String -> Maybe ByteString)
-> (ByteString -> Maybe ByteString)
-> Either String ByteString
-> Maybe ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe ByteString -> String -> Maybe ByteString
forall a b. a -> b -> a
const Maybe ByteString
forall a. Maybe a
Nothing) ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Either String ByteString -> Maybe ByteString)
-> (Text -> Either String ByteString) -> Text -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
Base16.decode (ByteString -> Either String ByteString)
-> (Text -> ByteString) -> Text -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8