{- | https://stripe.com/docs/webhooks/signatures#verify-manually -}

module Stripe.Signature
  ( Sig (..), isSigValid, digest, signedPayload, natBytes, parseSig
  ) where

-- base
import qualified Data.List
import qualified Data.Maybe
import qualified Data.String
import           Numeric.Natural (Natural)
import qualified Text.Read

-- base16-bytestring
import qualified Data.ByteString.Base16 as Base16

-- bytestring
import Data.ByteString (ByteString)

-- cryptohash-sha256
import qualified Crypto.Hash.SHA256

-- stripe-concepts
import Stripe.Concepts (WebhookSecretKey (..))

-- text
import           Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text

isSigValid :: Sig -> WebhookSecretKey -> ByteString -> Bool
isSigValid :: Sig -> WebhookSecretKey -> ByteString -> Bool
isSigValid Sig
x WebhookSecretKey
secret ByteString
body =
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Data.List.any (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 =
    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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Show a => a -> String
show :: Natural -> String)

encodeAscii :: String -> ByteString
encodeAscii :: String -> ByteString
encodeAscii = 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 <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
Data.List.lookup (String -> Text
Text.pack String
"t") [(Text, Text)]
parts
                    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Maybe Natural
readNatural forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack)

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

      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 =
    forall a. [Maybe a] -> [a]
Data.Maybe.catMaybes
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text -> Maybe (Text, Text)
split2 (String -> Text
Text.pack String
"="))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) = 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 forall a. Maybe a
Nothing else 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 = forall a. Read a => String -> Maybe a
Text.Read.readMaybe

{- | Decodes hexidecimal 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 = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
Base16.decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8