servant-github-webhook-0.1.0.0: Servant combinators to facilitate writing GitHub webhooks.

Copyright(c) Jacob Thomas Errington 2016
LicenseMIT
Maintainerservant-github-webhook@mail.jerrington.me
Stabilityexperimental
Safe HaskellNone
LanguageHaskell2010

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.

Synopsis

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 # 

Associated Types

type ServerT ((:>) k * (GitHubSignedReqBody list result) sublayout) (context :: (:>) k * (GitHubSignedReqBody list result) sublayout) (m :: * -> *) :: * #

Methods

route :: Proxy ((k :> *) (GitHubSignedReqBody list result) sublayout) context -> Context context -> Delayed env (Server ((k :> *) (GitHubSignedReqBody list result) sublayout) context) -> Router env #

type ServerT * ((:>) k * (GitHubSignedReqBody list result) sublayout) m Source # 
type ServerT * ((:>) k * (GitHubSignedReqBody list result) sublayout) m = result -> ServerT k sublayout m

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.

Instances

(Reflect [RepoWebhookEvent] events, HasServer k sublayout context) => HasServer * ((:>) k * (GitHubEvent events) sublayout) context Source # 

Associated Types

type ServerT ((:>) k * (GitHubEvent events) sublayout) (context :: (:>) k * (GitHubEvent events) sublayout) (m :: * -> *) :: * #

Methods

route :: Proxy ((k :> *) (GitHubEvent events) sublayout) context -> Context context -> Delayed env (Server ((k :> *) (GitHubEvent events) sublayout) context) -> Router env #

type ServerT * ((:>) k * (GitHubEvent events) sublayout) m Source # 
type ServerT * ((:>) k * (GitHubEvent events) sublayout) m = RepoWebhookEvent -> ServerT k sublayout m

newtype GitHubKey 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.

Constructors

GitHubKey 

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 :: * #

Instances

Eq RepoWebhookEvent 
Data RepoWebhookEvent 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> RepoWebhookEvent -> c RepoWebhookEvent #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c RepoWebhookEvent #

toConstr :: RepoWebhookEvent -> Constr #

dataTypeOf :: RepoWebhookEvent -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c RepoWebhookEvent) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RepoWebhookEvent) #

gmapT :: (forall b. Data b => b -> b) -> RepoWebhookEvent -> RepoWebhookEvent #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> RepoWebhookEvent -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> RepoWebhookEvent -> r #

gmapQ :: (forall d. Data d => d -> u) -> RepoWebhookEvent -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> RepoWebhookEvent -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> RepoWebhookEvent -> m RepoWebhookEvent #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> RepoWebhookEvent -> m RepoWebhookEvent #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> RepoWebhookEvent -> m RepoWebhookEvent #

Ord RepoWebhookEvent 
Show RepoWebhookEvent 
Generic RepoWebhookEvent 
ToJSON RepoWebhookEvent 
FromJSON RepoWebhookEvent 
Binary RepoWebhookEvent 
NFData RepoWebhookEvent 

Methods

rnf :: RepoWebhookEvent -> () #

Reflect RepoWebhookEvent WebhookWatchEvent Source # 
Reflect RepoWebhookEvent WebhookTeamAddEvent Source # 
Reflect RepoWebhookEvent WebhookStatusEvent Source # 
Reflect RepoWebhookEvent WebhookReleaseEvent Source # 
Reflect RepoWebhookEvent WebhookPushEvent Source # 
Reflect RepoWebhookEvent WebhookPullRequestEvent Source # 
Reflect RepoWebhookEvent WebhookPullRequestReviewCommentEvent Source # 
Reflect RepoWebhookEvent WebhookPublicEvent Source # 
Reflect RepoWebhookEvent WebhookPageBuildEvent Source # 
Reflect RepoWebhookEvent WebhookMemberEvent Source # 
Reflect RepoWebhookEvent WebhookIssuesEvent Source # 
Reflect RepoWebhookEvent WebhookIssueCommentEvent Source # 
Reflect RepoWebhookEvent WebhookGollumEvent Source # 
Reflect RepoWebhookEvent WebhookForkEvent Source # 
Reflect RepoWebhookEvent WebhookDeploymentStatusEvent Source # 
Reflect RepoWebhookEvent WebhookDeploymentEvent Source # 
Reflect RepoWebhookEvent WebhookDeleteEvent Source # 
Reflect RepoWebhookEvent WebhookCreateEvent Source # 
Reflect RepoWebhookEvent WebhookCommitCommentEvent Source # 
Reflect RepoWebhookEvent WebhookWildcardEvent Source # 
type Rep RepoWebhookEvent 
type Rep RepoWebhookEvent = D1 (MetaData "RepoWebhookEvent" "GitHub.Data.Webhooks" "github-0.15.0-IOpW6sFDZDCFPivSSbrr5H" False) ((:+:) ((:+:) ((:+:) ((:+:) (C1 (MetaCons "WebhookWildcardEvent" PrefixI False) U1) (C1 (MetaCons "WebhookCommitCommentEvent" PrefixI False) U1)) ((:+:) (C1 (MetaCons "WebhookCreateEvent" PrefixI False) U1) ((:+:) (C1 (MetaCons "WebhookDeleteEvent" PrefixI False) U1) (C1 (MetaCons "WebhookDeploymentEvent" PrefixI False) U1)))) ((:+:) ((:+:) (C1 (MetaCons "WebhookDeploymentStatusEvent" PrefixI False) U1) (C1 (MetaCons "WebhookForkEvent" PrefixI False) U1)) ((:+:) (C1 (MetaCons "WebhookGollumEvent" PrefixI False) U1) ((:+:) (C1 (MetaCons "WebhookIssueCommentEvent" PrefixI False) U1) (C1 (MetaCons "WebhookIssuesEvent" PrefixI False) U1))))) ((:+:) ((:+:) ((:+:) (C1 (MetaCons "WebhookMemberEvent" PrefixI False) U1) (C1 (MetaCons "WebhookPageBuildEvent" PrefixI False) U1)) ((:+:) (C1 (MetaCons "WebhookPingEvent" PrefixI False) U1) ((:+:) (C1 (MetaCons "WebhookPublicEvent" PrefixI False) U1) (C1 (MetaCons "WebhookPullRequestReviewCommentEvent" PrefixI False) U1)))) ((:+:) ((:+:) (C1 (MetaCons "WebhookPullRequestEvent" PrefixI False) U1) ((:+:) (C1 (MetaCons "WebhookPushEvent" PrefixI False) U1) (C1 (MetaCons "WebhookReleaseEvent" PrefixI False) U1))) ((:+:) (C1 (MetaCons "WebhookStatusEvent" PrefixI False) U1) ((:+:) (C1 (MetaCons "WebhookTeamAddEvent" PrefixI False) U1) (C1 (MetaCons "WebhookWatchEvent" PrefixI False) U1))))))

Implementation details

Type-level programming machinery

type Demote a = Demote' (KProxy :: KProxy k) Source #

class Reflect a where Source #

Class of types that can be reflected to values.

Minimal complete definition

reflect

Methods

reflect :: Proxy (a :: k) -> Demote a Source #

Instances

KnownSymbol s => Reflect Symbol s Source # 

Methods

reflect :: Proxy s a -> Demote s a Source #

Reflect RepoWebhookEvent WebhookWatchEvent Source # 
Reflect RepoWebhookEvent WebhookTeamAddEvent Source # 
Reflect RepoWebhookEvent WebhookStatusEvent Source # 
Reflect RepoWebhookEvent WebhookReleaseEvent Source # 
Reflect RepoWebhookEvent WebhookPushEvent Source # 
Reflect RepoWebhookEvent WebhookPullRequestEvent Source # 
Reflect RepoWebhookEvent WebhookPullRequestReviewCommentEvent Source # 
Reflect RepoWebhookEvent WebhookPublicEvent Source # 
Reflect RepoWebhookEvent WebhookPageBuildEvent Source # 
Reflect RepoWebhookEvent WebhookMemberEvent Source # 
Reflect RepoWebhookEvent WebhookIssuesEvent Source # 
Reflect RepoWebhookEvent WebhookIssueCommentEvent Source # 
Reflect RepoWebhookEvent WebhookGollumEvent Source # 
Reflect RepoWebhookEvent WebhookForkEvent Source # 
Reflect RepoWebhookEvent WebhookDeploymentStatusEvent Source # 
Reflect RepoWebhookEvent WebhookDeploymentEvent Source # 
Reflect RepoWebhookEvent WebhookDeleteEvent Source # 
Reflect RepoWebhookEvent WebhookCreateEvent Source # 
Reflect RepoWebhookEvent WebhookCommitCommentEvent Source # 
Reflect RepoWebhookEvent WebhookWildcardEvent Source # 
Reflect [k] ([] k) Source # 

Methods

reflect :: Proxy [k] a -> Demote [k] a Source #

(Reflect a x, Reflect [a] xs) => Reflect [a] ((:) a x xs) Source # 

Methods

reflect :: Proxy ((a ': x) xs) a -> Demote ((a ': x) xs) a Source #

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.