{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}
module Network.Bugsnag.Request
( BugsnagRequest(..)
, bugsnagRequest
, bugsnagRequestFromWaiRequest
) where
import Prelude
import Control.Applicative ((<|>))
import Data.Aeson
import Data.Aeson.Ext
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as C8
import Data.IP
import Data.Maybe (fromMaybe)
import GHC.Generics
import Network.Bugsnag.BugsnagRequestHeaders
import Network.HTTP.Types
import Network.Socket
import Network.Wai
data BugsnagRequest = BugsnagRequest
{ BugsnagRequest -> Maybe ByteString
brClientIp :: Maybe ByteString
, :: Maybe BugsnagRequestHeaders
, BugsnagRequest -> Maybe ByteString
brHttpMethod :: Maybe Method
, BugsnagRequest -> Maybe ByteString
brUrl :: Maybe ByteString
, BugsnagRequest -> Maybe ByteString
brReferer :: Maybe ByteString
}
deriving stock (forall x. BugsnagRequest -> Rep BugsnagRequest x)
-> (forall x. Rep BugsnagRequest x -> BugsnagRequest)
-> Generic BugsnagRequest
forall x. Rep BugsnagRequest x -> BugsnagRequest
forall x. BugsnagRequest -> Rep BugsnagRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BugsnagRequest x -> BugsnagRequest
$cfrom :: forall x. BugsnagRequest -> Rep BugsnagRequest x
Generic
instance ToJSON BugsnagRequest where
toJSON :: BugsnagRequest -> Value
toJSON = Options -> BugsnagRequest -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> BugsnagRequest -> Value)
-> Options -> BugsnagRequest -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
bsAesonOptions String
"br"
toEncoding :: BugsnagRequest -> Encoding
toEncoding = Options -> BugsnagRequest -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding (Options -> BugsnagRequest -> Encoding)
-> Options -> BugsnagRequest -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
bsAesonOptions String
"br"
bugsnagRequest :: BugsnagRequest
bugsnagRequest :: BugsnagRequest
bugsnagRequest = BugsnagRequest :: Maybe ByteString
-> Maybe BugsnagRequestHeaders
-> Maybe ByteString
-> Maybe ByteString
-> Maybe ByteString
-> BugsnagRequest
BugsnagRequest
{ brClientIp :: Maybe ByteString
brClientIp = Maybe ByteString
forall a. Maybe a
Nothing
, brHeaders :: Maybe BugsnagRequestHeaders
brHeaders = Maybe BugsnagRequestHeaders
forall a. Maybe a
Nothing
, brHttpMethod :: Maybe ByteString
brHttpMethod = Maybe ByteString
forall a. Maybe a
Nothing
, brUrl :: Maybe ByteString
brUrl = Maybe ByteString
forall a. Maybe a
Nothing
, brReferer :: Maybe ByteString
brReferer = Maybe ByteString
forall a. Maybe a
Nothing
}
bugsnagRequestFromWaiRequest :: Request -> BugsnagRequest
bugsnagRequestFromWaiRequest :: Request -> BugsnagRequest
bugsnagRequestFromWaiRequest Request
request = BugsnagRequest
bugsnagRequest
{ brClientIp :: Maybe ByteString
brClientIp = Request -> Maybe ByteString
requestRealIp Request
request
Maybe ByteString -> Maybe ByteString -> Maybe ByteString
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (SockAddr -> ByteString
sockAddrToIp (SockAddr -> ByteString) -> SockAddr -> ByteString
forall a b. (a -> b) -> a -> b
$ Request -> SockAddr
remoteHost Request
request)
, brHeaders :: Maybe BugsnagRequestHeaders
brHeaders = BugsnagRequestHeaders -> Maybe BugsnagRequestHeaders
forall a. a -> Maybe a
Just (BugsnagRequestHeaders -> Maybe BugsnagRequestHeaders)
-> BugsnagRequestHeaders -> Maybe BugsnagRequestHeaders
forall a b. (a -> b) -> a -> b
$ RequestHeaders -> BugsnagRequestHeaders
bugsnagRequestHeaders (RequestHeaders -> BugsnagRequestHeaders)
-> RequestHeaders -> BugsnagRequestHeaders
forall a b. (a -> b) -> a -> b
$ Request -> RequestHeaders
requestHeaders Request
request
, brHttpMethod :: Maybe ByteString
brHttpMethod = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
requestMethod Request
request
, brUrl :: Maybe ByteString
brUrl = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
requestUrl Request
request
, brReferer :: Maybe ByteString
brReferer = Request -> Maybe ByteString
requestHeaderReferer Request
request
}
requestRealIp :: Request -> Maybe ByteString
requestRealIp :: Request -> Maybe ByteString
requestRealIp Request
request =
Request -> Maybe ByteString
requestForwardedFor Request
request Maybe ByteString -> Maybe ByteString -> Maybe ByteString
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> HeaderName -> RequestHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"X-Real-IP" (Request -> RequestHeaders
requestHeaders Request
request)
requestForwardedFor :: Request -> Maybe ByteString
requestForwardedFor :: Request -> Maybe ByteString
requestForwardedFor Request
request =
ByteString -> Maybe ByteString
readForwardedFor (ByteString -> Maybe ByteString)
-> Maybe ByteString -> Maybe ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HeaderName -> RequestHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"X-Forwarded-For" (Request -> RequestHeaders
requestHeaders Request
request)
readForwardedFor :: ByteString -> Maybe ByteString
readForwardedFor :: ByteString -> Maybe ByteString
readForwardedFor ByteString
bs
| ByteString -> Bool
C8.null ByteString
bs = Maybe ByteString
forall a. Maybe a
Nothing
| Bool
otherwise = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, ByteString) -> ByteString)
-> (ByteString, ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> (ByteString, ByteString)
C8.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',') ByteString
bs
requestUrl :: Request -> ByteString
requestUrl :: Request -> ByteString
requestUrl Request
request =
ByteString
requestProtocol
ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"://"
ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Request -> ByteString
requestHost Request
request
ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString -> ByteString
prependIfNecessary ByteString
"/" (Request -> ByteString
rawPathInfo Request
request)
ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Request -> ByteString
rawQueryString Request
request
where
clientProtocol :: ByteString
clientProtocol :: ByteString
clientProtocol = if Request -> Bool
isSecure Request
request then ByteString
"https" else ByteString
"http"
requestHost :: Request -> ByteString
requestHost :: Request -> ByteString
requestHost = ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
"<unknown>" (Maybe ByteString -> ByteString)
-> (Request -> Maybe ByteString) -> Request -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Maybe ByteString
requestHeaderHost
requestProtocol :: ByteString
requestProtocol :: ByteString
requestProtocol =
ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
clientProtocol (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ HeaderName -> RequestHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"X-Forwarded-Proto" (RequestHeaders -> Maybe ByteString)
-> RequestHeaders -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Request -> RequestHeaders
requestHeaders
Request
request
prependIfNecessary :: ByteString -> ByteString -> ByteString
prependIfNecessary ByteString
c ByteString
x
| ByteString
c ByteString -> ByteString -> Bool
`C8.isPrefixOf` ByteString
x = ByteString
x
| Bool
otherwise = ByteString
c ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
x
sockAddrToIp :: SockAddr -> ByteString
sockAddrToIp :: SockAddr -> ByteString
sockAddrToIp (SockAddrInet PortNumber
_ HostAddress
h) = String -> ByteString
C8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ IPv4 -> String
forall a. Show a => a -> String
show (IPv4 -> String) -> IPv4 -> String
forall a b. (a -> b) -> a -> b
$ HostAddress -> IPv4
fromHostAddress HostAddress
h
sockAddrToIp (SockAddrInet6 PortNumber
_ HostAddress
_ HostAddress6
h HostAddress
_) = String -> ByteString
C8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ IPv6 -> String
forall a. Show a => a -> String
show (IPv6 -> String) -> IPv6 -> String
forall a b. (a -> b) -> a -> b
$ HostAddress6 -> IPv6
fromHostAddress6 HostAddress6
h
sockAddrToIp (SockAddrUnix String
_) = ByteString
"<socket>"
sockAddrToIp SockAddr
_ = ByteString
"<invalid>"