sockets-and-pipes 0.2 → 0.3
raw patch · 11 files changed
+226/−917 lines, 11 filesdep +attoparsecdep +directorydep +filepathdep −pipesdep ~aesondep ~asciidep ~async
Dependencies added: attoparsec, directory, filepath, list-transformer, network-simple, relude, resourcet, unfork
Dependencies removed: pipes
Dependency ranges changed: aeson, ascii, async, base, containers, text, time
Files
- sockets-and-pipes.cabal +54/−246
- src/SocketsAndPipes/Serve.hs +0/−121
- src/SocketsAndPipes/Serve/Exceptions.hs +0/−103
- src/SocketsAndPipes/Serve/Finally.hs +0/−21
- src/SocketsAndPipes/Serve/Log.hs +0/−101
- src/SocketsAndPipes/Serve/Loop.hs +0/−51
- src/SocketsAndPipes/Serve/OnError.hs +0/−29
- src/SocketsAndPipes/Serve/Setup.hs +0/−149
- src/SocketsAndPipes/Serve/Shutdown.hs +0/−29
- src/SocketsAndPipes/Serve/Sockets.hs +0/−67
- src/SocketsAndPipes/Syllabus.hs +172/−0
sockets-and-pipes.cabal view
@@ -1,289 +1,97 @@-cabal-version: 2.0-build-type: Simple+cabal-version: 3.0 name: sockets-and-pipes-version: 0.2+version: 0.3+ synopsis: Support for the Sockets and Pipes book category: HTTP, Network, Streaming, Text+ license: Apache-2.0 license-file: license.txt+ author: Chris Martin, Julie Moronuki maintainer: Joy of Haskell <hello@joyofhaskell.com> -tested-with: GHC == 9.0.1, GHC == 8.10.3, GHC == 8.8.4, GHC == 8.6.5+build-type: Simple description: This package contains some utilities that support /Sockets and Pipes/ (available on <https://leanpub.com/sockets-and-pipes Leanpub>), as well as re-exports from all the libraries mentioned in the book.- .- == Code in this package- .- Original contributions from this package:- .- * "SocketsAndPipes.Serve"- .- == Chapters- .- List of modules that make a significant appearance in each chapter:- .- +----+----------------------+----------------------------------+---------------------------------------+- | | Chapter | Module | Purpose |- +====+======================+==================================+=======================================+- | 1 | __Handles__ | "System.IO" | Writing to a file |- | | +----------------------------------+---------------------------------------+- | | | "Control.Exception.Safe" | Using `bracket` to ensure |- | | | | the file handle is closed |- +----+----------------------+----------------------------------+---------------------------------------+- | 2 | __Chunks__ | "Data.Text" | `Text` is a chunk of characters |- | | +----------------------------------+---------------------------------------+- | | | "Data.Text.IO" | Reading and writing files using |- | | | | `Text` instead of `String` |- +----+----------------------+----------------------------------+---------------------------------------+- | 3 | __Bytes__ | "Data.Word" | What a byte is |- | | +----------------------------------+---------------------------------------+- | | | "Data.ByteString" | `ByteString` is a chunk of bytes |- | | +----------------------------------+---------------------------------------+- | | | "Data.Text.Encoding" | Conversions between `ByteString` |- | | | | and `Text` |- | | +----------------------------------+---------------------------------------+- | | | "Data.String" | How `ByteString` works with |- | | +----------------------------------+ `OverloadedStrings` |- | | | "Data.ByteString.Char8" | |- | | +----------------------------------+---------------------------------------+- | | | "System.IO" | Putting `Handle`s into binary mode |- +----+----------------------+----------------------------------+---------------------------------------+- | 4 | __Sockets__ | "Network.Socket" | Opening and closing sockets |- | | +----------------------------------+---------------------------------------+- | | | "Network.Socket.ByteString" | Writing to and reading from sockets |- | | +----------------------------------+---------------------------------------+- | | | "System.Timeout" | Giving up quickly when a service |- | | | | does not respond |- +----+----------------------+----------------------------------+---------------------------------------+- | 5 | __HTTP__ | "ASCII" | Expressing HTTP messages as strings |- | | +----------------------------------+ |- | | | "ASCII.Char" | |- | | +----------------------------------+---------------------------------------+- | | | "SocketsAndPipes.Serve" | Our first rudimentary web server |- +----+----------------------+----------------------------------+---------------------------------------+- | 6 | __HTTP types__ | "Data.ByteString" | Defining datatypes for the |- | | +----------------------------------+ parts of an HTTP message |- | | | "Data.ByteString.Lazy" | |- +----+----------------------+----------------------------------+---------------------------------------+- | 7 | __Encoding__ | "Data.Text.Lazy" | Efficient string concatenations |- | | +----------------------------------+ |- | | | "Data.Text.Lazy.Builder" | |- | | +----------------------------------+ |- | | | "Data.ByteString.Builder" | |- | | +----------------------------------+---------------------------------------+- | | | "Data.Time" | Simple performance testing |- | | +----------------------------------+---------------------------------------+- | | | "Data.Foldable" | Encoding repetitions with `foldMap` |- +----+----------------------+----------------------------------+---------------------------------------+- | 8 | __Responding__ | "Network.Socket.ByteString.Lazy" | Sending responses constructed by |- | | | | bytestring `Builder` |- | | +----------------------------------+---------------------------------------+- | | | "SocketsAndPipes.Serve" | New web server using the |- | | | | encoding functions |- | | +----------------------------------+---------------------------------------+- | | | "Data.Int" | Contrasting `Integer`, `Int`, |- | | | | and `Int64` |- +----+----------------------+----------------------------------+---------------------------------------+- | 9 | __Content types__ | "Data.Text.Lazy.Builder.Int" | Building a text response body |- | | +----------------------------------+---------------------------------------+- | | | "Text.Blaze.Html" | Building an HTML response body |- | | +----------------------------------+ |- | | | "Text.Blaze.Html5" | |- | | +----------------------------------+ |- | | | "Text.Blaze.Html.Renderer.Utf8" | |- | | +----------------------------------+---------------------------------------+- | | | "Data.Aeson" | Building a JSON response body |- +----+----------------------+----------------------------------+---------------------------------------+- | 10 | __Change__ | "Control.Concurrent.STM.TVar" | Shared state for request-handling |- | | +----------------------------------+ threads |- | | | "Control.Monad.STM" | |- +----+----------------------+----------------------------------+---------------------------------------+- | 11 | __Streaming__ | "Data.ByteString.Builder" | Chunked HTTP message encoding |- +----+----------------------+----------------------------------+---------------------------------------+- | 12 | __ListT IO__ | "Pipes" | Representing files and chunked HTTP |- | | | | message bodies as I/O streams |- +----+----------------------+----------------------------------+---------------------------------------+- | 13 | __Request parsing__ | |- +----+----------------------+ |- | 14 | __Reading headers__ | |- +----+----------------------+ |- | 15 | __Body parsing__ | |- +----+----------------------+ The remaining chapters are in progress. |- | 16 | __Connection reuse__ | |- +----+----------------------+ |- | 17 | __Producers and__ | |- | | __Consumers__ | |- +----+----------------------+--------------------------------------------------------------------------+- .- == Libraries- .- Re-exported modules, grouped by the package that each module originally comes from:- .- __ascii__ - "ASCII", "ASCII.Char"- .- __aeson__ - "Data.Aeson"- .- __async__ - "Control.Concurrent.Async"- .- __base__- .- * File handles - "System.IO"- * Fundamental data types - "Data.Word", "Data.Int", "Data.Char"- * Integer conversions - "Data.Bits"- * Miscellania - "System.Timeout", "Control.Monad",- "Data.Foldable", "Data.List"- .- __blaze-html__ - "Text.Blaze.Html", "Text.Blaze.Html5",- "Text.Blaze.Html5.Attributes", "Text.Blaze.Html.Renderer.Utf8"- .- __bytestring__- .- * Strict - "Data.ByteString"- * Lazy - "Data.ByteString.Lazy"- * Builder - "Data.ByteString.Builder"- * "Data.ByteString.Char8" -- This is included mostly to discuss why we don't use it.- .- __network__- .- * "Network.Socket" -- The Socket type, operations for opening and closing sockets- * "Network.Socket.ByteString" -- Socket read/write operations with strict byte strings- * "Network.Socket.ByteString.Lazy" -- Socket read/write operations with lazy byte strings- .- __pipes__- .- * "Pipes" - ListT- .- __safe-exceptions__ - "Control.Exception.Safe"- .- __stm__ - "Control.Monad.STM", "Control.Concurrent.STM.TVar"- .- __text__- .- * Strict - "Data.Text", "Data.Text.Encoding", "Data.Text.IO"- * Lazy - "Data.Text.Lazy", "Data.Text.Lazy.Encoding", "Data.Text.Lazy.IO"- * Builder - "Data.Text.Lazy.Builder", "Data.Text.Lazy.Builder.Int"- .- __time__ - "Data.Time" + Please read the "SocketsAndPipes.Syllabus".++ This release is for the sixth draft of the book, released September 2022.+ source-repository head type: git location: git://github.com/joyofhaskell/sockets-and-pipes.git library default-language: Haskell2010- default-extensions: NamedFieldPuns- ghc-options: -Wall+ default-extensions: NoImplicitPrelude+ ghc-options: -Wall -fno-warn-unused-imports hs-source-dirs: src-- exposed-modules: SocketsAndPipes.Serve- other-modules:- SocketsAndPipes.Serve.Setup- SocketsAndPipes.Serve.Loop- SocketsAndPipes.Serve.Sockets- SocketsAndPipes.Serve.Exceptions- SocketsAndPipes.Serve.Log- SocketsAndPipes.Serve.OnError- SocketsAndPipes.Serve.Finally- SocketsAndPipes.Serve.Shutdown+ exposed-modules: SocketsAndPipes.Syllabus - build-depends: ascii ^>= 1.0- reexported-modules: ASCII, ASCII.Char+ build-depends: ascii ^>= 1.2.3.0+ reexported-modules: ASCII, ASCII.Char, ASCII.Decimal - build-depends: aeson ^>= 1.3 || ^>= 1.4 || ^>= 1.5- reexported-modules: Data.Aeson+ build-depends: aeson ^>= 2.0+ reexported-modules: Data.Aeson, Data.Aeson.Key, Data.Aeson.KeyMap - build-depends: async ^>= 2.2+ build-depends: async ^>= 2.2.2 reexported-modules: Control.Concurrent.Async - build-depends: base ^>= 4.12 || ^>= 4.13 || ^>= 4.14 || ^>= 4.15- reexported-modules:- Control.Concurrent,- Control.Monad,- Data.Bits,- Data.Char,- Data.Foldable,- Data.Int,- Data.List,- Data.Word,- System.IO,- System.Timeout+ build-depends: attoparsec ^>= 0.13 || ^>= 0.14+ reexported-modules: Data.Attoparsec.ByteString + build-depends: base ^>= 4.14 || ^>= 4.15 || ^>= 4.16+ reexported-modules: Control.Concurrent, Control.Monad, Data.Char, Prelude, System.IO+ build-depends: blaze-html ^>= 0.9- reexported-modules:- Text.Blaze.Html,- Text.Blaze.Html5,- Text.Blaze.Html5.Attributes,- Text.Blaze.Html.Renderer.Utf8+ reexported-modules: Text.Blaze.Html, Text.Blaze.Html5, Text.Blaze.Html5.Attributes, Text.Blaze.Html.Renderer.Utf8 build-depends: bytestring ^>= 0.10 || ^>= 0.11- reexported-modules:- Data.ByteString,- Data.ByteString.Builder,- Data.ByteString.Char8,- Data.ByteString.Lazy+ reexported-modules: Data.ByteString, Data.ByteString.Builder, Data.ByteString.Char8, Data.ByteString.Lazy - build-depends: containers ^>= 0.5.7 || ^>= 0.6+ build-depends: containers ^>= 0.6.2.1+ reexported-modules: Data.Map.Strict + build-depends: directory ^>= 1.3.6+ reexported-modules: System.Directory++ build-depends: filepath ^>= 1.4+ reexported-modules: System.FilePath++ build-depends: list-transformer ^>= 1.0.7+ reexported-modules: List.Transformer+ build-depends: network ^>= 3.1.2- --- -- Reasons for lower bounds:- --- -- * 3.1.1 introduced the 'gracefulClose' function.- -- * 3.1.1 series is deprecated due to flaw in 'gracefulClose'.- -- * 3.1.2 introduced the 'openSocket' function.- --- reexported-modules:- Network.Socket,- Network.Socket.ByteString,- Network.Socket.ByteString.Lazy+ reexported-modules: Network.Socket, Network.Socket.ByteString, - build-depends: pipes ^>= 4.3.9- --- -- Reasons for lower bounds:- -- * Among pipes releases that have a tight upper bound on the- -- base library, 4.3.9 is the earliest that supports base-4.12.- --- reexported-modules:- Pipes+ build-depends: network-simple ^>= 0.4.2+ reexported-modules: Network.Simple.TCP + build-depends: relude ^>= 1.0 || ^>= 1.1+ reexported-modules: Relude++ build-depends: resourcet ^>= 1.2.4+ reexported-modules: Control.Monad.Trans.Resource+ build-depends: safe-exceptions ^>= 0.1.7.0- --- -- Reasons for lower bounds:- --- -- * 0.1.7.0 is the first version that works with base-4.12.- -- reexported-modules: Control.Exception.Safe build-depends: stm ^>= 2.5- reexported-modules:- Control.Concurrent.STM,- Control.Concurrent.STM.TVar,- Control.Monad.STM+ reexported-modules: Control.Concurrent.STM, Control.Concurrent.STM.TVar, Control.Monad.STM - build-depends: text ^>= 1.2.3- --- -- Reasons for lower bounds:- --- -- * 1.2.3 is the first version that works with base-4.12.- --- reexported-modules:- Data.Text,- Data.Text.Encoding,- Data.Text.Lazy,- Data.Text.Lazy.Builder,- Data.Text.Lazy.Builder.Int,- Data.Text.Lazy.Encoding,- Data.Text.Lazy.IO,- Data.Text.IO+ build-depends: text ^>= 1.2.4.1+ reexported-modules: Data.Text, Data.Text.Encoding, Data.Text.IO+ reexported-modules: Data.Text.Lazy, Data.Text.Lazy.Encoding, Data.Text.Lazy.IO+ reexported-modules: Data.Text.Lazy.Builder, Data.Text.Lazy.Builder.Int - build-depends: time ^>= 1.9 || ^>= 1.10 || ^>= 1.11+ build-depends: time ^>= 1.10 || ^>= 1.11 || ^>= 1.12 reexported-modules: Data.Time++ build-depends: unfork ^>= 1.0+ reexported-modules: Unfork
− src/SocketsAndPipes/Serve.hs
@@ -1,121 +0,0 @@-module SocketsAndPipes.Serve- ( {- * Serve -} serve,- {- * Example -} {- $example -}- {- * Options -} ServeOptions, port- {- * Particulars -} {- $particulars -}- {- * Alternatives -} {- $alternatives -}- ) where--import SocketsAndPipes.Serve.Exceptions ( displayBindFailed )-import SocketsAndPipes.Serve.Sockets ( Socket, PortNumber, PassiveSocket,- passiveSocketAddress, peerSocket )-import SocketsAndPipes.Serve.Setup ( withSocketOnPort )-import SocketsAndPipes.Serve.Loop ( run )-import SocketsAndPipes.Serve.Log ( Write, withLogging )--import Control.Exception.Safe ( catch )-import Data.Functor ( void, (<&>) )--import qualified Data.Text.Lazy as LT-import qualified Data.Text.Lazy.Builder as TB-import qualified System.IO as IO---- | The first argument to 'serve'.-data ServeOptions =- ServeOnPort PortNumber-{- This type is abstract so that we might add more options in- the future without disturbing the users of this library. -}--port :: PortNumber -- ^ The port number that your server will listen on- -> ServeOptions-port = ServeOnPort--serve ::- ServeOptions- -> (Socket -> IO ())- {- ^ What to do each time a new client connects to your server.- These actions run concurrently in separate threads. -}- -> IO ()- {- ^ Perpetually listens for incoming connections and runs- the @(Socket -> IO ())@ function each time a new client- opens a connection. -}-serve (ServeOnPort p) f =- withLogging IO.stderr $ \w -> (go w `catch` ifBindFailed w)-- where- go w =- withSocketOnPort p $ \s ->- do- logBindSuccess w s- run w (f . peerSocket) s-- ifBindFailed w =- void . w . LT.unpack . TB.toLazyText . displayBindFailed--logBindSuccess :: Write -> PassiveSocket -> IO ()-logBindSuccess w s =- void . w . LT.unpack . TB.toLazyText =<< displayBindSuccess s--displayBindSuccess :: PassiveSocket -> IO TB.Builder-displayBindSuccess s =- passiveSocketAddress s <&> \a ->- TB.fromString "The server is listening on address "- <> TB.fromString (show a)--{- $particulars--This library ought to be mostly suitable for real applications, but keep in mind-that some of the details were chosen primarily with /Sockets and Pipes/-exercises in mind.--The server prints some messages to the standard error stream. It gives an-initial success/failure message when setting up the listening socket, and it-displays any exceptions thrown from your connection handler. We provide no means-of customizing or redirecting this output.--When the server is brought to a stop by an asynchronous exception, all of the-threads it has spawned to handle connections are immediately stopped as well.-This avoids any potentially confusing behavior that might arise if old threads-could continue running after you stop and restart a server in GHCi.--We set the `SO_REUSEADDR` flag on on the listening socket. This has some-security-related ramifications, but it lets you restart a server quickly. By-default, the OS would require some amount of time to elapse before a-previously-used port is allowed to be bound again.--When possible, the listening socket is bound to an IPv6 address with IPv4 also-enabled. This allows us to run an HTTP server that can be reached at both the-IPv4 address @http:/\/127.0.0.1:8000@ and the IPv6 adddress @http:/\/[::1]:8000@.---}--{- $example--Suppose you have a function that reads an HTTP request from a-socket and then writes an HTTP response back to the socket.--@handleHttpRequest :: 'Socket' -> IO ()@--Then you might start a server by running the following in GHCi:--@-λ> import "SocketsAndPipes.Serve"-λ> 'serve' ('port' 8000) handleHttpRequest-@--And while the server is still running, test it on the command line-like so:--> $ curl http://localhost:8000---}--{- $alternatives--Some other packages offer different choices and configuration options:-- * <https://hackage.haskell.org/package/network-simple/docs/Network-Simple-TCP.html network-simple>- * <https://hackage.haskell.org/package/network-run/docs/Network-Run-TCP.html network-run>- * <https://hackage.haskell.org/package/streaming-commons/docs/Data-Streaming-Network.html streaming-commons>---}
− src/SocketsAndPipes/Serve/Exceptions.hs
@@ -1,103 +0,0 @@-module SocketsAndPipes.Serve.Exceptions- (- -- * Types- BindFailed (..), AddrTried (..),-- -- * Functions related to the types- displayBindFailed, displayAddrTried,-- -- * General functions for working with exceptions- overException, firstSuccessOrAllExceptions-- ) where--import Control.Exception.Safe- ( Exception (displayException), SomeException, catch, throw )--import Data.Foldable ( fold )--import qualified Data.Sequence as Seq-import qualified Data.Foldable as Seq ( toList )-import qualified Data.List as List-import qualified Data.Text.Lazy as LT-import qualified Data.Text.Lazy.Builder as TB-import qualified Network.Socket as Socket--data BindFailed =- BindFailed- { bindAddrsTried :: [AddrTried]- }- deriving Show--instance Exception BindFailed- where- displayException = LT.unpack . TB.toLazyText . displayBindFailed--data AddrTried =- AddrTried- { addrTried :: Socket.AddrInfo- , addrException :: SomeException- }- deriving Show--instance Exception AddrTried- where- displayException = LT.unpack . TB.toLazyText . displayAddrTried--displayBindFailed :: BindFailed -> TB.Builder-displayBindFailed BindFailed{ bindAddrsTried }- | null bindAddrsTried = displayBindFailedNoAddresses- | otherwise = displayBindFailedWithAddrs bindAddrsTried--displayBindFailedNoAddresses :: TB.Builder-displayBindFailedNoAddresses =- TB.fromString- "Failed to set up a passive socket for the server \- \because no candidate addresses were found."--displayBindFailedWithAddrs :: [AddrTried] -> TB.Builder-displayBindFailedWithAddrs bindAddrsTried =- TB.fromString "Failed to set up a passive socket for the server. \- \The following addresses were tried:\n" <>- fold- (- List.intersperse- (TB.fromString "\n")- (- List.map- ( \AddrTried{ addrTried, addrException } ->- TB.fromString " ❌ " <>- TB.fromString (show (Socket.addrAddress addrTried)) <>- TB.fromString " — " <>- TB.fromString (displayException addrException)- )- bindAddrsTried- )- )--displayAddrTried :: AddrTried -> TB.Builder-displayAddrTried AddrTried{ addrTried, addrException } =- TB.fromString (show addrTried) <> TB.fromString ": "- <> TB.fromString (displayException addrException)--overException :: (Exception e1, Exception e2) =>- (e1 -> e2) -- ^ How to turn the exception- -- into a different exception- -> IO a -- ^ Action that might throw the first exception- -> IO a -- ^ Action that might throw the second exception-overException f a = catch a (throw . f)-{- ^- If the action throws an exception, turn it into a different- exception. This is useful to add information that explains- the context in which the original exception occurred.--}--firstSuccessOrAllExceptions :: (Exception e1, Exception e2) =>- ([e1] -> e2) -- ^ How to collect the many exceptions into one- -> [IO a] -- ^ Many actions that may fail- -> IO a -- ^ The result from the first action that succeeds,- -- or else throws a collection of all the exceptions.-firstSuccessOrAllExceptions f = go Seq.empty- where- go exs [] = throw (f (Seq.toList exs))- go exs (a : as) = catch a (\ex -> go (exs Seq.|> ex) as)
− src/SocketsAndPipes/Serve/Finally.hs
@@ -1,21 +0,0 @@-module SocketsAndPipes.Serve.Finally ( finallyInterruptible ) where--import Control.Exception.Safe ( tryAny, throw )--{- |--The second action runs even if the first action throws a synchronous exception.-But the entire sequence ends promptly when an async exception arrives.-If an async exception interrupts the first action, the second action will not run.-Both actions run in an unmasked (interruptible) context.---}-finallyInterruptible ::- IO a -- ^ First action- -> IO b -- ^ Second action- -> IO a-finallyInterruptible a b =- do- result <- tryAny a- _ <- b- either throw return result
− src/SocketsAndPipes/Serve/Log.hs
@@ -1,101 +0,0 @@-{- |--If multiple threads are printing to the same handle at once, the messages can-interleave and become nonsensical. So instead of printing directly, we write-messages to a queue, and a single thread is responsible for reading from the-queue and writing to a handle.---}-module SocketsAndPipes.Serve.Log ( withLogging, Write, writeException ) where--import Data.Functor ( ($>), (<&>), void )-import Control.Applicative ( (<|>) )-import Control.Concurrent.Async ( withAsync, wait )-import Control.Concurrent.STM.TQueue ( TQueue, newTQueue, writeTQueue, readTQueue, isEmptyTQueue )-import Control.Concurrent.STM.TVar ( TVar, newTVar, writeTVar, readTVar )-import Control.Monad ( join, guard )-import Control.Monad.STM ( STM, atomically )-import Control.Exception.Safe ( SomeException, finally, displayException )-import System.IO ( Handle, hPutStrLn )---- | The internal state of the logging system.-data Log =- Log- { messageQueue :: TQueue Message- , runStateVar :: TVar RunState- }--data RunState =- Run {- ^ Log state is initially 'Run'. -}- | Shutdown {- ^ The state changes to 'Shutdown' when the rest of the program- has ended. In the 'Shutdown' state, the log-printing thread- continues printing until the queue is empty, then stops. -}- deriving Eq---- | A message that can be written to a log.-type Message = String---- | Value returned after a message is written to the log.-data MessageWritten = MessageWritten---- | Function that writes a message to the log.-type Write = Message -> IO MessageWritten---- | Value returned at the very end when logging is shut down and the queue is empty.-data LoggingFinished = LoggingFinished---- | A log is initially created with an empty queue, in the 'Run' state.-newLog :: STM Log-newLog = Log <$> newTQueue <*> newTVar Run---- | This function typically encloses an entire `main` action.-withLogging ::- Handle -- ^ What handle the log output shall be written to- -> (Write -> IO ()) -- ^ Continuation provided with a thread-safe print function- -> IO ()-withLogging h go =- do- l <- atomically newLog- withAsync (go (writeToLog l)) $ \a1 ->- withAsync (printFromLog h l) $ \a2 ->- do- wait a1 `finally` requestLogStop l- LoggingFinished <- wait a2- return ()--requestLogStop :: Log -> IO ()-requestLogStop l = atomically (requestLogStopSTM l)--requestLogStopSTM :: Log -> STM ()-requestLogStopSTM Log{ runStateVar } = writeTVar runStateVar Shutdown--writeToLog :: Log -> Write-writeToLog l x = atomically (writeToLogSTM l x)--writeToLogSTM :: Log -> Message -> STM MessageWritten-writeToLogSTM Log{ messageQueue } message =- writeTQueue messageQueue message $> MessageWritten--printFromLog :: Handle -> Log -> IO LoggingFinished-printFromLog h l@Log{ messageQueue } = continue- where- continue :: IO LoggingFinished- continue = join $ atomically (a <|> b)-- a = readTQueue messageQueue <&> \x ->- hPutStrLn h x *> continue- b = (guard =<< isReadyToStop l) $>- return LoggingFinished--shutdownRequested :: Log -> STM Bool-shutdownRequested Log{ runStateVar } =- readTVar runStateVar <&> \s ->- s == Shutdown--isReadyToStop :: Log -> STM Bool-isReadyToStop l@Log{ messageQueue } =- (&&) <$> shutdownRequested l- <*> isEmptyTQueue messageQueue--writeException :: Write -> SomeException -> IO ()-writeException w e = void (w (displayException e))
− src/SocketsAndPipes/Serve/Loop.hs
@@ -1,51 +0,0 @@-module SocketsAndPipes.Serve.Loop ( run ) where--import Control.Concurrent.Async ( race_ )-import Control.Monad ( forever )--import SocketsAndPipes.Serve.OnError ( OnError, bracketOnError, forkOnError )-import SocketsAndPipes.Serve.Finally ( finallyInterruptible )-import SocketsAndPipes.Serve.Log ( Write, writeException )-import SocketsAndPipes.Serve.Shutdown ( withRunStateVar, waitForShutdown )-import SocketsAndPipes.Serve.Sockets ( PeerSocket, PassiveSocket, accept,- closePeerSocketPolitely,- closePeerSocketAbruptly )--run ::- Write -- ^ How to write log messages- -> (PeerSocket -> IO a) -- ^ What to do when a new client connects.- -> PassiveSocket -- ^ A socket that is listening for connections.- -> IO b -- ^ Perpetually awaits new connections, forking a new thread to handle each one.-run write go s =- withRunStateVar $ \runStateVar ->- forever $- bracketOnError (accept s) ({-2-} logAndCloseAbruptly write) $ \peer ->- forkOnError ({-3-} logAndCloseAbruptly write peer) $- race_ (waitForShutdown runStateVar *> {-4-} closePeerSocketAbruptly peer) $- go peer `finallyInterruptible` {-1-} closePeerSocketPolitely peer--{---Threads normally conclude with a graceful close of the peer socket. (1)--Since the graceful close procedure is a network operation that potentially-blocks for several seconds, exceptions are made in the following circumstances-where the delay would be unacceptable:-- * When a fork fails, thereby forcing the close to take place on the main thread,- which needs to stay free to accept connections responsively. (2)-- * When the goal is to stop the forked thread as quickly as possible:-- * If an asynchronous exception has been thrown to the forked thread. (3)-- * If we're shutting down because an async exception has been thrown- to the main thread. (4)---}--logAndCloseAbruptly :: Write -> PeerSocket -> OnError-logAndCloseAbruptly write peer e =- do- closePeerSocketAbruptly peer- writeException write e
− src/SocketsAndPipes/Serve/OnError.hs
@@ -1,29 +0,0 @@-module SocketsAndPipes.Serve.OnError ( OnError, bracketOnError, forkOnError ) where--import Control.Exception.Safe ( SomeException )--import Data.Foldable ( for_ )-import Data.Functor ( void )--import qualified Control.Concurrent as Concurrent-import qualified Control.Exception.Safe as Exception---- | Some effect to perform only if an exception is thrown.-type OnError = SomeException -> IO ()--bracketOnError ::- IO resource -- ^ Create some resource- -> (resource -> OnError) -- ^ Effect to run if the action fails- -> (resource -> IO c) -- ^ The action- -> IO c-bracketOnError setup onError =- Exception.bracketWithError setup $ \exceptionMaybe resource ->- for_ exceptionMaybe $ onError resource--forkOnError ::- OnError -- ^ Effect to run (in the forked thread) if the action fails- -> IO a -- ^ The action (to run in a forked thread)- -> IO ()-forkOnError onError action = void $- Concurrent.forkFinally action $ \exceptionEither ->- for_ (either Just (\_ -> Nothing) exceptionEither) onError
− src/SocketsAndPipes/Serve/Setup.hs
@@ -1,149 +0,0 @@-module SocketsAndPipes.Serve.Setup ( withSocketOnPort ) where--import SocketsAndPipes.Serve.Sockets- ( PortNumber, Socket, PassiveSocket (..), closePassiveSocket )--import SocketsAndPipes.Serve.Exceptions- ( BindFailed (..), AddrTried (..),- overException, firstSuccessOrAllExceptions )--import Control.Monad ( (>=>), when )-import Data.Function ( on )--import qualified Control.Exception.Safe as Exception-import qualified Data.List as List-import qualified Network.Socket as Socket--withSocketOnPort :: PortNumber -> (PassiveSocket -> IO a) -> IO a-withSocketOnPort port = Exception.bracket (bindToPort port) closePassiveSocket--bindToPort :: PortNumber -> IO PassiveSocket-bindToPort = addrsForPort >=> chooseAddrAndBind--addrsForPort :: PortNumber -> IO [Socket.AddrInfo]-addrsForPort port = Socket.getAddrInfo hints hostName serviceName- where- hints = Just serverAddrHints :: Maybe Socket.AddrInfo- hostName = Nothing :: Maybe Socket.HostName- serviceName = Just (show port) :: Maybe Socket.ServiceName-{- ^- The first thing we have to do when starting a server is figure- out exactly what network address to listen on.-- We've been given a port number, but that's only half the story;- a network address actually include a lot more obnoxious details- in addition to the port number.-- 'addrsForPort' uses the 'S.getAddrInfo' function from the network- library to find a list of possible addresses for us to choose from.--}--serverAddrHints :: Socket.AddrInfo-serverAddrHints =- Socket.defaultHints{ Socket.addrSocketType, Socket.addrFlags }- where- addrSocketType = Socket.Stream :: Socket.SocketType- {- A "stream" socket uses TCP to make sure all the- packets arrive in the right order. -}- addrFlags = [Socket.AI_PASSIVE] :: [Socket.AddrInfoFlag]- {- A "passive" socket is a socket that will be- used to listen for incoming connections. -}--chooseAddrAndBind :: [Socket.AddrInfo] -> IO PassiveSocket-chooseAddrAndBind =- firstSuccessOrAllExceptions BindFailed . map bindToAddr- . List.sortBy (compare `on` addrPreference)--addrPreference :: Socket.AddrInfo -> Int-addrPreference addr =- case Socket.addrFamily addr of- Socket.AF_INET6 -> 1 {- IPv6 is best, because these addresses can- accept both IPv4 and IPv6 connections. -}- Socket.AF_INET -> 2 {- IPv4 is next best, if IPv6 is not supported. -}- _ -> 3 {- Other addressing schemes are unfamiliar. -}-{- ^- Assigns a ranking to each address, indicating our relative preference.- A lesser number indicates a more preferable address.--}--bindToAddr :: Socket.AddrInfo -> IO PassiveSocket-bindToAddr addr =- overException (AddrTried addr) $- Exception.bracketOnError (Socket.openSocket addr) Socket.close $ \s ->- initServerSocket addr s *> return (PassiveSocket s)--initServerSocket :: Socket.AddrInfo -> Socket -> IO ()-initServerSocket addr s =- do- setReuseAddr s -- Disable some safety to permit fast restarts.- setKeepAlive s -- Send empty packets to keep connections alive.- setNoDelay s -- Send bytes immediately without buffering.- allowIPv4and6 addr s -- If it's an IPv6 address, enable IPv4 also.- bind addr s -- Assign the address to the socket.- listen s -- Announce willingness to receive connections.--bind :: Socket.AddrInfo -> Socket -> IO ()-bind addr s = Socket.bind s (Socket.addrAddress addr)--allowIPv4and6 :: Socket.AddrInfo -> Socket -> IO ()-allowIPv4and6 addr s =- when (Socket.addrFamily addr == Socket.AF_INET6) $- Socket.setSocketOption s Socket.IPv6Only 0--setReuseAddr :: Socket -> IO ()-setReuseAddr s = Socket.setSocketOption s Socket.ReuseAddr 1-{- ^- By default, the operating system will not let us restart our server and- bind to the same address immediately, because the new process will- receive any TCP packets that were in flight during the restart, which- is typically undesirable.-- Overriding the default behavior like this is not really safe!- But it lets us restart our server quickly :)--}--setKeepAlive :: Socket -> IO ()-setKeepAlive s = Socket.setSocketOption s Socket.KeepAlive 1-{- ^- This enables a nice TCP feature: if there is a long period of time- with no activity on the socket, the OS will occasionally send an- empty packet. This has two benefits:-- 1. It lets the peer know that we're still here; otherwise the peer will- close the connection, assuming that we've abandoned the conversation.-- 2. If lets us know whether the peer is still there. If we don't receive- an acknowledgement of the empty packet, we can close the connection.--}--setNoDelay :: Socket -> IO ()-setNoDelay s = Socket.setSocketOption s Socket.NoDelay 1-{- ^-- Since it's more efficient to transmit a few large packets than many- small packets, the OS doesn't always send your bytes right away when- you write to a socket; By default, it make some effort to group- together small writes into larger packets.-- The downside of this optimization is that it means sometimes we don't- immediately see the effect of writing to a socket. For experimental- and demonstration purposes, this can be quite undesirable, so we use- this setting to disable the feature.--}--listen :: Socket -> IO ()-listen s = Socket.listen s listenBacklog-{- ^- Informs the operating system that this socket will be used to- accept incoming connection requests.-- Such as socket is called a "passive socket".--}--listenBacklog :: Int-listenBacklog = 1024-{- ^- The 'S.accept' function pulls sockets from a queue maintained by- the operating system. This is the size we are requesting for that queue.- (The OS might not actually give us a queue as big as we ask for.)--}
− src/SocketsAndPipes/Serve/Shutdown.hs
@@ -1,29 +0,0 @@-module SocketsAndPipes.Serve.Shutdown ( RunStateVar, withRunStateVar, waitForShutdown ) where--import Control.Monad ( guard )-import Control.Monad.STM ( atomically )-import Control.Concurrent.STM.TVar ( TVar, newTVar, writeTVar, readTVar )--import qualified Control.Exception.Safe as Exception--data RunState =- Run {- ^ The state is initially 'Run'. -}- | Shutdown {- ^ The state changes to 'Shutdown' when the main event loop- is killed by an async exception. Entering the 'Shutdown'- state causes all of the child threads to stop. -}- deriving Eq--type RunStateVar = TVar RunState--withRunStateVar :: (RunStateVar -> IO a) -> IO a-withRunStateVar f =- do- runStateVar <- atomically (newTVar Run)- f runStateVar `Exception.finally` atomically (writeTVar runStateVar Shutdown)--waitForShutdown :: RunStateVar -> IO ()-waitForShutdown runStateVar =- atomically $- do- x <- readTVar runStateVar- guard (x == Shutdown)
− src/SocketsAndPipes/Serve/Sockets.hs
@@ -1,67 +0,0 @@-{- |-- The 'PassiveSocket' and 'PeerSocket' newtypes- distinguish passive sockets from peer sockets.-- This module also includes a few basic operations- involving these types.---}-module SocketsAndPipes.Serve.Sockets- (-- Socket,- PortNumber,-- PassiveSocket (..), closePassiveSocket,- passiveSocketAddress,-- PeerSocket (..), closePeerSocketAbruptly,- closePeerSocketPolitely,-- accept-- ) where--import Network.Socket ( Socket, PortNumber )-import qualified Network.Socket as Socket--newtype PassiveSocket = PassiveSocket { passiveSocket :: Socket }- -- ^ A passive socket that is listening for connections.--newtype PeerSocket = PeerSocket { peerSocket :: Socket }- -- ^ A socket that we're using to talk to a client- -- that has connected to our server.--closePassiveSocket :: PassiveSocket -> IO ()-closePassiveSocket = Socket.close . passiveSocket--closePeerSocketAbruptly :: PeerSocket -> IO ()-closePeerSocketAbruptly = Socket.close . peerSocket--closePeerSocketPolitely :: PeerSocket -> IO ()-closePeerSocketPolitely s =- Socket.gracefulClose (peerSocket s) finMilliseconds-{- ^- Closes a TCP connection by sending a FIN packet, which is more- respectful to the peer than if we were to simply ghost them.--}--finMilliseconds :: Int-finMilliseconds = 5000-{- ^- Timeout for the 'fin' action.- 5 seconds = 5000 milliseconds--}--accept :: PassiveSocket -> IO PeerSocket-accept s =- Socket.accept (passiveSocket s) >>=- \(s', _) -> return (PeerSocket s')-{- ^- Waits until a new client shows up to connect to our server.- Returns the socket that we use to talk to this particular peer.--}--passiveSocketAddress :: PassiveSocket -> IO Socket.SockAddr-passiveSocketAddress = Socket.getSocketName . passiveSocket
+ src/SocketsAndPipes/Syllabus.hs view
@@ -0,0 +1,172 @@+module SocketsAndPipes.Syllabus+ (+ -- * Chapters+ -- $chapters++ -- * Libraries+ -- $libraries+ )+ where++import Prelude ()++import qualified ASCII as A+import qualified Control.Concurrent as Concurrent+import qualified Control.Concurrent.Async as Async+import qualified Control.Concurrent.STM as STM+import qualified Control.Monad.Trans.Resource as Resource+import qualified Data.ByteString as BS+import qualified Data.ByteString.Builder as BSB+import qualified Data.Text as T+import qualified Data.Text.Lazy.Builder as TB+import qualified Data.Time as Time+import qualified Network.Simple.TCP as Net+import qualified Prelude++{- $chapters++List of modules that make a significant appearance in each chapter:++__Setup__++ * "Relude" - Alternate prelude that includes a lot of standard utilities+ * "System.Directory", "System.FilePath" - Determining where our data files should go++__1 - Handles__++ * "System.IO" - Writing to a file+ * "Control.Monad.Trans.Resource" - Using 'Resource.allocate' to ensure that file handles are closed++__2 - Chunks__++ * "Data.Text" - 'T.Text' is a chunk of characters+ * "Data.Text.IO" - Reading and writing files using 'T.Text' instead of 'Prelude.String'++__3 - Bytes__++ * "Data.ByteString" - 'BS.ByteString' is a chunk of bytes+ * "Data.Text.Encoding" - Conversions between 'BS.ByteString' and 'T.Text'++__4 - Sockets__++ * "Network.Socket" - Opening and closing sockets, resolving network addresses+ * "Network.Socket.ByteString" - Writing to and reading from sockets++__5 - HTTP__++ * "ASCII", "ASCII.Char" - Expressing HTTP messages as strings using the 'A.string' quasi-quoter+ * "Network.Simple.TCP" - Listening for client connections using 'Net.serve'++__6 - HTTP types__++ * "ASCII.Decimal", "Data.ByteString.Lazy" - Defining datatypes for the parts of an HTTP message++__7 - Encoding__++ * "Data.Text.Lazy", "Data.Text.Lazy.Builder" - Efficient text concatenations with 'TB.Builder'+ * "Data.ByteString.Lazy", "Data.ByteString.Builder" - Efficient byte string concatenations with 'BSB.Builder'+ * "Data.Time" - Simple performance testing with 'Time.getCurrentTime' and 'Time.diffUTCTime'++__8 - Responding__++ * No additional imports in this chapter++__9 - Content types__++ * "Data.Text.Lazy.Builder.Int", "Data.Text.Lazy.IO", "Data.Text.Lazy.Encoding" - Building a text response body+ * "Text.Blaze.Html", "Text.Blaze.Html5", "Text.Blaze.Html.Renderer.Utf8" - Building an HTML response body+ * "Data.Aeson", "Data.Aeson.Key", "Data.Aeson.KeyMap" - Building a JSON response body++__10 - Change__++ * "Control.Concurrent.STM" - Shared 'STM.TVar' state for request-handling threads+ * "Control.Concurrent.Async" - Demonstrating thread safety with 'Async.replicateConcurrently_'++__11 - Streaming__++ * "Control.Concurrent" - Slowing things down with 'Concurrent.threadDelay'++__12 - ListT IO__++ * "List.Transformer" - Representing files and chunked HTTP message bodies as I/O streams++__13 - Parsing__++ * "Data.Map.Strict" - Mapping resource names to file paths+ * "Data.Attoparsec.ByteString" - Parsing HTTP requests++__14 - Errors__++ * "Unfork" - Thread-safe logging++The remaining chapters are in progress:++__15 - Reading the head__++__16 - Reading the body__++__17 - Connection reuse__++-}++{- $libraries++Re-exported modules, grouped by the package that each module originally comes from:++__ascii__ - "ASCII", "ASCII.Char", "ASCII.Decimal"++__aeson__ - "Data.Aeson", "Data.Aeson.Key", "Data.Aeson.KeyMap"++__async__ - "Control.Concurrent.Async"++__base__++ * File handles - "System.IO"+ * Fundamental data types - "Data.Char"+ * Miscellanea - "Control.Concurrent", "Control.Monad"++__blaze-html__ - "Text.Blaze.Html", "Text.Blaze.Html5", "Text.Blaze.Html5.Attributes", "Text.Blaze.Html.Renderer.Utf8"++__bytestring__++ * Strict - "Data.ByteString"+ * Lazy - "Data.ByteString.Lazy"+ * Builder - "Data.ByteString.Builder"+ * "Data.ByteString.Char8" - To discuss why we don't use it++__containers__ - "Data.Map.Strict"++__directory__ - "System.Directory"++__filepath__ - "System.FilePath"++__list-transformer__ - "List.Transformer"++__network__++ * "Network.Socket" - The Socket type, operations for opening and closing sockets+ * "Network.Socket.ByteString" - Socket read/write operations with strict byte strings++__network-simple__++ * "Network.Simple.TCP" - Sockets that listen for incoming client connections++__relude__ - "Relude"++__resourcet__ - "Control.Monad.Trans.Resource"++__safe-exceptions__ - "Control.Exception.Safe"++__stm__ - "Control.Monad.STM", "Control.Concurrent.STM", "Control.Concurrent.STM.TVar"++__text__++ * Strict - "Data.Text", "Data.Text.Encoding", "Data.Text.IO"+ * Lazy - "Data.Text.Lazy", "Data.Text.Lazy.Encoding", "Data.Text.Lazy.IO"+ * Builder - "Data.Text.Lazy.Builder", "Data.Text.Lazy.Builder.Int"++__time__ - "Data.Time"++__unfork__ - "Unfork"++-}