{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fno-warn-deriving-typeable #-}
{-# OPTIONS_HADDOCK not-home #-}

-- | A type for profile preferences. These preference values are used by both
-- Firefox and Opera profiles.
module Test.WebDriver.Profile (
  -- * Profiles and profile preferences
  Profile(..)
  , ProfilePref(..)
  , ToPref(..)

  -- * Preferences
  , getPref
  , addPref
  , deletePref

  -- * Extensions
  -- , addExtension
  -- , deleteExtension
  , hasExtension

  -- * Miscellaneous profile operations
  , unionProfiles
  , onProfileFiles
  , onProfilePrefs

  -- * Profile errors
  , ProfileParseError(..)

  -- * Firefox
  , Firefox
  , defaultFirefoxProfile
  , loadFirefoxProfile
  , saveFirefoxProfile
  , firefoxProfileToArchive
  ) where

import Codec.Archive.Zip
import Control.Applicative
import Control.Exception.Safe hiding (try)
import Control.Monad
import Control.Monad.IO.Class
import Data.Aeson (Result(..), encode, fromJSON)
import qualified Data.Aeson as A
import Data.Aeson.Parser (jstring, value')
import Data.Aeson.Types (FromJSON, ToJSON, Value(..), parseJSON, toJSON, typeMismatch)
import Data.Attoparsec.ByteString.Char8 as AP
import Data.ByteString as BS (readFile)
import qualified Data.ByteString.Base64.Lazy as B64L
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as LBS
import Data.Fixed
import Data.Function ((&))
import qualified Data.HashMap.Strict as HM
import Data.Int
import qualified Data.List as L
import Data.Maybe
import Data.Ratio
import Data.Text (Text, pack)
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
import Data.Word
import Prelude -- hides some "unused import" warnings
import System.Directory
import System.FilePath ((</>), (<.>), takeFileName)

#if MIN_VERSION_aeson(0,7,0)
import Data.Scientific
#else
import Data.Attoparsec.Number (Number(..))
#endif


-- | This structure allows you to construct and manipulate profiles. This type
-- is shared by both Firefox and Opera profiles; when a distinction must be
-- made, the phantom type parameter is used to differentiate.
data Profile b = Profile {
  -- | A mapping from relative destination filepaths to source contents.
  forall b. Profile b -> HashMap FilePath ByteString
profileFiles   :: HM.HashMap FilePath ByteString
  -- | A map of profile preferences. These are the settings found in the
  -- profile's prefs.js, and entries found in about:config
  , forall b. Profile b -> HashMap Text ProfilePref
profilePrefs  :: HM.HashMap Text ProfilePref
  }
  deriving (Profile b -> Profile b -> Bool
(Profile b -> Profile b -> Bool)
-> (Profile b -> Profile b -> Bool) -> Eq (Profile b)
forall b. Profile b -> Profile b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall b. Profile b -> Profile b -> Bool
== :: Profile b -> Profile b -> Bool
$c/= :: forall b. Profile b -> Profile b -> Bool
/= :: Profile b -> Profile b -> Bool
Eq, Int -> Profile b -> ShowS
[Profile b] -> ShowS
Profile b -> FilePath
(Int -> Profile b -> ShowS)
-> (Profile b -> FilePath)
-> ([Profile b] -> ShowS)
-> Show (Profile b)
forall b. Int -> Profile b -> ShowS
forall b. [Profile b] -> ShowS
forall b. Profile b -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall b. Int -> Profile b -> ShowS
showsPrec :: Int -> Profile b -> ShowS
$cshow :: forall b. Profile b -> FilePath
show :: Profile b -> FilePath
$cshowList :: forall b. [Profile b] -> ShowS
showList :: [Profile b] -> ShowS
Show)

-- | A profile preference value. This is the subset of JSON values that excludes
-- arrays, objects, and null.
data ProfilePref = PrefInteger !Integer
                 | PrefDouble  !Double
                 | PrefString  !Text
                 | PrefBool    !Bool
                 deriving (ProfilePref -> ProfilePref -> Bool
(ProfilePref -> ProfilePref -> Bool)
-> (ProfilePref -> ProfilePref -> Bool) -> Eq ProfilePref
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProfilePref -> ProfilePref -> Bool
== :: ProfilePref -> ProfilePref -> Bool
$c/= :: ProfilePref -> ProfilePref -> Bool
/= :: ProfilePref -> ProfilePref -> Bool
Eq, Int -> ProfilePref -> ShowS
[ProfilePref] -> ShowS
ProfilePref -> FilePath
(Int -> ProfilePref -> ShowS)
-> (ProfilePref -> FilePath)
-> ([ProfilePref] -> ShowS)
-> Show ProfilePref
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProfilePref -> ShowS
showsPrec :: Int -> ProfilePref -> ShowS
$cshow :: ProfilePref -> FilePath
show :: ProfilePref -> FilePath
$cshowList :: [ProfilePref] -> ShowS
showList :: [ProfilePref] -> ShowS
Show)

instance ToJSON ProfilePref where
  toJSON :: ProfilePref -> Value
toJSON ProfilePref
v = case ProfilePref
v of
    PrefInteger Integer
i -> Integer -> Value
forall a. ToJSON a => a -> Value
toJSON Integer
i
    PrefDouble Double
d  -> Double -> Value
forall a. ToJSON a => a -> Value
toJSON Double
d
    PrefString Text
s  -> Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
s
    PrefBool  Bool
b   -> Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Bool
b

instance FromJSON ProfilePref where
  parseJSON :: Value -> Parser ProfilePref
parseJSON (String Text
s) = ProfilePref -> Parser ProfilePref
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProfilePref -> Parser ProfilePref)
-> ProfilePref -> Parser ProfilePref
forall a b. (a -> b) -> a -> b
$ Text -> ProfilePref
PrefString Text
s
  parseJSON (Bool Bool
b) = ProfilePref -> Parser ProfilePref
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProfilePref -> Parser ProfilePref)
-> ProfilePref -> Parser ProfilePref
forall a b. (a -> b) -> a -> b
$ Bool -> ProfilePref
PrefBool Bool
b
#if MIN_VERSION_aeson(0,7,0)
  parseJSON (Number Scientific
s)
    | Scientific -> Int
base10Exponent Scientific
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = ProfilePref -> Parser ProfilePref
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProfilePref -> Parser ProfilePref)
-> ProfilePref -> Parser ProfilePref
forall a b. (a -> b) -> a -> b
$ Integer -> ProfilePref
PrefInteger (Scientific -> Integer
coefficient Scientific
s Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Scientific -> Int
base10Exponent Scientific
s))
    | Bool
otherwise = ProfilePref -> Parser ProfilePref
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProfilePref -> Parser ProfilePref)
-> ProfilePref -> Parser ProfilePref
forall a b. (a -> b) -> a -> b
$ Double -> ProfilePref
PrefDouble (Double -> ProfilePref) -> Double -> ProfilePref
forall a b. (a -> b) -> a -> b
$ Scientific -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Scientific
s
#else
  parseJSON (Number (I i)) = return $ PrefInteger i
  parseJSON (Number (D d)) = return $ PrefDouble d
#endif
  parseJSON Value
other = FilePath -> Value -> Parser ProfilePref
forall a. FilePath -> Value -> Parser a
typeMismatch FilePath
"ProfilePref" Value
other

instance Exception ProfileParseError
-- | An error occured while attempting to parse a profile's preference file.
newtype ProfileParseError = ProfileParseError String
  deriving  (ProfileParseError -> ProfileParseError -> Bool
(ProfileParseError -> ProfileParseError -> Bool)
-> (ProfileParseError -> ProfileParseError -> Bool)
-> Eq ProfileParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProfileParseError -> ProfileParseError -> Bool
== :: ProfileParseError -> ProfileParseError -> Bool
$c/= :: ProfileParseError -> ProfileParseError -> Bool
/= :: ProfileParseError -> ProfileParseError -> Bool
Eq, Int -> ProfileParseError -> ShowS
[ProfileParseError] -> ShowS
ProfileParseError -> FilePath
(Int -> ProfileParseError -> ShowS)
-> (ProfileParseError -> FilePath)
-> ([ProfileParseError] -> ShowS)
-> Show ProfileParseError
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProfileParseError -> ShowS
showsPrec :: Int -> ProfileParseError -> ShowS
$cshow :: ProfileParseError -> FilePath
show :: ProfileParseError -> FilePath
$cshowList :: [ProfileParseError] -> ShowS
showList :: [ProfileParseError] -> ShowS
Show, ReadPrec [ProfileParseError]
ReadPrec ProfileParseError
Int -> ReadS ProfileParseError
ReadS [ProfileParseError]
(Int -> ReadS ProfileParseError)
-> ReadS [ProfileParseError]
-> ReadPrec ProfileParseError
-> ReadPrec [ProfileParseError]
-> Read ProfileParseError
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ProfileParseError
readsPrec :: Int -> ReadS ProfileParseError
$creadList :: ReadS [ProfileParseError]
readList :: ReadS [ProfileParseError]
$creadPrec :: ReadPrec ProfileParseError
readPrec :: ReadPrec ProfileParseError
$creadListPrec :: ReadPrec [ProfileParseError]
readListPrec :: ReadPrec [ProfileParseError]
Read, Typeable)

-- | A typeclass to convert types to profile preference values
class ToPref a where
  toPref :: a -> ProfilePref

instance ToPref Text where
  toPref :: Text -> ProfilePref
toPref = Text -> ProfilePref
PrefString

instance ToPref String where
  toPref :: FilePath -> ProfilePref
toPref = Text -> ProfilePref
forall a. ToPref a => a -> ProfilePref
toPref (Text -> ProfilePref)
-> (FilePath -> Text) -> FilePath -> ProfilePref
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
pack

instance ToPref Bool where
  toPref :: Bool -> ProfilePref
toPref = Bool -> ProfilePref
PrefBool

instance ToPref Integer where
  toPref :: Integer -> ProfilePref
toPref = Integer -> ProfilePref
PrefInteger

#define I(t) instance ToPref t where toPref = PrefInteger . toInteger

I(Int)
I(Int8)
I(Int16)
I(Int32)
I(Int64)
I(Word)
I(Word8)
I(Word16)
I(Word32)
I(Word64)

instance ToPref Double where
  toPref :: Double -> ProfilePref
toPref = Double -> ProfilePref
PrefDouble

instance ToPref Float where
  toPref :: Float -> ProfilePref
toPref = Double -> ProfilePref
PrefDouble (Double -> ProfilePref)
-> (Float -> Double) -> Float -> ProfilePref
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac

instance (Integral a) => ToPref (Ratio a) where
  toPref :: Ratio a -> ProfilePref
toPref = Double -> ProfilePref
PrefDouble (Double -> ProfilePref)
-> (Ratio a -> Double) -> Ratio a -> ProfilePref
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ratio a -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac

instance (HasResolution r) => ToPref (Fixed r) where
  toPref :: Fixed r -> ProfilePref
toPref = Double -> ProfilePref
PrefDouble (Double -> ProfilePref)
-> (Fixed r -> Double) -> Fixed r -> ProfilePref
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixed r -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac

instance ToPref ProfilePref where
  toPref :: ProfilePref -> ProfilePref
toPref = ProfilePref -> ProfilePref
forall a. a -> a
id

-- | Retrieve a preference from a profile by key name.
getPref :: Text -> Profile b -> Maybe ProfilePref
getPref :: forall b. Text -> Profile b -> Maybe ProfilePref
getPref Text
k (Profile HashMap FilePath ByteString
_ HashMap Text ProfilePref
m) = Text -> HashMap Text ProfilePref -> Maybe ProfilePref
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
k HashMap Text ProfilePref
m

-- | Add a new preference entry to a profile, overwriting any existing entry
-- with the same key.
addPref :: ToPref a => Text -> a -> Profile b -> Profile b
addPref :: forall a b. ToPref a => Text -> a -> Profile b -> Profile b
addPref Text
k a
v Profile b
p = Profile b
-> (HashMap Text ProfilePref -> HashMap Text ProfilePref)
-> Profile b
forall b.
Profile b
-> (HashMap Text ProfilePref -> HashMap Text ProfilePref)
-> Profile b
onProfilePrefs Profile b
p ((HashMap Text ProfilePref -> HashMap Text ProfilePref)
 -> Profile b)
-> (HashMap Text ProfilePref -> HashMap Text ProfilePref)
-> Profile b
forall a b. (a -> b) -> a -> b
$ Text
-> ProfilePref
-> HashMap Text ProfilePref
-> HashMap Text ProfilePref
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
k (a -> ProfilePref
forall a. ToPref a => a -> ProfilePref
toPref a
v)

-- | Delete an existing preference entry from a profile. This operation is
-- silent if the preference wasn't found.
deletePref :: Text -> Profile b -> Profile b
deletePref :: forall b. Text -> Profile b -> Profile b
deletePref Text
k Profile b
p = Profile b
-> (HashMap Text ProfilePref -> HashMap Text ProfilePref)
-> Profile b
forall b.
Profile b
-> (HashMap Text ProfilePref -> HashMap Text ProfilePref)
-> Profile b
onProfilePrefs Profile b
p ((HashMap Text ProfilePref -> HashMap Text ProfilePref)
 -> Profile b)
-> (HashMap Text ProfilePref -> HashMap Text ProfilePref)
-> Profile b
forall a b. (a -> b) -> a -> b
$ Text -> HashMap Text ProfilePref -> HashMap Text ProfilePref
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HM.delete Text
k

-- | Determines if a profile contains the given file, specified as a path
-- relative to the profile directory.
hasFile :: String -> Profile b -> Bool
hasFile :: forall b. FilePath -> Profile b -> Bool
hasFile FilePath
path (Profile HashMap FilePath ByteString
files HashMap Text ProfilePref
_) = FilePath
path FilePath -> HashMap FilePath ByteString -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
`HM.member` HashMap FilePath ByteString
files

-- | Determines if a profile contains the given extension. specified as an
-- .xpi file or directory name
hasExtension :: String -> Profile b -> Bool
hasExtension :: forall b. FilePath -> Profile b -> Bool
hasExtension FilePath
name = FilePath -> Profile b -> Bool
forall b. FilePath -> Profile b -> Bool
hasFile (FilePath
"extensions" FilePath -> ShowS
</> FilePath
name)

-- | Takes the union of two profiles. This is the union of their 'HashMap'
-- fields.
unionProfiles :: Profile b -> Profile b -> Profile b
unionProfiles :: forall b. Profile b -> Profile b -> Profile b
unionProfiles (Profile HashMap FilePath ByteString
f1 HashMap Text ProfilePref
p1) (Profile HashMap FilePath ByteString
f2 HashMap Text ProfilePref
p2)
  = HashMap FilePath ByteString
-> HashMap Text ProfilePref -> Profile b
forall b.
HashMap FilePath ByteString
-> HashMap Text ProfilePref -> Profile b
Profile (HashMap FilePath ByteString
f1 HashMap FilePath ByteString
-> HashMap FilePath ByteString -> HashMap FilePath ByteString
forall k v. Eq k => HashMap k v -> HashMap k v -> HashMap k v
`HM.union` HashMap FilePath ByteString
f2) (HashMap Text ProfilePref
p1 HashMap Text ProfilePref
-> HashMap Text ProfilePref -> HashMap Text ProfilePref
forall k v. Eq k => HashMap k v -> HashMap k v -> HashMap k v
`HM.union` HashMap Text ProfilePref
p2)

-- | Modifies the 'profilePrefs' field of a profile.
onProfilePrefs ::
  Profile b
  -> (HM.HashMap Text ProfilePref -> HM.HashMap Text ProfilePref)
  -> Profile b
onProfilePrefs :: forall b.
Profile b
-> (HashMap Text ProfilePref -> HashMap Text ProfilePref)
-> Profile b
onProfilePrefs (Profile HashMap FilePath ByteString
hs HashMap Text ProfilePref
hm) HashMap Text ProfilePref -> HashMap Text ProfilePref
f = HashMap FilePath ByteString
-> HashMap Text ProfilePref -> Profile b
forall b.
HashMap FilePath ByteString
-> HashMap Text ProfilePref -> Profile b
Profile HashMap FilePath ByteString
hs (HashMap Text ProfilePref -> HashMap Text ProfilePref
f HashMap Text ProfilePref
hm)

-- | Modifies the 'profileFiles' field of a profile
onProfileFiles ::
  Profile b
  -> (HM.HashMap FilePath ByteString -> HM.HashMap FilePath ByteString)
  -> Profile b
onProfileFiles :: forall b.
Profile b
-> (HashMap FilePath ByteString -> HashMap FilePath ByteString)
-> Profile b
onProfileFiles (Profile HashMap FilePath ByteString
ls HashMap Text ProfilePref
hm) HashMap FilePath ByteString -> HashMap FilePath ByteString
f = HashMap FilePath ByteString
-> HashMap Text ProfilePref -> Profile b
forall b.
HashMap FilePath ByteString
-> HashMap Text ProfilePref -> Profile b
Profile (HashMap FilePath ByteString -> HashMap FilePath ByteString
f HashMap FilePath ByteString
ls) HashMap Text ProfilePref
hm

-- -- | Prepare a zip file of a profile on disk for network transmission.
-- -- This function is very efficient at loading large profiles from disk.
-- prepareZippedProfile :: MonadIO m => FilePath -> m (PreparedProfile a)
-- prepareZippedProfile path = prepareRawZip <$> liftIO (LBS.readFile path)

-- -- | Prepare a zip archive of a profile for network transmission.
-- prepareZipArchive :: Archive -> PreparedProfile a
-- prepareZipArchive = prepareRawZip . fromArchive

-- -- | Prepare a 'ByteString' of raw zip data for network transmission.
-- prepareRawZip :: ByteString -> PreparedProfile a
-- prepareRawZip = PreparedProfile . B64.encode

-- * Firefox


-- | Phantom type used in the parameters of 'Profile' and 'PreparedProfile'
data Firefox

-- | Default Firefox Profile, used when no profile is supplied.
defaultFirefoxProfile :: Profile Firefox
defaultFirefoxProfile :: Profile Firefox
defaultFirefoxProfile = HashMap FilePath ByteString
-> HashMap Text ProfilePref -> Profile Firefox
forall b.
HashMap FilePath ByteString
-> HashMap Text ProfilePref -> Profile b
Profile HashMap FilePath ByteString
forall k v. HashMap k v
HM.empty (HashMap Text ProfilePref -> Profile Firefox)
-> HashMap Text ProfilePref -> Profile Firefox
forall a b. (a -> b) -> a -> b
$ [(Text, ProfilePref)] -> HashMap Text ProfilePref
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [
  (Text
"app.update.auto", Bool -> ProfilePref
PrefBool Bool
False)
  ,(Text
"app.update.enabled", Bool -> ProfilePref
PrefBool Bool
False)
  ,(Text
"browser.startup.page" , Integer -> ProfilePref
PrefInteger Integer
0)
  ,(Text
"browser.download.manager.showWhenStarting", Bool -> ProfilePref
PrefBool Bool
False)
  ,(Text
"browser.EULA.override", Bool -> ProfilePref
PrefBool Bool
True)
  ,(Text
"browser.EULA.3.accepted", Bool -> ProfilePref
PrefBool Bool
True)
  ,(Text
"browser.link.open_external", Integer -> ProfilePref
PrefInteger Integer
2)
  ,(Text
"browser.link.open_newwindow", Integer -> ProfilePref
PrefInteger Integer
2)
  ,(Text
"browser.offline", Bool -> ProfilePref
PrefBool Bool
False)
  ,(Text
"browser.safebrowsing.enabled", Bool -> ProfilePref
PrefBool Bool
False)
  ,(Text
"browser.search.update", Bool -> ProfilePref
PrefBool Bool
False)
  ,(Text
"browser.sessionstore.resume_from_crash", Bool -> ProfilePref
PrefBool Bool
False)
  ,(Text
"browser.shell.checkDefaultBrowser", Bool -> ProfilePref
PrefBool Bool
False)
  ,(Text
"browser.tabs.warnOnClose", Bool -> ProfilePref
PrefBool Bool
False)
  ,(Text
"browser.tabs.warnOnOpen", Bool -> ProfilePref
PrefBool Bool
False)
  ,(Text
"browser.startup.page", Integer -> ProfilePref
PrefInteger Integer
0)
  ,(Text
"browser.safebrowsing.malware.enabled", Bool -> ProfilePref
PrefBool Bool
False)
  ,(Text
"startup.homepage_welcome_url", Text -> ProfilePref
PrefString Text
"about:blank")
  ,(Text
"devtools.errorconsole.enabled", Bool -> ProfilePref
PrefBool Bool
True)
  ,(Text
"focusmanager.testmode", Bool -> ProfilePref
PrefBool Bool
True)
  ,(Text
"dom.disable_open_during_load", Bool -> ProfilePref
PrefBool Bool
False)
  ,(Text
"extensions.autoDisableScopes" , Integer -> ProfilePref
PrefInteger Integer
10)
  ,(Text
"extensions.logging.enabled", Bool -> ProfilePref
PrefBool Bool
True)
  ,(Text
"extensions.update.enabled", Bool -> ProfilePref
PrefBool Bool
False)
  ,(Text
"extensions.update.notifyUser", Bool -> ProfilePref
PrefBool Bool
False)
  ,(Text
"network.manage-offline-status", Bool -> ProfilePref
PrefBool Bool
False)
  ,(Text
"network.http.max-connections-per-server", Integer -> ProfilePref
PrefInteger Integer
10)
  ,(Text
"network.http.phishy-userpass-length", Integer -> ProfilePref
PrefInteger Integer
255)
  ,(Text
"offline-apps.allow_by_default", Bool -> ProfilePref
PrefBool Bool
True)
  ,(Text
"prompts.tab_modal.enabled", Bool -> ProfilePref
PrefBool Bool
False)
  ,(Text
"security.fileuri.origin_policy", Integer -> ProfilePref
PrefInteger Integer
3)
  ,(Text
"security.fileuri.strict_origin_policy", Bool -> ProfilePref
PrefBool Bool
False)
  ,(Text
"security.warn_entering_secure", Bool -> ProfilePref
PrefBool Bool
False)
  ,(Text
"security.warn_submit_insecure", Bool -> ProfilePref
PrefBool Bool
False)
  ,(Text
"security.warn_entering_secure.show_once", Bool -> ProfilePref
PrefBool Bool
False)
  ,(Text
"security.warn_entering_weak", Bool -> ProfilePref
PrefBool Bool
False)
  ,(Text
"security.warn_entering_weak.show_once", Bool -> ProfilePref
PrefBool Bool
False)
  ,(Text
"security.warn_leaving_secure", Bool -> ProfilePref
PrefBool Bool
False)
  ,(Text
"security.warn_leaving_secure.show_once", Bool -> ProfilePref
PrefBool Bool
False)
  ,(Text
"security.warn_submit_insecure", Bool -> ProfilePref
PrefBool Bool
False)
  ,(Text
"security.warn_viewing_mixed", Bool -> ProfilePref
PrefBool Bool
False)
  ,(Text
"security.warn_viewing_mixed.show_once", Bool -> ProfilePref
PrefBool Bool
False)
  ,(Text
"signon.rememberSignons", Bool -> ProfilePref
PrefBool Bool
False)
  ,(Text
"toolkit.networkmanager.disable", Bool -> ProfilePref
PrefBool Bool
True)
  ,(Text
"toolkit.telemetry.enabled", Bool -> ProfilePref
PrefBool Bool
False)
  ,(Text
"toolkit.telemetry.prompted", Integer -> ProfilePref
PrefInteger Integer
2)
  ,(Text
"toolkit.telemetry.rejected", Bool -> ProfilePref
PrefBool Bool
True)
  ,(Text
"javascript.options.showInConsole", Bool -> ProfilePref
PrefBool Bool
True)
  ,(Text
"browser.dom.window.dump.enabled", Bool -> ProfilePref
PrefBool Bool
True)
  ,(Text
"webdriver_accept_untrusted_certs", Bool -> ProfilePref
PrefBool Bool
True)
  ,(Text
"webdriver_enable_native_events", ProfilePref
native_events)
  ,(Text
"webdriver_assume_untrusted_issuer", Bool -> ProfilePref
PrefBool Bool
True)
  ,(Text
"dom.max_script_run_time", Integer -> ProfilePref
PrefInteger Integer
30)
  ]
    where
#ifdef darwin_HOST_OS
      native_events = PrefBool False
#else
      native_events :: ProfilePref
native_events = Bool -> ProfilePref
PrefBool Bool
True
#endif


-- | Load an existing profile from the file system. Any prepared changes made to
-- the 'Profile' will have no effect to the profile on disk.
--
-- To make automated browser run smoothly, preferences found in
-- 'defaultFirefoxProfile' are automatically merged into the preferences of the on-disk
-- profile. The on-disk profile's preference will override those found in the
-- default profile.
loadFirefoxProfile :: forall m. MonadIO m => FilePath -> m (Profile Firefox)
loadFirefoxProfile :: forall (m :: * -> *). MonadIO m => FilePath -> m (Profile Firefox)
loadFirefoxProfile FilePath
path = Profile Firefox -> Profile Firefox -> Profile Firefox
forall b. Profile b -> Profile b -> Profile b
unionProfiles Profile Firefox
defaultFirefoxProfile (Profile Firefox -> Profile Firefox)
-> m (Profile Firefox) -> m (Profile Firefox)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HashMap FilePath ByteString
-> HashMap Text ProfilePref -> Profile Firefox
forall b.
HashMap FilePath ByteString
-> HashMap Text ProfilePref -> Profile b
Profile (HashMap FilePath ByteString
 -> HashMap Text ProfilePref -> Profile Firefox)
-> m (HashMap FilePath ByteString)
-> m (HashMap Text ProfilePref -> Profile Firefox)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> m (HashMap FilePath ByteString)
getFiles FilePath
path m (HashMap Text ProfilePref -> Profile Firefox)
-> m (HashMap Text ProfilePref) -> m (Profile Firefox)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (HashMap Text ProfilePref)
getPrefs)
  where
    userPrefFile :: FilePath
userPrefFile = FilePath
path FilePath -> ShowS
</> FilePath
"prefs" FilePath -> ShowS
<.> FilePath
"js"

    getFiles :: FilePath -> m (HM.HashMap FilePath ByteString)
    getFiles :: FilePath -> m (HashMap FilePath ByteString)
getFiles FilePath
dir = IO (HashMap FilePath ByteString) -> m (HashMap FilePath ByteString)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HashMap FilePath ByteString)
 -> m (HashMap FilePath ByteString))
-> IO (HashMap FilePath ByteString)
-> m (HashMap FilePath ByteString)
forall a b. (a -> b) -> a -> b
$ do
      [FilePath]
allFiles <- FilePath -> IO [FilePath]
getAllFiles FilePath
dir
      (HashMap FilePath ByteString
 -> FilePath -> IO (HashMap FilePath ByteString))
-> HashMap FilePath ByteString
-> [FilePath]
-> IO (HashMap FilePath ByteString)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\HashMap FilePath ByteString
acc FilePath
p -> FilePath
-> ByteString
-> HashMap FilePath ByteString
-> HashMap FilePath ByteString
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert FilePath
p (ByteString
 -> HashMap FilePath ByteString -> HashMap FilePath ByteString)
-> IO ByteString
-> IO (HashMap FilePath ByteString -> HashMap FilePath ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
LBS.readFile FilePath
p IO (HashMap FilePath ByteString -> HashMap FilePath ByteString)
-> IO (HashMap FilePath ByteString)
-> IO (HashMap FilePath ByteString)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap FilePath ByteString -> IO (HashMap FilePath ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap FilePath ByteString
acc) HashMap FilePath ByteString
forall k v. HashMap k v
HM.empty ([FilePath] -> IO (HashMap FilePath ByteString))
-> [FilePath] -> IO (HashMap FilePath ByteString)
forall a b. (a -> b) -> a -> b
$
        (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter ((FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [FilePath]
filesToIgnore) (FilePath -> Bool) -> ShowS -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
takeFileName) [FilePath]
allFiles

    getAllFiles :: FilePath -> IO [FilePath]
    getAllFiles :: FilePath -> IO [FilePath]
getAllFiles FilePath
dir = do
      Bool
exists <- FilePath -> IO Bool
doesDirectoryExist FilePath
dir
      if Bool -> Bool
not Bool
exists then [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [] else do
        [FilePath]
contents <- ShowS -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
dir FilePath -> ShowS
</>) ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
listDirectory FilePath
dir
        [FilePath]
files <- (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
doesFileExist [FilePath]
contents
        [FilePath]
dirs <- (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
doesDirectoryExist [FilePath]
contents
        [FilePath]
subFiles <- [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO [FilePath]) -> [FilePath] -> IO [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FilePath -> IO [FilePath]
getAllFiles [FilePath]
dirs
        [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath]
files [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
subFiles)

    filesToIgnore :: [FilePath]
filesToIgnore = [FilePath
".", FilePath
"..", FilePath
"OfflineCache", FilePath
"Cache", FilePath
"parent.lock", FilePath
".parentlock", FilePath
".lock", FilePath
userPrefFile]

    getPrefs :: m (HashMap Text ProfilePref)
getPrefs = IO (HashMap Text ProfilePref) -> m (HashMap Text ProfilePref)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HashMap Text ProfilePref) -> m (HashMap Text ProfilePref))
-> IO (HashMap Text ProfilePref) -> m (HashMap Text ProfilePref)
forall a b. (a -> b) -> a -> b
$ do
       FilePath -> IO Bool
doesFileExist FilePath
userPrefFile IO Bool
-> (Bool -> IO (HashMap Text ProfilePref))
-> IO (HashMap Text ProfilePref)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
         Bool
True -> [(Text, ProfilePref)] -> HashMap Text ProfilePref
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(Text, ProfilePref)] -> HashMap Text ProfilePref)
-> IO [(Text, ProfilePref)] -> IO (HashMap Text ProfilePref)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> IO [(Text, ProfilePref)]
forall {m :: * -> *}.
MonadThrow m =>
ByteString -> m [(Text, ProfilePref)]
parsePrefs (ByteString -> IO [(Text, ProfilePref)])
-> IO ByteString -> IO [(Text, ProfilePref)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO ByteString
BS.readFile FilePath
userPrefFile)
         Bool
False -> HashMap Text ProfilePref -> IO (HashMap Text ProfilePref)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return HashMap Text ProfilePref
forall k v. HashMap k v
HM.empty
      where
        parsePrefs :: ByteString -> m [(Text, ProfilePref)]
parsePrefs ByteString
s = (FilePath -> m [(Text, ProfilePref)])
-> ([(Text, ProfilePref)] -> m [(Text, ProfilePref)])
-> Either FilePath [(Text, ProfilePref)]
-> m [(Text, ProfilePref)]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ProfileParseError -> m [(Text, ProfilePref)]
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throwIO (ProfileParseError -> m [(Text, ProfilePref)])
-> (FilePath -> ProfileParseError)
-> FilePath
-> m [(Text, ProfilePref)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ProfileParseError
ProfileParseError) [(Text, ProfilePref)] -> m [(Text, ProfilePref)]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
                     (Either FilePath [(Text, ProfilePref)] -> m [(Text, ProfilePref)])
-> Either FilePath [(Text, ProfilePref)] -> m [(Text, ProfilePref)]
forall a b. (a -> b) -> a -> b
$ Parser [(Text, ProfilePref)]
-> ByteString -> Either FilePath [(Text, ProfilePref)]
forall a. Parser a -> ByteString -> Either FilePath a
AP.parseOnly Parser [(Text, ProfilePref)]
prefsParser ByteString
s

-- | Save a Firefox profile to a destination directory. This directory should
-- already exist.
saveFirefoxProfile :: MonadIO m => Profile Firefox -> FilePath -> m ()
saveFirefoxProfile :: forall (m :: * -> *).
MonadIO m =>
Profile Firefox -> FilePath -> m ()
saveFirefoxProfile (Profile Firefox -> Archive
firefoxProfileToArchive -> Archive
archive) FilePath
dest = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ([ZipOption] -> Archive -> IO ())
-> Archive -> [ZipOption] -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip [ZipOption] -> Archive -> IO ()
extractFilesFromArchive Archive
archive [
  ZipOption
OptRecursive
  , FilePath -> ZipOption
OptDestination FilePath
dest
  ]

-- | Prepare a Firefox profile for network transmission.
firefoxProfileToArchive :: Profile Firefox -> Archive
firefoxProfileToArchive :: Profile Firefox -> Archive
firefoxProfileToArchive (Profile {profileFiles :: forall b. Profile b -> HashMap FilePath ByteString
profileFiles = HashMap FilePath ByteString
files, profilePrefs :: forall b. Profile b -> HashMap Text ProfilePref
profilePrefs = HashMap Text ProfilePref
prefs}) =
  (Archive -> (FilePath, ByteString) -> Archive)
-> Archive -> [(FilePath, ByteString)] -> Archive
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Archive -> (FilePath, ByteString) -> Archive
addProfileFile Archive
baseArchive (HashMap FilePath ByteString -> [(FilePath, ByteString)]
forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap FilePath ByteString
files)

  where
    baseArchive :: Archive
baseArchive = Archive
emptyArchive
                Archive -> (Archive -> Archive) -> Archive
forall a b. a -> (a -> b) -> b
& Entry -> Archive -> Archive
addEntryToArchive (FilePath -> Integer -> ByteString -> Entry
toEntry (FilePath
"user" FilePath -> ShowS
<.> FilePath
"js") Integer
0 ByteString
userJsContents)

    userJsContents :: ByteString
userJsContents = HashMap Text ProfilePref
prefs
                   HashMap Text ProfilePref
-> (HashMap Text ProfilePref -> [(Text, ProfilePref)])
-> [(Text, ProfilePref)]
forall a b. a -> (a -> b) -> b
& HashMap Text ProfilePref -> [(Text, ProfilePref)]
forall k v. HashMap k v -> [(k, v)]
HM.toList
                   [(Text, ProfilePref)]
-> ([(Text, ProfilePref)] -> [ByteString]) -> [ByteString]
forall a b. a -> (a -> b) -> b
& ((Text, ProfilePref) -> ByteString)
-> [(Text, ProfilePref)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
k, ProfilePref
v) -> [ByteString] -> ByteString
LBS.concat [ ByteString
"user_pref(", Text -> ByteString
forall a. ToJSON a => a -> ByteString
encode Text
k, ByteString
", ", ProfilePref -> ByteString
forall a. ToJSON a => a -> ByteString
encode ProfilePref
v, ByteString
");\n"])
                   [ByteString] -> ([ByteString] -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
& [ByteString] -> ByteString
LBS.concat

    addProfileFile :: Archive -> (FilePath, ByteString) -> Archive
    addProfileFile :: Archive -> (FilePath, ByteString) -> Archive
addProfileFile Archive
archive (FilePath
dest, ByteString
bytes) = Entry -> Archive -> Archive
addEntryToArchive (FilePath -> Integer -> ByteString -> Entry
toEntry FilePath
dest Integer
0 ByteString
bytes) Archive
archive

instance ToJSON (Profile Firefox) where
  toJSON :: Profile Firefox -> Value
toJSON Profile Firefox
prof = Profile Firefox -> Archive
firefoxProfileToArchive Profile Firefox
prof
              Archive -> (Archive -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
& Archive -> ByteString
fromArchive
              ByteString -> (ByteString -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
& ByteString -> ByteString
B64L.encode
              ByteString -> (ByteString -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
& ByteString -> ByteString
LBS.toStrict
              ByteString -> (ByteString -> Text) -> Text
forall a b. a -> (a -> b) -> b
& ByteString -> Text
T.decodeUtf8
              Text -> (Text -> Value) -> Value
forall a b. a -> (a -> b) -> b
& Text -> Value
A.String

instance FromJSON (Profile Firefox) where
  parseJSON :: Value -> Parser (Profile Firefox)
parseJSON (String Text
t) = case ByteString -> Either FilePath ByteString
B64L.decode (Text -> ByteString
TL.encodeUtf8 (Text -> Text
TL.fromStrict Text
t)) of
    Left FilePath
err -> FilePath -> Parser (Profile Firefox)
forall a. FilePath -> Parser a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath
"Couldn't decode Firefox profile archive: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
err)
    Right ByteString
bytes -> case ByteString -> Either FilePath Archive
toArchiveOrFail ByteString
bytes of
      Left FilePath
err -> FilePath -> Parser (Profile Firefox)
forall a. FilePath -> Parser a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath
"Couldn't unzip Firefox profile archive: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
err)
      Right Archive
archive -> Profile Firefox -> Parser (Profile Firefox)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Profile Firefox -> Parser (Profile Firefox))
-> Profile Firefox -> Parser (Profile Firefox)
forall a b. (a -> b) -> a -> b
$ Profile {
        profileFiles :: HashMap FilePath ByteString
profileFiles = [(FilePath, ByteString)] -> HashMap FilePath ByteString
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [(FilePath
eRelativePath, Entry -> ByteString
fromEntry Entry
e) | e :: Entry
e@(Entry {Integer
FilePath
Word16
Word32
ByteString
EncryptionMethod
CompressionMethod
eRelativePath :: FilePath
eCompressionMethod :: CompressionMethod
eEncryptionMethod :: EncryptionMethod
eLastModified :: Integer
eCRC32 :: Word32
eCompressedSize :: Word32
eUncompressedSize :: Word32
eExtraField :: ByteString
eFileComment :: ByteString
eVersionMadeBy :: Word16
eInternalFileAttributes :: Word16
eExternalFileAttributes :: Word32
eCompressedData :: ByteString
eCompressedData :: Entry -> ByteString
eExternalFileAttributes :: Entry -> Word32
eInternalFileAttributes :: Entry -> Word16
eVersionMadeBy :: Entry -> Word16
eFileComment :: Entry -> ByteString
eExtraField :: Entry -> ByteString
eUncompressedSize :: Entry -> Word32
eCompressedSize :: Entry -> Word32
eCRC32 :: Entry -> Word32
eLastModified :: Entry -> Integer
eEncryptionMethod :: Entry -> EncryptionMethod
eCompressionMethod :: Entry -> CompressionMethod
eRelativePath :: Entry -> FilePath
..}) <- [Entry]
otherFiles]
        , profilePrefs :: HashMap Text ProfilePref
profilePrefs = HashMap Text ProfilePref
prefs
        }
        where
          prefs :: HashMap Text ProfilePref
prefs = case (Entry -> Bool) -> [Entry] -> Maybe Entry
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (\(Entry {Integer
FilePath
Word16
Word32
ByteString
EncryptionMethod
CompressionMethod
eCompressedData :: Entry -> ByteString
eExternalFileAttributes :: Entry -> Word32
eInternalFileAttributes :: Entry -> Word16
eVersionMadeBy :: Entry -> Word16
eFileComment :: Entry -> ByteString
eExtraField :: Entry -> ByteString
eUncompressedSize :: Entry -> Word32
eCompressedSize :: Entry -> Word32
eCRC32 :: Entry -> Word32
eLastModified :: Entry -> Integer
eEncryptionMethod :: Entry -> EncryptionMethod
eCompressionMethod :: Entry -> CompressionMethod
eRelativePath :: Entry -> FilePath
eRelativePath :: FilePath
eCompressionMethod :: CompressionMethod
eEncryptionMethod :: EncryptionMethod
eLastModified :: Integer
eCRC32 :: Word32
eCompressedSize :: Word32
eUncompressedSize :: Word32
eExtraField :: ByteString
eFileComment :: ByteString
eVersionMadeBy :: Word16
eInternalFileAttributes :: Word16
eExternalFileAttributes :: Word32
eCompressedData :: ByteString
..}) -> FilePath
eRelativePath FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"prefs.js") (Archive -> [Entry]
zEntries Archive
archive) of
            Maybe Entry
Nothing -> HashMap Text ProfilePref
forall a. Monoid a => a
mempty
            Just Entry
entry -> case Parser [(Text, ProfilePref)]
-> ByteString -> Either FilePath [(Text, ProfilePref)]
forall a. Parser a -> ByteString -> Either FilePath a
AP.parseOnly Parser [(Text, ProfilePref)]
prefsParser (ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Entry -> ByteString
fromEntry Entry
entry) of
              Left FilePath
_err -> HashMap Text ProfilePref
forall a. Monoid a => a
mempty
              Right [(Text, ProfilePref)]
p -> [(Text, ProfilePref)] -> HashMap Text ProfilePref
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [(Text, ProfilePref)]
p

          otherFiles :: [Entry]
otherFiles = [Entry
e | e :: Entry
e@(Entry {Integer
FilePath
Word16
Word32
ByteString
EncryptionMethod
CompressionMethod
eCompressedData :: Entry -> ByteString
eExternalFileAttributes :: Entry -> Word32
eInternalFileAttributes :: Entry -> Word16
eVersionMadeBy :: Entry -> Word16
eFileComment :: Entry -> ByteString
eExtraField :: Entry -> ByteString
eUncompressedSize :: Entry -> Word32
eCompressedSize :: Entry -> Word32
eCRC32 :: Entry -> Word32
eLastModified :: Entry -> Integer
eEncryptionMethod :: Entry -> EncryptionMethod
eCompressionMethod :: Entry -> CompressionMethod
eRelativePath :: Entry -> FilePath
eRelativePath :: FilePath
eCompressionMethod :: CompressionMethod
eEncryptionMethod :: EncryptionMethod
eLastModified :: Integer
eCRC32 :: Word32
eCompressedSize :: Word32
eUncompressedSize :: Word32
eExtraField :: ByteString
eFileComment :: ByteString
eVersionMadeBy :: Word16
eInternalFileAttributes :: Word16
eExternalFileAttributes :: Word32
eCompressedData :: ByteString
..}) <- Archive -> [Entry]
zEntries Archive
archive, FilePath
eRelativePath FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
"prefs.js"]
  parseJSON Value
other = FilePath -> Value -> Parser (Profile Firefox)
forall a. FilePath -> Value -> Parser a
typeMismatch FilePath
"Profile Firefox" Value
other

-- Firefox prefs.js parser

prefsParser :: AP.Parser [(Text, ProfilePref)]
prefsParser :: Parser [(Text, ProfilePref)]
prefsParser = Parser ByteString (Text, ProfilePref)
-> Parser [(Text, ProfilePref)]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
AP.many1 (Parser ByteString (Text, ProfilePref)
 -> Parser [(Text, ProfilePref)])
-> Parser ByteString (Text, ProfilePref)
-> Parser [(Text, ProfilePref)]
forall a b. (a -> b) -> a -> b
$ do
  Parser ByteString ByteString -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString ByteString -> Parser ByteString ())
-> (Parser ByteString ByteString -> Parser ByteString ByteString)
-> Parser ByteString ByteString
-> Parser ByteString ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser ByteString ByteString -> Parser ByteString ByteString
forall {b}. Parser ByteString b -> Parser ByteString b
padSpaces (Parser ByteString ByteString -> Parser ByteString ())
-> Parser ByteString ByteString -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Parser ByteString ByteString
AP.string ByteString
"user_pref("
  Text
k <- Parser Text
prefKey Parser Text -> FilePath -> Parser Text
forall i a. Parser i a -> FilePath -> Parser i a
<?> FilePath
"preference key"
  Parser ByteString Char -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString Char -> Parser ByteString ())
-> (Parser ByteString Char -> Parser ByteString Char)
-> Parser ByteString Char
-> Parser ByteString ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser ByteString Char -> Parser ByteString Char
forall {b}. Parser ByteString b -> Parser ByteString b
padSpaces (Parser ByteString Char -> Parser ByteString ())
-> Parser ByteString Char -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser ByteString Char
AP.char Char
','
  ProfilePref
v <- Parser ByteString ProfilePref
prefVal Parser ByteString ProfilePref
-> FilePath -> Parser ByteString ProfilePref
forall i a. Parser i a -> FilePath -> Parser i a
<?> FilePath
"preference value"
  Parser ByteString ByteString -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString ByteString -> Parser ByteString ())
-> (Parser ByteString ByteString -> Parser ByteString ByteString)
-> Parser ByteString ByteString
-> Parser ByteString ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser ByteString ByteString -> Parser ByteString ByteString
forall {b}. Parser ByteString b -> Parser ByteString b
padSpaces (Parser ByteString ByteString -> Parser ByteString ())
-> Parser ByteString ByteString -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Parser ByteString ByteString
AP.string ByteString
");"
  (Text, ProfilePref) -> Parser ByteString (Text, ProfilePref)
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
k,ProfilePref
v)
  where
    prefKey :: Parser Text
prefKey = Parser Text
jstring
    prefVal :: Parser ByteString ProfilePref
prefVal = do
      Value
v <- Parser Value
value'
      case Value -> Result ProfilePref
forall a. FromJSON a => Value -> Result a
fromJSON Value
v of
        Error FilePath
str -> FilePath -> Parser ByteString ProfilePref
forall a. FilePath -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
str
        Success ProfilePref
p -> ProfilePref -> Parser ByteString ProfilePref
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return ProfilePref
p

    padSpaces :: Parser ByteString b -> Parser ByteString b
padSpaces Parser ByteString b
p = Parser ByteString [()]
spaces Parser ByteString [()]
-> Parser ByteString b -> Parser ByteString b
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString b
p Parser ByteString b
-> Parser ByteString [()] -> Parser ByteString b
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString [()]
spaces
    spaces :: Parser ByteString [()]
spaces = Parser ByteString () -> Parser ByteString [()]
forall a. Parser ByteString a -> Parser ByteString [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser ByteString ()
AP.endOfLine Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString Char -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser ByteString Char
AP.space Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString FilePath -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser ByteString FilePath
comment)
      where
        comment :: Parser ByteString FilePath
comment = Parser ByteString FilePath
inlineComment Parser ByteString FilePath
-> Parser ByteString FilePath -> Parser ByteString FilePath
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString FilePath
lineComment
        lineComment :: Parser ByteString FilePath
lineComment = Char -> Parser ByteString Char
AP.char Char
'#' Parser ByteString Char
-> Parser ByteString FilePath -> Parser ByteString FilePath
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Char
-> Parser ByteString () -> Parser ByteString FilePath
forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
AP.manyTill Parser ByteString Char
AP.anyChar Parser ByteString ()
AP.endOfLine
        inlineComment :: Parser ByteString FilePath
inlineComment = ByteString -> Parser ByteString ByteString
AP.string ByteString
"/*" Parser ByteString ByteString
-> Parser ByteString FilePath -> Parser ByteString FilePath
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Char
-> Parser ByteString ByteString -> Parser ByteString FilePath
forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
AP.manyTill Parser ByteString Char
AP.anyChar (ByteString -> Parser ByteString ByteString
AP.string ByteString
"*/")