aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Sproxy/Application.hs147
-rw-r--r--src/Sproxy/Application/Cookie.hs14
-rw-r--r--src/Sproxy/Application/OAuth2/Google.hs100
-rw-r--r--src/Sproxy/Application/OAuth2/LinkedIn.hs101
-rw-r--r--src/Sproxy/Application/OAuth2/Yandex.hs88
-rw-r--r--src/Sproxy/Server.hs65
-rw-r--r--src/Sproxy/Server/DB.hs7
7 files changed, 295 insertions, 227 deletions
diff --git a/src/Sproxy/Application.hs b/src/Sproxy/Application.hs
index c05844b..d2880ce 100644
--- a/src/Sproxy/Application.hs
+++ b/src/Sproxy/Application.hs
@@ -10,7 +10,12 @@ module Sproxy.Application
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 Data.Word8 (_colon)
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 Web.Cookie (Cookies, parseCookies, renderCookies)
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 @@ authenticate key be user url _req resp = do
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 @@ authorize db (authCookie, otherCookies) req = do
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 :: BE.Manager -> W.Application
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 @@ authenticationRequired key oa2 req resp = do
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 @@ logout key cookieName cookieDomain req resp = do
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
index a9a8ad6..d027e19 100644
--- a/src/Sproxy/Application/Cookie.hs
+++ b/src/Sproxy/Application/Cookie.hs
@@ -42,9 +42,9 @@ instance DS.Serialize AuthCookie where
(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 @@ getFamilyNameUtf8 = auFamilyName
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
index b2ea2c1..82c08c0 100644
--- a/src/Sproxy/Application/OAuth2/Google.hs
+++ b/src/Sproxy/Application/OAuth2/Google.hs
@@ -7,8 +7,7 @@ module Sproxy.Application.OAuth2.Google
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 Data.Typeable (Typeable)
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
index 3fdd7be..905aa56 100644
--- a/src/Sproxy/Application/OAuth2/LinkedIn.hs
+++ b/src/Sproxy/Application/OAuth2/LinkedIn.hs
@@ -7,8 +7,7 @@ module Sproxy.Application.OAuth2.LinkedIn
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 Data.Typeable (Typeable)
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
index e943a39..174cca9 100644
--- a/src/Sproxy/Application/OAuth2/Yandex.hs
+++ b/src/Sproxy/Application/OAuth2/Yandex.hs
@@ -7,8 +7,7 @@ module Sproxy.Application.OAuth2.Yandex
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 Data.Typeable (Typeable)
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
index 2b9bb75..d5e396c 100644
--- a/src/Sproxy/Server.hs
+++ b/src/Sproxy/Server.hs
@@ -11,19 +11,44 @@ import Data.Maybe (fromMaybe)
import Data.Text (Text)
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
- (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)
+ ( 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.Exit (exitFailure)
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
@@ -151,10 +182,10 @@ newBackendManager be = do
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
diff --git a/src/Sproxy/Server/DB.hs b/src/Sproxy/Server/DB.hs
index be44f69..3050687 100644
--- a/src/Sproxy/Server/DB.hs
+++ b/src/Sproxy/Server/DB.hs
@@ -26,8 +26,11 @@ import Text.InterpolatedString.Perl6 (q, qc)
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-22 00:13:24 +0000