git.iko.soy/typeable/servant
on servant-auth-uverb help sign in
typeable/servant/servant-http-streams/test/Servant/StreamSpec.hs
110 lines 4.0 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE ConstraintKinds #-}
3{-# LANGUAGE DataKinds #-}
4{-# LANGUAGE DeriveGeneric #-}
5{-# LANGUAGE FlexibleContexts #-}
6{-# LANGUAGE FlexibleInstances #-}
7{-# LANGUAGE FunctionalDependencies #-}
8{-# LANGUAGE GADTs #-}
9{-# LANGUAGE MultiParamTypeClasses #-}
10{-# LANGUAGE OverloadedStrings #-}
11{-# LANGUAGE PolyKinds #-}
12{-# LANGUAGE RecordWildCards #-}
13{-# LANGUAGE ScopedTypeVariables #-}
14{-# LANGUAGE StandaloneDeriving #-}
15{-# LANGUAGE TypeFamilies #-}
16{-# LANGUAGE TypeOperators #-}
17{-# LANGUAGE UndecidableInstances #-}
18{-# OPTIONS_GHC -freduction-depth=100 #-}
19{-# OPTIONS_GHC -fno-warn-orphans #-}
20{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
22module Servant.StreamSpec (spec) where
24import Control.Monad.Trans.Except
25import qualified Data.ByteString as BS
26import Data.Proxy
27import Prelude ()
28import Prelude.Compat
29import Servant.API
30 ((:<|>) ((:<|>)), (:>), JSON, NetstringFraming,
31 NewlineFraming, NoFraming, OctetStream, SourceIO, StreamBody,
32 StreamGet)
33import Servant.ClientSpec
34 (Person (..))
35import qualified Servant.ClientSpec as CS
36import Servant.HttpStreams
37import Servant.Server
38import Servant.Types.SourceT
39import System.Entropy
40 (getEntropy, getHardwareEntropy)
41import Test.Hspec
44spec :: Spec
45spec = describe "Servant.HttpStreams streaming" $ do
46 streamSpec
48type StreamApi =
49 "streamGetNewline" :> StreamGet NewlineFraming JSON (SourceIO Person)
50 :<|> "streamGetNetstring" :> StreamGet NetstringFraming JSON (SourceIO Person)
51 :<|> "streamALot" :> StreamGet NoFraming OctetStream (SourceIO BS.ByteString)
52 :<|> "streamBody" :> StreamBody NoFraming OctetStream (SourceIO BS.ByteString) :> StreamGet NoFraming OctetStream (SourceIO BS.ByteString)
54api :: Proxy StreamApi
55api = Proxy
57getGetNL, getGetNS :: ClientM (SourceIO Person)
58_getGetALot :: ClientM (SourceIO BS.ByteString)
59getStreamBody :: SourceT IO BS.ByteString -> ClientM (SourceIO BS.ByteString)
60getGetNL :<|> getGetNS :<|> _getGetALot :<|> getStreamBody = client api
62alice :: Person
63alice = Person "Alice" 42
65bob :: Person
66bob = Person "Bob" 25
68server :: Application
69server = serve api
70 $ return (source [alice, bob, alice])
71 :<|> return (source [alice, bob, alice])
72 -- 2 ^ (18 + 10) = 256M
73 :<|> return (SourceT ($ lots (powerOfTwo 18)))
74 :<|> return
75 where
76 lots n
77 | n < 0 = Stop
78 | otherwise = Effect $ do
79 let size = powerOfTwo 10
80 mbs <- getHardwareEntropy size
81 bs <- maybe (getEntropy size) pure mbs
82 return (Yield bs (lots (n - 1)))
84powerOfTwo :: Int -> Int
85powerOfTwo = (2 ^)
87withClient :: ClientM a -> BaseUrl -> (Either ClientError a -> IO r) -> IO r
88withClient x burl k = do
89 withClientEnvIO burl $ \env -> withClientM x env k
91testRunSourceIO :: SourceIO a
92 -> IO (Either String [a])
93testRunSourceIO = runExceptT . runSourceT
95streamSpec :: Spec
96streamSpec = beforeAll (CS.startWaiApp server) $ afterAll CS.endWaiApp $ do
97 it "works with Servant.API.StreamGet.Newline" $ \(_, baseUrl) -> do
98 withClient getGetNL baseUrl $ \(Right res) ->
99 testRunSourceIO res `shouldReturn` Right [alice, bob, alice]
101 it "works with Servant.API.StreamGet.Netstring" $ \(_, baseUrl) -> do
102 withClient getGetNS baseUrl $ \(Right res) ->
103 testRunSourceIO res `shouldReturn` Right [alice, bob, alice]
105 it "works with Servant.API.StreamBody" $ \(_, baseUrl) -> do
106 withClient (getStreamBody (source input)) baseUrl $ \(Right res) ->
107 testRunSourceIO res `shouldReturn` Right output
108 where
109 input = ["foo", "", "bar"]
110 output = ["foo", "bar"]