summaryrefslogtreecommitdiff
path: root/src/Network/Bugsnag/Request.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/Bugsnag/Request.hs')
-rw-r--r--src/Network/Bugsnag/Request.hs34
1 files changed, 18 insertions, 16 deletions
diff --git a/src/Network/Bugsnag/Request.hs b/src/Network/Bugsnag/Request.hs
index 6e25d84..37d4667 100644
--- a/src/Network/Bugsnag/Request.hs
+++ b/src/Network/Bugsnag/Request.hs
@@ -1,10 +1,12 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}
module Network.Bugsnag.Request
( BugsnagRequest(..)
, bugsnagRequest
, bugsnagRequestFromWaiRequest
- ) where
+ )
+where
import Control.Applicative ((<|>))
import Data.Aeson
@@ -13,7 +15,6 @@ import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as C8
import Data.IP
import Data.Maybe (fromMaybe)
-import Data.Monoid ((<>))
import GHC.Generics
import Network.HTTP.Types
import Network.Socket
@@ -55,12 +56,12 @@ bugsnagRequestFromWaiRequest request = bugsnagRequest
}
requestRealIp :: Request -> Maybe ByteString
-requestRealIp request = requestForwardedFor request
- <|> lookup "X-Real-IP" (requestHeaders request)
+requestRealIp request =
+ requestForwardedFor request <|> lookup "X-Real-IP" (requestHeaders request)
requestForwardedFor :: Request -> Maybe ByteString
-requestForwardedFor request = readForwardedFor
- =<< lookup "X-Forwarded-For" (requestHeaders request)
+requestForwardedFor request =
+ readForwardedFor =<< lookup "X-Forwarded-For" (requestHeaders request)
-- |
--
@@ -79,23 +80,24 @@ readForwardedFor bs
| otherwise = Just $ fst $ C8.break (== ',') bs
requestUrl :: Request -> ByteString
-requestUrl request = requestProtocol
- <> "://"
- <> requestHost request
- <> rawPathInfo request
- <> rawQueryString request
+requestUrl request =
+ requestProtocol
+ <> "://"
+ <> requestHost request
+ <> rawPathInfo request
+ <> rawQueryString request
where
clientProtocol = if isSecure request then "https" else "http"
requestHost = fromMaybe "<unknown>" . requestHeaderHost
- requestProtocol = fromMaybe clientProtocol
- $ lookup "X-Forwarded-Proto"
- $ requestHeaders request
+ requestProtocol =
+ fromMaybe clientProtocol $ lookup "X-Forwarded-Proto" $ requestHeaders
+ request
sockAddrToIp :: SockAddr -> ByteString
sockAddrToIp (SockAddrInet _ h) = C8.pack $ show $ fromHostAddress h
sockAddrToIp (SockAddrInet6 _ _ h _) = C8.pack $ show $ fromHostAddress6 h
sockAddrToIp (SockAddrUnix _) = "<socket>"
--- N.B. Can't match deprecated SockAddrCan without warning. TODO: make patterns
--- exhaustive without a wildcard once it's actually removed.
+-- Matches deprecated and eventually removed SockAddrCan on older GHCs.
+-- overlapping-patterns warning is disabled for this.
sockAddrToIp _ = "<invalid>"