Review fixes

This commit is contained in:
Julian K. Arni 2018-03-19 11:02:47 +01:00
parent c02ca1b6e1
commit d78543575b
3 changed files with 25 additions and 19 deletions

View file

@ -116,6 +116,7 @@ test-suite spec
, generics-sop >= 0.3.1.0 && < 0.4 , generics-sop >= 0.3.1.0 && < 0.4
, hspec >= 2.4.4 && < 2.5 , hspec >= 2.4.4 && < 2.5
, HUnit >= 1.6 && < 1.7 , HUnit >= 1.6 && < 1.7
, random-bytestring >= 0.1 && < 0.2
, network >= 2.6.3.2 && < 2.7 , network >= 2.6.3.2 && < 2.7
, QuickCheck >= 2.10.1 && < 2.12 , QuickCheck >= 2.10.1 && < 2.12
, servant == 0.13.* , servant == 0.13.*

View file

@ -29,14 +29,12 @@ 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 (currentBytesUsed, getGCStats) import GHC.Stats
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,
@ -46,6 +44,7 @@ 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
@ -81,17 +80,17 @@ server = serve sapi
:<|> return (StreamGenerator lotsGenerator) :<|> return (StreamGenerator lotsGenerator)
where where
lotsGenerator f r = do lotsGenerator f r = do
f "" _ <- f ""
withFile "/dev/urandom" ReadMode $ streamFiveMBNTimes 1000 r
\handle -> streamFiveMBNTimes handle 1000 r
return () return ()
streamFiveMBNTimes handle left sink streamFiveMBNTimes :: Int -> (BS.ByteString -> IO ()) -> IO ()
| left <= 0 = return "" streamFiveMBNTimes left sink
| left <= 0 = return ()
| otherwise = do | otherwise = do
msg <- BS.hGet handle (megabytes 5) msg <- random (megabytes 5)
sink msg sink msg
streamFiveMBNTimes handle (left - 1) sink streamFiveMBNTimes (left - 1) sink
@ -129,8 +128,12 @@ 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) megabytes n = n * (1000 ^ (2 :: Int))

View file

@ -18,6 +18,8 @@ extra-deps:
- aeson-compat-0.3.7.1 - aeson-compat-0.3.7.1
- free-5.0.1 - free-5.0.1
- lens-4.16 - lens-4.16
- random-bytestring-0.1.3
- pcg-random-0.1.3.5
# allow-newer: true # ignores all bounds, that's a sledgehammer # allow-newer: true # ignores all bounds, that's a sledgehammer
# - doc/tutorial/ # - doc/tutorial/