-- Hoogle documentation, generated by Haddock -- See Hoogle, http://www.haskell.org/hoogle/ -- | Servant combinators to facilitate writing GitHub webhooks. -- -- This package provides servant combinators that make writing safe -- GitHub webhooks very simple. -- -- It features automatic verification of the digital signatures provided -- by GitHub in the webhook HTTP requests as well as route dispatching -- based on repository event type. @package servant-github-webhook @version 0.4.2.0 -- | 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 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' 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. module Servant.GitHub.Webhook -- | 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 its kind k and hence -- proxy, which is . 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. data GitHubSignedReqBody'' (proxy :: KProxy k) (key :: k) (list :: [*]) (result :: *) -- | Convenient synonym for GitHubSignedReqBody'' that computes its -- first type argument given just the second one. -- -- Use this type synonym if you are creating a webhook server to handle -- webhooks from multiple repositories, with different secret keys. type GitHubSignedReqBody' (key :: k) = GitHubSignedReqBody'' ( 'KProxy :: KProxy k) key -- | A convenient alias for a trivial key index. -- -- USe this type synonym if you are creating a webhook server to handle -- only webhooks from a single repository, or for mutliple repositories -- using the same secret key. type GitHubSignedReqBody = GitHubSignedReqBody' '() -- | 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. data GitHubEvent (events :: [RepoWebhookEvent]) -- | 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 Demote -- k where k is the kind whose types are used as indices in -- GitHubSignedReqBody'. -- -- If you don't care about indices and just want to write a webhook using -- a global key, see GitHubKey' which fixes key to -- () and use gitHubKey, which fills the newtype with a -- constant function. newtype GitHubKey' key result GitHubKey :: (key -> result -> IO (Maybe ByteString)) -> GitHubKey' key result [unGitHubKey] :: GitHubKey' key result -> key -> result -> IO (Maybe ByteString) -- | A synonym for strategies producing so-called global keys, in -- which the key index is simply (). type GitHubKey result = GitHubKey' () result -- | Smart constructor for GitHubKey', for a so-called global -- key. gitHubKey :: IO ByteString -> GitHubKey result -- | dynamicKey keyLookup keyIdLookup acquires the key identifier, -- such as repository or user name, from the result then uses -- keyLookup to acquire the key (or Nothing). -- -- Dynamic keys allow servers to specify per-user repository keys. This -- limits the impact of compromized keys and allows the server to acquire -- the key from external sources, such as a live configuration or -- per-user rows in a database. dynamicKey :: (Text -> IO (Maybe ByteString)) -> (result -> Maybe Text) -> GitHubKey result repositoryKey :: HasRepository result => (Text -> IO (Maybe ByteString)) -> GitHubKey result -- | The HasRepository class helps extract the full (unique) "name/repo" of -- a repository, allowing easy lookup of a per-repository key or, using -- takeWhile (=''), lookup of per user keys. class HasRepository r -- | For use with 'github-webhooks' package types. Routes would look like: -- -- 
--   api = "github-webevent" :>
--       :> GitHubSignedReqBody '[JSON] (EventWithHookRepo IssuesEvent)
--       :> Post '[JSON] ()
--
-- -- And the handler would unwrap the event: -- -- 
--   handler :: EventWithHookRepo IssuesEvent -> Handler ()
--   handler (eventOf -> e) = -- ... expr handling e :: IssuesEvent ...
--
newtype EventWithHookRepo e EventWithHookRepo :: e -> EventWithHookRepo e [eventOf] :: EventWithHookRepo e -> e -- | See https://developer.github.com/webhooks/#events. data RepoWebhookEvent WebhookWildcardEvent :: RepoWebhookEvent WebhookCheckRunEvent :: RepoWebhookEvent WebhookCheckSuiteEvent :: RepoWebhookEvent WebhookCommitCommentEvent :: RepoWebhookEvent WebhookContentReferenceEvent :: RepoWebhookEvent WebhookCreateEvent :: RepoWebhookEvent WebhookDeleteEvent :: RepoWebhookEvent WebhookDeployKeyEvent :: RepoWebhookEvent WebhookDeploymentEvent :: RepoWebhookEvent WebhookDeploymentStatusEvent :: RepoWebhookEvent WebhookDownloadEvent :: RepoWebhookEvent WebhookFollowEvent :: RepoWebhookEvent WebhookForkEvent :: RepoWebhookEvent WebhookForkApplyEvent :: RepoWebhookEvent WebhookGitHubAppAuthorizationEvent :: RepoWebhookEvent WebhookGistEvent :: RepoWebhookEvent WebhookGollumEvent :: RepoWebhookEvent WebhookInstallationEvent :: RepoWebhookEvent WebhookInstallationRepositoriesEvent :: RepoWebhookEvent WebhookIssueCommentEvent :: RepoWebhookEvent WebhookIssuesEvent :: RepoWebhookEvent WebhookLabelEvent :: RepoWebhookEvent WebhookMarketplacePurchaseEvent :: RepoWebhookEvent WebhookMemberEvent :: RepoWebhookEvent WebhookMembershipEvent :: RepoWebhookEvent WebhookMetaEvent :: RepoWebhookEvent WebhookMilestoneEvent :: RepoWebhookEvent WebhookOrganizationEvent :: RepoWebhookEvent WebhookOrgBlockEvent :: RepoWebhookEvent WebhookPageBuildEvent :: RepoWebhookEvent WebhookPingEvent :: RepoWebhookEvent WebhookProjectCardEvent :: RepoWebhookEvent WebhookProjectColumnEvent :: RepoWebhookEvent WebhookProjectEvent :: RepoWebhookEvent WebhookPublicEvent :: RepoWebhookEvent WebhookPullRequestEvent :: RepoWebhookEvent WebhookPullRequestReviewEvent :: RepoWebhookEvent WebhookPullRequestReviewCommentEvent :: RepoWebhookEvent WebhookPushEvent :: RepoWebhookEvent WebhookRegistryPackageEvent :: RepoWebhookEvent WebhookReleaseEvent :: RepoWebhookEvent WebhookRepositoryEvent :: RepoWebhookEvent WebhookRepositoryImportEvent :: RepoWebhookEvent WebhookRepositoryVulnerabilityAlertEvent :: RepoWebhookEvent WebhookSecurityAdvisoryEvent :: RepoWebhookEvent WebhookStarEvent :: RepoWebhookEvent WebhookStatusEvent :: RepoWebhookEvent WebhookTeamEvent :: RepoWebhookEvent WebhookTeamAddEvent :: RepoWebhookEvent WebhookWatchEvent :: 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 data KProxy t KProxy :: KProxy t -- | Convient alias for Demote' that allows us to avoid using -- KProxy explicitly. type Demote (a :: k) = Demote' ( 'KProxy :: KProxy k) -- | Type function that reflects a kind to a type. type family Demote' (kparam :: KProxy k) :: * -- | Class of types that can be reflected to values. class Reflect (a :: k) reflect :: Reflect a => Proxy (a :: k) -> Demote a -- | Helper that parses a header using a FromHttpApiData instance -- and discards the parse error message if any. parseHeaderMaybe :: FromHttpApiData a => ByteString -> Maybe a -- | 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. matchEvent :: RepoWebhookEvent -> ByteString -> Maybe RepoWebhookEvent instance forall k sublayout (context :: [*]) (key :: k) result (list :: [*]). (Servant.Server.Internal.HasServer sublayout context, Servant.Server.Internal.Context.HasContextEntry context (Servant.GitHub.Webhook.GitHubKey' (Servant.GitHub.Webhook.Demote key) result), Servant.GitHub.Webhook.Reflect key, Servant.API.ContentTypes.AllCTUnrender list result) => Servant.Server.Internal.HasServer (Servant.GitHub.Webhook.GitHubSignedReqBody'' 'Data.Proxy.KProxy key list result Servant.API.Sub.:> sublayout) context instance (Servant.GitHub.Webhook.Reflect events, Servant.Server.Internal.HasServer sublayout context) => Servant.Server.Internal.HasServer (Servant.GitHub.Webhook.GitHubEvent events Servant.API.Sub.:> sublayout) context instance GHC.TypeLits.KnownSymbol s => Servant.GitHub.Webhook.Reflect s instance Servant.GitHub.Webhook.Reflect '() instance Servant.GitHub.Webhook.Reflect '[] instance forall a (x :: a) (xs :: [a]). (Servant.GitHub.Webhook.Reflect x, Servant.GitHub.Webhook.Reflect xs) => Servant.GitHub.Webhook.Reflect (x : xs) instance Servant.GitHub.Webhook.Reflect 'GitHub.Data.Webhooks.WebhookWildcardEvent instance Servant.GitHub.Webhook.Reflect 'GitHub.Data.Webhooks.WebhookCommitCommentEvent instance Servant.GitHub.Webhook.Reflect 'GitHub.Data.Webhooks.WebhookCreateEvent instance Servant.GitHub.Webhook.Reflect 'GitHub.Data.Webhooks.WebhookDeleteEvent instance Servant.GitHub.Webhook.Reflect 'GitHub.Data.Webhooks.WebhookDeploymentEvent instance Servant.GitHub.Webhook.Reflect 'GitHub.Data.Webhooks.WebhookDeploymentStatusEvent instance Servant.GitHub.Webhook.Reflect 'GitHub.Data.Webhooks.WebhookForkEvent instance Servant.GitHub.Webhook.Reflect 'GitHub.Data.Webhooks.WebhookGollumEvent instance Servant.GitHub.Webhook.Reflect 'GitHub.Data.Webhooks.WebhookInstallationEvent instance Servant.GitHub.Webhook.Reflect 'GitHub.Data.Webhooks.WebhookInstallationRepositoriesEvent instance Servant.GitHub.Webhook.Reflect 'GitHub.Data.Webhooks.WebhookIssueCommentEvent instance Servant.GitHub.Webhook.Reflect 'GitHub.Data.Webhooks.WebhookIssuesEvent instance Servant.GitHub.Webhook.Reflect 'GitHub.Data.Webhooks.WebhookMemberEvent instance Servant.GitHub.Webhook.Reflect 'GitHub.Data.Webhooks.WebhookPageBuildEvent instance Servant.GitHub.Webhook.Reflect 'GitHub.Data.Webhooks.WebhookPingEvent instance Servant.GitHub.Webhook.Reflect 'GitHub.Data.Webhooks.WebhookPublicEvent instance Servant.GitHub.Webhook.Reflect 'GitHub.Data.Webhooks.WebhookPullRequestReviewCommentEvent instance Servant.GitHub.Webhook.Reflect 'GitHub.Data.Webhooks.WebhookPullRequestEvent instance Servant.GitHub.Webhook.Reflect 'GitHub.Data.Webhooks.WebhookPushEvent instance Servant.GitHub.Webhook.Reflect 'GitHub.Data.Webhooks.WebhookReleaseEvent instance Servant.GitHub.Webhook.Reflect 'GitHub.Data.Webhooks.WebhookStatusEvent instance Servant.GitHub.Webhook.Reflect 'GitHub.Data.Webhooks.WebhookTeamAddEvent instance Servant.GitHub.Webhook.Reflect 'GitHub.Data.Webhooks.WebhookWatchEvent instance Data.Aeson.Types.FromJSON.FromJSON e => Data.Aeson.Types.FromJSON.FromJSON (Servant.GitHub.Webhook.EventWithHookRepo e) instance GitHub.Data.Webhooks.Events.EventHasRepo e => Servant.GitHub.Webhook.HasRepository (Servant.GitHub.Webhook.EventWithHookRepo e) instance Servant.GitHub.Webhook.HasRepository Data.Aeson.Types.Internal.Value instance Servant.GitHub.Webhook.HasRepository Data.Aeson.Types.Internal.Object