Review fixes
This commit is contained in:
parent
c02ca1b6e1
commit
d78543575b
3 changed files with 25 additions and 19 deletions
|
@ -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.*
|
||||||
|
|
|
@ -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))
|
||||||
|
|
|
@ -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/
|
||||||
|
|
Loading…
Reference in a new issue