module Stripe.Signature
( Sig (..), isSigValid, digest, signedPayload, natBytes, parseSig
) where
import qualified Data.List
import qualified Data.Maybe
import qualified Data.String
import Numeric.Natural (Natural)
import qualified Text.Read
import qualified Data.ByteString.Base16 as Base16
import Data.ByteString (ByteString)
import qualified Crypto.Hash.SHA256
import Stripe.Concepts (WebhookSecretKey (..))
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
]
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
data Sig =
Sig
{ Sig -> Natural
sigTime :: Natural
, Sig -> [ByteString]
sigV1 :: [ByteString]
}
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')
readNatural :: String -> Maybe Natural
readNatural :: String -> Maybe Natural
readNatural = forall a. Read a => String -> Maybe a
Text.Read.readMaybe
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