servant-github-webhook 0.3.0.2 → 0.3.1.0
raw patch · 4 files changed
+66/−46 lines, 4 filesdep +cryptonitedep +memorydep −Cryptodep ~aesondep ~githubdep ~servantPVP ok
version bump matches the API change (PVP)
Dependencies added: cryptonite, memory
Dependencies removed: Crypto
Dependency ranges changed: aeson, github, servant, servant-server
API changes (from Hackage documentation)
Files
- ChangeLog.md +7/−0
- README.md +20/−9
- servant-github-webhook.cabal +8/−7
- src/Servant/GitHub/Webhook.hs +31/−30
ChangeLog.md view
@@ -1,5 +1,12 @@ # Revision history for servant-github-webhook +## 0.3.1.0 -- 2017-08-06++* Drop support for GHC <8.+* Drop support for Servant <0.11.+* Switch from Crypto package to cryptonite package.+* Now servant-github-webhook builds with stack.+ ## 0.3.0.0 -- 2016-09-22 * Pass reflected key index to the handler function for GitHubSignedReqBody.
README.md view
@@ -1,8 +1,9 @@-[](https://travis-ci.org/tsani/servant-github-webhook)- servant-github-webhook ====================== +[![Build Status][badge-travis]][travis]+[![Hackage][badge-hackage]][hackage]+ This library facilitates writing Servant routes that can safely act as GitHub webhooks. @@ -10,13 +11,23 @@ * Dispatching to routes based on the type of repository event. * Automatic verification of request signatures.+ * Route protection expressed in the type system, so webhook routes and+ regular routes cannot be confused. -See the-[documentation](https://hackage.haskell.org/package/servant-github-webhook-0.2.0.0/docs/Servant-GitHub-Webhook.html)-for more details about how the library works, and how to use it.+Why use servant-github-webhook?+------------------------------- -TODO------+A webhook server needs to be publicly hosted. How can legitimate requests sent+by GitHub be distinguished from (malicious) requests sent by other clients? - * `servant-client` and `servant-docs` instances.- * Tests.+When a webhook is configured on a repository, a *secret key* is added. This key+is used by GitHub to compute a *signature* of the request body that it sends;+this signature is included in the request headers. The routing combinators in+servant-github-webhook compute the signature of the received request body using+the same key, and check that the signature in the request headers matches. If+it does, then the request is legitimate.++[hackage]: https://hackage.haskell.org/package/servant-github-webhook+[badge-hackage]: https://img.shields.io/hackage/v/servant-github-webhook.svg+[travis]: https://travis-ci.org/tsani/servant-github-webhook?branch=master+[badge-travis]: https://travis-ci.org/tsani/servant-github-webhook.svg?branch=master
servant-github-webhook.cabal view
@@ -2,7 +2,7 @@ -- further documentation, see http://haskell.org/cabal/users-guide/ name: servant-github-webhook-version: 0.3.0.2+version: 0.3.1.0 synopsis: Servant combinators to facilitate writing GitHub webhooks. description: This package provides servant combinators that make writing safe GitHub@@ -19,7 +19,7 @@ copyright: Jacob Thomas Errington 2016 category: Web build-type: Simple-tested-with: GHC == 7.10.2, GHC == 7.10.3, GHC == 8.0.1+tested-with: GHC == 8.0.1, GHC == 8.0.2 extra-source-files: ChangeLog.md README.md@@ -41,14 +41,15 @@ ghc-options: -Wall build-depends:- aeson >=0.11 && <1.1,+ aeson >=0.11 && <1.2, base16-bytestring >=0.1 && <0.2, bytestring >= 0.10 && <0.11,- Crypto >=4.2 && <4.3,- github >=0.15 && <0.16,+ cryptonite >=0.23 && <0.25,+ github >=0.15 && <0.17, http-types >=0.9 && <0.10,- servant >=0.8 && <0.10,- servant-server >=0.8 && <0.10,+ memory >=0.14 && <0.15,+ servant >=0.11 && <0.12,+ servant-server >=0.11 && <0.12, string-conversions >=0.4 && <0.5, text >=1.2 && <1.3, wai >=3.2 && <3.3
src/Servant/GitHub/Webhook.hs view
@@ -38,8 +38,6 @@ retrieve. -} -{-# LANGUAGE CPP #-}- {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}@@ -48,21 +46,13 @@ {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} --- GHC 8 seems to have improved its decidability check for type family--- instances and class instances. In particular, without UndecidableInstances--- enabled, the Demote' instance for lists, which we need, will not compile.--- Similarly, the Reflect instance for Symbol, which just requires KnownSymbol,--- won't compile on GHC < 8 because the instance head is no smaller than the--- instance head.-#if __GLASGOW_HASKELL__ < 800-{-# LANGUAGE UndecidableInstances #-}-#endif- module Servant.GitHub.Webhook ( -- * Servant combinators GitHubSignedReqBody''@@ -101,11 +91,13 @@ ) where import Control.Monad.IO.Class ( liftIO )+import Crypto.Hash.Algorithms ( SHA1 )+import Crypto.MAC.HMAC ( hmac, HMAC(..) ) import Data.Aeson ( decode', encode )+import Data.ByteArray ( convert ) import qualified Data.ByteString as BS import Data.ByteString.Lazy ( fromStrict, toStrict ) import qualified Data.ByteString.Base16 as B16-import Data.HMAC ( hmac_sha1 ) import Data.List ( intercalate ) import Data.Maybe ( catMaybes, fromMaybe ) import Data.Monoid ( (<>) )@@ -222,36 +214,45 @@ -> Delayed env ((Demote key, result) -> Server sublayout) -> Router env route _ context subserver- = route (Proxy :: Proxy sublayout) context (addBodyCheck subserver go)+ = route (Proxy :: Proxy sublayout) context (addBodyCheck subserver ct go) where lookupSig = lookup "X-Hub-Signature" keyIndex :: Demote key keyIndex = reflect (Proxy :: Proxy key) - go :: DelayedIO (Demote key, result)- go = withRequest $ \req -> do+ ct :: DelayedIO (BS.ByteString, Maybe BS.ByteString, result)+ ct = withRequest $ \req -> do let hdrs = requestHeaders req- key <- BS.unpack <$>- liftIO (unGitHubKey (getContextEntry context) keyIndex)- msg <- BS.unpack <$> liftIO (toStrict <$> strictRequestBody req)- let sig = B16.encode $ BS.pack $ hmac_sha1 key msg- let contentTypeH = fromMaybe "application/octet-stream"- $ lookup hContentType $ hdrs+ let contentTypeH =+ fromMaybe "application/octet-stream" $ lookup hContentType hdrs++ msg <- liftIO (toStrict <$> strictRequestBody req)+ let mrqbody = handleCTypeH (Proxy :: Proxy list) (cs contentTypeH) $- fromStrict (BS.pack msg)+ fromStrict msg case mrqbody of Nothing -> delayedFailFatal err415 Just (Left e) -> delayedFailFatal err400 { errBody = cs e }- Just (Right v) -> case parseHeaderMaybe =<< lookupSig hdrs of- Nothing -> delayedFailFatal err401- Just h -> do- let h' = BS.drop 5 $ E.encodeUtf8 h -- remove "sha1=" prefix- if h' == sig- then pure (keyIndex, v)- else delayedFailFatal err401+ Just (Right v) -> pure (msg, lookupSig hdrs, v)++ go+ :: (BS.ByteString, Maybe BS.ByteString, result)+ -> DelayedIO (Demote key, result)+ go (msg, hdr, v) = do+ key <- liftIO (unGitHubKey (getContextEntry context) keyIndex)+ let sig =+ B16.encode $ convert $ hmacGetDigest $ hmac @_ @_ @SHA1 key msg++ case parseHeaderMaybe =<< hdr of+ Nothing -> delayedFailFatal err401+ Just h -> do+ let h' = BS.drop 5 $ E.encodeUtf8 h -- remove "sha1=" prefix+ if h' == sig+ then pure (keyIndex, v)+ else delayedFailFatal err401 instance forall sublayout context events. (Reflect events, HasServer sublayout context)