diff --git a/sockets-and-pipes.cabal b/sockets-and-pipes.cabal --- a/sockets-and-pipes.cabal +++ b/sockets-and-pipes.cabal @@ -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 -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 ), 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 diff --git a/src/SocketsAndPipes/Serve.hs b/src/SocketsAndPipes/Serve.hs deleted file mode 100644 --- a/src/SocketsAndPipes/Serve.hs +++ /dev/null @@ -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: - - * - * - * - --} diff --git a/src/SocketsAndPipes/Serve/Exceptions.hs b/src/SocketsAndPipes/Serve/Exceptions.hs deleted file mode 100644 --- a/src/SocketsAndPipes/Serve/Exceptions.hs +++ /dev/null @@ -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) diff --git a/src/SocketsAndPipes/Serve/Finally.hs b/src/SocketsAndPipes/Serve/Finally.hs deleted file mode 100644 --- a/src/SocketsAndPipes/Serve/Finally.hs +++ /dev/null @@ -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 diff --git a/src/SocketsAndPipes/Serve/Log.hs b/src/SocketsAndPipes/Serve/Log.hs deleted file mode 100644 --- a/src/SocketsAndPipes/Serve/Log.hs +++ /dev/null @@ -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)) diff --git a/src/SocketsAndPipes/Serve/Loop.hs b/src/SocketsAndPipes/Serve/Loop.hs deleted file mode 100644 --- a/src/SocketsAndPipes/Serve/Loop.hs +++ /dev/null @@ -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 diff --git a/src/SocketsAndPipes/Serve/OnError.hs b/src/SocketsAndPipes/Serve/OnError.hs deleted file mode 100644 --- a/src/SocketsAndPipes/Serve/OnError.hs +++ /dev/null @@ -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 diff --git a/src/SocketsAndPipes/Serve/Setup.hs b/src/SocketsAndPipes/Serve/Setup.hs deleted file mode 100644 --- a/src/SocketsAndPipes/Serve/Setup.hs +++ /dev/null @@ -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.) --} diff --git a/src/SocketsAndPipes/Serve/Shutdown.hs b/src/SocketsAndPipes/Serve/Shutdown.hs deleted file mode 100644 --- a/src/SocketsAndPipes/Serve/Shutdown.hs +++ /dev/null @@ -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) diff --git a/src/SocketsAndPipes/Serve/Sockets.hs b/src/SocketsAndPipes/Serve/Sockets.hs deleted file mode 100644 --- a/src/SocketsAndPipes/Serve/Sockets.hs +++ /dev/null @@ -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 diff --git a/src/SocketsAndPipes/Syllabus.hs b/src/SocketsAndPipes/Syllabus.hs new file mode 100644 --- /dev/null +++ b/src/SocketsAndPipes/Syllabus.hs @@ -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" + +-}