test/Hspec/Server/Stream.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 {-# LANGUAGE NoMonomorphismRestriction #-}
   3 module Hspec.Server.Stream where
   4
   5 import Control.Monad (when)
   6 import Data.Bool
   7 import Data.Either (Either(..))
   8 import Data.Eq (Eq(..))
   9 import Data.Ord (Ord(..))
  10 import Data.Functor ((<$))
  11 import Data.Int (Int)
  12 import Data.Maybe (Maybe(..))
  13 import Data.Semigroup (Semigroup(..))
  14 import Data.String (String)
  15 import Prelude ((+), (-))
  16 import System.IO (putStrLn)
  17 import Test.Hspec.Wai (liftIO)
  18 import Text.Read (readMaybe)
  19 import Text.Show (Show(..))
  20 import qualified Control.Concurrent as Concurrent
  21 import qualified Data.ByteString.Base64 as BS64
  22 import qualified Data.ByteString.Lazy as BSL
  23 import qualified Data.Text as Text
  24 import qualified Data.Text.Encoding as Text
  25 import qualified Data.Text.Lazy as TL
  26 import qualified Data.Text.Lazy.Encoding as TL
  27 import qualified Network.HTTP.Types as HTTP
  28 import qualified Network.Wai.Handler.Warp as Warp
  29 import qualified Test.Hspec.Wai as Wai
  30 import qualified Control.Monad.Classes as MC
  31
  32 import Symantic.HTTP
  33 import Hspec.Utils
  34
  35 {-
  36 api = "stream" </> "slow"
  37                </> capture @Int "n"
  38                <.> getStream @(SourceIO Int) @'[PlainText] @NewlineFraming
  39
  40 srv = server api $ route_slow
  41         where
  42         route_slow n = MC.exec $ do
  43                 putStrLn $ "/stream/slow/" <> show n
  44                 return $ mapStepT (delaySource 100000) $ fastSource n
  45         fastSource n = source [1..n]
  46         delaySource t = mapYield $ \a next ->
  47                 Yield a $ Effect $ do
  48                         -- NOTE: add a delay after each yielded value.
  49                         Concurrent.threadDelay t
  50                         return $ delaySource t next
  51
  52 cli_slow = client api
  53
  54 warp :: IO ()
  55 warp = Warp.run 8080 srv
  56 -}
  57
  58 {-
  59 hspec = testSpecs $ describe "Error" $ Wai.with (return srv) $ do
  60         describe "Path" $ do
  61                 it "checks shorter path" $ do
  62                         Wai.get "/good"
  63                          `Wai.shouldRespondWith` 404
  64                 it "checks longer path" $ do
  65                         Wai.get "/good/path/bad"
  66                          `Wai.shouldRespondWith` 404
  67 -}
  68
  69 {-
  70 type FastAPI = "get" :> Capture "num" Int :> StreamGet NewlineFraming JSON (SourceIO Int)
  71
  72 type API = FastAPI
  73     :<|> "slow" :> Capture "num" Int :> StreamGet NewlineFraming JSON (SourceIO Int)
  74     -- monad can be ResourceT IO too.
  75     :<|> "readme" :> StreamGet NoFraming OctetStream (SourceIO BS.ByteString)
  76     -- we can have streaming request body
  77     :<|> "proxy"
  78         :> StreamBody NoFraming OctetStream (SourceIO BS.ByteString)
  79         :> StreamPost NoFraming OctetStream (SourceIO BS.ByteString)
  80
  81 api :: Proxy API
  82 api = Proxy
  83
  84 server :: Server API
  85 server = fast :<|> slow :<|> readme :<|> proxy where
  86     fast n = liftIO $ do
  87         putStrLn $ "/get/" ++ show n
  88         return $ fastSource n
  89
  90     slow n = liftIO $ do
  91         putStrLn $ "/slow/" ++ show n
  92         return $ slowSource n
  93
  94     readme = liftIO $ do
  95         putStrLn "/proxy"
  96         return (S.readFile "README.md")
  97
  98     proxy c = liftIO $ do
  99         putStrLn "/proxy"
 100         return c
 101
 102     -- for some reason unfold leaks?
 103     fastSource = S.fromStepT . mk where
 104         mk m
 105             | m < 0     = S.Stop
 106             | otherwise = S.Yield m (mk (m - 1))
 107
 108     slowSource m = S.mapStepT delay (fastSource m) where
 109         delay S.Stop        = S.Stop
 110         delay (S.Error err) = S.Error err
 111         delay (S.Skip s)    = S.Skip (delay s)
 112         delay (S.Effect ms) = S.Effect (delay <$> ms)
 113         delay (S.Yield x s) = S.Effect $
 114             S.Yield x (delay s) <$ threadDelay 1000000
 115
 116 app :: Application
 117 app = serve api server
 118
 119 cli :: Client ClientM FastAPI
 120 cli :<|> _ :<|> _ :<|> _ = client api
 121
 122 main :: IO ()
 123 main = do
 124     args <- getArgs
 125     case args of
 126         ("server":_) -> do
 127             putStrLn "Starting cookbook-basic-streaming at http://localhost:8000"
 128             port <- fromMaybe 8000 . (>>= readMaybe) <$> lookupEnv "PORT"
 129             Warp.run port app
 130         ("client":ns:_) -> do
 131             n <- maybe (fail $ "not a number: " ++ ns) pure $ readMaybe ns
 132             mgr <- newManager defaultManagerSettings
 133             burl <- parseBaseUrl "http://localhost:8000/"
 134             withClientM (cli n) (mkClientEnv mgr burl) $ \me -> case me of
 135                 Left err  -> print err
 136                 Right src -> do
 137                     x <- S.unSourceT src (go (0 :: Int))
 138                     print x
 139                   where
 140                     go !acc S.Stop        = return acc
 141                     go !acc (S.Error err) = print err >> return acc
 142                     go !acc (S.Skip s)    = go acc s
 143                     go !acc (S.Effect ms) = ms >>= go acc
 144                     go !acc (S.Yield _ s) = go (acc + 1) s
 145         _ -> do
 146             putStrLn "Try:"
 147             putStrLn "cabal new-run cookbook-basic-streaming server"
 148             putStrLn "cabal new-run cookbook-basic-streaming client 10"
 149             putStrLn "time curl -H 'Accept: application/json' localhost:8000/slow/5"
 150 -}