{-# LANGUAGE Trustworthy #-}
module GitHub.Data.Webhooks.Secure
( PayloadNotSecure(..)
, isSecurePayload
, assertSecurePayload
) where
import Crypto.Hash.Algorithms (SHA1)
import Crypto.MAC.HMAC (HMAC(..), hmac)
import Control.Monad (unless)
import Control.Exception (Exception, throwIO)
import Data.ByteArray (convert, constEq)
import Data.Data (Typeable)
import Data.Monoid ((<>))
import Data.Functor ((<$>))
import Data.ByteString (ByteString)
import Data.Text (Text)
import qualified Data.ByteString.Base16 as B16
import qualified Data.Text.Encoding as E
isSecurePayload
:: Text
-> Maybe Text
-> ByteString
-> Bool
isSecurePayload :: Text -> Maybe Text -> ByteString -> Bool
isSecurePayload Text
secret Maybe Text
shaOpt ByteString
payload = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
constEq ByteString
ourSig) Maybe ByteString
theirSig
where
hexDigest :: HMAC a -> ByteString
hexDigest = ByteString -> ByteString
B16.encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HMAC a -> Digest a
hmacGetDigest
theirSig :: Maybe ByteString
theirSig = Text -> ByteString
E.encodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
shaOpt
ourSig :: ByteString
ourSig = ByteString
"sha1=" forall a. Semigroup a => a -> a -> a
<> forall {a}. HMAC a -> ByteString
hexDigest (forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
hmac (Text -> ByteString
E.encodeUtf8 Text
secret) ByteString
payload :: HMAC SHA1)
data PayloadNotSecure = PayloadNotSecure
deriving (Typeable)
instance Exception PayloadNotSecure
instance Show PayloadNotSecure where
showsPrec :: Int -> PayloadNotSecure -> ShowS
showsPrec Int
_ PayloadNotSecure
PayloadNotSecure = String -> ShowS
showString String
"the origin of this request may not originate from GitHub"
assertSecurePayload
:: Text
-> Maybe Text
-> ByteString
-> IO ()
assertSecurePayload :: Text -> Maybe Text -> ByteString -> IO ()
assertSecurePayload Text
secret Maybe Text
shaOpt ByteString
payload = do
let secure :: Bool
secure = Text -> Maybe Text -> ByteString -> Bool
isSecurePayload Text
secret Maybe Text
shaOpt ByteString
payload
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
secure forall a b. (a -> b) -> a -> b
$! forall e a. Exception e => e -> IO a
throwIO PayloadNotSecure
PayloadNotSecure