WIP #2: Provide utilities to validate the secret key

github-webhooks.cabal

@@ -2,7 +2,7 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 5615459135d4ff74ceec05176fb1708f3f5c7b50dd4184b4d462e62af6bbdb17
+-- hash: f7a90de8da51ba7bfe8b932cd2e197309c530257d3ed031c1d776ccb5cd7f39e
 
 name:           github-webhooks
 version:        0.9.0
@@ -36,14 +36,19 @@ library
   build-depends:
       aeson
     , base ==4.*
+    , base16-bytestring
+    , bytestring
+    , cryptonite
     , deepseq
     , deepseq-generics
+    , memory
     , text
     , time
     , vector
   exposed-modules:
       GitHub.Data.Webhooks.Events
       GitHub.Data.Webhooks.Payload
+      GitHub.Data.Webhooks.Secure
   other-modules:
       Paths_github_webhooks
   default-language: Haskell2010

package.yaml

@@ -29,14 +29,18 @@ default-extensions:
 dependencies:
  - base == 4.*
  - aeson
+ - bytestring
  - text
  - vector
 
 library:
   source-dirs: src
   dependencies:
+    - base16-bytestring
+    - cryptonite
     - deepseq
     - deepseq-generics
+    - memory
     - time
 
 tests:
@@ -46,6 +50,5 @@ tests:
     dependencies:
       - github-webhooks
       - hspec == 2.*
-      - bytestring
     default-extensions:
       - ScopedTypeVariables

src/GitHub/Data/Webhooks/Secure.hs

@@ -0,0 +1,52 @@
+-- See <https://developer.github.com/webhooks/securing/>.
+module GitHub.Data.Webhooks.Secure
+    ( 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.Monoid              ((<>))
+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 secret shaOpt payload = maybe False (constEq ourSig) theirSig
+    where
+      hexDigest = B16.encode . convert . hmacGetDigest
+      theirSig = E.encodeUtf8 <$> shaOpt
+      ourSig = "sha1=" <> hexDigest (hmac (E.encodeUtf8 secret) payload :: HMAC SHA1)
+
+
+-- | An exception indicating that the given payload is not secure.
+data PayloadNotSecure = PayloadNotSecure
+
+instance Exception PayloadNotSecure
+
+instance Show PayloadNotSecure where
+    showsPrec _ PayloadNotSecure = showString "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 secret shaOpt payload = do
+    let secure = isSecurePayload secret shaOpt payload
+    unless secure $! throwIO PayloadNotSecure