module Network.Bugsnag.Device
    ( Bytes(..)
    , BugsnagDevice(..)
    , bugsnagDevice
    , bugsnagDeviceFromWaiRequest
    ) where

import Prelude

import Data.Aeson
import Data.Aeson.Ext
import Data.ByteString (ByteString)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Version
import GHC.Generics
import Network.Wai
import Numeric.Natural
import Text.Read (readMaybe)
import Web.UAParser

newtype Bytes = Bytes Natural
    deriving newtype [Bytes] -> Encoding
[Bytes] -> Value
Bytes -> Encoding
Bytes -> Value
(Bytes -> Value)
-> (Bytes -> Encoding)
-> ([Bytes] -> Value)
-> ([Bytes] -> Encoding)
-> ToJSON Bytes
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Bytes] -> Encoding
$ctoEncodingList :: [Bytes] -> Encoding
toJSONList :: [Bytes] -> Value
$ctoJSONList :: [Bytes] -> Value
toEncoding :: Bytes -> Encoding
$ctoEncoding :: Bytes -> Encoding
toJSON :: Bytes -> Value
$ctoJSON :: Bytes -> Value
ToJSON

data BugsnagDevice = BugsnagDevice
    { BugsnagDevice -> Maybe Text
bdHostname :: Maybe Text
    , BugsnagDevice -> Maybe Text
bdId :: Maybe Text
    , BugsnagDevice -> Maybe Text
bdManufacturer :: Maybe Text
    , BugsnagDevice -> Maybe Text
bdModel :: Maybe Text
    , BugsnagDevice -> Maybe Text
bdModelNumber :: Maybe Text
    , BugsnagDevice -> Maybe Text
bdOsName :: Maybe Text
    , BugsnagDevice -> Maybe Version
bdOsVersion :: Maybe Version
    , BugsnagDevice -> Maybe Bytes
bdFreeMemory :: Maybe Bytes
    , BugsnagDevice -> Maybe Bytes
bdTotalMemory :: Maybe Bytes
    , BugsnagDevice -> Maybe Bytes
bdFreeDisk :: Maybe Bytes
    , BugsnagDevice -> Maybe Text
bdBrowserName :: Maybe Text
    , BugsnagDevice -> Maybe Version
bdBrowserVersion :: Maybe Version
    , BugsnagDevice -> Maybe Bool
bdJailBroken :: Maybe Bool
    , BugsnagDevice -> Maybe Text
bdOrientation :: Maybe Text
    }
    deriving stock (forall x. BugsnagDevice -> Rep BugsnagDevice x)
-> (forall x. Rep BugsnagDevice x -> BugsnagDevice)
-> Generic BugsnagDevice
forall x. Rep BugsnagDevice x -> BugsnagDevice
forall x. BugsnagDevice -> Rep BugsnagDevice x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BugsnagDevice x -> BugsnagDevice
$cfrom :: forall x. BugsnagDevice -> Rep BugsnagDevice x
Generic

instance ToJSON BugsnagDevice where
    toJSON :: BugsnagDevice -> Value
toJSON = Options -> BugsnagDevice -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> BugsnagDevice -> Value)
-> Options -> BugsnagDevice -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
bsAesonOptions String
"bd"
    toEncoding :: BugsnagDevice -> Encoding
toEncoding = Options -> BugsnagDevice -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding (Options -> BugsnagDevice -> Encoding)
-> Options -> BugsnagDevice -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
bsAesonOptions String
"bd"

bugsnagDevice :: BugsnagDevice
bugsnagDevice :: BugsnagDevice
bugsnagDevice = BugsnagDevice :: Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Version
-> Maybe Bytes
-> Maybe Bytes
-> Maybe Bytes
-> Maybe Text
-> Maybe Version
-> Maybe Bool
-> Maybe Text
-> BugsnagDevice
BugsnagDevice
    { bdHostname :: Maybe Text
bdHostname = Maybe Text
forall a. Maybe a
Nothing
    , bdId :: Maybe Text
bdId = Maybe Text
forall a. Maybe a
Nothing
    , bdManufacturer :: Maybe Text
bdManufacturer = Maybe Text
forall a. Maybe a
Nothing
    , bdModel :: Maybe Text
bdModel = Maybe Text
forall a. Maybe a
Nothing
    , bdModelNumber :: Maybe Text
bdModelNumber = Maybe Text
forall a. Maybe a
Nothing
    , bdOsName :: Maybe Text
bdOsName = Maybe Text
forall a. Maybe a
Nothing
    , bdOsVersion :: Maybe Version
bdOsVersion = Maybe Version
forall a. Maybe a
Nothing
    , bdFreeMemory :: Maybe Bytes
bdFreeMemory = Maybe Bytes
forall a. Maybe a
Nothing
    , bdTotalMemory :: Maybe Bytes
bdTotalMemory = Maybe Bytes
forall a. Maybe a
Nothing
    , bdFreeDisk :: Maybe Bytes
bdFreeDisk = Maybe Bytes
forall a. Maybe a
Nothing
    , bdBrowserName :: Maybe Text
bdBrowserName = Maybe Text
forall a. Maybe a
Nothing
    , bdBrowserVersion :: Maybe Version
bdBrowserVersion = Maybe Version
forall a. Maybe a
Nothing
    , bdJailBroken :: Maybe Bool
bdJailBroken = Maybe Bool
forall a. Maybe a
Nothing
    , bdOrientation :: Maybe Text
bdOrientation = Maybe Text
forall a. Maybe a
Nothing
    }

-- | /Attempt/ to divine a @'BugsnagDevice'@ from a request's User Agent
bugsnagDeviceFromWaiRequest :: Request -> Maybe BugsnagDevice
bugsnagDeviceFromWaiRequest :: Request -> Maybe BugsnagDevice
bugsnagDeviceFromWaiRequest Request
request = do
    ByteString
userAgent <- HeaderName -> [(HeaderName, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"User-Agent" ([(HeaderName, ByteString)] -> Maybe ByteString)
-> [(HeaderName, ByteString)] -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Request -> [(HeaderName, ByteString)]
requestHeaders Request
request
    BugsnagDevice -> Maybe BugsnagDevice
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BugsnagDevice -> Maybe BugsnagDevice)
-> BugsnagDevice -> Maybe BugsnagDevice
forall a b. (a -> b) -> a -> b
$ ByteString -> BugsnagDevice
bugsnagDeviceFromUserAgent ByteString
userAgent

-- |
--
-- >>> device = bugsnagDeviceFromUserAgent "Mozilla/5.0 (X11; Linux x86_64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/64.0.3282.119 Safari/537.36"
-- >>> bdOsName device
-- Just "Linux"
--
-- N.B. we always return a Device, it may just be lacking some or all fields.
--
-- >>> showVersion <$> bdOsVersion device
-- Nothing
--
-- >>> bdBrowserName device
-- Just "Chrome"
--
-- >>> showVersion <$> bdBrowserVersion device
-- Just "64.0.3282"
--
bugsnagDeviceFromUserAgent :: ByteString -> BugsnagDevice
bugsnagDeviceFromUserAgent :: ByteString -> BugsnagDevice
bugsnagDeviceFromUserAgent ByteString
userAgent = BugsnagDevice
bugsnagDevice
    { bdOsName :: Maybe Text
bdOsName = OSResult -> Text
osrFamily (OSResult -> Text) -> Maybe OSResult -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe OSResult
osResult
    , bdOsVersion :: Maybe Version
bdOsVersion = do
        OSResult
result <- Maybe OSResult
osResult
        Int
v1 <- String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> (Text -> String) -> Text -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Maybe Int) -> Maybe Text -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< OSResult -> Maybe Text
osrV1 OSResult
result
        Int
v2 <- String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> (Text -> String) -> Text -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Maybe Int) -> Maybe Text -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< OSResult -> Maybe Text
osrV2 OSResult
result
        Int
v3 <- String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> (Text -> String) -> Text -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Maybe Int) -> Maybe Text -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< OSResult -> Maybe Text
osrV3 OSResult
result
        Int
v4 <- String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> (Text -> String) -> Text -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Maybe Int) -> Maybe Text -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< OSResult -> Maybe Text
osrV4 OSResult
result
        Version -> Maybe Version
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Version -> Maybe Version) -> Version -> Maybe Version
forall a b. (a -> b) -> a -> b
$ [Int] -> Version
makeVersion [Int
v1, Int
v2, Int
v3, Int
v4]
    , bdBrowserName :: Maybe Text
bdBrowserName = UAResult -> Text
uarFamily (UAResult -> Text) -> Maybe UAResult -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe UAResult
uaResult
    , bdBrowserVersion :: Maybe Version
bdBrowserVersion = do
        UAResult
result <- Maybe UAResult
uaResult
        Int
v1 <- String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> (Text -> String) -> Text -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Maybe Int) -> Maybe Text -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< UAResult -> Maybe Text
uarV1 UAResult
result
        Int
v2 <- String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> (Text -> String) -> Text -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Maybe Int) -> Maybe Text -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< UAResult -> Maybe Text
uarV2 UAResult
result
        Int
v3 <- String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> (Text -> String) -> Text -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Maybe Int) -> Maybe Text -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< UAResult -> Maybe Text
uarV3 UAResult
result
        Version -> Maybe Version
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Version -> Maybe Version) -> Version -> Maybe Version
forall a b. (a -> b) -> a -> b
$ [Int] -> Version
makeVersion [Int
v1, Int
v2, Int
v3]
    }
  where
    uaResult :: Maybe UAResult
uaResult = ByteString -> Maybe UAResult
parseUA ByteString
userAgent
    osResult :: Maybe OSResult
osResult = ByteString -> Maybe OSResult
parseOS ByteString
userAgent