git.iko.soy/reflex-dom
on develop help sign in
Abstract out utils used by gc test for headless Chrome tests
commitc5cf180a3ef443cf475dc68746effdd6fef18075 authorKen Micklas <kmicklas@gmail.com> dateThu 7 Mar 2019, 10:47 (8 years ago) parent5bebc3e
4 files changed+59−16
compare with develop
unifiedsplit
reflex-dom-core/reflex-dom-core.cabal+19−5 reflex-dom-core/src-chromedriver-utils/Test/Util/ChromeFlags.hs+16 reflex-dom-core/src-chromedriver-utils/Test/Util/UnshareNetwork.hs+12 reflex-dom-core/test/gc.hs+12−11
reflex-dom-core/reflex-dom-core.cabal+19−5
@@ -196,14 +196,13 @@ test-suite hydration
196196-- needs to be updated for changes in GHC.Stats
197197test-suite gc
198198 build-depends: base
199− , reflex
200− , reflex-dom-core
199+ , chromedriver-utils
201200 , jsaddle
202201 , jsaddle-warp
203− , linux-namespaces
204202 , process
205− , temporary
206− , unix
203+ , reflex
204+ , reflex-dom-core
205+ , text
207206 hs-source-dirs: test
208207 ghc-options: -rtsopts -with-rtsopts=-T -Wall -fwarn-tabs -funbox-strict-fields -O2 -ferror-spans
209208 ghc-prof-options: -fprof-auto -optP-DPROFILING
@@ -212,6 +211,21 @@ test-suite gc
212211 if !os(linux) || !arch(x86_64)
213212 buildable: False
214213
214+library chromedriver-utils
215+ hs-source-dirs: src-chromedriver-utils
216+ ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2 -ferror-spans
217+ build-depends: base
218+ , linux-namespaces
219+ , process
220+ , temporary
221+ , text
222+ , unix
223+ exposed-modules:
224+ Test.Util.UnshareNetwork
225+ Test.Util.ChromeFlags
226+ if !os(linux) || !arch(x86_64)
227+ buildable: False
228+
215229source-repository head
216230 type: git
217231 location: https://github.com/reflex-frp/reflex-dom
reflex-dom-core/src-chromedriver-utils/Test/Util/ChromeFlags.hsnew file+16
@@ -0,0 +1,16 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+module Test.Util.ChromeFlags where
3+
4+import Data.Text
5+import System.IO.Temp
6+
7+withSandboxedChromeFlags :: Bool -> ([Text] -> IO a) -> IO a
8+withSandboxedChromeFlags headless action =
9+ withSystemTempDirectory "reflex-dom-core_test" $ \tmp ->
10+ action
11+ [ if headless then "--headless" else "--auto-open-devtools-for-tabs"
12+ , "--disable-gpu"
13+ , "--no-sandbox"
14+ , "--remote-debugging-port=9222"
15+ , "--user-data-dir=" <> pack tmp
16+ ]
reflex-dom-core/src-chromedriver-utils/Test/Util/UnshareNetwork.hsnew file+12
@@ -0,0 +1,12 @@
1+module Test.Util.UnshareNetwork where
2+
3+import System.Linux.Namespaces
4+import System.Posix
5+import System.Process
6+
7+unshareNetork :: IO ()
8+unshareNetork = do
9+ uid <- getEffectiveUserID
10+ unshare [User, Network]
11+ writeUserMappings Nothing [UserMapping 0 uid 1]
12+ callCommand "ip link set lo up ; ip addr"
reflex-dom-core/test/gc.hs+12−11
@@ -8,16 +8,17 @@ import Control.Exception
88import Control.Monad
99import Control.Monad.IO.Class
1010import Data.Int
11+import Data.Text
1112import Language.Javascript.JSaddle.Warp
1213import Reflex.Dom.Core
1314import Reflex.Time
1415import System.Exit
15−import System.IO.Temp
16−import System.Linux.Namespaces
1716import System.Mem
18−import System.Posix
1917import System.Process
2018
19+import Test.Util.ChromeFlags
20+import Test.Util.UnshareNetwork
21+
2122#if MIN_VERSION_base(4,11,0)
2223import GHC.Stats (getRTSStatsEnabled, getRTSStats, RTSStats(..), gcdetails_live_bytes, gc)
2324currentBytesUsed :: RTSStats -> Int64
@@ -46,14 +47,14 @@ failureLimit = 0
4647
4748main :: IO ()
4849main = do
49− uid <- getEffectiveUserID
50− handle (\(_ :: IOError) -> return ()) $ do -- If we run into an exception with sandboxing, just don't bother
51− unshare [User, Network]
52− writeUserMappings Nothing [UserMapping 0 uid 1]
53− callCommand "ip link set lo up ; ip addr"
54− mainThread <- myThreadId
55− withSystemTempDirectory "reflex-dom-core_test_gc" $ \tmp -> do
56− browserProcess <- spawnCommand $ "echo 'Starting Chromium' ; chromium --headless --disable-gpu --no-sandbox --remote-debugging-port=9222 --user-data-dir=" ++ tmp ++ " http://localhost:3911 ; echo 'Chromium exited'"
50+ handle (\(_ :: IOError) -> return ()) $ unshareNetork -- If we run into an exception with sandboxing, just don't bother
51+ withSandboxedChromeFlags True $ \chromeFlags -> do
52+ mainThread <- myThreadId
53+ browserProcess <- spawnCommand $ mconcat
54+ [ "echo 'Starting Chromium' ; chromium "
55+ , unpack $ intercalate " " chromeFlags
56+ , " http://localhost:3911 ; echo 'Chromium exited'"
57+ ]
5758 let finishTest result = do
5859 interruptProcessGroupOf browserProcess
5960 throwTo mainThread result