sockets-and-pipes (empty) → 0.1
raw patch · 8 files changed
+802/−0 lines, 8 filesdep +aesondep +asciidep +async
Dependencies added: aeson, ascii, async, base, blaze-html, bytestring, containers, network, safe-exceptions, stm, text, time
Files
- license.txt +13/−0
- sockets-and-pipes.cabal +278/−0
- src/SocketsAndPipes/Serve.hs +92/−0
- src/SocketsAndPipes/Serve/Exceptions.hs +103/−0
- src/SocketsAndPipes/Serve/ForkBracket.hs +58/−0
- src/SocketsAndPipes/Serve/Loop.hs +42/−0
- src/SocketsAndPipes/Serve/Setup.hs +149/−0
- src/SocketsAndPipes/Serve/Sockets.hs +67/−0
+ license.txt view
@@ -0,0 +1,13 @@+Copyright 2021 Mission Valley Software LLC++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.
+ sockets-and-pipes.cabal view
@@ -0,0 +1,278 @@+cabal-version: 2.0+build-type: Simple++name: sockets-and-pipes+version: 0.1+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>++-- GHC 9.0 support is held back by the 'base' version; see comments below.+tested-with: GHC == 8.10.3, GHC == 8.8.4, GHC == 8.6.5++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 | __Chunked bodies__ | |+ +----+----------------------+ |+ | 12 | __Request parsing__ | |+ +----+----------------------+ |+ | 13 | __Reading headers__ | |+ +----+----------------------+ The remaining chapters are in progress. |+ | 14 | __Body parsing__ | |+ +----+----------------------+ |+ | 15 | __Connection reuse__ | |+ +----+----------------------+ |+ | 16 | __Pipes__ | |+ +----+----------------------+--------------------------------------------------------------------------++ .+ == 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"+ * 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+ .+ __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"++source-repository head+ type: git+ location: git://github.com/joyofhaskell/sockets-and-pipes.git++library+ default-language: Haskell2010+ default-extensions: GADTs, NamedFieldPuns, NumericUnderscores+ ghc-options: -Wall+ hs-source-dirs: src++ exposed-modules: SocketsAndPipes.Serve+ other-modules:+ SocketsAndPipes.Serve.Setup+ SocketsAndPipes.Serve.Loop+ SocketsAndPipes.Serve.Sockets+ SocketsAndPipes.Serve.ForkBracket+ SocketsAndPipes.Serve.Exceptions++ build-depends: ascii ^>= 1.0+ reexported-modules: ASCII, ASCII.Char++ build-depends: aeson ^>= 1.3 || ^>= 1.4 || ^>= 1.5+ reexported-modules: Data.Aeson++ build-depends: async ^>= 2.2+ reexported-modules: Control.Concurrent.Async++ build-depends: base ^>= 4.12 || ^>= 4.13 || ^>= 4.14+ --+ -- Update to 4.15 is held back by:+ --+ -- * network-3.1.2 introduced a dependency on the 'directory'+ -- package, which does not yet support base-4.15.+ --+ reexported-modules:+ Control.Monad,+ Data.Char,+ Data.Foldable,+ Data.Int,+ Data.List,+ Data.Word,+ System.IO,+ System.Timeout++ build-depends: blaze-html ^>= 0.9+ reexported-modules:+ Text.Blaze.Html,+ Text.Blaze.Html5,+ Text.Blaze.Html5.Attributes,+ Text.Blaze.Html.Renderer.Utf8++ build-depends: bytestring ^>= 0.10+ --+ -- Update to 0.11 is held back by:+ --+ -- * https://github.com/jaspervdj/blaze-html/issues/135+ --+ reexported-modules:+ Data.ByteString,+ Data.ByteString.Builder,+ Data.ByteString.Char8,+ Data.ByteString.Lazy++ build-depends: containers ^>= 0.5.7 || ^>= 0.6++ 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++ build-depends: safe-exceptions ^>= 0.1+ reexported-modules: Control.Exception.Safe++ build-depends: stm ^>= 2.5+ 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: time ^>= 1.9 || ^>= 1.10+ --+ -- Update to 1.11 is held back by:+ --+ -- * https://github.com/haskell/directory/issues/115+ --+ reexported-modules: Data.Time
+ src/SocketsAndPipes/Serve.hs view
@@ -0,0 +1,92 @@+module SocketsAndPipes.Serve+ ( {- * Serve -} serve,+ {- * Example -} {- $example -}+ {- * Options -} ServeOptions, port+ {- * 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 Control.Exception.Safe ( catch )++import qualified Data.Text.Lazy.IO as LT+import qualified Data.Text.Lazy.Builder as TB+import qualified System.IO as IO++import Prelude hiding (print)++-- | 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 =+ go `catch` ifBindFailed++ where+ go = withSocketOnPort p $ \s ->+ do+ print =<< displayBindSuccess s+ run (f . peerSocket) s++ ifBindFailed = print . displayBindFailed++print :: TB.Builder -> IO ()+print = LT.hPutStrLn IO.stderr . TB.toLazyText++displayBindSuccess :: PassiveSocket -> IO TB.Builder+displayBindSuccess s =+ passiveSocketAddress s >>= \a ->+ return $+ TB.fromString "The server is listening on address "+ <> TB.fromString (show a)++{- $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++The 'serve' function here is somewhat narrowly tailored+to fit our purposes in /Sockets and Pipes/.+Some other packages have more expansive offerings:++ * <https://hackage.haskell.org/package/network-simple network-simple>+ * <https://hackage.haskell.org/package/network-run network-run>++-}
+ src/SocketsAndPipes/Serve/Exceptions.hs view
@@ -0,0 +1,103 @@+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/ForkBracket.hs view
@@ -0,0 +1,58 @@+{- |++ The 'forkBracket' function ensures that if the setup+ action completes, then no matter what else happens,+ exactly one of either 'onForkFail' or 'onThreadEnd' will run.++-}+module SocketsAndPipes.Serve.ForkBracket+ ( forkBracket, Cleanup (..), ThreadId ) where++import Control.Concurrent ( forkFinally, ThreadId )+import Control.Exception.Safe ( bracketOnError )++forkBracket ::+ IO resource -- ^ Setup:+ -- How to open some resource.+ -> Cleanup resource -- ^ Cleanup:+ -- How to close the resource.+ -> (resource -> IO x) -- ^ Action that uses the resource.+ -- This will run in a new thread.+ -> IO ThreadId+forkBracket setup Cleanup{onForkFail, onThreadEnd} action =+ bracketOnError setup onForkFail $ \resource ->+ action resource `forkFinally` \_result ->+ onThreadEnd resource >> return ()++{- |+ A strategy for closing a resource that is opened+ by a main event loop and used in a forked thread.++ It consists of handlers for two possibilities:++ * 'onThreadEnd' runs after the thread has completed.+ * 'onForkFail' runs if the thread failed to start.+-}+data Cleanup resource+ where+ Cleanup ::+ { onForkFail :: resource -> IO x+ {- ^ Cleanup if forking fails.++ This action runs in the original thread.++ It only runs if there was an exception that+ prevented a new thread from starting.+ -}++ , onThreadEnd :: resource -> IO y+ {- ^ Cleanup after the thread terminates.++ This action runs in the forked thread.++ If the thread actually started, this cleanup+ action runs regardless of whether the thread+ terminates normally or with an exception.+ -}+ }+ -> Cleanup resource
+ src/SocketsAndPipes/Serve/Loop.hs view
@@ -0,0 +1,42 @@+module SocketsAndPipes.Serve.Loop ( run ) where++import SocketsAndPipes.Serve.ForkBracket+ ( forkBracket, Cleanup (..), ThreadId )++import SocketsAndPipes.Serve.Sockets+ ( PeerSocket, PassiveSocket, accept,+ closePeerSocketPolitely, closePeerSocketAbruptly )++import Control.Monad ( forever )++run ::+ (PeerSocket -> IO a) -- ^ What to do when a new client connects.+ -> PassiveSocket -- ^ A socket that is listening for connections.+ -> IO b+run server s = forever (acceptAndFork s server)+{- ^+ Perpetually awaits new connections,+ forking a new thread to handle each one.+-}++acceptAndFork ::+ PassiveSocket -- ^ A socket that is listening for connections.+ -> (PeerSocket -> IO a) -- ^ What to do when a new client connects.+ -> IO ThreadId+acceptAndFork s = forkBracket (accept s) socketForkBracketCleanup+{- ^+ Waits until a new client shows up to connect to our server.+ When a peer connects, the socket for talking to them will+ be passed to the given function.+-}++socketForkBracketCleanup :: Cleanup PeerSocket+socketForkBracketCleanup = Cleanup{onForkFail, onThreadEnd}+ where+ onThreadEnd = -- At the end of the thread:+ closePeerSocketPolitely -- Politely conclude the connection.++ onForkFail = -- If an exception occurs before the thread even starts:+ closePeerSocketAbruptly -- Just close the socket abruptly.+ -- Since this happens on the main thread, we don't+ -- want to take the time to wait for a graceful close.
+ src/SocketsAndPipes/Serve/Setup.hs view
@@ -0,0 +1,149 @@+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 = 1_024+{- ^+ 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/Sockets.hs view
@@ -0,0 +1,67 @@+{- |++ 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 = 5_000+{- ^+ 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