{-# LANGUAGE ScopedTypeVariables #-}

module Fake.Provider.UserAgent where

------------------------------------------------------------------------------
import Data.Monoid
import Data.Time
import Text.Printf
------------------------------------------------------------------------------
import Fake.Combinators
import Fake.Provider.DateTime
import Fake.Provider.Locale
import Fake.Types
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- | Fake user agent strings using a uniform distribution across the five
-- major browsers.
userAgent :: FGen String
userAgent :: FGen String
userAgent = [FGen String] -> FGen String
forall a. [FGen a] -> FGen a
oneof
    [ FGen String
chromeUserAgent
    , FGen String
internetExplorerUserAgent
    , FGen String
firefoxUserAgent
    , FGen String
safariUserAgent
    , FGen String
operaUserAgent
    ]

------------------------------------------------------------------------------
-- | Fake user agent strings using a real-world distribution across the five
-- major browsers.
userAgentRealDist :: FGen String
userAgentRealDist :: FGen String
userAgentRealDist = [(Int, FGen String)] -> FGen String
forall a. [(Int, FGen a)] -> FGen a
frequency
    -- Browser stats from https://www.w3schools.com/browsers/default.asp
    [ (Int
768, FGen String
chromeUserAgent)
    , (Int
43, FGen String
internetExplorerUserAgent)
    , (Int
125, FGen String
firefoxUserAgent)
    , (Int
33, FGen String
safariUserAgent)
    , (Int
16, FGen String
operaUserAgent)
    ]

------------------------------------------------------------------------------
-- | Fake user agent strings for Chrome.
chromeUserAgent :: FGen String
chromeUserAgent :: FGen String
chromeUserAgent = do
    String
plat <- FGen String
fakePlatform
    Int
appleA <- Int -> Int -> FGen Int
fakeInt Int
531 Int
536
    Int
appleB <- Int -> Int -> FGen Int
fakeInt Int
0 Int
2
    let saf :: String
saf = Int -> String
forall a. Show a => a -> String
show Int
appleA String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"." String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
appleB
    Int
chromeMajor <- Int -> Int -> FGen Int
fakeInt Int
13 Int
15
    Int
chromeMinor <- Int -> Int -> FGen Int
fakeInt Int
800 Int
899
    let rest :: String
rest = String -> String -> String -> Int -> Int -> String -> String
forall r. PrintfType r => String -> r
printf
          String
"(%s) AppleWebKit/%s (KHTML, like Gecko) Chrome/%d.0.%d.0 Safari/%s"
          String
plat String
saf Int
chromeMajor Int
chromeMinor String
saf
    String -> FGen String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> FGen String) -> String -> FGen String
forall a b. (a -> b) -> a -> b
$ String
"Mozilla/5.0 " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
rest

------------------------------------------------------------------------------
-- | Fake user agent strings for Internet Explorer.
internetExplorerUserAgent :: FGen String
internetExplorerUserAgent :: FGen String
internetExplorerUserAgent = do
    String
plat <- FGen String
windowsPlatform
    Int
a <- Int -> Int -> FGen Int
fakeInt Int
5 Int
9
    Int
b <- Int -> Int -> FGen Int
fakeInt Int
3 Int
5
    Int
c <- Int -> Int -> FGen Int
fakeInt Int
0 Int
1
    String -> FGen String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> FGen String) -> String -> FGen String
forall a b. (a -> b) -> a -> b
$ String -> Int -> String -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf String
"Mozilla/5.0 (compatible; MSIE %d.0; %s; Trident/%d.%d)"
                    Int
a String
plat Int
b Int
c

underscoreToDash :: Char -> Char
underscoreToDash :: Char -> Char
underscoreToDash Char
'_' = Char
'-'
underscoreToDash Char
c = Char
c

dayStr :: Day -> String
dayStr :: Day -> String
dayStr = TimeLocale -> String -> Day -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%Y%m%d"


------------------------------------------------------------------------------
-- | Fake user agent strings for Firefox.
firefoxUserAgent :: FGen String
firefoxUserAgent :: FGen String
firefoxUserAgent = do
    let a :: FGen String
        a :: FGen String
a = do
          String
d <- Day -> String
dayStr (Day -> String) -> FGen Day -> FGen String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Day -> Day -> FGen Day
dayBetween (Integer -> Int -> Int -> Day
fromGregorian Integer
2011 Int
1 Int
1) (Integer -> Int -> Int -> Day
fromGregorian Integer
2017 Int
1 Int
1)
          Int
n <- Int -> Int -> FGen Int
fakeInt Int
4 Int
15
          String -> FGen String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> FGen String) -> String -> FGen String
forall a b. (a -> b) -> a -> b
$ String -> String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"Gecko/%s Firefox/%d.0" String
d Int
n
        b :: FGen String
        b :: FGen String
b = do
          String
d <- Day -> String
dayStr (Day -> String) -> FGen Day -> FGen String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Day -> Day -> FGen Day
dayBetween (Integer -> Int -> Int -> Day
fromGregorian Integer
2010 Int
1 Int
1) (Integer -> Int -> Int -> Day
fromGregorian Integer
2017 Int
1 Int
1)
          Int
n <- Int -> Int -> FGen Int
fakeInt Int
1 Int
20
          String -> FGen String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> FGen String) -> String -> FGen String
forall a b. (a -> b) -> a -> b
$ String -> String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"Gecko/%s Firefox/3.6.%d" String
d Int
n
        c :: FGen String
        c :: FGen String
c = do
          String
d <- Day -> String
dayStr (Day -> String) -> FGen Day -> FGen String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Day -> Day -> FGen Day
dayBetween (Integer -> Int -> Int -> Day
fromGregorian Integer
2010 Int
1 Int
1) (Integer -> Int -> Int -> Day
fromGregorian Integer
2017 Int
1 Int
1)
          String -> FGen String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> FGen String) -> String -> FGen String
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Gecko/%s Firefox/3.8" String
d
    String
ver <- [FGen String] -> FGen String
forall a. [FGen a] -> FGen a
oneof [FGen String
a, FGen String
b, FGen String
c]

    let win :: FGen String
        win :: FGen String
win = do
          String
plat <- FGen String
windowsPlatform
          String
l <- (Char -> Char) -> String -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
underscoreToDash (String -> String) -> FGen String -> FGen String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FGen String
fakeLocale
          Int
n <- Int -> Int -> FGen Int
fakeInt Int
0 Int
2
          String -> FGen String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> FGen String) -> String -> FGen String
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> Int -> String -> String
forall r. PrintfType r => String -> r
printf String
"(%s; %s; rv:1.9.%d.20) %s"
                          String
plat String
l Int
n String
ver
        lin :: FGen String
        lin :: FGen String
lin = do
          String
plat <- FGen String
linuxPlatform
          Int
n <- Int -> Int -> FGen Int
fakeInt Int
5 Int
7
          String -> FGen String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> FGen String) -> String -> FGen String
forall a b. (a -> b) -> a -> b
$ String -> String -> Int -> String -> String
forall r. PrintfType r => String -> r
printf String
"(%s; rv:1.9.%d.20) %s" String
plat Int
n String
ver

        mac :: FGen String
        mac :: FGen String
mac = do
          String
plat <- FGen String
macPlatform
          Int
n <- Int -> Int -> FGen Int
fakeInt Int
2 Int
6
          String -> FGen String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> FGen String) -> String -> FGen String
forall a b. (a -> b) -> a -> b
$ String -> String -> Int -> String -> String
forall r. PrintfType r => String -> r
printf String
"(%s; rv:1.9.%d.20) %s" String
plat Int
n String
ver
    String
plat <- [FGen String] -> FGen String
forall a. [FGen a] -> FGen a
oneof [FGen String
win, FGen String
lin, FGen String
mac]
    String -> FGen String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> FGen String) -> String -> FGen String
forall a b. (a -> b) -> a -> b
$ String
"Mozilla/5.0 " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
plat


------------------------------------------------------------------------------
-- | Fake user agent strings for Safari.
safariUserAgent :: FGen String
safariUserAgent :: FGen String
safariUserAgent = do
    String
saf :: String <- do
        Int
a <- Int -> Int -> FGen Int
fakeInt Int
531 Int
535
        Int
b <- Int -> Int -> FGen Int
fakeInt Int
1 Int
50
        Int
c <- Int -> Int -> FGen Int
fakeInt Int
1 Int
7
        String -> FGen String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> FGen String) -> String -> FGen String
forall a b. (a -> b) -> a -> b
$ String -> Int -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%d.%d.%d" Int
a Int
b Int
c
    Bool
twoVers <- [Bool] -> FGen Bool
forall a. [a] -> FGen a
elements [Bool
False, Bool
True]
    String
ver :: String <- if Bool
twoVers
             then String -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%d.%d" (Int -> Int -> String) -> FGen Int -> FGen (Int -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> FGen Int
fakeInt Int
4 Int
5 FGen (Int -> String) -> FGen Int -> FGen String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Int -> FGen Int
fakeInt Int
0 Int
1
             else String -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%d.0.%d" (Int -> Int -> String) -> FGen Int -> FGen (Int -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> FGen Int
fakeInt Int
4 Int
5 FGen (Int -> String) -> FGen Int -> FGen String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Int -> FGen Int
fakeInt Int
1 Int
5

    let win :: FGen String
        win :: FGen String
win = do
          String
plat <- FGen String
windowsPlatform
          String -> FGen String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> FGen String) -> String -> FGen String
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"(Windows; U; %s) AppleWebKit/%s (KHTML, like Gecko) Version/%s Safari/%s"
                          String
plat String
saf String
ver String
saf
        mac :: FGen String
        mac :: FGen String
mac = do
          String
plat <- FGen String
macPlatform
          Int
n <- Int -> Int -> FGen Int
fakeInt Int
2 Int
6
          String
l <- (Char -> Char) -> String -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
underscoreToDash (String -> String) -> FGen String -> FGen String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FGen String
fakeLocale
          String -> FGen String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> FGen String) -> String -> FGen String
forall a b. (a -> b) -> a -> b
$ String
-> String -> Int -> String -> String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"(%s rv:%d.0; %s) AppleWebKit/%s (KHTML, like Gecko) Version/%s Safari/%s"
                          String
plat Int
n String
l String
saf String
ver String
saf
        ipod :: FGen String
        ipod :: FGen String
ipod = do
          Int
a <- Int -> Int -> FGen Int
fakeInt Int
3 Int
4
          Int
b <- Int -> Int -> FGen Int
fakeInt Int
0 Int
3
          Int
c <- Int -> Int -> FGen Int
fakeInt Int
3 Int
4
          Int
d <- Int -> Int -> FGen Int
fakeInt Int
111 Int
119
          String
l <- (Char -> Char) -> String -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
underscoreToDash (String -> String) -> FGen String -> FGen String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FGen String
fakeLocale
          String -> FGen String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> FGen String) -> String -> FGen String
forall a b. (a -> b) -> a -> b
$ String
-> Int -> Int -> String -> String -> Int -> Int -> String -> String
forall r. PrintfType r => String -> r
printf String
"(iPod; U; CPU iPhone OS %d_%d like Mac OS X; %s) AppleWebKit/%s (KHTML, like Gecko) Version/%d.0.5 Mobile/8B%d Safari/6%s"
                          Int
a Int
b String
l String
saf Int
c Int
d String
saf

    String
plat <- [FGen String] -> FGen String
forall a. [FGen a] -> FGen a
oneof [FGen String
win, FGen String
mac, FGen String
ipod]
    String -> FGen String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> FGen String) -> String -> FGen String
forall a b. (a -> b) -> a -> b
$ String
"Mozilla/5.0 " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
plat


------------------------------------------------------------------------------
-- | Fake user agent strings for Opera.
operaUserAgent :: FGen String
operaUserAgent :: FGen String
operaUserAgent = do
    let getPlat :: FGen String
getPlat = do
          Bool
useLinux <- [Bool] -> FGen Bool
forall a. [a] -> FGen a
elements [Bool
False, Bool
True]
          if Bool
useLinux then FGen String
linuxPlatform else FGen String
windowsPlatform
    let FGen String
plat :: FGen String = String -> String -> String -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf String
"(%s; %s) Presto/2.9.%d Version/%d.00"
          (String -> String -> Int -> Int -> String)
-> FGen String -> FGen (String -> Int -> Int -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FGen String
getPlat
          FGen (String -> Int -> Int -> String)
-> FGen String -> FGen (Int -> Int -> String)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> String) -> FGen String -> FGen String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Char -> Char) -> String -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
underscoreToDash) FGen String
fakeLocale
          FGen (Int -> Int -> String) -> FGen Int -> FGen (Int -> String)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Int -> FGen Int
fakeInt Int
160 Int
190
          FGen (Int -> String) -> FGen Int -> FGen String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Int -> FGen Int
fakeInt Int
10 Int
12

    String -> Int -> Int -> String -> String
forall r. PrintfType r => String -> r
printf String
"Opera/%d.%d.%s"
      (Int -> Int -> String -> String)
-> FGen Int -> FGen (Int -> String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> FGen Int
fakeInt Int
8 Int
9
      FGen (Int -> String -> String)
-> FGen Int -> FGen (String -> String)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Int -> FGen Int
fakeInt Int
10 Int
99
      FGen (String -> String) -> FGen String -> FGen String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FGen String
plat

fakePlatform :: FGen String
fakePlatform :: FGen String
fakePlatform = [FGen String] -> FGen String
forall a. [FGen a] -> FGen a
oneof [FGen String
windowsPlatform, FGen String
linuxPlatform, FGen String
macPlatform]

windowsPlatform :: FGen String
windowsPlatform :: FGen String
windowsPlatform = [String] -> FGen String
forall a. [a] -> FGen a
elements
  [ String
"Windows 95", String
"Windows 98", String
"Windows 98; Win 9x 4.90", String
"Windows CE"
  , String
"Windows NT 4.0", String
"Windows NT 5.0", String
"Windows NT 5.01"
  , String
"Windows NT 5.1", String
"Windows NT 5.2", String
"Windows NT 6.0", String
"Windows NT 6.1"
  , String
"Windows NT 6.2"
  ]

linuxPlatform :: FGen String
linuxPlatform :: FGen String
linuxPlatform = do
    String
processor <- FGen String
linuxProcessor
    String -> FGen String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> FGen String) -> String -> FGen String
forall a b. (a -> b) -> a -> b
$ String
"X11; Linux " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
processor

macPlatform :: FGen String
macPlatform :: FGen String
macPlatform = do
    String
processor <- FGen String
macProcessor
    Int
b <- Int -> Int -> FGen Int
fakeInt Int
5 Int
8
    Int
c <- Int -> Int -> FGen Int
fakeInt Int
0 Int
9
    String -> FGen String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> FGen String) -> String -> FGen String
forall a b. (a -> b) -> a -> b
$ String -> String -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf String
"Macintosh; %s Mac OS X 10_%d_%d" String
processor Int
b Int
c

linuxProcessor :: FGen String
linuxProcessor :: FGen String
linuxProcessor = [String] -> FGen String
forall a. [a] -> FGen a
elements [String
"i686", String
"x86_64"]

macProcessor :: FGen String
macProcessor :: FGen String
macProcessor = [String] -> FGen String
forall a. [a] -> FGen a
elements [String
"Intel", String
"PPC", String
"U; Intel", String
"U; PPC"]