diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2018, Mitchell Rosen + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Mitchell Rosen nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Network/Wai/Middleware/TravisCI.hs b/Network/Wai/Middleware/TravisCI.hs new file mode 100644 --- /dev/null +++ b/Network/Wai/Middleware/TravisCI.hs @@ -0,0 +1,193 @@ +-- | +-- @travis-ci.com@ webhook authentication middleware. +-- +-- See +-- for more information about webhooks. +-- +-- In brief: +-- +-- * Configure @travis-ci.com@ to send webhook notifications to your +-- @WAI@-based web server (such as @@). +-- * Use the 'authenticate' middleware to reject requests that don't +-- originate from @travis-ci.com@. +-- +-- For example, +-- +-- > -- In .travis.yml +-- > notifications: +-- > webhooks: http://my-domain.com/my-webhook-path +-- +-- @ +-- -- In code +-- TravisCI.'authenticate' ["my-webhook-path"] +-- @ +-- +-- See the bottom of this module for a longer example. +{-# language LambdaCase #-} +{-# language OverloadedStrings #-} +{-# language ScopedTypeVariables #-} + +module Network.Wai.Middleware.TravisCI + ( -- * Authentication + authenticate + -- ** Payload + , payload + -- * Exceptions + , TravisException(..) + -- * Example + -- $example + ) where + +import Control.Exception (Exception, throwIO) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Maybe (MaybeT, runMaybeT) +import Crypto.Hash.Algorithms (SHA1(SHA1)) +import Crypto.PubKey.RSA (PublicKey(..)) +import Data.Aeson (Value) +import Data.ByteString (ByteString) +import Data.Text (Text) +import Network.HTTP.Types.Method (methodPost) +import Network.HTTP.Types.Status (status401) +import Network.HTTP.Types.URI (urlDecode) +import Network.Wai + (Middleware, Request, pathInfo, requestHeaders, requestMethod, + responseBuilder, strictRequestBody, vault) +import System.IO.Unsafe (unsafePerformIO) + +import qualified Crypto.PubKey.RSA.PKCS15 as RSA (verify) +import qualified Data.Aeson as Aeson (decodeStrict) +import qualified Data.ByteString.Base64 as Base64 (decode) +import qualified Data.ByteString.Lazy as Lazy (ByteString) +import qualified Data.ByteString.Lazy as LazyByteString (stripPrefix, toStrict) +import qualified Data.Vault.Lazy as Vault (Key, insert, lookup, newKey) + +-- | Only allow @travis-ci.com@ to @POST@ to the given path. +authenticate :: [Text] -> Middleware +authenticate path app request respond + | pathInfo request == path && requestMethod request == methodPost = + runMaybeT (authenticate_ request) >>= \case + Nothing -> + respond (responseBuilder status401 [] mempty) + + Just value -> + let + request' :: Request + request' = + request { vault = Vault.insert vaultKey value (vault request) } + in + app request' respond + + | otherwise = + app request respond + +authenticate_ :: Request -> MaybeT IO Value +authenticate_ request = do + -- base64-decode the "Signature" header. + Just signature :: Maybe ByteString <- + pure (lookup "Signature" (requestHeaders request)) + Right decodedSignature :: Either String ByteString <- + pure (Base64.decode signature) + + -- Strip the "payload=" prefix from the request body, and url-decode the rest + -- to JSON (converting '+' to ' '). + body :: Lazy.ByteString <- + lift (strictRequestBody request) + Just body' :: Maybe Lazy.ByteString <- + pure (LazyByteString.stripPrefix "payload=" body) + let blob :: ByteString + blob = + urlDecode True (LazyByteString.toStrict body') + + -- Verify the integrity of the payload + True <- + pure (RSA.verify (Just SHA1) travisPublicKey blob decodedSignature) + + case Aeson.decodeStrict blob of + Nothing -> + lift (throwIO (TravisNoParse request)) + Just value -> + pure value + +-- | Retrieve the payload from an authenticated 'Request'. +-- +-- This function /must/ be called on a 'Request' that was handled by the +-- 'authenticate' middleware. Otherwise, it will throw a 'TravisNoValue' +-- exception. +payload :: Request -> IO Value +payload request = + case Vault.lookup vaultKey (vault request) of + Nothing -> + throwIO (TravisNoValue request) + Just value -> + pure value + +vaultKey :: Vault.Key Value +vaultKey = + unsafePerformIO Vault.newKey +{-# NOINLINE vaultKey #-} + +-- Generated by ./print-pubkey.hs +travisPublicKey :: PublicKey +travisPublicKey = + PublicKey + { public_size = 256 + , public_n = 19821984571100721174801937457620616356826278863666395036092491929968642594870725800923165481927748936859185399099979204381315728615128617444471137310746875196305929578050077446870746964906791330757456711951792309209038242837017485691295115541567831580835001588720735252888165382117234029106545628408874399235402888561554376487524095653749826630076731478525532204204020975763080559118060924301943137668090191150244001738568733144533640931922256928565150196822324795442691411243969309366712382022175061865838244539628949282108447947299901919930392874255274028887037524853653490377264637621196465886362559811007585585749 + , public_e = 65537 + } + +-- | +data TravisException + = TravisNoParse Request + -- ^ JSON-decoding an authenticated payload failed. This should never + -- happen; it means Travis CI signed and sent a payload that was not valid + -- JSON. + | TravisNoValue Request + -- ^ A call to 'payload' failed because there was no 'Value' inserted into + -- the request vault by the 'authenticate' middleware. This should never + -- happen, but if it does, it's your fault; it means you called 'payload' + -- on a 'Request' that did not pass through the 'authenticate' middleware. + deriving Show + +instance Exception TravisException + +-- $example +-- +-- @ +-- {-\# language OverloadedStrings #-} +-- +-- import Network.Wai -- wai +-- import Network.Wai.Handler.Warp (run) -- warp +-- import Network.HTTP.Types -- http-types +-- +-- import qualified Network.Wai.Middleware.TravisCI as TravisCI +-- +-- main :: IO () +-- main = +-- 'Network.Wai.Handler.Warp.run' 8000 (middleware app) +-- +-- middleware :: 'Network.Wai.Middleware' +-- middleware = +-- TravisCI.'authenticate' ["travis"] -- (1) +-- +-- app :: 'Network.Wai.Application' +-- app request respond = +-- case 'Network.Wai.pathInfo' request of +-- ["travis"] -> do -- (2) +-- payload <- TravisCI.'payload' request -- (3) +-- print payload +-- _ -> pure () +-- respond ('Network.Wai.responseLBS' 'Networh.HTTP.Types.status200' [] "") +-- @ +-- +-- Above is a minimal @WAI@ application that authenticates @POST@s to @/travis@, +-- then prints out the parsed payload (an @aeson@ 'Value'). +-- +-- * At @(1)@, we define the middleware, which authenticates every @POST@ to +-- @/travis@. +-- +-- * At @(2)@, we handle these @POST@s in our application. +-- +-- * At @(3)@, we parse the JSON payload, whose schema is, unsurprisingly, +-- barely defined at all. See +-- +-- for more information. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/wai-middleware-travisci.cabal b/wai-middleware-travisci.cabal new file mode 100644 --- /dev/null +++ b/wai-middleware-travisci.cabal @@ -0,0 +1,38 @@ +cabal-version: 2.0 + +name: wai-middleware-travisci +version: 0.1.0 +synopsis: WAI middleware for authenticating webhook payloads from Travis CI +description: + This package provides a simple WAI middleware for authenticating webhook + payloads from @travis-ci.com@. +homepage: https://github.com/mitchellwrosen/wai-middleware-travisci +bug-reports: https://github.com/mitchellwrosen/wai-middleware-travisci/issues +license: BSD3 +license-file: LICENSE +author: Mitchell Rosen +maintainer: Mitchell Rosen +copyright: 2018 Mitchell Rosen +category: Web +build-type: Simple +tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.2 + +source-repository head + type: git + location: https://github.com/mitchellwrosen/wai-middleware-travisci.git + +library + build-depends: + aeson >= 0.8 + , base == 4.9.* || == 4.10.* || ^>= 4.11 + , base64-bytestring + , bytestring ^>= 0.10.8.0 + , cryptonite >= 0.3 + , http-types >= 0.7.0 + , transformers >= 0.2 + , text + , vault >= 0.3.0.0 + , wai >= 3.0.1 + ghc-options: -Wall -Wcompat + exposed-modules: Network.Wai.Middleware.TravisCI + default-language: Haskell2010