diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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 ====== diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,5 +1,5 @@ Copyright (c) 2016, Zalora South East Asia Pte. Ltd -Copyright (c) 2017, Igor Pashev +Copyright (c) 2017-2019, Igor Pashev Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the diff --git a/sproxy2.cabal b/sproxy2.cabal --- a/sproxy2.cabal +++ b/sproxy2.cabal @@ -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 +copyright: 2016-2017, Zalora South East Asia Pte. Ltd; + 2017-2019, Igor Pashev maintainer: Igor Pashev -copyright: - 2016-2017, Zalora South East Asia Pte. Ltd; - 2017-2018, Igor Pashev +author: Igor Pashev +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 diff --git a/src/Sproxy/Application.hs b/src/Sproxy/Application.hs --- a/src/Sproxy/Application.hs +++ b/src/Sproxy/Application.hs @@ -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}

Authenticate with {d}

|] + in [qc|{html}

Authenticate with {d}

|] 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 diff --git a/src/Sproxy/Application/Cookie.hs b/src/Sproxy/Application/Cookie.hs --- a/src/Sproxy/Application/Cookie.hs +++ b/src/Sproxy/Application/Cookie.hs @@ -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} diff --git a/src/Sproxy/Application/OAuth2/Google.hs b/src/Sproxy/Application/OAuth2/Google.hs --- a/src/Sproxy/Application/OAuth2/Google.hs +++ b/src/Sproxy/Application/OAuth2/Google.hs @@ -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) diff --git a/src/Sproxy/Application/OAuth2/LinkedIn.hs b/src/Sproxy/Application/OAuth2/LinkedIn.hs --- a/src/Sproxy/Application/OAuth2/LinkedIn.hs +++ b/src/Sproxy/Application/OAuth2/LinkedIn.hs @@ -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) diff --git a/src/Sproxy/Application/OAuth2/Yandex.hs b/src/Sproxy/Application/OAuth2/Yandex.hs --- a/src/Sproxy/Application/OAuth2/Yandex.hs +++ b/src/Sproxy/Application/OAuth2/Yandex.hs @@ -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) diff --git a/src/Sproxy/Server.hs b/src/Sproxy/Server.hs --- a/src/Sproxy/Server.hs +++ b/src/Sproxy/Server.hs @@ -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 diff --git a/src/Sproxy/Server/DB.hs b/src/Sproxy/Server/DB.hs --- a/src/Sproxy/Server/DB.hs +++ b/src/Sproxy/Server/DB.hs @@ -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