wai-middleware-crowd (empty) → 0.1.0.0
raw patch · 11 files changed
+590/−0 lines, 11 filesdep +authenticatedep +basedep +base64-bytestringsetup-changed
Dependencies added: authenticate, base, base64-bytestring, binary, blaze-builder, bytestring, case-insensitive, clientsession, containers, cookie, gitrev, http-client, http-client-tls, http-reverse-proxy, http-types, optparse-applicative, resourcet, template-haskell, text, time, transformers, unix-compat, wai, wai-app-static, wai-middleware-crowd, warp
Files
- ChangeLog.md +3/−0
- LICENSE +20/−0
- README.md +6/−0
- Setup.hs +2/−0
- app/SimpleOptions.hs +51/−0
- app/wai-crowd.hs +99/−0
- src/Network/Wai/Approot.hs +62/−0
- src/Network/Wai/ClientSession.hs +75/−0
- src/Network/Wai/Middleware/Crowd.hs +180/−0
- src/Network/Wai/OpenId.hs +28/−0
- wai-middleware-crowd.cabal +64/−0
+ ChangeLog.md view
@@ -0,0 +1,3 @@+## 0.0.0++* Initial release
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2015 Michael Snoyman++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,6 @@+## wai-middleware-crowd++This repository provides a WAI middleware for requiring Atlassian Crowd login+to some WAI application. It also provides useful helper functions, and prebaked+applications that provide reverse proxying and static file server+functionality.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/SimpleOptions.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE TemplateHaskell #-}+module SimpleOptions+ ( module SimpleOptions+ , module Options.Applicative+ ) where++import Control.Monad.Trans.Writer+import Data.Version (showVersion)+import Development.GitRev (gitDirty, gitHash)+import Language.Haskell.TH.Syntax (lift)+import Options.Applicative++simpleVersion version =+ [|concat+ [ "Version "+ , $(lift $ showVersion version)+ , ", Git revision "+ , $gitHash+ , if $gitDirty then " (dirty)" else ""+ ]+ |]++simpleOptions :: String -- ^ version string+ -> String -- ^ header+ -> String -- ^ program description+ -> Parser a -- ^ global settings+ -> Writer (Mod CommandFields b) () -- ^ commands (use 'addCommand')+ -> IO (a, b)+simpleOptions versionString h pd globalParser commandParser =+ execParser $ info (helpOption <*> versionOption <*> config) desc+ where+ desc = fullDesc <> header h <> progDesc pd+ helpOption =+ abortOption ShowHelpText $+ long "help" <>+ help "Show this help text"+ versionOption =+ infoOption+ versionString+ (long "version" <>+ help "Show version")+ config = (,) <$> globalParser <*> subparser (execWriter commandParser)++addCommand :: String -- ^ command string+ -> String -- ^ title of command+ -> (a -> b) -- ^ constructor to wrap up command in common data type+ -> Parser a -- ^ command parser+ -> Writer (Mod CommandFields b) ()+addCommand cmd title constr inner = tell $ command+ cmd+ (info (constr <$> inner) (progDesc title))
+ app/wai-crowd.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+import Data.String (fromString)+import qualified Data.Text as T+import Network.HTTP.Client (Manager, newManager)+import Network.HTTP.Client.TLS (tlsManagerSettings)+import Network.HTTP.ReverseProxy (ProxyDest (..), WaiProxyResponse (WPRProxyDest),+ defaultOnExc, waiProxyTo)+import Network.Wai (Application)+import Network.Wai.Application.Static (defaultFileServerSettings,+ staticApp)+import Network.Wai.Handler.Warp (run)+import Network.Wai.Middleware.Crowd+import SimpleOptions+import Web.ClientSession (getKey)++data BasicSettings = BasicSettings+ { warpPort :: Int+ , keyFile :: FilePath+ , crowdRoot :: T.Text+ , age :: Int+ }+ deriving Show++basicSettingsParser :: Parser BasicSettings+basicSettingsParser = BasicSettings+ <$> option auto+ ( long "listen-port"+ <> short 'p'+ <> metavar "LISTEN-PORT"+ <> help "Port to listen on for requests"+ <> value 3000 )+ <*> strOption+ ( long "key-file"+ <> short 'k'+ <> metavar "KEY-FILE"+ <> help "File containing the clientsession key"+ <> value "" )+ <*> (T.pack <$> strOption+ ( long "crowd-root"+ <> metavar "CROWD-ROOT"+ <> help "Base URL for the Crowd installation"+ <> value "" ))+ <*> option auto+ ( long "cookie-age"+ <> metavar "COOKIE-AGE"+ <> help "Number of seconds to keep auth cookie active"+ <> value 3600 )++data Service = ServiceFiles FileServer+ | ServiceProxy ReverseProxy++data FileServer = FileServer+ { fsRoot :: FilePath+ }++fileServerParser = FileServer+ <$> (argument str+ (metavar "ROOT-DIR" <> value "."))++data ReverseProxy = ReverseProxy+ { rpHost :: String+ , rpPort :: Int+ }++reverseProxyParser :: Parser ReverseProxy+reverseProxyParser = ReverseProxy+ <$> (argument str (metavar "HOST"))+ <*> (argument auto (metavar "PORT"))++serviceToApp :: Manager -> Service -> IO Application+serviceToApp _ (ServiceFiles FileServer {..}) =+ return $ staticApp $ defaultFileServerSettings $ fromString fsRoot+serviceToApp manager (ServiceProxy (ReverseProxy host port)) =+ return $ waiProxyTo+ (const $ return $ WPRProxyDest $ ProxyDest (fromString host) port)+ defaultOnExc+ manager++main :: IO ()+main = do+ (BasicSettings {..}, service) <- simpleOptions+ $(simpleVersion waiMiddlewareCrowdVersion)+ "wai-crowd - a Crowd-authenticated server"+ "Run a Crowd-authenticated file server or reverse proxy"+ basicSettingsParser $ do+ addCommand "file-server" "File server" ServiceFiles fileServerParser+ addCommand "reverse-proxy" "Reverse proxy" ServiceProxy reverseProxyParser+ manager <- newManager tlsManagerSettings+ let cs = (if null keyFile then id else setCrowdKey (getKey keyFile))+ $ (if T.null crowdRoot then id else setCrowdRoot crowdRoot)+ $ setCrowdManager (return manager)+ $ setCrowdAge age+ $ defaultCrowdSettings+ crowdMiddleware <- mkCrowdMiddleware cs+ app <- serviceToApp manager service+ putStrLn $ "Listening on port " ++ show warpPort+ run warpPort $ crowdMiddleware app
+ src/Network/Wai/Approot.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE OverloadedStrings #-}+module Network.Wai.Approot+ ( smartApproot+ ) where++import Data.ByteString (ByteString)+import Data.CaseInsensitive (CI, mk)+import qualified Data.Map as Map+import Data.Monoid ((<>))+import qualified Data.Text as T+import Data.Text.Encoding (decodeUtf8With)+import Data.Text.Encoding.Error (lenientDecode)+import Network.HTTP.Types (Header)+import Network.Wai (Request, isSecure, requestHeaderHost,+ requestHeaders)+import System.Environment (getEnvironment)++-- | Determine approot by:+--+-- * First respecting the APPROOT environment variable if present+--+-- * If not, respect the Host header and isSecure property, together with the following de facto standards: x-forwarded-protocol, x-forwarded-ssl, x-url-scheme, x-forwarded-proto, front-end-https. (Note: this list may be updated at will in the future without doc updates.)+--+-- Normally trusting headers in this way is insecure, however in the case of approot, the worst that can happen is that the client will get an incorrect URL. Note that this does not work for some situations, e.g.:+--+-- * Reverse proxies not setting one of the above mentioned headers+--+-- * Applications hosted somewhere besides the root of the domain name+--+-- * Reverse proxies that modify the host header+--+-- Since 0.1.0+smartApproot :: IO (Request -> IO T.Text)+smartApproot = do+ env <- getEnvironment+ case lookup "APPROOT" env of+ Just ar -> return $ const $ return $ T.pack ar+ Nothing -> return $ \req -> return $+ let secure = isSecure req || any isSecureHeader (requestHeaders req)+ host = maybe "localhost" (decodeUtf8With lenientDecode) (requestHeaderHost req)+ in (if secure then "https://" else "http://") <>+ host++-- |+--+-- See: http://stackoverflow.com/a/16042648/369198+httpsHeaders :: Map.Map (CI ByteString) (CI ByteString)+httpsHeaders = Map.fromList+ [ ("X-Forwarded-Protocol", "https")+ , ("X-Forwarded-Ssl", "on")+ , ("X-Url-Scheme", "https")+ , ("X-Forwarded-Proto", "https")+ , ("Front-End-Https", "on")+ ]++isSecureHeader :: Header -> Bool+isSecureHeader (key, value) =+ case Map.lookup key httpsHeaders of+ Nothing -> False+ Just value' -> valueCI == value'+ where+ valueCI = mk value
+ src/Network/Wai/ClientSession.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+module Network.Wai.ClientSession+ ( loadCookieValue+ , saveCookieValue+ , Key+ , getDefaultKey+ ) where++import Blaze.ByteString.Builder (toByteString)+import Control.Monad (guard)+import Data.Binary (Binary, decodeOrFail, encode)+import qualified Data.ByteString as S+import qualified Data.ByteString.Base64.URL as B64+import qualified Data.ByteString.Lazy as L+import Data.CaseInsensitive (CI)+import Data.Int (Int64)+import Data.Maybe (listToMaybe)+import Data.Time (DiffTime)+import Foreign.C.Types (CTime (..))+import GHC.Generics (Generic)+import Network.HTTP.Types (Header)+import Network.Wai (Request, requestHeaders)+import System.PosixCompat.Time (epochTime)+import Web.ClientSession (Key, decrypt, encryptIO,+ getDefaultKey)+import Web.Cookie (def, parseCookies, renderSetCookie,+ setCookieHttpOnly, setCookieMaxAge,+ setCookieName, setCookiePath,+ setCookieValue)++data Wrapper value = Wrapper+ { contained :: value+ , expires :: !Int64 -- ^ should really be EpochTime or CTime, but there's no Binary instance+ }+ deriving Generic+instance Binary value => Binary (Wrapper value)++loadCookieValue :: Binary value+ => Key+ -> S.ByteString -- ^ cookie name+ -> Request+ -> IO (Maybe value)+loadCookieValue key name req = do+ CTime now <- epochTime+ return $ listToMaybe $ do+ (k, v) <- requestHeaders req+ guard $ k == "cookie"+ (name', v') <- parseCookies v+ guard $ name == name'+ Right v'' <- return $ B64.decode v'+ Just v''' <- return $ decrypt key v''+ Right (_, _, Wrapper res expi) <- return $ decodeOrFail $ L.fromStrict v'''+ guard $ expi >= now+ return res++saveCookieValue :: Binary value+ => Key+ -> S.ByteString -- ^ cookie name+ -> Int -- ^ age in seconds+ -> value+ -> IO Header+saveCookieValue key name age value = do+ CTime now <- epochTime+ value' <- encryptIO key $ L.toStrict $ encode Wrapper+ { contained = value+ , expires = now + fromIntegral age+ }+ return ("Set-Cookie", toByteString $ renderSetCookie def+ { setCookieName = name+ , setCookieValue = B64.encode value'+ , setCookiePath = Just "/"+ , setCookieHttpOnly = True+ , setCookieMaxAge = Just $ fromIntegral age+ })
+ src/Network/Wai/Middleware/Crowd.hs view
@@ -0,0 +1,180 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+module Network.Wai.Middleware.Crowd+ ( -- * Settings+ CrowdSettings+ , defaultCrowdSettings+ , setCrowdKey+ , setCrowdRoot+ , setCrowdApprootStatic+ , setCrowdApprootGeneric+ , setCrowdManager+ , setCrowdAge+ -- * Middleware+ , mkCrowdMiddleware+ -- * Helpers+ , smartApproot+ , waiMiddlewareCrowdVersion+ ) where++import Blaze.ByteString.Builder (fromByteString, toByteString)+import Data.Binary (Binary)+import qualified Data.ByteString as S+import Data.Monoid ((<>))+import qualified Data.Text as T+import Data.Text.Encoding (decodeUtf8With, encodeUtf8)+import Data.Text.Encoding.Error (lenientDecode)+import Data.Version (Version)+import GHC.Generics (Generic)+import Network.HTTP.Client (Manager, newManager)+import Network.HTTP.Client.TLS (tlsManagerSettings)+import Network.HTTP.Types (Header, status200, status303)+import Network.Wai (Middleware, Request, pathInfo,+ rawPathInfo, rawQueryString,+ responseBuilder, responseLBS)+import Network.Wai.Approot+import Network.Wai.ClientSession+import Network.Wai.OpenId+import qualified Paths_wai_middleware_crowd as Paths++-- | Settings for creating the Crowd middleware.+--+-- To create a value, use 'defaultCrowdSettings' and then various setter+-- functions.+--+-- Since 0.1.0+data CrowdSettings = CrowdSettings+ { csGetKey :: IO Key+ , csCrowdRoot :: T.Text+ , csGetApproot :: IO (Request -> IO T.Text)+ , csGetManager :: IO Manager+ , csAge :: Int+ }++-- | Set the function to get client session key for encrypting cookie data.+--+-- Default: 'getDefaultKey'+--+-- Since 0.1.0+setCrowdKey :: IO Key -> CrowdSettings -> CrowdSettings+setCrowdKey x cs = cs { csGetKey = x }++-- | Set the root of the Crowd service. This is used as an OpenID endpoint.+--+-- Default: @http://localhost:8095/openidserver@+--+-- Since 0.1.0+setCrowdRoot :: T.Text -> CrowdSettings -> CrowdSettings+setCrowdRoot x cs = cs { csCrowdRoot = x }++-- | The application root for this application.+--+-- This is used for constructing completion URLs when communicating with+-- Crowd's OpenID implementation.+--+-- Default: use the APPROOT environment variable.+--+-- Since 0.1.0+setCrowdApprootStatic :: T.Text -> CrowdSettings -> CrowdSettings+setCrowdApprootStatic x = setCrowdApprootGeneric $ return $ const $ return x++-- | More generalized version of 'setCrowdApprootStatic'.+--+-- Since 0.1.0+setCrowdApprootGeneric :: IO (Request -> IO T.Text) -> CrowdSettings -> CrowdSettings+setCrowdApprootGeneric x cs = cs { csGetApproot = x }++-- | Acquire an HTTP connection manager.+--+-- Default: get a new tls-enabled manager.+--+-- Since 0.1.0+setCrowdManager :: IO Manager -> CrowdSettings -> CrowdSettings+setCrowdManager x cs = cs { csGetManager = x }++-- | Number of seconds to keep an authentication cookie active+--+-- Default: 3600+--+-- Since 0.1.0+setCrowdAge :: Int -> CrowdSettings -> CrowdSettings+setCrowdAge x cs = cs { csAge = x }++-- | Default value for 'CrowdSettings'.+--+-- Since 0.1.0+defaultCrowdSettings :: CrowdSettings+defaultCrowdSettings = CrowdSettings+ { csGetKey = getDefaultKey+ , csCrowdRoot = "http://localhost:8095/openidserver"+ , csGetApproot = smartApproot+ , csGetManager = newManager tlsManagerSettings+ , csAge = 3600+ }++data CrowdState = CSNeedRedirect S.ByteString+ | CSLoggedIn S.ByteString+ deriving (Generic, Show)+instance Binary CrowdState++csKey :: S.ByteString+csKey = "crowd_state"++saveCrowdState :: Key -> Int -> CrowdState -> IO Header+saveCrowdState key age cs = saveCookieValue key csKey age cs++-- | Create the Crowd middleware based on the given settings.+--+-- Since 0.1.0+mkCrowdMiddleware :: CrowdSettings -> IO Middleware+mkCrowdMiddleware CrowdSettings {..} = do+ key <- csGetKey+ getApproot <- csGetApproot+ man <- csGetManager+ let prefix = csCrowdRoot <> "/users/"+ return $ \app req respond -> do+ cs <- loadCookieValue key csKey req++ case cs of+ Just (CSLoggedIn _) -> app req respond+ _ -> case pathInfo req of+ ["_crowd_middleware", "complete"] -> do+ eres <- openIdComplete req man+ case eres of+ Left e -> respond $ responseLBS status200 [] "Login failed"+ Right res ->+ case T.stripPrefix prefix $ identifier $ oirOpLocal res of+ Just username -> do+ cookie <- saveCrowdState key csAge $ CSLoggedIn $ encodeUtf8 username+ let dest =+ case cs of+ Just (CSNeedRedirect bs) -> bs+ _ -> "/"+ respond $ responseBuilder status303+ [ ("Location", dest)+ , cookie+ ]+ (fromByteString "Redirecting to " <> fromByteString dest)+ _ -> do+ approot <- getApproot req+ loc <- runResourceT $ getForwardUrl+ (csCrowdRoot <> "/op")+ (approot <> "/_crowd_middleware/complete")+ Nothing+ []+ man+ cookie <- saveCrowdState key csAge $ CSNeedRedirect+ $ rawPathInfo req <> rawQueryString req+ respond $ responseLBS status303+ [ ("Location", encodeUtf8 loc)+ , cookie+ ]+ "Logging in"+ app req respond++-- | Current version+--+-- Since 0.1.0+waiMiddlewareCrowdVersion :: Version+waiMiddlewareCrowdVersion = Paths.version
+ src/Network/Wai/OpenId.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE OverloadedStrings #-}+module Network.Wai.OpenId+ ( openIdComplete+ , Identifier (..)+ , oirOpLocal+ , getForwardUrl+ , runResourceT+ ) where++import Control.Arrow ((***))+import Control.Exception (try)+import Control.Monad.Trans.Resource (runResourceT)+import qualified Data.Text as T+import Data.Text.Encoding (decodeUtf8With)+import Data.Text.Encoding.Error (lenientDecode)+import Network.HTTP.Client (Manager)+import Network.Wai (Request, queryString)+import Web.Authenticate.OpenId (AuthenticateException (..),+ Identifier (..), OpenIdResponse,+ authenticateClaimed,+ getForwardUrl, oirOpLocal)++openIdComplete :: Request -> Manager -> IO (Either AuthenticateException OpenIdResponse)+openIdComplete req man =+ try $ runResourceT $ authenticateClaimed params man+ where+ dec = decodeUtf8With lenientDecode+ params = map (dec *** maybe "" dec) $ queryString req
+ wai-middleware-crowd.cabal view
@@ -0,0 +1,64 @@+name: wai-middleware-crowd+version: 0.1.0.0+synopsis: Middleware and utilities for using Atlassian Crowd authentication+description: See README+license: MIT+license-file: LICENSE+author: Michael Snoyman+maintainer: michael@fpcomplete.com+category: Web+build-type: Simple+extra-source-files: README.md ChangeLog.md+cabal-version: >=1.10++library+ exposed-modules: Network.Wai.Middleware.Crowd+ other-modules: Paths_wai_middleware_crowd+ Network.Wai.OpenId+ Network.Wai.Approot+ Network.Wai.ClientSession+ build-depends: base >= 4.7 && < 5+ , resourcet >= 1.1+ , text >= 1.1+ , http-client >= 0.4+ , wai >= 3.0 && < 4+ , authenticate >= 1.3+ , bytestring >= 0.10+ , case-insensitive >= 1.2+ , containers >= 0.5+ , http-types >= 0.8+ , blaze-builder >= 0.4+ , binary >= 0.7+ , base64-bytestring >= 1.0+ , time >= 1.4+ , clientsession >= 0.9+ , cookie >= 0.4+ , http-client-tls >= 0.2+ , unix-compat >= 0.4+ hs-source-dirs: src+ default-language: Haskell2010++executable wai-crowd+ default-language: Haskell2010+ hs-source-dirs: app+ main-is: wai-crowd.hs+ other-modules: SimpleOptions+ build-depends: base+ , clientsession+ , gitrev >= 1.0+ , http-client+ , http-client-tls+ , http-reverse-proxy >= 0.4+ , optparse-applicative >= 0.11 && < 0.12+ , template-haskell+ , text+ , transformers+ , wai+ , wai-app-static+ , wai-middleware-crowd+ , warp+ ghc-options: -threaded -rtsopts -with-rtsopts=-N++source-repository head+ type: git+ location: https://github.com/fpco/dev-tools