| Copyright | (c) Jacob Thomas Errington 2016 |
|---|---|
| License | MIT |
| Maintainer | servant-github-webhook@mail.jerrington.me |
| Stability | experimental |
| Safe Haskell | None |
| Language | Haskell2010 |
Servant.GitHub.Webhook
Contents
Description
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 for the most part; 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
RepoWebhookEvents, 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 '[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.
- data GitHubSignedReqBody list result
- data GitHubEvent events
- newtype GitHubKey = GitHubKey {}
- data RepoWebhookEvent :: *
- = WebhookWildcardEvent
- | WebhookCommitCommentEvent
- | WebhookCreateEvent
- | WebhookDeleteEvent
- | WebhookDeploymentEvent
- | WebhookDeploymentStatusEvent
- | WebhookForkEvent
- | WebhookGollumEvent
- | WebhookIssueCommentEvent
- | WebhookIssuesEvent
- | WebhookMemberEvent
- | WebhookPageBuildEvent
- | WebhookPingEvent
- | WebhookPublicEvent
- | WebhookPullRequestReviewCommentEvent
- | WebhookPullRequestEvent
- | WebhookPushEvent
- | WebhookReleaseEvent
- | WebhookStatusEvent
- | WebhookTeamAddEvent
- | WebhookWatchEvent
- type Demote a = Demote' (KProxy :: KProxy k)
- class Reflect a where
- parseHeaderMaybe :: FromHttpApiData a => ByteString -> Maybe a
- matchEvent :: RepoWebhookEvent -> ByteString -> Maybe RepoWebhookEvent
Combinators
data GitHubSignedReqBody 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 a
GitHubKey entry. 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.
Instances
| (HasServer k sublayout context, HasContextEntry context GitHubKey, AllCTUnrender list result) => HasServer * ((:>) k * (GitHubSignedReqBody list result) sublayout) context Source # | |
| type ServerT * ((:>) k * (GitHubSignedReqBody list result) sublayout) m Source # | |
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.
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.
Constructors
| GitHubKey | |
Fields | |
Example
import Data.Aeson ( Object )
import qualified Data.ByteString as BS
import Servant.GitHub.Webhook
import Servant.Server
import Network.Wai ( Application )
import Network.Wai.Handler.Warp ( run )
main :: IO ()
main = do
key <- BS.init <$> BS.readFile "hook-secret"
run 8080 (app (GitHubKey $ pure key))
app :: GitHubKey -> Application
app key
= serveWithContext
(Proxy :: Proxy API)
(key :. EmptyContext)
server
server :: Server API
server = pushEvent
pushEvent :: RepoWebHookEvent -> Object -> Handler ()
pushEvent _ _
= liftIO $ putStrLn "someone pushed to servant-github-webhook!"
type API
=
:<|> "servant-github-webhook"
:> GitHubEvent '[ 'WebhookPushEvent ]
:> GitHubSignedReqBody '[JSON] Object
:> Post '[JSON] ()GitHub library reexports
data RepoWebhookEvent :: * #
Constructors
Instances
Implementation details
Type-level programming machinery
class Reflect a where Source #
Class of types that can be reflected to values.
Minimal complete definition
Instances
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.