@@ -0,0 +1,113 @@
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+#if __GLASGOW_HASKELL__ >= 800
19+{-# OPTIONS_GHC -freduction-depth=100 #-}
20+#else
21+{-# OPTIONS_GHC -fcontext-stack=100 #-}
22+#endif
23+{-# OPTIONS_GHC -fno-warn-orphans #-}
24+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
25+
26+#include "overlapping-compat.h"
27+module Servant.StreamSpec (spec) where
28+
29+import Prelude ()
30+import Prelude.Compat
31+import Data.Proxy
32+import qualified Network.HTTP.Client as C
33+import System.IO.Unsafe (unsafePerformIO)
34+import Test.Hspec
35+
36+import Servant.API ((:<|>) ((:<|>)),
37+ (:>),
38+ EmptyAPI, JSON,
39+ StreamGet,
40+ NewlineFraming,
41+ NetstringFraming,
42+ ResultStream(..),
43+ StreamGenerator(..))
44+import Servant.Client
45+import Servant.Server
46+import qualified Servant.ClientSpec as CS
47+import Servant.ClientSpec (Person(..))
48+
49+
50+spec :: Spec
51+spec = describe "Servant.Stream" $ do
52+ streamSpec
53+
54+type StreamApi f =
55+ "streamGetNewline" :> StreamGet NewlineFraming JSON (f Person)
56+ :<|> "streamGetNetstring" :> StreamGet NetstringFraming JSON (f Person)
57+ :<|> EmptyAPI
58+
59+
60+capi :: Proxy (StreamApi ResultStream)
61+capi = Proxy
62+
63+sapi :: Proxy (StreamApi StreamGenerator)
64+sapi = Proxy
65+
66+
67+getGetNL :<|> getGetNS :<|> EmptyClient = client capi
68+
69+
70+getGetNL :: ClientM (ResultStream Person)
71+getGetNS :: ClientM (ResultStream Person)
72+
73+alice :: Person
74+alice = Person "Alice" 42
75+
76+bob :: Person
77+bob = Person "Bob" 25
78+
79+server :: Application
80+server = serve sapi (
81+ (return (StreamGenerator (\f r -> f alice >> r bob >> r alice))
82+ :: Handler (StreamGenerator Person))
83+ :<|>
84+ (return (StreamGenerator (\f r -> f alice >> r bob >> r alice))
85+ :: Handler (StreamGenerator Person))
86+ :<|>
87+ emptyServer)
88+
89+
90+{-# NOINLINE manager' #-}
91+manager' :: C.Manager
92+manager' = unsafePerformIO $ C.newManager C.defaultManagerSettings
93+
94+runClient :: ClientM a -> BaseUrl -> IO (Either ServantError a)
95+runClient x baseUrl' = runClientM x (ClientEnv manager' baseUrl')
96+
97+runResultStream :: ResultStream a -> IO (Maybe (Either String a), Maybe (Either String a), Maybe (Either String a), Maybe (Either String a))
98+runResultStream (ResultStream k) = k $ \act -> (,,,) <$> act <*> act <*> act <*> act
99+
100+streamSpec :: Spec
101+streamSpec = beforeAll (CS.startWaiApp server) $ afterAll CS.endWaiApp $ do
102+
103+ it "Servant.API.StreamGet.Newline" $ \(_, baseUrl) -> do
104+ Right res <- runClient getGetNL baseUrl
105+ let jra = Just (Right alice)
106+ jrb = Just (Right bob)
107+ runResultStream res `shouldReturn` (jra, jrb, jra, Nothing)
108+
109+ it "Servant.API.StreamGet.Netstring" $ \(_, baseUrl) -> do
110+ Right res <- runClient getGetNS baseUrl
111+ let jra = Just (Right alice)
112+ jrb = Just (Right bob)
113+ runResultStream res `shouldReturn` (jra, jrb, jra, Nothing)