Copyright | (c) Jacob Thomas Errington, 2016 |
---|---|
License | MIT |
Maintainer | servant-github-webhook@mail.jerrington.me |
Stability | experimental |
Safe Haskell | None |
Language | Haskell2010 |
The GitHub webhook machinery will attach three headers to the HTTP requests
that it fires: X-Github-Event
, X-Hub-Signature
, and X-Github-Delivery
.
The former two headers correspond with the GitHubEvent
and
GitHubSignedReqBody''
routing combinators. This library ignores the
X-Github-Delivery
header; if you would like to access its value, then use the
builtin Header
combinator from Servant.
Usage of the library is straightforward: protect routes with the GitHubEvent
combinator to ensure that the route is only reached for specific
RepoWebhookEvent
s, and replace any ReqBody
combinators you would write
under that route with GitHubSignedReqBody''
. It is advised to always include
a GitHubSignedReqBody''
, as this is the only way you can be sure that it is
GitHub who is sending the request, and not a malicious user. If you don't care
about the request body, then simply use Aeson's Object
type as the
deserialization target -- GitHubSignedReqBody' key '[JSON] Object
-- and
ignore the Object
in the handler.
The GitHubSignedReqBody
combinator makes use of the Servant Context
in
order to extract the signing key. This is the same key that must be entered in
the configuration of the webhook on GitHub. See 'GitHubKey\'' for more details.
In order to support multiple keys on a per-route basis, the basic combinator
GitHubSignedReqBody''
takes as a type parameter as a key index. To use this,
create a datatype, e.g. KeyIndex
whose constructors identify the different
keys you will be using. Generally, this means one constructor per repository.
Use the DataKinds
extension to promote this datatype to a kind, and write an
instance of Reflect
for each promoted constructor of your datatype. Finally,
create a Context
containing GitHubKey'
whose wrapped function's domain is
the datatype you've built up. Thus, your function can determine which key to
retrieve.
- data GitHubSignedReqBody'' proxy key list result
- type GitHubSignedReqBody' key = GitHubSignedReqBody'' (KProxy :: KProxy k) key
- type GitHubSignedReqBody = GitHubSignedReqBody' ()
- data GitHubEvent events
- newtype GitHubKey' key = GitHubKey {
- unGitHubKey :: key -> IO ByteString
- type GitHubKey = GitHubKey' ()
- gitHubKey :: IO ByteString -> GitHubKey
- data RepoWebhookEvent :: *
- = WebhookWildcardEvent
- | WebhookCommitCommentEvent
- | WebhookCreateEvent
- | WebhookDeleteEvent
- | WebhookDeploymentEvent
- | WebhookDeploymentStatusEvent
- | WebhookForkEvent
- | WebhookGollumEvent
- | WebhookIssueCommentEvent
- | WebhookIssuesEvent
- | WebhookMemberEvent
- | WebhookPageBuildEvent
- | WebhookPingEvent
- | WebhookPublicEvent
- | WebhookPullRequestReviewCommentEvent
- | WebhookPullRequestEvent
- | WebhookPushEvent
- | WebhookReleaseEvent
- | WebhookStatusEvent
- | WebhookTeamAddEvent
- | WebhookWatchEvent
- data KProxy t :: * -> * = KProxy
- type Demote a = Demote' (KProxy :: KProxy k)
- type family Demote' (kparam :: KProxy k) :: *
- class Reflect a where
- parseHeaderMaybe :: FromHttpApiData a => ByteString -> Maybe a
- matchEvent :: RepoWebhookEvent -> ByteString -> Maybe RepoWebhookEvent
Servant combinators
data GitHubSignedReqBody'' proxy key list result Source #
A clone of Servant's ReqBody
combinator, except that it will also
verify the signature provided by GitHub in the X-Hub-Signature
header by
computing the SHA1 HMAC of the request body and comparing.
The use of this combinator will require that the router context contain an
appropriate GitHubKey'
entry. Specifically, the type parameter of
GitHubKey'
must correspond with Demote k$ where
k is the kind of the
index
key@ used here. Consequently, it will be necessary to use
serveWithContext
instead of serve
.
Other routes are not tried upon the failure of this combinator, and a 401 response is generated.
Use of this datatype directly is discouraged, since the choice of the index
key
determines k
and hence proxy
. Instead, use GitHubSignedReqBody'
,
which computes the proxy argument given just key$. The proxy argument is
necessary to avoid
UndecidableInstances@ for the implementation of the
HasServer
instance for the datatype.
(HasServer k1 sublayout context, HasContextEntry context (GitHubKey' (Demote k key)), Reflect k key, AllCTUnrender list result) => HasServer * ((:>) * k1 (GitHubSignedReqBody'' k (KProxy k) key list result) sublayout) context Source # | |
type ServerT * ((:>) * k1 (GitHubSignedReqBody'' k (KProxy k) key list result) sublayout) m Source # | |
type GitHubSignedReqBody' key = GitHubSignedReqBody'' (KProxy :: KProxy k) key Source #
Convenient synonym for GitHubSignedReqBody''
that computes its first
type argument given just the second one.
type GitHubSignedReqBody = GitHubSignedReqBody' () Source #
A convenient alias for a trivial key index.
data GitHubEvent events Source #
A routing combinator that succeeds only for a webhook request that matches
one of the given RepoWebhookEvent
given in the type-level list events
.
If the list contains WebhookWildcardEvent
, then all events will be
matched.
The combinator will require that its associated handler take a
RepoWebhookEvent
parameter, and the matched event will be passed to the
handler. This allows the handler to determine which event triggered it from
the list.
Other routes are tried if there is a mismatch.
Security
newtype GitHubKey' key Source #
A wrapper for an IO strategy to obtain the signing key for the webhook as
configured in GitHub. The strategy is executed each time the
GitHubSignedReqBody'
s routing logic is executed.
We allow the use of IO
here so that you can fetch the key from a cache or
a database. If the key is a constant or read only once, just use pure
.
The type key
used here must correspond with
where Demote
kk
is the
kind whose types are used as indices in GitHubSignedReqBody'
.
If you don't care about indices and just want to write a webhooks using a
global key, see GitHubKey
which fixes key
to ()
and use gitHubKey
,
which fills the newtype with a constant function.
GitHubKey | |
|
type GitHubKey = GitHubKey' () Source #
A synonym for strategies producing so-called global keys, in which the
key index is simply ()
.
gitHubKey :: IO ByteString -> GitHubKey Source #
Smart constructor for GitHubKey
, for a so-called global key.
Reexports
We reexport a few datatypes that are typically needed to use the library.
data RepoWebhookEvent :: * #
A concrete, promotable proxy type, for use at the kind level There are no instances for this because it is intended at the kind level only
Implementation details
Type-level programming machinery
class Reflect a where Source #
Class of types that can be reflected to values.
Stringy stuff
parseHeaderMaybe :: FromHttpApiData a => ByteString -> Maybe a Source #
Helper that parses a header using a FromHttpApiData
instance and
discards the parse error message if any.
matchEvent :: RepoWebhookEvent -> ByteString -> Maybe RepoWebhookEvent Source #
Determines whether a given webhook event matches a given raw
representation of one. The result is Nothing
if there is no match. This
function accounts for the WebhookWildcardEvent
matching everything, so it
returns the result of parsing the raw representation when trying to match
against the wildcard.
Examples
Using a global key
{-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} import Control.Monad.IO.Class ( liftIO ) import Data.Aeson ( Object ) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as C8 import Servant import Servant.GitHub.Webhook import Network.Wai ( Application ) import Network.Wai.Handler.Warp ( run ) main :: IO () main = do [key, _] <- C8.lines <$> BS.readFile "test/test-keys" run 8080 (app (gitHubKey $ pure key)) app :: GitHubKey -> Application app key = serveWithContext (Proxy :: Proxy API) (key :. EmptyContext) server server :: Server API server = anyEvent anyEvent :: RepoWebhookEvent -> Object -> Handler () anyEvent e _ = liftIO $ putStrLn $ "got event: " ++ show e type API = "repo1" :> GitHubEvent '[ 'WebhookPushEvent ] :> GitHubSignedReqBody '[JSON] Object :> Post '[JSON] ()
{-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} module Main ( main ) where import Control.Monad.IO.Class ( liftIO ) import Data.Aeson ( Object ) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as C8 import Network.Wai ( Application ) import Network.Wai.Handler.Warp ( run ) import Servant import Servant.GitHub.Webhook main :: IO () main = do [k1, k2] <- C8.lines <$> BS.readFile "test/test-keys" run 8080 (app (constKeys k1 k2)) app :: MyGitHubKey -> Application app k = serveWithContext api (k :. EmptyContext) server server :: Server WebhookApi server = (repo1ping :<|> repo1any) :<|> repo2any repo1ping :: RepoWebhookEvent -> Object -> Handler () repo1ping _ _ = liftIO $ putStrLn "got ping on repo1!" repo1any :: RepoWebhookEvent -> Object -> Handler () repo1any e _ = liftIO $ putStrLn $ "got event on repo 1: " ++ show e repo2any :: RepoWebhookEvent -> Object -> Handler () repo2any e _ = liftIO $ putStrLn $ "got event on repo 2: " ++ show e api :: Proxy WebhookApi api = Proxy type WebhookApi = "repo1" :> ( GitHubEvent '[ 'WebhookPingEvent ] :> GitHubSignedReqBody' 'Repo1 '[JSON] Object :> Post '[JSON] () :<|> GitHubEvent '[ 'WebhookWildcardEvent ] :> GitHubSignedReqBody' 'Repo1 '[JSON] Object :> Post '[JSON] () ) :<|> "repo2" :> GitHubEvent '[ 'WebhookWildcardEvent ] :> GitHubSignedReqBody' 'Repo2 '[JSON] Object :> Post '[JSON] () type MyGitHubKey = GitHubKey' Key data Key = Repo1 | Repo2 constKeys :: BS.ByteString -> BS.ByteString -> MyGitHubKey constKeys k1 k2 = GitHubKey $ \k -> pure $ case k of Repo1 -> k1 Repo2 -> k2 type instance Demote' ('KProxy :: KProxy Key) = Key instance Reflect 'Repo1 where reflect _ = Repo1 instance Reflect 'Repo2 where reflect _ = Repo2