wai-middleware-travisci (empty) → 0.1.0

raw patch · 4 files changed

+263/−0 lines, 4 filesdep +aesondep +basedep +base64-bytestringsetup-changed

Dependencies added: aeson, base, base64-bytestring, bytestring, cryptonite, http-types, text, transformers, vault, wai

Files

• LICENSE +30/−0
• Network/Wai/Middleware/TravisCI.hs +193/−0
• Setup.hs +2/−0
• wai-middleware-travisci.cabal +38/−0

@@ -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.

@@ -0,0 +1,193 @@+-- |+-- @travis-ci.com@ webhook authentication middleware.+--+-- See <https://docs.travis-ci.com/user/notifications/#Configuring-webhook-notifications>+-- for more information about webhooks.+--+-- In brief:+--+--     * Configure @travis-ci.com@ to send webhook notifications to your+--       @WAI@-based web server (such as @<https://hackage.haskell.org/package/warp warp>@).+--     * 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+--   <https://docs.travis-ci.com/user/notifications/#Webhooks-Delivery-Format>+--   for more information.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -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 <mitchellwrosen@gmail.com>+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