git.iko.soy/typeable/servant
on servant-docs-0.11.5 help sign in
typeable/servant/servant-pipes/example/Main.hs
107 lines 3.6 kB history raw
1{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE TypeOperators #-}
4module Main (main) where
6import Prelude ()
7import Prelude.Compat
9import Control.Concurrent
10 (threadDelay)
11import Control.Monad.IO.Class
12 (MonadIO (..))
13import qualified Data.ByteString as BS
14import Data.Maybe
15 (fromMaybe)
16import Network.HTTP.Client
17 (defaultManagerSettings, newManager)
18import Network.Wai
19 (Application)
20import System.Environment
21 (getArgs, lookupEnv)
22import System.IO
23 (IOMode (..))
24import Text.Read
25 (readMaybe)
27import qualified Pipes as P
28import Pipes.ByteString as PBS
29import qualified Pipes.Prelude as P
30import Pipes.Safe
31 (SafeT)
32import qualified Pipes.Safe.Prelude as P
33import Servant
34import Servant.Client.Streaming
35import Servant.Pipes ()
37import qualified Network.Wai.Handler.Warp as Warp
39type FastAPI = "get" :> Capture "num" Int :> StreamGet NewlineFraming JSON (P.Producer Int IO ())
41-- TODO: Change IO to something with MonadError ServantUnrenderError
42type API = FastAPI
43 :<|> "slow" :> Capture "num" Int :> StreamGet NewlineFraming JSON (P.Producer Int IO ())
44 -- monad can be SafeT IO too.
45 :<|> "readme" :> StreamGet NoFraming OctetStream (P.Producer BS.ByteString (SafeT IO) ())
46 -- we can have streaming request body
47 :<|> "proxy"
48 :> StreamBody NoFraming OctetStream (P.Producer BS.ByteString IO ())
49 :> StreamPost NoFraming OctetStream (P.Producer BS.ByteString IO ())
51api :: Proxy API
52api = Proxy
54server :: Server API
55server = fast :<|> slow :<|> readme :<|> proxy
56 where
57 fast n = liftIO $ do
58 putStrLn ("/get/" ++ show n)
59 return $ fastPipe n
61 slow n = liftIO $ do
62 putStrLn ("/slow/" ++ show n)
63 return $ slowPipe n
65 readme = liftIO $ do
66 putStrLn "/readme"
67 return $ P.withFile "README.md" ReadMode PBS.fromHandle
69 proxy c = liftIO $ do
70 putStrLn "/proxy"
71 return c
73 -- for some reason unfold leaks?
74 fastPipe m
75 | m < 0 = return ()
76 | otherwise = P.yield m >> fastPipe (m - 1)
78 slowPipe m = fastPipe m P.>-> P.mapM (<$ threadDelay 1000000)
80app :: Application
81app = serve api server
83cli :: Client ClientM FastAPI
84cli :<|> _ :<|> _ :<|> _ = client api
86main :: IO ()
87main = do
88 args <- getArgs
89 case args of
90 ("server":_) -> do
91 putStrLn "Starting servant-pipes:example at http://localhost:8000"
92 port <- fromMaybe 8000 . (>>= readMaybe) <$> lookupEnv "PORT"
93 Warp.run port app
94 ("client":ns:_) -> do
95 n <- maybe (fail $ "not a number: " ++ ns) pure $ readMaybe ns
96 mgr <- newManager defaultManagerSettings
97 burl <- parseBaseUrl "http://localhost:8000/"
98 withClientM (cli n) (mkClientEnv mgr burl) $ \me -> case me of
99 Left err -> print err
100 Right p -> do
101 x <- P.fold (\c _ -> c + 1) (0 :: Int) id p
102 print x
103 _ -> do
104 putStrLn "Try:"
105 putStrLn "cabal new-run servant-pipes:example server"
106 putStrLn "cabal new-run servant-pipes:example client 10"
107 putStrLn "time curl -H 'Accept: application/json' localhost:8000/slow/5"