git.iko.soy/servant
on 79caafe help sign in
servant/doc/cookbook/basic-streaming/Streaming.lhs
126 lines 4.3 kB history raw
1# Streaming out-of-the-box
3In other words, without streaming libraries.
5## Introduction
7- Servant supports streaming
8- Some basic usage doesn't require usage of streaming libraries,
9 like `conduit`, `pipes`, `machines` or `streaming`.
10 We have bindings for them though.
11- This is similar example file, which is bundled with each of the packages (TODO: links)
12- `SourceT` doesn't have *Prelude* with handy combinators, so we have to write
13 things ourselves. (Note to self: `mapM` and `foldM` would be handy to have).
15## Code
17```haskell
18{-# LANGUAGE BangPatterns #-}
19{-# LANGUAGE DataKinds #-}
20{-# LANGUAGE DeriveGeneric #-}
21{-# LANGUAGE TypeOperators #-}
22module Main (main) where
24import Control.Concurrent
25 (threadDelay)
26import Control.Monad.IO.Class
27 (MonadIO (..))
28import qualified Data.ByteString as BS
29import Data.Maybe
30 (fromMaybe)
31import Network.HTTP.Client
32 (defaultManagerSettings, newManager)
33import Network.Wai
34 (Application)
35import System.Environment
36 (getArgs, lookupEnv)
37import Text.Read
38 (readMaybe)
40import Servant
41import Servant.Client
42import qualified Servant.Types.SourceT as S
44import qualified Network.Wai.Handler.Warp as Warp
46type FastAPI = "get" :> Capture "num" Int :> StreamGet NewlineFraming JSON (SourceIO Int)
48type API = FastAPI
49 :<|> "slow" :> Capture "num" Int :> StreamGet NewlineFraming JSON (SourceIO Int)
50 -- monad can be ResourceT IO too.
51 :<|> "readme" :> StreamGet NoFraming OctetStream (SourceIO BS.ByteString)
52 -- we can have streaming request body
53 :<|> "proxy"
54 :> StreamBody NoFraming OctetStream (SourceIO BS.ByteString)
55 :> StreamPost NoFraming OctetStream (SourceIO BS.ByteString)
57api :: Proxy API
58api = Proxy
60server :: Server API
61server = fast :<|> slow :<|> readme :<|> proxy where
62 fast n = liftIO $ do
63 putStrLn $ "/get/" ++ show n
64 return $ fastSource n
66 slow n = liftIO $ do
67 putStrLn $ "/slow/" ++ show n
68 return $ slowSource n
70 readme = liftIO $ do
71 putStrLn "/proxy"
72 return (S.readFile "README.md")
74 proxy c = liftIO $ do
75 putStrLn "/proxy"
76 return c
78 -- for some reason unfold leaks?
79 fastSource = S.fromStepT . mk where
80 mk m
81 | m < 0 = S.Stop
82 | otherwise = S.Yield m (mk (m - 1))
84 slowSource m = S.mapStepT delay (fastSource m) where
85 delay S.Stop = S.Stop
86 delay (S.Error err) = S.Error err
87 delay (S.Skip s) = S.Skip (delay s)
88 delay (S.Effect ms) = S.Effect (fmap delay ms)
89 delay (S.Yield x s) = S.Effect $
90 S.Yield x (delay s) <$ threadDelay 1000000
92app :: Application
93app = serve api server
95cli :: Client ClientM FastAPI
96cli :<|> _ :<|> _ :<|> _ = client api
98main :: IO ()
99main = do
100 args <- getArgs
101 case args of
102 ("server":_) -> do
103 putStrLn "Starting cookbook-basic-streaming at http://localhost:8000"
104 port <- fromMaybe 8000 . (>>= readMaybe) <$> lookupEnv "PORT"
105 Warp.run port app
106 ("client":ns:_) -> do
107 n <- maybe (fail $ "not a number: " ++ ns) pure $ readMaybe ns
108 mgr <- newManager defaultManagerSettings
109 burl <- parseBaseUrl "http://localhost:8000/"
110 withClientM (cli n) (mkClientEnv mgr burl) $ \me -> case me of
111 Left err -> print err
112 Right src -> do
113 x <- S.unSourceT src (go (0 :: Int))
114 print x
115 where
116 go !acc S.Stop = return acc
117 go !acc (S.Error err) = print err >> return acc
118 go !acc (S.Skip s) = go acc s
119 go !acc (S.Effect ms) = ms >>= go acc
120 go !acc (S.Yield _ s) = go (acc + 1) s
121 _ -> do
122 putStrLn "Try:"
123 putStrLn "cabal new-run cookbook-basic-streaming server"
124 putStrLn "cabal new-run cookbook-basic-streaming client 10"
125 putStrLn "time curl -H 'Accept: application/json' localhost:8000/slow/5"
126```