Skip to content

Commit

Permalink
Allow Unix sockets on Windows
Browse files Browse the repository at this point in the history
  • Loading branch information
thomasjm committed Nov 6, 2024
1 parent 5049e1c commit f438fb6
Show file tree
Hide file tree
Showing 2 changed files with 0 additions and 28 deletions.
24 changes: 0 additions & 24 deletions Data/Streaming/Network.hs
Original file line number Diff line number Diff line change
Expand Up @@ -8,50 +8,40 @@ module Data.Streaming.Network
, HostPreference
, Message (..)
, AppData
#if !WINDOWS
, ServerSettingsUnix
, ClientSettingsUnix
, AppDataUnix
#endif
-- ** Smart constructors
, serverSettingsTCP
, serverSettingsTCPSocket
, clientSettingsTCP
, serverSettingsUDP
, clientSettingsUDP
#if !WINDOWS
, serverSettingsUnix
, clientSettingsUnix
#endif
, message
-- ** Classes
, HasPort (..)
, HasAfterBind (..)
, HasReadWrite (..)
, HasReadBufferSize (..)
#if !WINDOWS
, HasPath (..)
#endif
-- ** Setters
, setPort
, setHost
, setAddrFamily
, setAfterBind
, setNeedLocalAddr
, setReadBufferSize
#if !WINDOWS
, setPath
#endif
-- ** Getters
, getPort
, getHost
, getAddrFamily
, getAfterBind
, getNeedLocalAddr
, getReadBufferSize
#if !WINDOWS
, getPath
#endif
, appRead
, appWrite
, appSockAddr
Expand Down Expand Up @@ -82,13 +72,11 @@ module Data.Streaming.Network
, bindPortUDP
, bindRandomPortUDP
, getSocketUDP
#if !WINDOWS
-- ** Unix
, bindPath
, getSocketUnix
, runUnixServer
, runUnixClient
#endif
) where

import qualified Network.Socket as NS
Expand Down Expand Up @@ -265,7 +253,6 @@ defaultReadBufferSize :: Int
defaultReadBufferSize = unsafeDupablePerformIO $
bracket (NS.socket NS.AF_INET NS.Stream 0) NS.close (\sock -> NS.getSocketOption sock NS.RecvBuffer)

#if !WINDOWS
-- | Attempt to connect to the given Unix domain socket path.
getSocketUnix :: FilePath -> IO Socket
getSocketUnix path = do
Expand Down Expand Up @@ -317,7 +304,6 @@ clientSettingsUnix path = ClientSettingsUnix
{ clientPath = path
, clientReadBufferSizeUnix = defaultReadBufferSize
}
#endif

#if defined(__GLASGOW_HASKELL__) && WINDOWS
-- Socket recv and accept calls on Windows platform cannot be interrupted when compiled with -threaded.
Expand Down Expand Up @@ -495,7 +481,6 @@ setAddrFamily af cs = cs { clientAddrFamily = af }
getAddrFamily :: ClientSettings -> NS.Family
getAddrFamily = clientAddrFamily

#if !WINDOWS
class HasPath a where
pathLens :: Functor f => (FilePath -> f FilePath) -> a -> f a
instance HasPath ServerSettingsUnix where
Expand All @@ -508,7 +493,6 @@ getPath = getConstant . pathLens Constant

setPath :: HasPath a => FilePath -> a -> a
setPath p = runIdentity . pathLens (const (Identity p))
#endif

setNeedLocalAddr :: Bool -> ServerSettings -> ServerSettings
setNeedLocalAddr x y = y { serverNeedLocalAddr = x }
Expand All @@ -520,10 +504,8 @@ class HasAfterBind a where
afterBindLens :: Functor f => ((Socket -> IO ()) -> f (Socket -> IO ())) -> a -> f a
instance HasAfterBind ServerSettings where
afterBindLens f ss = fmap (\p -> ss { serverAfterBind = p }) (f (serverAfterBind ss))
#if !WINDOWS
instance HasAfterBind ServerSettingsUnix where
afterBindLens f ss = fmap (\p -> ss { serverAfterBindUnix = p }) (f (serverAfterBindUnix ss))
#endif

getAfterBind :: HasAfterBind a => a -> (Socket -> IO ())
getAfterBind = getConstant . afterBindLens Constant
Expand All @@ -540,14 +522,12 @@ instance HasReadBufferSize ServerSettings where
-- | Since 0.1.13
instance HasReadBufferSize ClientSettings where
readBufferSizeLens f cs = fmap (\p -> cs { clientReadBufferSize = p }) (f (clientReadBufferSize cs))
#if !WINDOWS
-- | Since 0.1.13
instance HasReadBufferSize ServerSettingsUnix where
readBufferSizeLens f ss = fmap (\p -> ss { serverReadBufferSizeUnix = p }) (f (serverReadBufferSizeUnix ss))
-- | Since 0.1.14
instance HasReadBufferSize ClientSettingsUnix where
readBufferSizeLens f ss = fmap (\p -> ss { clientReadBufferSizeUnix = p }) (f (clientReadBufferSizeUnix ss))
#endif

-- | Get buffer size used when reading from socket.
--
Expand Down Expand Up @@ -640,19 +620,16 @@ class HasReadWrite a where
instance HasReadWrite AppData where
readLens f a = fmap (\x -> a { appRead' = x }) (f (appRead' a))
writeLens f a = fmap (\x -> a { appWrite' = x }) (f (appWrite' a))
#if !WINDOWS
instance HasReadWrite AppDataUnix where
readLens f a = fmap (\x -> a { appReadUnix = x }) (f (appReadUnix a))
writeLens f a = fmap (\x -> a { appWriteUnix = x }) (f (appWriteUnix a))
#endif

appRead :: HasReadWrite a => a -> IO ByteString
appRead = getConstant . readLens Constant

appWrite :: HasReadWrite a => a -> ByteString -> IO ()
appWrite = getConstant . writeLens Constant

#if !WINDOWS
-- | Run an @Application@ with the given settings. This function will create a
-- new listening socket, accept connections on it, and spawn a new thread for
-- each connection.
Expand Down Expand Up @@ -686,4 +663,3 @@ runUnixClient (ClientSettingsUnix path readBufferSize) app = E.bracket
{ appReadUnix = safeRecv sock readBufferSize
, appWriteUnix = sendAll sock
})
#endif
4 changes: 0 additions & 4 deletions Data/Streaming/Network/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -5,11 +5,9 @@ module Data.Streaming.Network.Internal
, HostPreference (..)
, Message (..)
, AppData (..)
#if !WINDOWS
, ServerSettingsUnix (..)
, ClientSettingsUnix (..)
, AppDataUnix (..)
#endif
) where

import Data.String (IsString (..))
Expand Down Expand Up @@ -73,7 +71,6 @@ instance IsString HostPreference where
fromString "!6" = HostIPv6Only
fromString s = Host s

#if !WINDOWS
-- | Settings for a Unix domain sockets server.
data ServerSettingsUnix = ServerSettingsUnix
{ serverPath :: !FilePath
Expand All @@ -92,7 +89,6 @@ data AppDataUnix = AppDataUnix
{ appReadUnix :: !(IO ByteString)
, appWriteUnix :: !(ByteString -> IO ())
}
#endif

-- | Representation of a single UDP message
data Message = Message { msgData :: {-# UNPACK #-} !ByteString
Expand Down

0 comments on commit f438fb6

Please sign in to comment.