eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Re-review changes.

Browse source 
Using random packages mysteriously fail on CI, and also uses a lot
    more CPU.
This commit is contained in:
Julian K. Arni 2018-03-19 18:22:49 +01:00
parent d78543575b
commit 7c901dcb7d
1 changed files with 11 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

25
servant-client/test/Servant/StreamSpec.hs
View file

@ -29,12 +29,14 @@ module Servant.StreamSpec (spec) where
import Control.Monad (replicateM_, void)
import qualified Data.ByteString as BS
import Data.Proxy
import GHC.Stats
import GHC.Stats (currentBytesUsed, getGCStats)
import qualified Network.HTTP.Client as C
import Prelude ()
import Prelude.Compat
import System.IO (IOMode (ReadMode), withFile)
import System.IO.Unsafe (unsafePerformIO)
import Test.Hspec
import Test.QuickCheck
import Servant.API ((:<|>) ((:<|>)), (:>), JSON,
NetstringFraming, NewlineFraming,
@ -44,7 +46,6 @@ import Servant.Client
import Servant.ClientSpec (Person (..))
import qualified Servant.ClientSpec as CS
import Servant.Server
import Data.ByteString.Random.MWC (random)
spec :: Spec
@ -80,17 +81,17 @@ server = serve sapi
:<|> return (StreamGenerator lotsGenerator)
where
lotsGenerator f r = do
_ <- f ""
streamFiveMBNTimes 1000 r
f ""
withFile "/dev/urandom" ReadMode $
\handle -> streamFiveMBNTimes handle 1000 r
return ()
streamFiveMBNTimes :: Int -> (BS.ByteString -> IO ()) -> IO ()
streamFiveMBNTimes left sink
| left <= 0 = return ()
streamFiveMBNTimes handle left sink
| left <= 0 = return ""
| otherwise = do
msg <- random (megabytes 5)
msg <- BS.hGet handle (megabytes 5)
sink msg
streamFiveMBNTimes (left - 1) sink
streamFiveMBNTimes handle (left - 1) sink
@ -128,12 +129,8 @@ streamSpec = beforeAll (CS.startWaiApp server) $ afterAll CS.endWaiApp $ do
Right (ResultStream res) <- runClient getGetALot baseUrl
let consumeNChunks n = replicateM_ n (res void)
consumeNChunks 900
#if MIN_VERSION_base(4,9,0)
memUsed <- max_mem_in_use_bytes <$> getRTSStats
#else
memUsed <- currentBytesUsed <$> getGCStats
#endif
memUsed `shouldSatisfy` (< (megabytes 20))
megabytes :: Num a => a -> a
megabytes n = n * (1000 ^ (2 :: Int))
megabytes n = n * (1000 ^ 2)