http-pony 0.1.0.0 → 0.1.0.1
raw patch · 4 files changed
+110/−26 lines, 4 files
Files
- README.md +55/−0
- http-pony.cabal +6/−4
- src/Network/HTTP/Pony/Serve.hs +35/−19
- src/Network/HTTP/Pony/Type.hs +14/−3
+ README.md view
@@ -0,0 +1,55 @@+Teaser+======++Let's write a hello world app.++ {-# LANGUAGE OverloadedStrings #-}++ module Hello where++ import Pipes (yield)++ hello _ = pure ("HTTP/1.1 200 OK", [], yield "hello world\n")++Note, we are not importing any interface!++If we take a closer look at the type of `hello`:++ Prelude Hello> :t hello+ hello+ :: (Applicative f, Data.String.IsString a, Data.String.IsString t,+ Monad m) =>+ t2 -> f (t, [t1], Pipes.Internal.Proxy x' x () a m ())++This is a *pure* app!++Shall we run it?++{-# LANGUAGE OverloadedStrings #-}++ module RunHello where++ import Network.HTTP.Pony.Serve (run, http)+ import Pipes.Safe (runSafeT)+ import PonyHello (ponyHello)++ main :: IO ()+ main = (runSafeT . run "localhost" "8080" . http) ponyHello++Test it:++ # the above files are mirrored in `./test`+ runghc -isrc -itest test/RunHello.hs+ + # open another terminal+ curl localhost:8080 -i+ + # output:++ > HTTP/1.1 200 OK+ >+ > hello world+ +wow ~++Exercise: write a `tcp cat`
http-pony.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: http-pony-version: 0.1.0.0+version: 0.1.0.1 synopsis: A type unsafe http library -- description: license: BSD3@@ -12,9 +12,11 @@ -- copyright: category: Network build-type: Simple-extra-source-files: ChangeLog.md+extra-source-files: ChangeLog.md README.md cabal-version: >=1.10 +Homepage: https://github.com/nfjinjing/http-pony+ library exposed-modules: Network.HTTP.Pony.Type , Network.HTTP.Pony.Builder@@ -23,7 +25,8 @@ , Network.HTTP.Pony.Helper -- other-modules: -- other-extensions: OverloadedStrings- build-depends: base >=4.9 && <4.10+ build-depends: attoparsec >=0.13+ , base >=4.9 && <4.10 , bytestring >=0.10 && <0.11 , case-insensitive >=1.2 , network >=2.6@@ -33,7 +36,6 @@ , pipes-parse >=3.0 , pipes-safe >=2.2 , transformers >=0.5- , attoparsec >=0.13 hs-source-dirs: src default-language: Haskell2010
src/Network/HTTP/Pony/Serve.hs view
@@ -17,48 +17,64 @@ import qualified Network.HTTP.Pony.Builder as Builder import Network.HTTP.Pony.Helper ((-), shutdownSend, shutdownReceive) import qualified Network.HTTP.Pony.Parser as Parser-import Network.HTTP.Pony.Type (Application, App)+import Network.HTTP.Pony.Type (Application, App, Middleware, Request, Response) import Prelude hiding ((-), log) -serve :: (MonadIO m) => Producer ByteString m a- -> Consumer ByteString m b- -> Application m ByteString ByteString a b- -> m (Maybe ParsingError)-serve pull push app = do+-- http :: (Monad m) => Application m ByteString ByteString a b+-- -> (Producer ByteString m a -> m (Producer ByteString m ()))+http :: (Monad m) => Middleware m+ (Producer ByteString m a)+ (Producer ByteString m ())+ (Request ByteString m a)+ (Response ByteString m b)+http app pull = do maybeRequest <- Parser.parseMessage pull (pure ()) case maybeRequest of Just (Right request) -> do response <- app request - runEffect -- Builder.message response >-> push+ pure - Builder.message response >> pure () - pure Nothing- Just (Left err) -> pure - pure - err- _ -> pure Nothing+ _ -> pure - pure () + -- Just (Left err) -> pure - pure - err+ -- _ -> pure Nothing +serveWithPipe :: (Monad m) => Producer ByteString m a+ -> Consumer ByteString m b+ -> (Producer ByteString m a -> m (Producer ByteString m b))+ -> m ()+serveWithPipe pull push pipe = do+ r <- pipe pull+ runEffect - r >-> push++ pure ()+ serveWithSocket :: (MonadIO m) => (NS.Socket, NS.SockAddr)- -> Application m ByteString ByteString () ()- -> m (Maybe ParsingError)+ -> (Producer ByteString m () -> m (Producer ByteString m ()))+ -> m () serveWithSocket (s,_) = let pull = fromSocket s 4096 >> shutdownReceive s push = toSocket s >> shutdownSend s in - serve pull push+ serveWithPipe pull push run :: (MonadSafe m) => HostPreference -> NS.ServiceName- -> App+ -> (Producer ByteString IO () -> IO (Producer ByteString IO ())) -> m () run host service app = PipesNetwork.serve host service - \socket -> do- r <- serveWithSocket socket app- case r of- Nothing -> pure ()- Just err -> pure () -- log - view packed - show err+ serveWithSocket socket app++ -- pure ()++ -- r <- serveWithSocket socket app+ -- case r of+ -- Nothing -> pure ()+ -- Just err -> pure () -- log - view packed - show err
src/Network/HTTP/Pony/Type.hs view
@@ -1,5 +1,6 @@-module Network.HTTP.Pony.Type where+{-# LANGUAGE Rank2Types #-} +module Network.HTTP.Pony.Type where import Data.ByteString (ByteString) import Data.CaseInsensitive (CI)@@ -15,5 +16,15 @@ type Response a m r = Message a m r -- App shouldn't block!-type Application m a b c d = Request a m c -> m (Response b m d)-type App = Application IO ByteString ByteString () ()+type Application m a b x y = Request a m x -> m (Response b m y)+type Application' m a x = Application m a a x x+type Application'' m a = Application m a a () ()++type App = Application'' IO ByteString++-- type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t+-- A Middleware is a Lens on Message?++-- type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t+type Middleware f s t a b = (a -> f b) -> s -> f t+type Middleware' f s t = (s -> f t) -> s -> f t