module Rollbar.Item.Request
( Request(..)
, Get(..)
, Headers(..)
, IP(..)
, Method(..)
, QueryString(..)
, RawBody(..)
, URL(..)
) where
import Data.Aeson
(KeyValue, ToJSON, object, pairs, toEncoding, toJSON, (.=))
import Data.CaseInsensitive (original)
import Data.Maybe (catMaybes, fromMaybe)
import Data.String (IsString)
import GHC.Generics (Generic)
import Network.HTTP.Types (Header, Query, RequestHeaders)
import Network.Socket (SockAddr)
import qualified Data.ByteString as BS
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
data Request
= Request
{ rawBody :: RawBody
, get :: Get
, headers :: Headers
, method :: Method
, queryString :: QueryString
, url :: URL
, userIP :: IP
}
deriving (Eq, Generic, Show)
newtype RawBody
= RawBody BS.ByteString
deriving (Eq, Generic, IsString, Show)
instance ToJSON RawBody where
toJSON (RawBody body) = toJSON (myDecodeUtf8 body)
toEncoding (RawBody body) = toEncoding (myDecodeUtf8 body)
newtype Get
= Get Query
deriving (Eq, Generic, Show)
instance ToJSON Get where
toJSON (Get q) = object . catMaybes . queryKVs $ q
toEncoding (Get q) = pairs . mconcat . catMaybes . queryKVs $ q
queryKVs :: forall kv. (KeyValue kv) => Query -> [Maybe kv]
queryKVs = fmap go
where
go :: (BS.ByteString, Maybe BS.ByteString) -> Maybe kv
go (key', val') = do
key <- myDecodeUtf8 key'
let val = val' >>= myDecodeUtf8
pure (key .= val)
newtype Headers
= Headers RequestHeaders
deriving (Eq, Generic, Show)
instance ToJSON Headers where
toJSON (Headers hs) = object . catMaybes . requestHeadersKVs $ hs
toEncoding (Headers hs) = pairs . mconcat . catMaybes . requestHeadersKVs $ hs
requestHeadersKVs :: forall kv. KeyValue kv => RequestHeaders -> [Maybe kv]
requestHeadersKVs = fmap go
where
go :: Header -> Maybe kv
go (key', val') = do
key <- myDecodeUtf8 $ original key'
val <- myDecodeUtf8 val'
pure (T.pack (show key) .= val)
newtype Method
= Method BS.ByteString
deriving (Eq, Generic, Show)
instance ToJSON Method where
toJSON (Method q) = toJSON (myDecodeUtf8 q)
toEncoding (Method q) = toEncoding (myDecodeUtf8 q)
newtype QueryString
= QueryString BS.ByteString
deriving (Eq, Generic, Show)
instance ToJSON QueryString where
toJSON (QueryString q) = toJSON (myDecodeUtf8' q)
toEncoding (QueryString q) = toEncoding (myDecodeUtf8' q)
newtype IP
= IP SockAddr
deriving (Eq, Generic, Show)
instance ToJSON IP where
toJSON (IP ip) = toJSON (show ip)
toEncoding (IP ip) = toEncoding (show ip)
requestKVs :: KeyValue kv => Request -> [kv]
requestKVs Request{..} =
[ "body" .= rawBody
, "GET" .= get
, "headers" .= headers
, "method" .= method
, "query_string" .= queryString
, "url" .= url
, "user_ip" .= userIP
]
instance ToJSON Request where
toJSON = object . requestKVs
toEncoding = pairs . mconcat . requestKVs
newtype URL
= URL (Maybe BS.ByteString, [T.Text])
deriving (Eq, Generic, Show)
prettyURL :: URL -> T.Text
prettyURL (URL (host, parts)) =
T.intercalate "/" (fromMaybe "" (host >>= myDecodeUtf8) : parts)
instance ToJSON URL where
toJSON = toJSON . prettyURL
toEncoding = toEncoding . prettyURL
myDecodeUtf8 :: BS.ByteString -> Maybe T.Text
myDecodeUtf8 = either (const Nothing) Just . TE.decodeUtf8'
myDecodeUtf8' :: BS.ByteString -> T.Text
myDecodeUtf8' = fromMaybe "" . myDecodeUtf8