{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE CPP #-} -- | -- -- A socket could be used indirectly via a 'System.IO.Handle' or a conduit from -- Michael Snoyman's conduit package. But doing so presents an encapsulation -- problem. Do we allow access to the underlying socket and trust that it wont -- be used in an unsafe way? Or do we protect it at the higher level and deny -- access to various state information? -- -- The 'SocketLike' class enables the approach that provides a safe wrapper to -- the underlying socket and gives access to various state information without -- enabling direct reads or writes. module Network.SocketLike ( SocketLike(..) , RestrictedSocket , restrictSocket , restrictHandleSocket -- * Re-exports -- -- | To make the 'SocketLike' methods less awkward to use, the types -- 'CUInt', 'SockAddr', and 'PortNumber' are re-exported. , CUInt , PortNumber , SockAddr(..) ) where import Network.Socket ( PortNumber , SockAddr ) import Foreign.C.Types ( CUInt ) import qualified Network.Socket as NS import System.IO (Handle,hClose,hIsOpen) import Control.Arrow -- | A safe (mostly read-only) interface to a 'NS.Socket'. Note that despite -- how this class is named, it provides no access to typical 'NS.Socket' uses -- like sending or receiving network packets. class SocketLike sock where -- | See 'NS.getSocketName' getSocketName :: sock -> IO SockAddr -- | See 'NS.getPeerName' getPeerName :: sock -> IO SockAddr -- | See 'NS.getPeerCred' -- getPeerCred :: sock -> IO (CUInt, CUInt, CUInt) -- | Is the socket still valid? Connected -- -- In order to give the instance writer -- the option to do book-keeping in a pure -- type, a conceptually modified version of -- the 'SocketLike' is returned. -- isValidSocket :: sock -> IO (sock,Bool) instance SocketLike NS.Socket where getSocketName = NS.getSocketName getPeerName = NS.getPeerName -- getPeerCred = NS.getPeerCred #if MIN_VERSION_network(3,1,0) isValidSocket s = (s,) <$> NS.withFdSocket s (return . (/= (-1))) #else #if MIN_VERSION_network(3,0,0) isValidSocket s = (s,) . (/= (-1)) <$> NS.fdSocket s #else #if MIN_VERSION_network(2,4,0) isValidSocket s = (s,) <$> NS.isConnected s -- warning: this is always False if the socket -- was converted to a Handle #else isValidSocket s = (s,) <$> NS.sIsConnected s -- warning: this is always False if the socket -- was converted to a Handle #endif #endif #endif -- | An encapsulated socket. Data reads and writes are not possible. data RestrictedSocket = Restricted (Maybe Handle) NS.Socket deriving Show instance SocketLike RestrictedSocket where getSocketName (Restricted mb sock) = NS.getSocketName sock getPeerName (Restricted mb sock) = NS.getPeerName sock -- getPeerCred (Restricted mb sock) = NS.getPeerCred sock isValidSocket rs@(Restricted mb sock) = maybe (first (Restricted mb) <$> isValidSocket sock) (((rs,) <$>) . hIsOpen) mb -- | Create a 'RestrictedSocket' that explicitly disallows sending or -- receiving data. restrictSocket :: NS.Socket -> RestrictedSocket restrictSocket socket = Restricted Nothing socket -- | Build a 'RestrictedSocket' for which 'sClose' will close the given -- 'Handle'. It is intended that this 'Handle' was obtained via -- 'NS.socketToHandle'. restrictHandleSocket :: Handle -> NS.Socket -> RestrictedSocket restrictHandleSocket h socket = Restricted (Just h) socket