{-# LANGUAGE Trustworthy #-}
{-|
Module      : Github.Data.Webhooks.Secure
Copyright   : (c) Cuedo Control Engineering 2017-2022
License     : MIT
Maintainer  : Kyle Van Berendonck <foss@cuedo.com.au>

See <https://developer.github.com/webhooks/securing/>.
-}
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


-- The implementation of this module is partially lifted from the @github@ package.



-- | Returns 'True' if the given HMAC digest (passed in the @X-Hub-Signature@ header)

-- agrees with the provided secret and request body. If not, this request may be forged.

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)


-- | An exception indicating that the given payload is not secure.

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"

-- | Like 'isSecurePayload', but throws 'PayloadNotSecure' if the payload is not secure.

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