├── .gitignore ├── LICENSE ├── README.md ├── example.hs ├── scalable-server.cabal └── src └── Network └── Server └── ScalableServer.hs /.gitignore: -------------------------------------------------------------------------------- 1 | dist/ 2 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2011 Jamie Turner. All rights reserved. 2 | 3 | Redistribution and use in source and binary forms, with or without modification, are 4 | permitted provided that the following conditions are met: 5 | 6 | 1. Redistributions of source code must retain the above copyright notice, this list of 7 | conditions and the following disclaimer. 8 | 9 | 2. Redistributions in binary form must reproduce the above copyright notice, this list 10 | of conditions and the following disclaimer in the documentation and/or other materials 11 | provided with the distribution. 12 | 13 | THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED 14 | WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND 15 | FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR 16 | CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 17 | CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 18 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON 19 | ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 20 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF 21 | ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 22 | 23 | The views and conclusions contained in the software and documentation are those of the 24 | authors and should not be interpreted as representing official policies, either expressed 25 | or implied, of Jamie Turner. 26 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Library for building fast/scalable TCP-based services in Haskell. 2 | 3 | Docs: 4 | http://hackage.haskell.org/packages/archive/scalable-server/latest/doc/html/Network-Server-ScalableServer.html 5 | 6 | Example: 7 | https://github.com/jamwt/haskell-scalable-server/blob/master/example.hs 8 | -------------------------------------------------------------------------------- /example.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | import qualified Data.Attoparsec as Atto 4 | import qualified Data.ByteString.Char8 as S 5 | 6 | import Control.Monad (void, forever) 7 | import Control.Concurrent (forkIO, threadDelay) 8 | 9 | import Blaze.ByteString.Builder.ByteString (copyByteString, fromByteString) 10 | import Blaze.ByteString.Builder (Builder) 11 | 12 | import Network.Server.ScalableServer 13 | 14 | data PingPongRequest = Request S.ByteString 15 | 16 | parseRequest :: Atto.Parser PingPongRequest 17 | parseRequest = do 18 | w <- Atto.takeTill (==13) 19 | _ <- Atto.string "\r\n" 20 | return $ Request w 21 | 22 | handler :: PingPongRequest -> IO Builder 23 | handler req = return $ handle req 24 | 25 | handle :: PingPongRequest -> Builder 26 | handle (Request "PING") = do 27 | copyByteString "PONG\r\n" 28 | 29 | handle (Request _) = do 30 | copyByteString "ERROR\r\n" 31 | 32 | main = testServer 33 | 34 | testServer = do 35 | let definition = RequestPipeline parseRequest handler 36 | void $ forkIO $ runServer definition 6004 37 | forever $ threadDelay (1000000 * 60) 38 | -------------------------------------------------------------------------------- /scalable-server.cabal: -------------------------------------------------------------------------------- 1 | Name: scalable-server 2 | 3 | Synopsis: Library for writing fast/scalable TCP-based services 4 | Description: Library for writing fast/scalable TCP-based services 5 | 6 | Version: 0.3.3 7 | 8 | License: BSD3 9 | 10 | License-file: LICENSE 11 | 12 | Homepage: https://github.com/jamwt/haskell-scalable-server/ 13 | 14 | Author: Jamie Turner 15 | 16 | Maintainer: jamie@bu.mp 17 | 18 | Category: Network 19 | Build-type: Simple 20 | 21 | Extra-source-files: example.hs 22 | 23 | Cabal-version: >=1.2 24 | 25 | 26 | Library 27 | Exposed-modules: Network.Server.ScalableServer 28 | 29 | hs-source-dirs: src 30 | 31 | Build-depends: base >=4 && <5, 32 | bytestring >=0.9, 33 | attoparsec >=0.10 && < 0.11, 34 | network>=2.3, 35 | blaze-builder>=0.3 && <0.4, 36 | conduit>=1.0 && < 1.1, 37 | network-conduit>=1.0 && < 1.1, 38 | mtl >=2, 39 | attoparsec-conduit>=1.0 && < 1.1 40 | 41 | Extensions: ScopedTypeVariables 42 | ghc-options: -O2 43 | -------------------------------------------------------------------------------- /src/Network/Server/ScalableServer.hs: -------------------------------------------------------------------------------- 1 | module Network.Server.ScalableServer ( 2 | -- * Introduction 3 | -- $intro 4 | 5 | runServer, 6 | RequestPipeline(..), RequestCreator, 7 | RequestProcessor) where 8 | 9 | import Blaze.ByteString.Builder (Builder, toByteString) 10 | import Control.Monad.Trans (liftIO) 11 | import Control.Applicative 12 | import Data.ByteString 13 | import Data.Conduit 14 | import Data.Conduit.List as CL 15 | import Data.Conduit.Network 16 | import Data.Conduit.Attoparsec 17 | import Network.BSD 18 | import qualified Data.Attoparsec as Atto 19 | 20 | -- $intro 21 | -- 22 | -- 'ScalableServer' is a library that attempts to capture current best 23 | -- practices for writing fast/scalable socket servers in Haskell. 24 | -- 25 | -- Currently, that involves providing the right glue for hooking up 26 | -- to conduit/network-conduit/attoparsec-conduit/blaze-builder 27 | -- 28 | -- It provides a relatively simple parse/generate toolchain for 29 | -- plugging into these engines 30 | -- 31 | -- Server written using this library also can be invoked with +RTS -NX 32 | -- invocation for multicore support 33 | 34 | -- |The 'RequestPipeline' acts as a specification for your service, 35 | -- indicating both a parser/request object generator, the RequestCreator, 36 | -- and the processor of these requests, one that ultimately generates a 37 | -- response expressed by a blaze 'Builder' 38 | data RequestPipeline a = RequestPipeline (RequestCreator a) (RequestProcessor a) 39 | 40 | -- |The RequestCreator is an Attoparsec parser that yields some request 41 | -- object 'a' 42 | type RequestCreator a = Atto.Parser a 43 | 44 | -- |The RequestProcessor is a function in the IO monad (for DB access, etc) 45 | -- that returns a builder that can generate the response 46 | type RequestProcessor a = a -> IO Builder 47 | 48 | runServer :: RequestPipeline a -> PortNumber -> IO () 49 | runServer pipe port = do 50 | let app = (processRequest pipe) 51 | let settings = serverSettings (fromIntegral port) HostAny 52 | runTCPServer settings app 53 | 54 | processRequest :: RequestPipeline a -> AppData IO -> IO () 55 | processRequest (RequestPipeline parser handler) appdata = do 56 | let source = appSource appdata 57 | let sink = appSink appdata 58 | source $$ conduitParser parser =$= CL.mapM wrapHandler =$= sink 59 | where 60 | wrapHandler (_, n) = toByteString <$> handler n 61 | --------------------------------------------------------------------------------