sproxy2 1.97.0 → 1.97.1
raw patch · 10 files changed
+377/−302 lines, 10 files
Files
- ChangeLog.md +6/−0
- LICENSE +1/−1
- sproxy2.cabal +65/−67
- src/Sproxy/Application.hs +88/−59
- src/Sproxy/Application/Cookie.hs +7/−7
- src/Sproxy/Application/OAuth2/Google.hs +51/−49
- src/Sproxy/Application/OAuth2/LinkedIn.hs +51/−50
- src/Sproxy/Application/OAuth2/Yandex.hs +45/−43
- src/Sproxy/Server.hs +58/−24
- src/Sproxy/Server/DB.hs +5/−2
ChangeLog.md view
@@ -1,3 +1,9 @@+1.97.1+======++ * Update for newer network library (>= 3.0.0.0) where `inet_addr` has been removed.++ 1.97.0 ======
LICENSE view
@@ -1,5 +1,5 @@ Copyright (c) 2016, Zalora South East Asia Pte. Ltd-Copyright (c) 2017, Igor Pashev <pashev.igor@gmail.com>+Copyright (c) 2017-2019, Igor Pashev <pashev.igor@gmail.com> Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the
sproxy2.cabal view
@@ -1,81 +1,79 @@+cabal-version: 1.20 name: sproxy2-version: 1.97.0-synopsis: Secure HTTP proxy for authenticating users via OAuth2-description:- Sproxy is secure by default. No requests makes it to the backend- server if they haven't been explicitly whitelisted. Sproxy is- independent. Any web application written in any language can- use it.+version: 1.97.1 license: MIT license-file: LICENSE-author: Igor Pashev <pashev.igor@gmail.com>+copyright: 2016-2017, Zalora South East Asia Pte. Ltd;+ 2017-2019, Igor Pashev <pashev.igor@gmail.com> maintainer: Igor Pashev <pashev.igor@gmail.com>-copyright:- 2016-2017, Zalora South East Asia Pte. Ltd;- 2017-2018, Igor Pashev <pashev.igor@gmail.com>+author: Igor Pashev <pashev.igor@gmail.com>+synopsis: Secure HTTP proxy for authenticating users via OAuth2+description:+ Sproxy is secure by default. No requests makes it to the backend+ server if they haven't been explicitly whitelisted. Sproxy is+ independent. Any web application written in any language can+ use it. category: Databases, Web build-type: Simple-cabal-version: 1.20 extra-source-files:- ChangeLog.md- README.md- datafile.example.yml- sproxy.example.yml- sproxy.sql+ ChangeLog.md+ README.md+ datafile.example.yml+ sproxy.example.yml+ sproxy.sql source-repository head- type: git- location: https://github.com/ip1981/sproxy2.git+ type: git+ location: https://github.com/ip1981/sproxy2.git executable sproxy2- default-language: Haskell2010- ghc-options: -Wall -static -threaded- hs-source-dirs: src main-is: Main.hs+ hs-source-dirs: src other-modules:- Sproxy.Application- Sproxy.Application.Access- Sproxy.Application.Cookie- Sproxy.Application.OAuth2- Sproxy.Application.OAuth2.Common- Sproxy.Application.OAuth2.Google- Sproxy.Application.OAuth2.LinkedIn- Sproxy.Application.OAuth2.Yandex- Sproxy.Application.State- Sproxy.Config- Sproxy.Logging- Sproxy.Server- Sproxy.Server.DB- Sproxy.Server.DB.DataFile+ Sproxy.Application+ Sproxy.Application.Access+ Sproxy.Application.Cookie+ Sproxy.Application.OAuth2+ Sproxy.Application.OAuth2.Common+ Sproxy.Application.OAuth2.Google+ Sproxy.Application.OAuth2.LinkedIn+ Sproxy.Application.OAuth2.Yandex+ Sproxy.Application.State+ Sproxy.Config+ Sproxy.Logging+ Sproxy.Server+ Sproxy.Server.DB+ Sproxy.Server.DB.DataFile+ default-language: Haskell2010+ ghc-options: -Wall -static -threaded build-depends:- base >= 4.8 && < 50- , aeson- , base64-bytestring- , blaze-builder- , bytestring- , cereal- , conduit- , cookie >= 0.4.2- , docopt- , entropy- , Glob- , http-client >= 0.5.3- , http-conduit- , http-types- , interpolatedstring-perl6- , network- , postgresql-simple- , resource-pool- , SHA- , sqlite-simple- , text- , time- , unix- , unordered-containers- , wai- , wai-conduit- , warp- , warp-tls >= 3.2- , word8- , yaml >= 0.8.4-+ base >=4.8 && <50,+ aeson -any,+ base64-bytestring -any,+ blaze-builder -any,+ bytestring -any,+ cereal -any,+ conduit -any,+ cookie >=0.4.2,+ docopt -any,+ entropy -any,+ Glob -any,+ http-client >=0.5.3,+ http-conduit -any,+ http-types -any,+ interpolatedstring-perl6 -any,+ network -any,+ postgresql-simple -any,+ resource-pool -any,+ SHA -any,+ sqlite-simple -any,+ text -any,+ time -any,+ unix -any,+ unordered-containers -any,+ wai -any,+ wai-conduit -any,+ warp -any,+ warp-tls >=3.2,+ word8 -any,+ yaml >=0.8.4
src/Sproxy/Application.hs view
@@ -10,7 +10,12 @@ import Blaze.ByteString.Builder (toByteString) import Blaze.ByteString.Builder.ByteString (fromByteString) import Control.Exception- (Exception, Handler(..), SomeException, catches, displayException)+ ( Exception+ , Handler(..)+ , SomeException+ , catches+ , displayException+ ) import qualified Data.Aeson as JSON import Data.ByteString (ByteString) import qualified Data.ByteString as BS@@ -29,18 +34,36 @@ import Foreign.C.Types (CTime(..)) import qualified Network.HTTP.Client as BE import Network.HTTP.Client.Conduit (bodyReaderSource)-import Network.HTTP.Conduit- (requestBodySourceChunkedIO, requestBodySourceIO)+import Network.HTTP.Conduit (requestBodySourceChunkedIO, requestBodySourceIO) import Network.HTTP.Types- (RequestHeaders, ResponseHeaders, methodGet, methodPost)+ ( RequestHeaders+ , ResponseHeaders+ , methodGet+ , methodPost+ ) import Network.HTTP.Types.Header- (hConnection, hContentLength, hContentType, hCookie, hLocation,- hTransferEncoding)+ ( hConnection+ , hContentLength+ , hContentType+ , hCookie+ , hLocation+ , hTransferEncoding+ ) import Network.HTTP.Types.Status- (Status(..), badGateway502, badRequest400, forbidden403, found302,- internalServerError500, methodNotAllowed405, movedPermanently301,- networkAuthenticationRequired511, notFound404, ok200, seeOther303,- temporaryRedirect307)+ ( Status(..)+ , badGateway502+ , badRequest400+ , forbidden403+ , found302+ , internalServerError500+ , methodNotAllowed405+ , movedPermanently301+ , networkAuthenticationRequired511+ , notFound404+ , ok200+ , seeOther303+ , temporaryRedirect307+ ) import Network.Socket (NameInfoFlag(NI_NUMERICHOST), getNameInfo) import qualified Network.Wai as W import Network.Wai.Conduit (responseSource, sourceRequestBody)@@ -51,14 +74,20 @@ import qualified Web.Cookie as WC import Sproxy.Application.Cookie- (AuthCookie(..), AuthUser, cookieDecode, cookieEncode, getEmail,- getEmailUtf8, getFamilyNameUtf8, getGivenNameUtf8)+ ( AuthCookie(..)+ , AuthUser+ , cookieDecode+ , cookieEncode+ , getEmail+ , getEmailUtf8+ , getFamilyNameUtf8+ , getGivenNameUtf8+ ) import Sproxy.Application.OAuth2.Common (OAuth2Client(..)) import qualified Sproxy.Application.State as State import Sproxy.Config (BackendConf(..)) import qualified Sproxy.Logging as Log-import Sproxy.Server.DB- (Database, userAccess, userExists, userGroups)+import Sproxy.Server.DB (Database, userAccess, userExists, userGroups) redirect :: Word16 -> W.Application redirect p req resp =@@ -189,16 +218,16 @@ authCookie = AuthCookie {acUser = user, acExpiry = expiry} cookie = WC.def- { WC.setCookieName = pack $ beCookieName be- , WC.setCookieHttpOnly = True- , WC.setCookiePath = Just "/"- , WC.setCookieSameSite = Nothing- , WC.setCookieSecure = True- , WC.setCookieValue = cookieEncode key authCookie- , WC.setCookieDomain = domain- , WC.setCookieExpires =- Just . posixSecondsToUTCTime . realToFrac $ expiry- }+ { WC.setCookieName = pack $ beCookieName be+ , WC.setCookieHttpOnly = True+ , WC.setCookiePath = Just "/"+ , WC.setCookieSameSite = Nothing+ , WC.setCookieSecure = True+ , WC.setCookieValue = cookieEncode key authCookie+ , WC.setCookieDomain = domain+ , WC.setCookieExpires =+ Just . posixSecondsToUTCTime . realToFrac $ expiry+ } resp $ W.responseLBS seeOther303@@ -227,17 +256,17 @@ getNameInfo [NI_NUMERICHOST] True False (W.remoteHost req) return . Just $ req- { W.requestHeaders =- HM.toList $- HM.insert "From" emailUtf8 $- HM.insert "X-Groups" (BS.intercalate "," $ encodeUtf8 <$> grps) $- HM.insert "X-Given-Name" givenUtf8 $- HM.insert "X-Family-Name" familyUtf8 $- HM.insert "X-Forwarded-Proto" "https" $- HM.insertWith (flip combine) "X-Forwarded-For" ip $- setCookies otherCookies $- HM.fromListWith combine $ W.requestHeaders req- }+ { W.requestHeaders =+ HM.toList $+ HM.insert "From" emailUtf8 $+ HM.insert "X-Groups" (BS.intercalate "," $ encodeUtf8 <$> grps) $+ HM.insert "X-Given-Name" givenUtf8 $+ HM.insert "X-Family-Name" familyUtf8 $+ HM.insert "X-Forwarded-Proto" "https" $+ HM.insertWith (flip combine) "X-Forwarded-For" ip $+ setCookies otherCookies $+ HM.fromListWith combine $ W.requestHeaders req+ } where combine a b = a <> "," <> b setCookies [] = HM.delete hCookie@@ -267,19 +296,19 @@ forward mgr req resp = do let beReq = BE.defaultRequest- { BE.method = W.requestMethod req- , BE.path = W.rawPathInfo req- , BE.queryString = W.rawQueryString req- , BE.requestHeaders = modifyRequestHeaders $ W.requestHeaders req- , BE.redirectCount = 0- , BE.decompress = const False- , BE.requestBody =- case W.requestBodyLength req of- W.ChunkedBody ->- requestBodySourceChunkedIO (sourceRequestBody req)- W.KnownLength l ->- requestBodySourceIO (fromIntegral l) (sourceRequestBody req)- }+ { BE.method = W.requestMethod req+ , BE.path = W.rawPathInfo req+ , BE.queryString = W.rawQueryString req+ , BE.requestHeaders = modifyRequestHeaders $ W.requestHeaders req+ , BE.redirectCount = 0+ , BE.decompress = const False+ , BE.requestBody =+ case W.requestBodyLength req of+ W.ChunkedBody ->+ requestBodySourceChunkedIO (sourceRequestBody req)+ W.KnownLength l ->+ requestBodySourceIO (fromIntegral l) (sourceRequestBody req)+ } msg = unpack (BE.method beReq <> " " <> BE.path beReq <> BE.queryString beReq) Log.debug $ "BACKEND <<< " ++ msg ++ " " ++ show (BE.requestHeaders beReq)@@ -339,7 +368,7 @@ authLink provider oa2c html = let u = oauth2AuthorizeURL oa2c state (redirectURL req provider) d = pack $ oauth2Description oa2c- in [qc|{html}<p><a href="{u}">Authenticate with {d}</a></p>|]+ in [qc|{html}<p><a href="{u}">Authenticate with {d}</a></p>|] authHtml = HM.foldrWithKey authLink "" oa2 page = fromStrict@@ -414,16 +443,16 @@ Just _ -> do let cookie = WC.def- { WC.setCookieName = cookieName- , WC.setCookieHttpOnly = True- , WC.setCookiePath = Just "/"- , WC.setCookieSameSite = Just WC.sameSiteStrict- , WC.setCookieSecure = True- , WC.setCookieValue = "goodbye"- , WC.setCookieDomain = cookieDomain- , WC.setCookieExpires =- Just . posixSecondsToUTCTime . realToFrac $ CTime 0- }+ { WC.setCookieName = cookieName+ , WC.setCookieHttpOnly = True+ , WC.setCookiePath = Just "/"+ , WC.setCookieSameSite = Just WC.sameSiteStrict+ , WC.setCookieSecure = True+ , WC.setCookieValue = "goodbye"+ , WC.setCookieDomain = cookieDomain+ , WC.setCookieExpires =+ Just . posixSecondsToUTCTime . realToFrac $ CTime 0+ } resp $ W.responseLBS found302
src/Sproxy/Application/Cookie.hs view
@@ -42,9 +42,9 @@ (e, n, f, x) <- DS.get return AuthCookie- { acUser = AuthUser {auEmail = e, auGivenName = n, auFamilyName = f}- , acExpiry = CTime x- }+ { acUser = AuthUser {auEmail = e, auGivenName = n, auFamilyName = f}+ , acExpiry = CTime x+ } cookieDecode :: ByteString -> ByteString -> Either String AuthCookie cookieDecode key d = State.decode key d >>= DS.decode@@ -67,10 +67,10 @@ newUser :: Text -> AuthUser newUser email = AuthUser- { auEmail = encodeUtf8 . toLower . strip $ email- , auGivenName = ""- , auFamilyName = ""- }+ { auEmail = encodeUtf8 . toLower . strip $ email+ , auGivenName = ""+ , auFamilyName = ""+ } setGivenName :: Text -> AuthUser -> AuthUser setGivenName given au = au {auGivenName = encodeUtf8 . strip $ given}
src/Sproxy/Application/OAuth2/Google.hs view
@@ -7,8 +7,7 @@ import Control.Applicative (empty) import Control.Exception (Exception, throwIO)-import Data.Aeson- (FromJSON, Value(Object), (.:), decode, parseJSON)+import Data.Aeson (FromJSON, Value(Object), (.:), decode, parseJSON) import Data.ByteString.Lazy (ByteString) import Data.Monoid ((<>)) import Data.Text (Text, unpack)@@ -16,58 +15,61 @@ import qualified Network.HTTP.Conduit as H import Network.HTTP.Types.URI (urlEncode) -import Sproxy.Application.Cookie- (newUser, setFamilyName, setGivenName)+import Sproxy.Application.Cookie (newUser, setFamilyName, setGivenName) import Sproxy.Application.OAuth2.Common- (AccessTokenBody(accessToken), OAuth2Client(..), OAuth2Provider)+ ( AccessTokenBody(accessToken)+ , OAuth2Client(..)+ , OAuth2Provider+ ) provider :: OAuth2Provider provider (client_id, client_secret) = OAuth2Client- { oauth2Description = "Google"- , oauth2AuthorizeURL =- \state redirect_uri ->- "https://accounts.google.com/o/oauth2/v2/auth" <> "?scope=" <>- urlEncode- True- "https://www.googleapis.com/auth/userinfo.email https://www.googleapis.com/auth/userinfo.profile" <>- "&client_id=" <>- urlEncode True client_id <>- "&prompt=select_account" <>- "&redirect_uri=" <>- urlEncode True redirect_uri <>- "&response_type=code" <>- "&state=" <>- urlEncode True state- , oauth2Authenticate =- \code redirect_uri -> do- let treq =- H.urlEncodedBody- [ ("client_id", client_id)- , ("client_secret", client_secret)- , ("code", code)- , ("grant_type", "authorization_code")- , ("redirect_uri", redirect_uri)- ] $- H.parseRequest_ "POST https://www.googleapis.com/oauth2/v4/token"- mgr <- H.newManager H.tlsManagerSettings- tresp <- H.httpLbs treq mgr- case decode $ H.responseBody tresp of- Nothing -> throwIO $ GoogleException tresp- Just atResp -> do- ureq <-- H.parseRequest $- unpack- ("https://www.googleapis.com/oauth2/v1/userinfo?access_token=" <>- accessToken atResp)- uresp <- H.httpLbs ureq mgr- case decode $ H.responseBody uresp of- Nothing -> throwIO $ GoogleException uresp- Just u ->- return $- setFamilyName (familyName u) $- setGivenName (givenName u) $ newUser (email u)- }+ { oauth2Description = "Google"+ , oauth2AuthorizeURL =+ \state redirect_uri ->+ "https://accounts.google.com/o/oauth2/v2/auth" <> "?scope=" <>+ urlEncode+ True+ "https://www.googleapis.com/auth/userinfo.email https://www.googleapis.com/auth/userinfo.profile" <>+ "&client_id=" <>+ urlEncode True client_id <>+ "&prompt=select_account" <>+ "&redirect_uri=" <>+ urlEncode True redirect_uri <>+ "&response_type=code" <>+ "&state=" <>+ urlEncode True state+ , oauth2Authenticate =+ \code redirect_uri -> do+ let treq =+ H.urlEncodedBody+ [ ("client_id", client_id)+ , ("client_secret", client_secret)+ , ("code", code)+ , ("grant_type", "authorization_code")+ , ("redirect_uri", redirect_uri)+ ] $+ H.parseRequest_+ "POST https://www.googleapis.com/oauth2/v4/token"+ mgr <- H.newManager H.tlsManagerSettings+ tresp <- H.httpLbs treq mgr+ case decode $ H.responseBody tresp of+ Nothing -> throwIO $ GoogleException tresp+ Just atResp -> do+ ureq <-+ H.parseRequest $+ unpack+ ("https://www.googleapis.com/oauth2/v1/userinfo?access_token=" <>+ accessToken atResp)+ uresp <- H.httpLbs ureq mgr+ case decode $ H.responseBody uresp of+ Nothing -> throwIO $ GoogleException uresp+ Just u ->+ return $+ setFamilyName (familyName u) $+ setGivenName (givenName u) $ newUser (email u)+ } data GoogleException = GoogleException (H.Response ByteString)
src/Sproxy/Application/OAuth2/LinkedIn.hs view
@@ -7,8 +7,7 @@ import Control.Applicative (empty) import Control.Exception (Exception, throwIO)-import Data.Aeson- (FromJSON, Value(Object), (.:), decode, parseJSON)+import Data.Aeson (FromJSON, Value(Object), (.:), decode, parseJSON) import Data.ByteString.Lazy (ByteString) import Data.Monoid ((<>)) import Data.Text (Text)@@ -17,60 +16,62 @@ import qualified Network.HTTP.Conduit as H import Network.HTTP.Types.URI (urlEncode) -import Sproxy.Application.Cookie- (newUser, setFamilyName, setGivenName)+import Sproxy.Application.Cookie (newUser, setFamilyName, setGivenName) import Sproxy.Application.OAuth2.Common- (AccessTokenBody(accessToken), OAuth2Client(..), OAuth2Provider)+ ( AccessTokenBody(accessToken)+ , OAuth2Client(..)+ , OAuth2Provider+ ) provider :: OAuth2Provider provider (client_id, client_secret) = OAuth2Client- { oauth2Description = "LinkedIn"- , oauth2AuthorizeURL =- \state redirect_uri ->- "https://www.linkedin.com/oauth/v2/authorization" <>- "?scope=r_basicprofile%20r_emailaddress" <>- "&client_id=" <>- urlEncode True client_id <>- "&redirect_uri=" <>- urlEncode True redirect_uri <>- "&response_type=code" <>- "&state=" <>- urlEncode True state- , oauth2Authenticate =- \code redirect_uri -> do- let treq =- H.urlEncodedBody- [ ("client_id", client_id)- , ("client_secret", client_secret)- , ("code", code)- , ("grant_type", "authorization_code")- , ("redirect_uri", redirect_uri)- ] $- H.parseRequest_- "POST https://www.linkedin.com/oauth/v2/accessToken"- mgr <- H.newManager H.tlsManagerSettings- tresp <- H.httpLbs treq mgr- case decode $ H.responseBody tresp of- Nothing -> throwIO $ LinkedInException tresp- Just atResp -> do- let ureq =- (H.parseRequest_- "https://api.linkedin.com/v1/people/\+ { oauth2Description = "LinkedIn"+ , oauth2AuthorizeURL =+ \state redirect_uri ->+ "https://www.linkedin.com/oauth/v2/authorization" <>+ "?scope=r_basicprofile%20r_emailaddress" <>+ "&client_id=" <>+ urlEncode True client_id <>+ "&redirect_uri=" <>+ urlEncode True redirect_uri <>+ "&response_type=code" <>+ "&state=" <>+ urlEncode True state+ , oauth2Authenticate =+ \code redirect_uri -> do+ let treq =+ H.urlEncodedBody+ [ ("client_id", client_id)+ , ("client_secret", client_secret)+ , ("code", code)+ , ("grant_type", "authorization_code")+ , ("redirect_uri", redirect_uri)+ ] $+ H.parseRequest_+ "POST https://www.linkedin.com/oauth/v2/accessToken"+ mgr <- H.newManager H.tlsManagerSettings+ tresp <- H.httpLbs treq mgr+ case decode $ H.responseBody tresp of+ Nothing -> throwIO $ LinkedInException tresp+ Just atResp -> do+ let ureq =+ (H.parseRequest_+ "https://api.linkedin.com/v1/people/\ \~:(email-address,first-name,last-name)?format=json")- { H.requestHeaders =- [ ( "Authorization"- , "Bearer " <> encodeUtf8 (accessToken atResp))- ]- }- uresp <- H.httpLbs ureq mgr- case decode $ H.responseBody uresp of- Nothing -> throwIO $ LinkedInException uresp- Just u ->- return $- setFamilyName (lastName u) $- setGivenName (firstName u) $ newUser (emailAddress u)- }+ { H.requestHeaders =+ [ ( "Authorization"+ , "Bearer " <> encodeUtf8 (accessToken atResp))+ ]+ }+ uresp <- H.httpLbs ureq mgr+ case decode $ H.responseBody uresp of+ Nothing -> throwIO $ LinkedInException uresp+ Just u ->+ return $+ setFamilyName (lastName u) $+ setGivenName (firstName u) $ newUser (emailAddress u)+ } data LinkedInException = LinkedInException (H.Response ByteString)
src/Sproxy/Application/OAuth2/Yandex.hs view
@@ -7,8 +7,7 @@ import Control.Applicative (empty) import Control.Exception (Exception, throwIO)-import Data.Aeson- (FromJSON, Value(Object), (.:), decode, parseJSON)+import Data.Aeson (FromJSON, Value(Object), (.:), decode, parseJSON) import Data.ByteString.Lazy (ByteString) import Data.Monoid ((<>)) import Data.Text (Text)@@ -17,52 +16,55 @@ import qualified Network.HTTP.Conduit as H import Network.HTTP.Types.URI (urlEncode) -import Sproxy.Application.Cookie- (newUser, setFamilyName, setGivenName)+import Sproxy.Application.Cookie (newUser, setFamilyName, setGivenName) import Sproxy.Application.OAuth2.Common- (AccessTokenBody(accessToken), OAuth2Client(..), OAuth2Provider)+ ( AccessTokenBody(accessToken)+ , OAuth2Client(..)+ , OAuth2Provider+ ) provider :: OAuth2Provider provider (client_id, client_secret) = OAuth2Client- { oauth2Description = "Yandex"- , oauth2AuthorizeURL =- \state _redirect_uri ->- "https://oauth.yandex.ru/authorize" <> "?state=" <> urlEncode True state <>- "&client_id=" <>- urlEncode True client_id <>- "&response_type=code" <>- "&force_confirm=yes"- , oauth2Authenticate =- \code _redirect_uri -> do- let treq =- H.urlEncodedBody- [ ("grant_type", "authorization_code")- , ("client_id", client_id)- , ("client_secret", client_secret)- , ("code", code)- ] $- H.parseRequest_ "POST https://oauth.yandex.ru/token"- mgr <- H.newManager H.tlsManagerSettings- tresp <- H.httpLbs treq mgr- case decode $ H.responseBody tresp of- Nothing -> throwIO $ YandexException tresp- Just atResp -> do- let ureq =- (H.parseRequest_ "https://login.yandex.ru/info?format=json")- { H.requestHeaders =- [ ( "Authorization"- , "OAuth " <> encodeUtf8 (accessToken atResp))- ]- }- uresp <- H.httpLbs ureq mgr- case decode $ H.responseBody uresp of- Nothing -> throwIO $ YandexException uresp- Just u ->- return $- setFamilyName (lastName u) $- setGivenName (firstName u) $ newUser (defaultEmail u)- }+ { oauth2Description = "Yandex"+ , oauth2AuthorizeURL =+ \state _redirect_uri ->+ "https://oauth.yandex.ru/authorize" <> "?state=" <>+ urlEncode True state <>+ "&client_id=" <>+ urlEncode True client_id <>+ "&response_type=code" <>+ "&force_confirm=yes"+ , oauth2Authenticate =+ \code _redirect_uri -> do+ let treq =+ H.urlEncodedBody+ [ ("grant_type", "authorization_code")+ , ("client_id", client_id)+ , ("client_secret", client_secret)+ , ("code", code)+ ] $+ H.parseRequest_ "POST https://oauth.yandex.ru/token"+ mgr <- H.newManager H.tlsManagerSettings+ tresp <- H.httpLbs treq mgr+ case decode $ H.responseBody tresp of+ Nothing -> throwIO $ YandexException tresp+ Just atResp -> do+ let ureq =+ (H.parseRequest_ "https://login.yandex.ru/info?format=json")+ { H.requestHeaders =+ [ ( "Authorization"+ , "OAuth " <> encodeUtf8 (accessToken atResp))+ ]+ }+ uresp <- H.httpLbs ureq mgr+ case decode $ H.responseBody uresp of+ Nothing -> throwIO $ YandexException uresp+ Just u ->+ return $+ setFamilyName (lastName u) $+ setGivenName (firstName u) $ newUser (defaultEmail u)+ } data YandexException = YandexException (H.Response ByteString)
src/Sproxy/Server.hs view
@@ -9,21 +9,46 @@ import qualified Data.HashMap.Strict as HM import Data.Maybe (fromMaybe) import Data.Text (Text)-import Data.Word (Word16) import Data.Yaml.Include (decodeFileEither) import Network.HTTP.Client- (Manager, ManagerSettings(..), defaultManagerSettings, newManager,- responseTimeoutMicro, socketConnection)+ ( Manager+ , ManagerSettings(..)+ , defaultManagerSettings+ , newManager+ , responseTimeoutMicro+ , socketConnection+ ) import Network.HTTP.Client.Internal (Connection) import Network.Socket- (Family(AF_INET, AF_UNIX), SockAddr(SockAddrInet, SockAddrUnix),- Socket, SocketOption(ReuseAddr), SocketType(Stream), bind, close,- connect, inet_addr, listen, maxListenQueue, setSocketOption,- socket)+ ( AddrInfoFlag(AI_NUMERICSERV)+ , Family(AF_INET, AF_UNIX)+ , SockAddr(SockAddrInet, SockAddrUnix)+ , Socket+ , SocketOption(ReuseAddr)+ , SocketType(Stream)+ , addrAddress+ , addrFamily+ , addrFlags+ , addrProtocol+ , addrSocketType+ , bind+ , close+ , connect+ , defaultHints+ , getAddrInfo+ , listen+ , maxListenQueue+ , setSocketOption+ , socket+ ) import Network.Wai (Application) import Network.Wai.Handler.Warp- (Settings, defaultSettings, runSettingsSocket, setHTTP2Disabled,- setOnException)+ ( Settings+ , defaultSettings+ , runSettingsSocket+ , setHTTP2Disabled+ , setOnException+ ) import Network.Wai.Handler.WarpTLS (runTLSSocket, tlsSettingsChain) import System.Entropy (getEntropy) import System.Environment (setEnv)@@ -31,14 +56,20 @@ import System.FilePath.Glob (compile) import System.IO (hPutStrLn, stderr) import System.Posix.User- (GroupEntry(..), UserEntry(..), getAllGroupEntries, getRealUserID,- getUserEntryForName, setGroupID, setGroups, setUserID)+ ( GroupEntry(..)+ , UserEntry(..)+ , getAllGroupEntries+ , getRealUserID+ , getUserEntryForName+ , setGroupID+ , setGroups+ , setUserID+ ) import Sproxy.Application (redirect, sproxy) import qualified Sproxy.Application.OAuth2 as OAuth2 import Sproxy.Application.OAuth2.Common (OAuth2Client)-import Sproxy.Config- (BackendConf(..), ConfigFile(..), OAuth2Conf(..))+import Sproxy.Config (BackendConf(..), ConfigFile(..), OAuth2Conf(..)) import qualified Sproxy.Logging as Log import qualified Sproxy.Server.DB as DB @@ -142,18 +173,19 @@ Log.info $ "backend `" ++ beName be ++ "' on UNIX socket " ++ f return $ openUnixSocketConnection f (Nothing, Just n) -> do+ let svc = show n Log.info $- "backend `" ++ beName be ++ "' on " ++ beAddress be ++ ":" ++ show n- return $ openTCPConnection (beAddress be) n+ "backend `" ++ beName be ++ "' on " ++ beAddress be ++ ":" ++ svc+ return $ openTCPConnection (beAddress be) svc _ -> do Log.error "either backend port number or UNIX socket path is required." exitFailure newManager defaultManagerSettings- { managerRawConnection = return $ \_ _ _ -> openConn- , managerConnCount = beConnCount be- , managerResponseTimeout = responseTimeoutMicro (1000000 * beTimeout be)- }+ { managerRawConnection = return $ \_ _ _ -> openConn+ , managerConnCount = beConnCount be+ , managerResponseTimeout = responseTimeoutMicro (1000000 * beTimeout be)+ } newServer :: ConfigFile -> IO (Settings -> Socket -> Application -> IO ()) newServer cf@@ -177,15 +209,17 @@ connect s (SockAddrUnix f) socketConnection s 8192) -openTCPConnection :: String -> Word16 -> IO Connection-openTCPConnection addr port =+openTCPConnection :: String -> String -> IO Connection+openTCPConnection host svc = do+ addr:_ <- getAddrInfo (Just hints) (Just host) (Just svc) bracketOnError- (socket AF_INET Stream 0)+ (socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)) close (\s -> do- a <- inet_addr addr- connect s (SockAddrInet (fromIntegral port) a)+ connect s (addrAddress addr) socketConnection s 8192)+ where+ hints = defaultHints {addrFlags = [AI_NUMERICSERV], addrSocketType = Stream} readConfigFile :: FilePath -> IO ConfigFile readConfigFile f = do
src/Sproxy/Server/DB.hs view
@@ -26,8 +26,11 @@ import qualified Sproxy.Application.Access as A import qualified Sproxy.Logging as Log import Sproxy.Server.DB.DataFile- (DataFile(..), GroupMember(..), GroupPrivilege(..),- PrivilegeRule(..))+ ( DataFile(..)+ , GroupMember(..)+ , GroupPrivilege(..)+ , PrivilegeRule(..)+ ) type Database = Pool SQLite.Connection