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