sproxy 0.9.6 → 0.9.7
raw patch · 13 files changed
+489/−319 lines, 13 files
Files
- ChangeLog.md +9/−0
- README.md +37/−59
- config/sproxy.yml.example +11/−5
- sproxy.cabal +14/−11
- sproxy.sql +30/−40
- src/Authenticate.hs +46/−167
- src/Authenticate/Google.hs +88/−0
- src/Authenticate/LinkedIn.hs +89/−0
- src/Authenticate/Token.hs +69/−0
- src/ConfigFile.hs +8/−4
- src/HTTP.hs +40/−13
- src/Main.hs +1/−1
- src/Proxy.hs +47/−19
ChangeLog.md view
@@ -1,3 +1,12 @@+0.9.7+=====++* Added support for [LinkedIn OAuth2 API](https://developer.linkedin.com/docs/oauth2).+ Added new options `linkedin_client_id` and `linkedin_client_secret`. They are optional+ as well as Google's `client_id` and `client_secret`. The user is now redirected to the+ `sproxy/login` page to choose an OAuth2 provider.++ 0.9.6 =====
README.md view
@@ -1,4 +1,4 @@-# sproxy - secure proxy - HTTP proxy for authenticating users via Google OAuth2+# Sproxy - HTTP proxy for authenticating users via OAuth2 ## Motivation @@ -9,36 +9,34 @@ * sproxy is independent. Any web application written in any language can use it. + ## How it Works -When an HTTP client makes a request, sproxy checks for a *session cookie*. If it-doesn't exist (or it's invalid), it redirects the client to a Google-authentication page. The user is then prompted to allow the application to-access information on the user (email address). If the user proceeds, they're-redirected back to sproxy with a code from Google. We then take that code and-send it to Google ourselves to get back an access token. Then, we use the-access token to make another call to Google, this time to their user info API-to retrieve the user's email address. Finally, we store the the email address-in a session cookie: signed with a hash to prevent tampering, set for HTTP only (to-prevent malicious JavaScript from reading it), and set it for secure (since we-don't want it traveling over plaintext HTTP connections).+When an HTTP client makes a request, Sproxy checks for a *session+cookie*. If it doesn't exist (or it's invalid, expired), it redirects+the client to the login page, where the user can choose+[OAuth2](https://tools.ietf.org/html/rfc6749) provider to authenticate with.+Finally, we store the the email address in a session cookie: signed with a+hash to prevent tampering, set for HTTP only (to prevent malicious JavaScript+from reading it), and set it for secure (since we don't want it traveling+over plaintext HTTP connections). From that point on, when sproxy detects a valid session cookie it extracts the email, checks it against the access rules, and relays the request to the back-end server (if allowed). + ## Logout -Hitting the endpoint `/sproxy/logout` will invalidate the session-cookie. The user will be redirected to `/` after logout. The-query parameter `state` can be provided to specify an alternate redirect path-(the path has to be percent-encoded, e.g. with `urlEncode` from-`Network.HTTP.Types.URI`).+Hitting the endpoint `/sproxy/logout` will invalidate the session cookie.+The user will be redirected to `/` after logout. The query parameter `state`+can be provided to specify an alternate URL-encoded redirect path + ## Robots -Since all sproxied resources are private, it doesn't make sense for web crawlers-to try to index them. In fact, crawlers will index only the Google authentication+Since all sproxied resources are private, it doesn't make sense for web+crawlers to try to index them. In fact, crawlers will index only the login page. To prevent this, sproxy returns the following for `/robots.txt`: ```@@ -46,6 +44,7 @@ Disallow: / ``` + ## Permissions system Permissions are stored in a PostgreSQL database. See sproxy.sql for details.@@ -63,28 +62,29 @@ whether a user is allowed to perform a request. This is often a bit surprising, please see the following example: + ### Privileges example Consider this `group_privilege` and `privilege_rule` relations: group | privilege | domain ---------------- | --------- | ------------------`readers` | `basic` | `wiki.zalora.com`-`readers` | `read` | `wiki.zalora.com`-`editors` | `basic` | `wiki.zalora.com`-`editors` | `read` | `wiki.zalora.com`-`editors` | `edit` | `wiki.zalora.com`-`administrators` | `basic` | `wiki.zalora.com`-`administrators` | `read` | `wiki.zalora.com`-`administrators` | `edit` | `wiki.zalora.com`-`administrators` | `admin` | `wiki.zalora.com`+`readers` | `basic` | `wiki.example.com`+`readers` | `read` | `wiki.example.com`+`editors` | `basic` | `wiki.example.com`+`editors` | `read` | `wiki.example.com`+`editors` | `edit` | `wiki.example.com`+`administrators` | `basic` | `wiki.example.com`+`administrators` | `read` | `wiki.example.com`+`administrators` | `edit` | `wiki.example.com`+`administrators` | `admin` | `wiki.example.com` privilege | domain | path | method ----------- | ----------------- | -------------- | -------`basic` | `wiki.zalora.com` | `/%` | `GET`-`read` | `wiki.zalora.com` | `/wiki/%` | `GET`-`edit` | `wiki.zalora.com` | `/wiki/edit/%` | `%`-`admin` | `wiki.zalora.com` | `/admin/%` | `%`+`basic` | `wiki.example.com` | `/%` | `GET`+`read` | `wiki.example.com` | `/wiki/%` | `GET`+`edit` | `wiki.example.com` | `/wiki/edit/%` | `%`+`admin` | `wiki.example.com` | `/admin/%` | `%` With this setup, everybody (that is `readers`, `editors` and `administrators`s) will have access to e.g. `/imgs/logo.png` and `/favicon.ico`, but only@@ -118,37 +118,15 @@ devops | all, devops | devops devops | all | Access denied + ## Configuration File -By default `sproxy` will read its configuration from `config/sproxy.yml`. You-can specify a custom path with:+By default `sproxy` will read its configuration from+`config/sproxy.yml`. There is example file with documentation+[config/sproxy.yml.example](config/sproxy.yml.example). You can specify a+custom path with: ``` sproxy --config /path/to/sproxy.yml ```--## Development--```-$ cp config/sproxy.yml.example config/sproxy.yml-```--Make sure that you have the following entry in `/etc/hosts`:--```-127.0.0.1 dev.zalora.com-```---### Create OAuth credentials--Create a project in the [Google Developers Console](https://console.developers.google.com/project).-- - visit *APIs & auth* -> *Credentials*- - select *CREATE NEW CLIENT ID*- - use `https://dev.zalora.com` as *Authorized JavaScript origins*- - use `https://dev.zalora.com/sproxy/oauth2callback` as *Authorized redirect URI*--Put the `Client ID` in `config/sproxy.yml` and the `Client secret` in a file-called `config/client_secret`.
config/sproxy.yml.example view
@@ -4,7 +4,7 @@ # The port sproxy listens on (this is always HTTPS). # Default is 443-# listen: 443+listen: 4430 # User to run as. # If launched with root privileges, sproxy will switch@@ -17,12 +17,18 @@ # to the above listen port. Default is "yes" if listen is 443 # redirect_http_to_https: yes -cookie_domain: dev.zalora.com+cookie_domain: example.com cookie_name: sproxy-dev -# The client ID and client secret come from Google's "Cloud Console".-client_id: a611zak494jxdgdn6ltlkn547rme91ig.apps.googleusercontent.com-client_secret: config/client_secret++# Google OAuth2 client ID & secret.+# The names are such for hysterical raisins:+# client_id: xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx.apps.googleusercontent.com+# client_secret: secret/file++# LinkedIn OAuth2 client ID & secret.+# linkedin_client_id: xxxxxxxxxxxxxx+# linkedin_client_secret: secret/file ssl_key: config/server.key.example
sproxy.cabal view
@@ -1,6 +1,6 @@ name: sproxy-version: 0.9.6-synopsis: HTTP proxy for authenticating users via Google OAuth2+version: 0.9.7+synopsis: HTTP proxy for authenticating users via OAuth2 license: MIT license-file: LICENSE copyright: 2013-2016, Zalora South East Asia Pte. Ltd@@ -20,15 +20,18 @@ executable sproxy main-is: Main.hs other-modules:- Authenticate- , Authorize- , ConfigFile- , Cookies- , HTTP- , Logging- , Proxy- , Type- , Util+ Authenticate+ Authenticate.Google+ Authenticate.LinkedIn+ Authenticate.Token+ Authorize+ ConfigFile+ Cookies+ HTTP+ Logging+ Proxy+ Type+ Util hs-source-dirs: src default-language: Haskell2010
sproxy.sql view
@@ -12,7 +12,6 @@ -- | devops | -- | all | -- | regional |--- | SG HQ | CREATE EXTENSION IF NOT EXISTS citext; @@ -24,20 +23,11 @@ -- | group | email | -- |--------------+------------------------|--- | data science | blah@zalora.com |--- | data science | foo@zalora.com |--- | devops | devops1@zalora.com |--- | devops | devops2@zalora.com |--- | all | %@zalora.com |--- | all | %@zalora.sg |--- | all | %@zalora.vn |--- | all | %@zalora.com.hk |--- | all | %@zalora.com.my |--- | all | %@zalora.com.ph |--- | all | %@zalora.co.id |--- | all | %@zalora.co.th |--- | regional | %@zalora.com |--- | SG | %@zalora.sg |+-- | data science | blah@example.com |+-- | data science | foo@example.com |+-- | devops | devops1@example.com |+-- | devops | devops2@example.com |+-- | all | %@example.com | -- Find out which groups a user (email address) belongs to: -- SELECT "group" FROM group_member WHERE 'email.address' LIKE email@@ -48,9 +38,9 @@ -- | domain | -- |-----------------------|--- | app1.zalora.com |--- | app2.zalora.com |--- | app3.zalora.com |+-- | app1.example.com |+-- | app2.example.com |+-- | app3.example.com | CREATE TABLE IF NOT EXISTS privilege ( "domain" TEXT REFERENCES domain (domain) ON UPDATE CASCADE ON DELETE CASCADE NOT NULL,@@ -60,10 +50,10 @@ -- | domain | privilege | -- |-----------------------+------------|--- | app3.zalora.com | view |--- | app3.zalora.com | export |--- | app1.zalora.com | list users |--- | app1.zalora.com | add users |+-- | app3.example.com | view |+-- | app3.example.com | export |+-- | app1.example.com | list users |+-- | app1.example.com | add users | CREATE TABLE IF NOT EXISTS privilege_rule ( "domain" TEXT NOT NULL,@@ -76,11 +66,11 @@ -- | domain | privilege | path | method | -- |-----------------------+------------+-----------+--------|--- | app3.zalora.com | view | /% | % |--- | app3.zalora.com | export | /export/% | % |--- | app1.zalora.com | list users | /users | GET |--- | app1.zalora.com | list users | /user/% | GET |--- | app1.zalora.com | add users | /users | POST |+-- | app3.example.com | view | /% | % |+-- | app3.example.com | export | /export/% | % |+-- | app1.example.com | list users | /users | GET |+-- | app1.example.com | list users | /user/% | GET |+-- | app1.example.com | add users | /users | POST | CREATE TABLE IF NOT EXISTS group_privilege ( "group" TEXT REFERENCES "group" ("group") ON UPDATE CASCADE ON DELETE CASCADE NOT NULL,@@ -92,10 +82,10 @@ -- | group | domain | privilege | -- |--------------+-----------------------+------------|--- | data science | app3.zalora.com | view |--- | data science | app3.zalora.com | export |--- | all | app1.zalora.com | list users |--- | devops | app1.zalora.com | add users |+-- | data science | app3.example.com | view |+-- | data science | app3.example.com | export |+-- | all | app1.example.com | list users |+-- | devops | app1.example.com | add users | -- Check if the user is authorized for the request. Let's break it -- down for understanding:@@ -106,19 +96,19 @@ -- -- SELECT p.privilege FROM privilege p -- INNER JOIN privilege_rule pr ON pr."domain" = p."domain" AND pr.privilege = p.privilege--- WHERE 'app3.zalora.com' LIKE pr."domain" AND '/export/test' LIKE "path" AND 'GET' ILIKE "method"+-- WHERE 'app3.example.com' LIKE pr."domain" AND '/export/test' LIKE "path" AND 'GET' ILIKE "method" -- ORDER by array_length(regexp_split_to_array("path", '/'), 1) DESC LIMIT 1 -- -- To get the groups that grant the user access, put that in a subquery: -- -- SELECT gp."group" FROM group_privilege gp -- INNER JOIN group_member gm ON gm."group" = gp."group"--- WHERE 'blah@zalora.com' LIKE email--- AND 'app3.zalora.com' LIKE "domain"+-- WHERE 'blah@example.com' LIKE email+-- AND 'app3.example.com' LIKE "domain" -- AND privilege IN ( -- SELECT p.privilege FROM privilege p -- INNER JOIN privilege_rule pr ON pr."domain" = p."domain" AND pr.privilege = p.privilege--- WHERE 'app3.zalora.com' LIKE pr."domain" AND '/export/test' LIKE "path" AND 'GET' ILIKE "method"+-- WHERE 'app3.example.com' LIKE pr."domain" AND '/export/test' LIKE "path" AND 'GET' ILIKE "method" -- ORDER by array_length(regexp_split_to_array("path", '/'), 1) DESC LIMIT 1 -- ) --@@ -128,7 +118,7 @@ -- SELECT COUNT(*) > 0 FROM group_privilege gp -- -- Note for the future: If you want to support wildcards that match--- only a single path component (e.g. app1.zalora.com/user/:/email),+-- only a single path component (e.g. app1.example.com/user/:/email), -- you could try something like: -- -- WHERE 'url' ~ regexp_replace(url, ':', '[^/]+')@@ -138,11 +128,11 @@ -- Example data for development: /*- INSERT INTO domain (domain) VALUES ('dev.zalora.com');+ INSERT INTO domain (domain) VALUES ('example.com'); INSERT INTO "group" ("group") VALUES ('dev'); INSERT INTO group_member ("group", email) VALUES ('dev', '%');- INSERT INTO privilege (domain, privilege) VALUES ('dev.zalora.com', 'full');- INSERT INTO group_privilege ("group", domain, privilege) VALUES ('dev', 'dev.zalora.com', 'full');- INSERT INTO privilege_rule (domain, privilege, path, method) VALUES ('dev.zalora.com', 'full', '%', '%');+ INSERT INTO privilege (domain, privilege) VALUES ('example.com', 'full');+ INSERT INTO group_privilege ("group", domain, privilege) VALUES ('dev', 'example.com', 'full');+ INSERT INTO privilege_rule (domain, privilege, path, method) VALUES ('example.com', 'full', '%', '%'); */
src/Authenticate.hs view
@@ -1,139 +1,61 @@-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-} module Authenticate (- AuthConfig(..)-, AuthToken(..)+ logout+, loginPage+, redirectToLoginPage , validAuth-, redirectForAuth-, authenticate-, logout---- exported to silence warnings-, AccessToken(..) ) where -import Control.Applicative-import Control.Exception-import Text.Read (readMaybe)-import Data.Monoid-import Data.ByteString (ByteString)-import qualified Data.ByteString.Char8 as B8+import Data.ByteString (ByteString)+import Data.Monoid ((<>))+import Network.HTTP.Toolkit (Response, BodyReader)+import Network.HTTP.Types (found302, ok200, urlEncode)+import System.Posix.Time (epochTime)+import Text.InterpolatedString.Perl6 (qc)+import Text.Read (readMaybe) import qualified Data.ByteString.UTF8 as UTF8-import qualified Data.ByteString.Lazy.Char8 as BL8-import Data.String.Conversions (cs)-import Data.List.Split (splitOn)-import Data.Aeson-import Network.HTTP.Types-import System.Posix.Types (EpochTime)-import System.Posix.Time (epochTime)-import Data.Digest.Pure.SHA (hmacSha1, showDigest)-import Network.HTTP.Conduit (simpleHttp, parseUrl, httpLbs, RequestBody(..))-import qualified Network.HTTP.Conduit as HTTP-import Network.HTTP.Toolkit --import Cookies-import HTTP-import qualified Logging as Log--data AuthConfig = AuthConfig {- authConfigCookieDomain :: String-, authConfigCookieName :: String-, authConfigClientID :: String-, authConfigClientSecret :: String-, authConfigAuthTokenKey :: String-, authConfigShelfLife :: EpochTime-} deriving (Eq, Show)--data AccessToken = AccessToken {- accessToken :: String-, expiresIn :: Integer-, tokenType :: String-} deriving (Eq, Show)--instance FromJSON AccessToken where- parseJSON (Object v) = AccessToken- <$> v .: "access_token"- <*> v .: "expires_in"- <*> v .: "token_type"- parseJSON _ = empty--data AuthToken = AuthToken {- authEmail :: String-, authName :: (String, String)-, authExpiry :: EpochTime-, authDigest :: String -- HMAC hash-}---- Here is the format of the actual cookie we send to the client.-instance Show AuthToken where- show a = authEmail a ++ ":" ++ authNameString (authName a) ++ ":" ++ show (authExpiry a) ++ ":" ++ authDigest a- where authNameString (given, family) = given ++ ":" ++ family--instance Read AuthToken where- readsPrec _ s = case splitOn ":" s of- [email, given, family, expire, digest] -> [(AuthToken email (given, family) (read expire) digest, "")]- _ -> []--data UserInfo = UserInfo {- userEmail :: String-, userGivenName :: String-, userFamilyName :: String-} deriving (Eq, Show)--instance FromJSON UserInfo where- parseJSON (Object v) = UserInfo- <$> v .: "email"- <*> v .: "given_name"- <*> v .: "family_name"- parseJSON _ = empty--redirectUri :: ByteString -> ByteString-redirectUri baseUri = baseUri <> "/sproxy/oauth2callback"--authUrl :: ByteString -> ByteString -> AuthConfig -> ByteString-authUrl path baseUri c = mconcat [- "https://accounts.google.com/o/oauth2/auth?scope=https%3A%2F%2Fwww.googleapis.com%2Fauth%2Fuserinfo.email+https%3A%2F%2Fwww.googleapis.com%2Fauth%2Fuserinfo.profile&"- , "state=", urlEncode True path- , "&redirect_uri=", redirectUri baseUri- , "&response_type=code&client_id=", B8.pack (authConfigClientID c)- , "&approval_prompt=force&access_type=offline"- ]+import Authenticate.Token (AuthToken(..), tokenDigest)+import Authenticate.Types (AuthConfig(..))+import Cookies (invalidateCookie)+import HTTP (mkResponse, mkHtmlResponse)+import qualified Authenticate.Google as Google+import qualified Authenticate.LinkedIn as LinkedIn -redirectForAuth :: AuthConfig -> ByteString -> ByteString -> IO (Response BodyReader)-redirectForAuth c path baseUri = mkResponse found302 [("Location", authUrl path baseUri c)] ""+redirectToLoginPage :: ByteString -> ByteString -> IO (Response BodyReader)+redirectToLoginPage base path =+ mkResponse found302 [+ ("Location", base <> "/sproxy/login?state=" <> urlEncode True path)+ ] "" -authenticate :: AuthConfig -> ByteString -> ByteString -> ByteString -> IO (Response BodyReader)-authenticate config baseUri path code = do- Log.info ("authentication request with code " ++ show code)- tokenRes <- try $ post "https://accounts.google.com/o/oauth2/token"- (cs $ "code=" ++ cs code ++ "&client_id=" ++ clientID- ++ "&client_secret=" ++ clientSecret ++ "&redirect_uri="- ++ cs (redirectUri baseUri) ++ "&grant_type=authorization_code")- case tokenRes of- Left err -> authenticationFailed ("error while authenticating: " ++ show (err :: HTTP.HttpException))- Right resp ->- case decode (HTTP.responseBody resp) of- Nothing ->- authenticationFailed "Received an invalid response from Google's authentication server."- Just token -> do- infoRes <- try $ simpleHttp ("https://www.googleapis.com/oauth2/v1/userinfo?access_token=" ++ accessToken token)- case infoRes of- Left err -> authenticationFailed ("error while retrieving user info: " ++ show (err :: HTTP.HttpException))- Right body ->- case decode body of- Nothing -> authenticationFailed "Received an invalid user info response from Google's authentication server."- Just userInfo -> do- clientToken <- authToken config userInfo- let cookie = setCookie cookieDomain cookieName (show clientToken) (authConfigShelfLife config)- mkResponse found302 [("Location", baseUri <> urlDecode False path), ("Set-Cookie", UTF8.fromString cookie)] ""+loginPage :: AuthConfig -> ByteString -> ByteString -> IO (Response BodyReader)+loginPage c base path =+ mkHtmlResponse ok200 body where- cookieDomain = authConfigCookieDomain config- cookieName = authConfigCookieName config- clientID = authConfigClientID config- clientSecret = authConfigClientSecret config+ google :: ByteString+ google = maybe "" (\u -> [qc|<p><a href="{u}">Authenticate with Google</a></p>|]) (Google.authUrl c base path)+ linkedin :: ByteString+ linkedin = maybe "" (\u -> [qc|<p><a href="{u}">Authenticate with LinkedIn</a></p>|]) (LinkedIn.authUrl c base path)+ body = [qc|+ <!DOCTYPE html>+ <html lang="en">+ <head>+ <meta charset="utf-8">+ <title>Authentication required</title>+ </head>+ <body style="text-align:center;">+ <h1>Authentication required</h1>+ {google}+ {linkedin}+ </body>+ </html>+ |] +-- ("Location", Google.authUrl path baseUri clientId)+ logout :: AuthConfig -> ByteString -> IO (Response BodyReader) logout config url = do let cookie = invalidateCookie cookieDomain cookieName@@ -142,18 +64,6 @@ cookieDomain = authConfigCookieDomain config cookieName = authConfigCookieName config -post :: String -> ByteString -> IO (HTTP.Response BL8.ByteString)-post url body = do- r' <- parseUrl url- let r = r' { HTTP.method = "POST"- , HTTP.requestBody = RequestBodyBS body- , HTTP.requestHeaders- = [ ("Content-Type" , "application/x-www-form-urlencoded")- ]- }- manager <- HTTP.newManager HTTP.tlsManagerSettings- httpLbs r manager- validAuth :: AuthConfig -> String -> IO (Maybe AuthToken) validAuth config token = case readMaybe token of@@ -165,35 +75,4 @@ else return Nothing where key = authConfigAuthTokenKey config---- | Create an AuthToken with the default expiration time, automatically--- calculating the digest.-authToken :: AuthConfig -> UserInfo -> IO AuthToken-authToken acfg user = do- now <- epochTime- let- email = userEmail user- name = (userGivenName user, userFamilyName user)- expires = now + authConfigShelfLife acfg- digest = tokenDigest (authConfigAuthTokenKey acfg) AuthToken {- authEmail = email- , authName = name- , authExpiry = expires- , authDigest = ""- }- token = AuthToken {- authEmail = email- , authName = name- , authExpiry = expires- , authDigest = digest- }- return token---- | This generates the HMAC digest of the auth token using SHA1.--- Eventually, we need to rotate the key used to generate the HMAC, while still--- storing old keys long enough to use them for any valid login session. Without--- this, authentication is less secure.-tokenDigest :: String -> AuthToken -> String-tokenDigest key a = showDigest $ hmacSha1 (BL8.pack key) (BL8.pack token)- where token = show (authEmail a) ++ show (authExpiry a)
+ src/Authenticate/Google.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}++module Authenticate.Google (+ authUrl+, authenticate+) where++import Control.Applicative (empty)+import Control.Exception (try)+import Data.Aeson (FromJSON, decode, parseJSON, Value(Object), (.:))+import Data.ByteString (ByteString)+import Data.Maybe (fromJust)+import Data.Monoid ((<>))+import Network.HTTP.Toolkit (Response, BodyReader)+import Network.HTTP.Types (found302, urlEncode, urlDecode)+import qualified Data.ByteString.UTF8 as UTF8+import qualified Network.HTTP.Conduit as HTTP++import Authenticate.Types (AccessToken(..), AuthConfig(..), OAuthClient(..))+import Authenticate.Token (AuthUser(..), mkAuthToken)+import Cookies (setCookie)+import HTTP (authenticationFailed, mkResponse, post, get)+import qualified Logging as Log++authUrl :: AuthConfig -> ByteString -> ByteString -> Maybe ByteString+authUrl c base path = url . oauthClientId <$> authConfigGoogleClient c+ where+ url cid = mconcat [+ "https://accounts.google.com/o/oauth2/auth"+ , "?scope=https%3A%2F%2Fwww.googleapis.com%2Fauth%2Fuserinfo.email+https%3A%2F%2Fwww.googleapis.com%2Fauth%2Fuserinfo.profile"+ , "&state=", urlEncode True path+ , "&redirect_uri=", redirectUri base+ , "&response_type=code&client_id=", cid+ , "&approval_prompt=force&access_type=offline"+ ]++authenticate :: AuthConfig -> ByteString -> ByteString -> ByteString -> IO (Response BodyReader)+authenticate acfg base path code = do+ Log.info ("Google authentication request with code " ++ show code)+ tokenRes <- try $ post "https://accounts.google.com/o/oauth2/token"+ ("code=" <> code <> "&client_id=" <> clientId+ <> "&client_secret=" <> clientSecret <> "&redirect_uri="+ <> (redirectUri base) <> "&grant_type=authorization_code")+ case tokenRes of+ Left err -> authenticationFailed ("error while authenticating: " ++ show (err :: HTTP.HttpException))+ Right tresp -> do+ Log.debug (show tresp)+ case decode (HTTP.responseBody tresp) of+ Nothing ->+ authenticationFailed "Received an invalid response from Google's authentication server."+ Just gtoken -> do+ infoRes <- try $ get ("https://www.googleapis.com/oauth2/v1/userinfo?access_token=" ++ accessToken gtoken) []+ case infoRes of+ Left err -> authenticationFailed ("error while retrieving user info: " ++ show (err :: HTTP.HttpException))+ Right uresp ->+ case decode (HTTP.responseBody uresp) of+ Nothing -> authenticationFailed "Received an invalid user info response from Google's authentication server."+ Just (GoogleUserInfo{email, givenName, familyName}) -> do+ token <- mkAuthToken acfg AuthUser{ authUserEmail = email+ , authUserGivenName = givenName+ , authUserFamilyName = familyName }+ let cookie = setCookie cookieDomain cookieName (show token) (authConfigShelfLife acfg)+ mkResponse found302 [("Location", base <> urlDecode False path), ("Set-Cookie", UTF8.fromString cookie)] ""+ where+ cookieDomain = authConfigCookieDomain acfg+ cookieName = authConfigCookieName acfg+ clientId = oauthClientId . fromJust $ authConfigGoogleClient acfg+ clientSecret = oauthClientSecret . fromJust $ authConfigGoogleClient acfg+++redirectUri :: ByteString -> ByteString+redirectUri base = base <> "/sproxy/oauth2callback"++data GoogleUserInfo = GoogleUserInfo {+ email :: String+, givenName :: String+, familyName :: String+} deriving (Eq, Show)++instance FromJSON GoogleUserInfo where+ parseJSON (Object v) = GoogleUserInfo+ <$> v .: "email"+ <*> v .: "given_name"+ <*> v .: "family_name"+ parseJSON _ = empty++
+ src/Authenticate/LinkedIn.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}++module Authenticate.LinkedIn (+ authUrl+, authenticate+) where++import Control.Applicative (empty)+import Control.Exception (try)+import Data.Aeson (FromJSON, decode, parseJSON, Value(Object), (.:))+import Data.ByteString (ByteString)+import Data.Maybe (fromJust)+import Data.Monoid ((<>))+import Network.HTTP.Toolkit (Response, BodyReader)+import Network.HTTP.Types (found302, urlEncode, urlDecode)+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.UTF8 as UTF8+import qualified Network.HTTP.Conduit as HTTP++import Authenticate.Types (AccessToken(..), AuthConfig(..), OAuthClient(..))+import Authenticate.Token (AuthUser(..), mkAuthToken)+import Cookies (setCookie)+import HTTP (authenticationFailed, mkResponse, post, get)+import qualified Logging as Log++authUrl :: AuthConfig -> ByteString -> ByteString -> Maybe ByteString+authUrl c base path = url . oauthClientId <$> authConfigLinkedInClient c+ where+ url cid = mconcat [+ "https://www.linkedin.com/oauth/v2/authorization"+ , "?scope=r_basicprofile%20r_emailaddress"+ , "&state=", urlEncode True path+ , "&redirect_uri=", redirectUri base+ , "&response_type=code&client_id=", cid+ ]++authenticate :: AuthConfig -> ByteString -> ByteString -> ByteString -> IO (Response BodyReader)+authenticate acfg base path code = do+ Log.info ("LinkedIn authentication request with code " ++ show code)+ tokenRes <- try $ post "https://www.linkedin.com/oauth/v2/accessToken"+ ("code=" <> code <> "&client_id=" <> clientId+ <> "&client_secret=" <> clientSecret <> "&redirect_uri="+ <> (redirectUri base) <> "&grant_type=authorization_code")+ case tokenRes of+ Left err -> authenticationFailed ("error while authenticating: " ++ show (err :: HTTP.HttpException))+ Right tresp -> do+ Log.debug (show tresp)+ case decode (HTTP.responseBody tresp) of+ Nothing ->+ authenticationFailed "Received an invalid response from LinkedIn authentication server."+ Just oat -> do+ infoRes <- try $ get ("https://api.linkedin.com/v1/people/~:(email-address,first-name,last-name)?format=json")+ [ ("Authorization", "Bearer " <> B8.pack (accessToken oat)) ]+ case infoRes of+ Left err -> authenticationFailed ("error while retrieving user info: " ++ show (err :: HTTP.HttpException))+ Right uresp -> do+ Log.debug (show uresp)+ case decode (HTTP.responseBody uresp) of+ Nothing -> authenticationFailed "Received an invalid user info response from LinkedIn authentication server."+ Just (LinkedInUserInfo{emailAddress, firstName, lastName}) -> do+ token <- mkAuthToken acfg AuthUser{ authUserEmail = emailAddress+ , authUserGivenName = firstName+ , authUserFamilyName = lastName }+ let cookie = setCookie cookieDomain cookieName (show token) (authConfigShelfLife acfg)+ mkResponse found302 [("Location", base <> urlDecode False path), ("Set-Cookie", UTF8.fromString cookie)] ""+ where+ cookieDomain = authConfigCookieDomain acfg+ cookieName = authConfigCookieName acfg+ clientId = oauthClientId . fromJust $ authConfigLinkedInClient acfg+ clientSecret = oauthClientSecret . fromJust $ authConfigLinkedInClient acfg+++redirectUri :: ByteString -> ByteString+redirectUri base = base <> "/sproxy/oauth2callback/linkedin"++data LinkedInUserInfo = LinkedInUserInfo {+ emailAddress :: String+, firstName :: String+, lastName :: String+} deriving (Eq, Show)++instance FromJSON LinkedInUserInfo where+ parseJSON (Object v) = LinkedInUserInfo+ <$> v .: "emailAddress"+ <*> v .: "firstName"+ <*> v .: "lastName"+ parseJSON _ = empty+
+ src/Authenticate/Token.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE OverloadedStrings #-}++module Authenticate.Token (+ AuthToken(..)+, AuthUser(..)+, mkAuthToken+, tokenDigest+) where++import Data.Digest.Pure.SHA (hmacSha1, showDigest)+import Data.List.Split (splitOn)+import System.Posix.Time (epochTime)+import System.Posix.Types (EpochTime)+import qualified Data.ByteString.Lazy.Char8 as BL8++import Authenticate.Types (AuthConfig(authConfigAuthTokenKey, authConfigShelfLife))++data AuthUser = AuthUser {+ authUserEmail :: String+, authUserGivenName :: String+, authUserFamilyName :: String+} deriving (Eq)++data AuthToken = AuthToken {+ authDigest :: String+, authExpiry :: EpochTime+, authUser :: AuthUser+}++-- Here is the format of the actual cookie we send to the client.+instance Show AuthToken where+ show a = user ++ ":" ++ show (authExpiry a) ++ ":" ++ authDigest a+ where+ u = authUser a+ user = authUserEmail u +++ ":" ++ authUserGivenName u +++ ":" ++ authUserFamilyName u++instance Read AuthToken where+ readsPrec _ s = case splitOn ":" s of+ [email, fn, ln, xpr, dgst]+ -> [(AuthToken+ { authUser = AuthUser email fn ln+ , authExpiry = read xpr+ , authDigest = dgst+ }, "")]+ _ -> []+++-- | This generates the HMAC digest of the auth token using SHA1.+tokenDigest :: String -> AuthToken -> String+tokenDigest key a = showDigest $ hmacSha1 (BL8.pack key) (BL8.pack token)+ where token = show (authUserEmail . authUser $ a) ++ show (authExpiry a)++-- | Create an AuthToken with the default expiration time, automatically+-- calculating the digest.+mkAuthToken :: AuthConfig -> AuthUser -> IO AuthToken+mkAuthToken acfg auser = do+ now <- epochTime+ let+ expires = now + authConfigShelfLife acfg+ token = AuthToken {+ authUser = auser+ , authExpiry = expires+ , authDigest = ""+ }+ digest = tokenDigest (authConfigAuthTokenKey acfg) token+ return $ token {authDigest = digest}+
src/ConfigFile.hs view
@@ -26,8 +26,10 @@ , cfRedirectHttpToHttps :: Maybe Bool , cfCookieDomain :: String , cfCookieName :: String-, cfClientID :: String-, cfClientSecretFile :: FilePath+, cfGoogleClientID :: Maybe String+, cfGoogleClientSecretFile :: Maybe FilePath+, cfLinkedInClientID :: Maybe String+, cfLinkedInClientSecretFile :: Maybe FilePath , cfSslKey :: FilePath , cfSslCerts :: FilePath , cfDatabase :: String@@ -45,8 +47,10 @@ <*> m .:? "redirect_http_to_https" <*> m .: "cookie_domain" <*> m .: "cookie_name"- <*> m .: "client_id"- <*> m .: "client_secret"+ <*> m .:? "client_id"+ <*> m .:? "client_secret"+ <*> m .:? "linkedin_client_id"+ <*> m .:? "linkedin_client_secret" <*> m .: "ssl_key" <*> m .: "ssl_certs" <*> m .: "database"
src/HTTP.hs view
@@ -1,20 +1,25 @@-{-# LANGUAGE OverloadedStrings, QuasiQuotes #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+ module HTTP ( hostHeaderMissing-, authenticationFailed , accessDenied+, authenticationFailed , badRequest+, get+, mkHtmlResponse , mkResponse , mkTextResponse-, mkHtmlResponse+, post ) where -import Data.ByteString (ByteString)-import qualified Data.ByteString.Char8 as B-import Network.HTTP.Types-import Network.HTTP.Toolkit-import Network.HTTP.Toolkit.Body-import Text.InterpolatedString.Perl6 (qc)+import Network.HTTP.Toolkit+import Network.HTTP.Toolkit.Body+import Network.HTTP.Types+import Text.InterpolatedString.Perl6 (qc)+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Lazy.Char8 as BL8+import qualified Network.HTTP.Conduit as HTTP import qualified Logging as Log @@ -60,13 +65,35 @@ badRequest :: IO (Response BodyReader) badRequest = mkTextResponse badRequest400 "400 Bad Request" -mkResponse :: Status -> [Header] -> ByteString -> IO (Response BodyReader)+mkResponse :: Status -> [Header] -> B8.ByteString -> IO (Response BodyReader) mkResponse status headers_ body = Response status headers <$> fromByteString body where- headers = ("Content-Length", B.pack . show . B.length $ body) : headers_+ headers = ("Content-Length", B8.pack . show . B8.length $ body) : headers_ -mkTextResponse :: Status -> ByteString -> IO (Response BodyReader)+mkTextResponse :: Status -> B8.ByteString -> IO (Response BodyReader) mkTextResponse status = mkResponse status [("Content-Type", "text/plain")] -mkHtmlResponse :: Status -> ByteString -> IO (Response BodyReader)+mkHtmlResponse :: Status -> B8.ByteString -> IO (Response BodyReader) mkHtmlResponse status = mkResponse status [("Content-Type", "text/html")]++post :: String -> B8.ByteString -> IO (HTTP.Response BL8.ByteString)+post url body = do+ r' <- HTTP.parseUrl url+ let r = r' { HTTP.method = "POST"+ , HTTP.requestBody = HTTP.RequestBodyBS body+ , HTTP.requestHeaders+ = [ ("Content-Type" , "application/x-www-form-urlencoded")+ ]+ }+ manager <- HTTP.newManager HTTP.tlsManagerSettings+ HTTP.httpLbs r manager++get :: String -> [Header] -> IO (HTTP.Response BL8.ByteString)+get url hdrs = do+ r' <- HTTP.parseUrl url+ let r = r' { HTTP.method = "GET"+ , HTTP.requestHeaders = hdrs+ }+ manager <- HTTP.newManager HTTP.tlsManagerSettings+ HTTP.httpLbs r manager+
src/Main.hs view
@@ -17,7 +17,7 @@ usage :: String usage = "SProxy " ++ showVersion version ++- " HTTP proxy for authenticating users via Google OAuth2" ++ [r|+ " HTTP proxy for authenticating users via OAuth2" ++ [r| Usage: sproxy [options]
src/Proxy.hs view
@@ -1,4 +1,6 @@-{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+ module Proxy ( run ) where@@ -37,13 +39,17 @@ import qualified Network.TLS as TLS import qualified Network.TLS.Extra as TLS -import Authenticate+import Authenticate (loginPage, logout, redirectToLoginPage, validAuth)+import Authenticate.Token (AuthToken(..), AuthUser(..))+import Authenticate.Types (AuthConfig(..), OAuthClient(..)) import Authorize import ConfigFile import Cookies import HTTP import Type import Util+import qualified Authenticate.Google as Google+import qualified Authenticate.LinkedIn as LinkedIn import qualified Logging as Log data Config = Config {@@ -84,17 +90,19 @@ changeWorkingDirectory (homeDirectory u) `catch` (\e -> logException e >> changeWorkingDirectory "/") - clientSecret <- strip <$> readFile (cfClientSecretFile cf) authTokenKey <- B8.unpack . Base64.encode <$> getEntropy 32 credential <- either error reverseCerts <$> TLS.credentialLoadX509 (cfSslCerts cf) (cfSslKey cf) + googleCLient <- mkOAuthClient (cfGoogleClientID cf) (cfGoogleClientSecretFile cf)+ linkedInCLient <- mkOAuthClient (cfLinkedInClientID cf) (cfLinkedInClientSecretFile cf)+ let authConfig = AuthConfig { authConfigCookieDomain = cfCookieDomain cf , authConfigCookieName = cfCookieName cf- , authConfigClientID = cfClientID cf- , authConfigClientSecret = clientSecret , authConfigAuthTokenKey = authTokenKey , authConfigShelfLife = CTime . fromIntegral $ cfSessionShelfLife cf+ , authConfigGoogleClient = googleCLient+ , authConfigLinkedInClient = linkedInCLient } config = Config { configTLSCredential = credential@@ -112,6 +120,7 @@ ++ show p _ -> return () -- XXX can't happen + mvar <- newEmptyMVar void . forkIO $ (runOnSocket sock (serve config authConfig authorize) `catch` logException)@@ -128,6 +137,15 @@ -- but the tls library expects them in the opposite order. reverseCerts (X509.CertificateChain certs, key) = (X509.CertificateChain $ reverse certs, key) + mkOAuthClient :: Maybe String -> Maybe FilePath -> IO (Maybe OAuthClient)+ mkOAuthClient _ Nothing = return Nothing+ mkOAuthClient Nothing _ = return Nothing+ mkOAuthClient (Just cid) (Just f) = do+ sec <- strip <$> readFile f+ return . Just $ OAuthClient { oauthClientId = B8.pack cid+ , oauthClientSecret = B8.pack sec}++ -- | Redirects requests to https. redirectToHttps :: SockAddr -> Socket -> IO () redirectToHttps _ sock = do@@ -138,7 +156,7 @@ Just uri -> do let location = uri <> requestPath request Log.debug ("Redirecting HTTP request to " ++ show location)- simpleResponse send seeOther303 [("Location", location)] ""+ simpleResponse send movedPermanently301 [("Location", location)] "" Nothing -> hostHeaderMissing request >>= sendResponse send where send = Socket.sendAll sock@@ -173,45 +191,55 @@ request@(Request _ path headers _) <- readRequest True conn mResponse <- case baseUri (requestHeaders request) of Nothing -> Just <$> hostHeaderMissing request- Just uri -> do+ Just base -> do let (segments, query) = (decodePath . extractPath) path let redirectPath = fromMaybe "/" $ join $ lookup "state" query case segments of ["sproxy", "oauth2callback"] -> case join $ lookup "code" query of Nothing -> Just <$> badRequest- Just code -> Just <$> authenticate authConfig uri redirectPath code- ["sproxy", "logout"] ->- Just <$> logout authConfig (uri <> redirectPath)- -- sproxy sites are private by design. It doesn't make sense to index the authentication page.+ Just code -> Just <$> Google.authenticate authConfig base redirectPath code+ ["sproxy", "oauth2callback", "linkedin"] ->+ case join $ lookup "code" query of+ Nothing -> Just <$> badRequest+ Just code -> Just <$> LinkedIn.authenticate authConfig base redirectPath code+ ["sproxy", "login"] -> Just <$> loginPage authConfig base redirectPath+ ["sproxy", "logout"] -> Just <$> logout authConfig (base <> redirectPath) ["robots.txt"] -> Just <$> mkTextResponse ok200 "User-agent: *\nDisallow: /" _ -> -- Check for an auth cookie. case removeCookie (authConfigCookieName authConfig) (parseCookies headers) of- Nothing -> Just <$> redirectForAuth authConfig path uri+ Nothing -> Just <$> redirectToLoginPage base path Just (authCookie, cookies) -> do auth <- validAuth authConfig authCookie case auth of- Nothing -> Just <$> redirectForAuth authConfig path uri+ Nothing -> Just <$> redirectToLoginPage base path Just token -> forwardRequest config send authorize cookies addr request token forM_ mResponse (sendResponse send) return ((not . isConnectionClose) headers) -- Check our access control list for this user's request and forward it to the backend if allowed.-forwardRequest :: Config -> SendData -> AuthorizeAction -> [(Name, Cookies.Value)] -> SockAddr -> Request BodyReader -> AuthToken -> IO (Maybe (Response BodyReader))+forwardRequest :: Config+ -> SendData+ -> AuthorizeAction+ -> [(Name, Cookies.Value)]+ -> SockAddr+ -> Request BodyReader+ -> AuthToken+ -> IO (Maybe (Response BodyReader)) forwardRequest config send authorize cookies addr request@(Request method path headers _) token = do- groups <- authorize (authEmail token) (maybe (error "No Host") cs $ lookup "Host" headers) path method+ groups <- authorize (authUserEmail . authUser $ token) (maybe (error "No Host") cs $ lookup "Host" headers) path method ip <- formatSockAddr addr case groups of- [] -> Just <$> accessDenied (authEmail token)+ [] -> Just <$> accessDenied (authUserEmail . authUser $ token) _ -> do -- TODO: Reuse connections to the backend server. let downStreamHeaders = toList $- insert "From" (cs $ authEmail token) $+ insert "From" (cs . authUserEmail . authUser $ token) $ insert "X-Groups" (cs $ intercalate "," groups) $- insert "X-Given-Name" (cs $ fst $ authName token) $- insert "X-Family-Name" (cs $ snd $ authName token) $+ insert "X-Given-Name" (cs . authUserGivenName . authUser $ token) $+ insert "X-Family-Name" (cs . authUserFamilyName . authUser $ token) $ insert "X-Forwarded-Proto" "https" $ addForwardedForHeader ip $ insert "Connection" "close" $