1{-# LANGUAGE CPP #-}
2{-# LANGUAGE ScopedTypeVariables #-}
3{-# LANGUAGE BangPatterns #-}
4module Data.Streaming.Network
5    ( -- * Types
6      ServerSettings
7    , ClientSettings
8    , HostPreference
9    , Message (..)
10    , AppData
11#if !WINDOWS
12    , ServerSettingsUnix
13    , ClientSettingsUnix
14    , AppDataUnix
15#endif
16      -- ** Smart constructors
17    , serverSettingsTCP
18    , serverSettingsTCPSocket
19    , clientSettingsTCP
20    , serverSettingsUDP
21    , clientSettingsUDP
22#if !WINDOWS
23    , serverSettingsUnix
24    , clientSettingsUnix
25#endif
26    , message
27      -- ** Classes
28    , HasPort (..)
29    , HasAfterBind (..)
30    , HasReadWrite (..)
31    , HasReadBufferSize (..)
32#if !WINDOWS
33    , HasPath (..)
34#endif
35      -- ** Setters
36    , setPort
37    , setHost
38    , setAddrFamily
39    , setAfterBind
40    , setNeedLocalAddr
41    , setReadBufferSize
42#if !WINDOWS
43    , setPath
44#endif
45      -- ** Getters
46    , getPort
47    , getHost
48    , getAddrFamily
49    , getAfterBind
50    , getNeedLocalAddr
51    , getReadBufferSize
52#if !WINDOWS
53    , getPath
54#endif
55    , appRead
56    , appWrite
57    , appSockAddr
58    , appLocalAddr
59    , appCloseConnection
60    , appRawSocket
61      -- * Functions
62      -- ** General
63    , bindPortGen
64    , bindPortGenEx
65    , bindRandomPortGen
66    , getSocketGen
67    , getSocketFamilyGen
68    , acceptSafe
69    , unassignedPorts
70    , getUnassignedPort
71      -- ** TCP
72    , bindPortTCP
73    , bindRandomPortTCP
74    , getSocketTCP
75    , getSocketFamilyTCP
76    , safeRecv
77    , runTCPServer
78    , runTCPClient
79    , ConnectionHandle()
80    , runTCPServerWithHandle
81      -- ** UDP
82    , bindPortUDP
83    , bindRandomPortUDP
84    , getSocketUDP
85#if !WINDOWS
86      -- ** Unix
87    , bindPath
88    , getSocketUnix
89    , runUnixServer
90    , runUnixClient
91#endif
92    ) where
93
94import qualified Network.Socket as NS
95import Data.Streaming.Network.Internal
96import Control.Concurrent (threadDelay)
97import Control.Exception (IOException, try, SomeException, throwIO, bracketOnError, bracket)
98import Network.Socket (Socket, AddrInfo, SocketType)
99import Network.Socket.ByteString (recv, sendAll)
100import System.IO.Error (isDoesNotExistError)
101import qualified Data.ByteString.Char8 as S8
102import qualified Control.Exception as E
103import Data.ByteString (ByteString)
104import System.Directory (removeFile)
105import Data.Functor.Constant (Constant (Constant), getConstant)
106import Data.Functor.Identity (Identity (Identity), runIdentity)
107import Control.Concurrent (forkIO)
108import Control.Monad (forever)
109import Data.IORef (IORef, newIORef, atomicModifyIORef)
110import Data.Array.Unboxed ((!), UArray, listArray)
111import System.IO.Unsafe (unsafePerformIO, unsafeDupablePerformIO)
112import System.Random (randomRIO)
113import System.IO.Error (isFullErrorType, ioeGetErrorType)
114#if WINDOWS
115import Control.Concurrent.MVar (putMVar, takeMVar, newEmptyMVar)
116#endif
117
118getPossibleAddrs :: SocketType -> String -> Int -> NS.Family -> IO [AddrInfo]
119getPossibleAddrs sockettype host' port' af =
120    NS.getAddrInfo (Just hints) (Just host') (Just $ show port')
121  where
122    hints = NS.defaultHints {
123                NS.addrSocketType = sockettype
124              , NS.addrFamily = af
125              }
126
127-- | Attempt to connect to the given host/port/address family using given @SocketType@.
128--
129-- Since 0.1.3
130getSocketFamilyGen :: SocketType -> String -> Int -> NS.Family -> IO (Socket, AddrInfo)
131getSocketFamilyGen sockettype host' port' af = do
132    (addr:_) <- getPossibleAddrs sockettype host' port' af
133    sock <- NS.socket (NS.addrFamily addr) (NS.addrSocketType addr)
134                      (NS.addrProtocol addr)
135    return (sock, addr)
136
137-- | Attempt to connect to the given host/port using given @SocketType@.
138getSocketGen :: SocketType -> String -> Int -> IO (Socket, AddrInfo)
139getSocketGen sockettype host port = getSocketFamilyGen sockettype host port NS.AF_UNSPEC
140
141defaultSocketOptions :: SocketType -> [(NS.SocketOption, Int)]
142defaultSocketOptions sockettype =
143    case sockettype of
144        NS.Datagram -> [(NS.ReuseAddr,1)]
145        _           -> [(NS.NoDelay,1), (NS.ReuseAddr,1)]
146
147-- | Attempt to bind a listening @Socket@ on the given host/port using given
148-- @SocketType@. If no host is given, will use the first address available.
149bindPortGen :: SocketType -> Int -> HostPreference -> IO Socket
150bindPortGen sockettype = bindPortGenEx (defaultSocketOptions sockettype) sockettype
151
152-- | Attempt to bind a listening @Socket@ on the given host/port using given
153-- socket options and @SocketType@. If no host is given, will use the first address available.
154--
155-- Since 0.1.17
156bindPortGenEx :: [(NS.SocketOption, Int)] -> SocketType -> Int -> HostPreference -> IO Socket
157bindPortGenEx sockOpts sockettype p s = do
158    let hints = NS.defaultHints
159            { NS.addrFlags = [NS.AI_PASSIVE]
160            , NS.addrSocketType = sockettype
161            }
162        host =
163            case s of
164                Host s' -> Just s'
165                _ -> Nothing
166        port = Just . show $ p
167    addrs <- NS.getAddrInfo (Just hints) host port
168    -- Choose an IPv6 socket if exists.  This ensures the socket can
169    -- handle both IPv4 and IPv6 if v6only is false.
170    let addrs4 = filter (\x -> NS.addrFamily x /= NS.AF_INET6) addrs
171        addrs6 = filter (\x -> NS.addrFamily x == NS.AF_INET6) addrs
172        addrs' =
173            case s of
174                HostIPv4     -> addrs4 ++ addrs6
175                HostIPv4Only -> addrs4
176                HostIPv6     -> addrs6 ++ addrs4
177                HostIPv6Only -> addrs6
178                _ -> addrs
179
180        tryAddrs (addr1:rest@(_:_)) =
181                                      E.catch
182                                      (theBody addr1)
183                                      (\(_ :: IOException) -> tryAddrs rest)
184        tryAddrs (addr1:[])         = theBody addr1
185        tryAddrs _                  = error "bindPort: addrs is empty"
186
187        theBody addr =
188          bracketOnError
189          (NS.socket (NS.addrFamily addr) (NS.addrSocketType addr) (NS.addrProtocol addr))
190          NS.close
191          (\sock -> do
192              mapM_ (\(opt,v) -> NS.setSocketOption sock opt v) sockOpts
193              NS.bind sock (NS.addrAddress addr)
194              return sock
195          )
196    tryAddrs addrs'
197
198-- | Bind to a random port number. Especially useful for writing network tests.
199--
200-- Since 0.1.1
201bindRandomPortGen :: SocketType -> HostPreference -> IO (Int, Socket)
202bindRandomPortGen sockettype s = do
203  socket <- bindPortGen sockettype 0 s
204  port <- NS.socketPort socket
205  return (fromIntegral port, socket)
206
207-- | Top 10 Largest IANA unassigned port ranges with no unauthorized uses known
208unassignedPortsList :: [Int]
209unassignedPortsList = concat
210    [ [43124..44320]
211    , [28120..29166]
212    , [45967..46997]
213    , [28241..29117]
214    , [40001..40840]
215    , [29170..29998]
216    , [38866..39680]
217    , [43442..44122]
218    , [41122..41793]
219    , [35358..36000]
220    ]
221
222unassignedPorts :: UArray Int Int
223unassignedPorts = listArray (unassignedPortsMin, unassignedPortsMax) unassignedPortsList
224
225unassignedPortsMin, unassignedPortsMax :: Int
226unassignedPortsMin = 0
227unassignedPortsMax = length unassignedPortsList - 1
228
229nextUnusedPort :: IORef Int
230nextUnusedPort = unsafePerformIO
231               $ randomRIO (unassignedPortsMin, unassignedPortsMax) >>= newIORef
232{-# NOINLINE nextUnusedPort #-}
233
234-- | Get a port from the IANA list of unassigned ports.
235--
236-- Internally, this function uses an @IORef@ to cycle through the list of ports
237getUnassignedPort :: IO Int
238getUnassignedPort = do
239    port <- atomicModifyIORef nextUnusedPort go
240    return $! port
241  where
242    go i
243        | i > unassignedPortsMax = (succ unassignedPortsMin, unassignedPorts ! unassignedPortsMin)
244        | otherwise = (succ i, unassignedPorts ! i)
245
246-- | Attempt to connect to the given host/port.
247getSocketUDP :: String -> Int -> IO (Socket, AddrInfo)
248getSocketUDP = getSocketGen NS.Datagram
249
250-- | Attempt to bind a listening @Socket@ on the given host/port. If no host is
251-- given, will use the first address available.
252bindPortUDP :: Int -> HostPreference -> IO Socket
253bindPortUDP = bindPortGen NS.Datagram
254
255-- | Bind a random UDP port.
256--
257-- See 'bindRandomPortGen'
258--
259-- Since 0.1.1
260bindRandomPortUDP :: HostPreference -> IO (Int, Socket)
261bindRandomPortUDP = bindRandomPortGen NS.Datagram
262
263{-# NOINLINE defaultReadBufferSize #-}
264defaultReadBufferSize :: Int
265defaultReadBufferSize = unsafeDupablePerformIO $
266  bracket (NS.socket NS.AF_INET NS.Stream 0) NS.close (\sock -> NS.getSocketOption sock NS.RecvBuffer)
267
268#if !WINDOWS
269-- | Attempt to connect to the given Unix domain socket path.
270getSocketUnix :: FilePath -> IO Socket
271getSocketUnix path = do
272    sock <- NS.socket NS.AF_UNIX NS.Stream 0
273    ee <- try' $ NS.connect sock (NS.SockAddrUnix path)
274    case ee of
275        Left e -> NS.close sock >> throwIO e
276        Right () -> return sock
277  where
278    try' :: IO a -> IO (Either SomeException a)
279    try' = try
280
281-- | Attempt to bind a listening Unix domain socket at the given path.
282bindPath :: FilePath -> IO Socket
283bindPath path = do
284  sock <- bracketOnError
285            (NS.socket NS.AF_UNIX NS.Stream 0)
286            NS.close
287            (\sock -> do
288                removeFileSafe path  -- Cannot bind if the socket file exists.
289                NS.bind sock (NS.SockAddrUnix path)
290                return sock)
291  NS.listen sock (max 2048 NS.maxListenQueue)
292  return sock
293
294removeFileSafe :: FilePath -> IO ()
295removeFileSafe path =
296    removeFile path `E.catch` handleExists
297  where
298    handleExists e
299          | isDoesNotExistError e = return ()
300          | otherwise = throwIO e
301
302-- | Smart constructor.
303serverSettingsUnix
304    :: FilePath -- ^ path to bind to
305    -> ServerSettingsUnix
306serverSettingsUnix path = ServerSettingsUnix
307    { serverPath = path
308    , serverAfterBindUnix = const $ return ()
309    , serverReadBufferSizeUnix = defaultReadBufferSize
310    }
311
312-- | Smart constructor.
313clientSettingsUnix
314    :: FilePath -- ^ path to connect to
315    -> ClientSettingsUnix
316clientSettingsUnix path = ClientSettingsUnix
317    { clientPath = path
318    , clientReadBufferSizeUnix = defaultReadBufferSize
319    }
320#endif
321
322#if defined(__GLASGOW_HASKELL__) && WINDOWS
323-- Socket recv and accept calls on Windows platform cannot be interrupted when compiled with -threaded.
324-- See https://ghc.haskell.org/trac/ghc/ticket/5797 for details.
325-- The following enables simple workaround
326#define SOCKET_ACCEPT_RECV_WORKAROUND
327#endif
328
329safeRecv :: Socket -> Int -> IO ByteString
330#ifndef SOCKET_ACCEPT_RECV_WORKAROUND
331safeRecv = recv
332#else
333safeRecv s buf = do
334    var <- newEmptyMVar
335    forkIO $ recv s buf `E.catch` (\(_::IOException) -> return S8.empty) >>= putMVar var
336    takeMVar var
337#endif
338
339-- | Smart constructor.
340serverSettingsUDP
341    :: Int -- ^ port to bind to
342    -> HostPreference -- ^ host binding preferences
343    -> ServerSettings
344serverSettingsUDP = serverSettingsTCP
345
346-- | Smart constructor.
347serverSettingsTCP
348    :: Int -- ^ port to bind to
349    -> HostPreference -- ^ host binding preferences
350    -> ServerSettings
351serverSettingsTCP port host = ServerSettings
352    { serverPort = port
353    , serverHost = host
354    , serverSocket = Nothing
355    , serverAfterBind = const $ return ()
356    , serverNeedLocalAddr = False
357    , serverReadBufferSize = defaultReadBufferSize
358    }
359
360-- | Create a server settings that uses an already available listening socket.
361-- Any port and host modifications made to this value will be ignored.
362--
363-- Since 0.1.1
364serverSettingsTCPSocket :: Socket -> ServerSettings
365serverSettingsTCPSocket lsocket = ServerSettings
366    { serverPort = 0
367    , serverHost = HostAny
368    , serverSocket = Just lsocket
369    , serverAfterBind = const $ return ()
370    , serverNeedLocalAddr = False
371    , serverReadBufferSize = defaultReadBufferSize
372    }
373
374-- | Smart constructor.
375clientSettingsUDP
376    :: Int -- ^ port to connect to
377    -> ByteString -- ^ host to connect to
378    -> ClientSettings
379clientSettingsUDP = clientSettingsTCP
380
381-- | Smart constructor.
382clientSettingsTCP
383    :: Int -- ^ port to connect to
384    -> ByteString -- ^ host to connect to
385    -> ClientSettings
386clientSettingsTCP port host = ClientSettings
387    { clientPort = port
388    , clientHost = host
389    , clientAddrFamily = NS.AF_UNSPEC
390    , clientReadBufferSize = defaultReadBufferSize
391    }
392
393-- | Attempt to connect to the given host/port/address family.
394--
395-- Since 0.1.3
396getSocketFamilyTCP :: ByteString -> Int -> NS.Family -> IO (NS.Socket, NS.SockAddr)
397getSocketFamilyTCP host' port' addrFamily = do
398    addrsInfo <- getPossibleAddrs NS.Stream (S8.unpack host') port' addrFamily
399    firstSuccess addrsInfo
400  where
401    firstSuccess [ai]     = connect ai
402    firstSuccess (ai:ais) = connect ai `E.catch` \(_ :: IOException) -> firstSuccess ais
403    firstSuccess _        = error "getSocketFamilyTCP: can't happen"
404
405    createSocket addrInfo = do
406        sock <- NS.socket (NS.addrFamily addrInfo) (NS.addrSocketType addrInfo)
407                          (NS.addrProtocol addrInfo)
408        NS.setSocketOption sock NS.NoDelay 1
409        return sock
410
411    connect addrInfo = E.bracketOnError (createSocket addrInfo) NS.close $ \sock -> do
412        NS.connect sock (NS.addrAddress addrInfo)
413        return (sock, NS.addrAddress addrInfo)
414
415-- | Attempt to connect to the given host/port.
416getSocketTCP :: ByteString -> Int -> IO (NS.Socket, NS.SockAddr)
417getSocketTCP host port = getSocketFamilyTCP host port NS.AF_UNSPEC
418
419-- | Attempt to bind a listening @Socket@ on the given host/port. If no host is
420-- given, will use the first address available.
421-- 'maxListenQueue' is topically 128 which is too short for
422-- high performance servers. So, we specify 'max 2048 maxListenQueue' to
423-- the listen queue.
424bindPortTCP :: Int -> HostPreference -> IO Socket
425bindPortTCP p s = do
426    sock <- bindPortGen NS.Stream p s
427    NS.listen sock (max 2048 NS.maxListenQueue)
428    return sock
429
430-- | Bind a random TCP port.
431--
432-- See 'bindRandomPortGen'.
433--
434-- Since 0.1.1
435bindRandomPortTCP :: HostPreference -> IO (Int, Socket)
436bindRandomPortTCP s = do
437    (port, sock) <- bindRandomPortGen NS.Stream s
438    NS.listen sock (max 2048 NS.maxListenQueue)
439    return (port, sock)
440
441-- | Try to accept a connection, recovering automatically from exceptions.
442--
443-- As reported by Kazu against Warp, "resource exhausted (Too many open files)"
444-- may be thrown by accept(). This function will catch that exception, wait a
445-- second, and then try again.
446acceptSafe :: Socket -> IO (Socket, NS.SockAddr)
447acceptSafe socket =
448#ifndef SOCKET_ACCEPT_RECV_WORKAROUND
449    loop
450#else
451    do var <- newEmptyMVar
452       forkIO $ loop >>= putMVar var
453       takeMVar var
454#endif
455  where
456    loop =
457        NS.accept socket `E.catch` \e ->
458            if isFullErrorType (ioeGetErrorType e)
459                then do
460                    threadDelay 1000000
461                    loop
462                else E.throwIO e
463
464message :: ByteString -> NS.SockAddr -> Message
465message = Message
466
467class HasPort a where
468    portLens :: Functor f => (Int -> f Int) -> a -> f a
469instance HasPort ServerSettings where
470    portLens f ss = fmap (\p -> ss { serverPort = p }) (f (serverPort ss))
471instance HasPort ClientSettings where
472    portLens f ss = fmap (\p -> ss { clientPort = p }) (f (clientPort ss))
473
474getPort :: HasPort a => a -> Int
475getPort = getConstant . portLens Constant
476
477setPort :: HasPort a => Int -> a -> a
478setPort p = runIdentity . portLens (const (Identity p))
479
480setHost :: ByteString -> ClientSettings -> ClientSettings
481setHost hp ss = ss { clientHost = hp }
482
483getHost :: ClientSettings -> ByteString
484getHost = clientHost
485
486-- | Set the address family for the given settings.
487--
488-- Since 0.1.3
489setAddrFamily :: NS.Family -> ClientSettings -> ClientSettings
490setAddrFamily af cs = cs { clientAddrFamily = af }
491
492-- | Get the address family for the given settings.
493--
494-- Since 0.1.3
495getAddrFamily :: ClientSettings -> NS.Family
496getAddrFamily = clientAddrFamily
497
498#if !WINDOWS
499class HasPath a where
500    pathLens :: Functor f => (FilePath -> f FilePath) -> a -> f a
501instance HasPath ServerSettingsUnix where
502    pathLens f ss = fmap (\p -> ss { serverPath = p }) (f (serverPath ss))
503instance HasPath ClientSettingsUnix where
504    pathLens f ss = fmap (\p -> ss { clientPath = p }) (f (clientPath ss))
505
506getPath :: HasPath a => a -> FilePath
507getPath = getConstant . pathLens Constant
508
509setPath :: HasPath a => FilePath -> a -> a
510setPath p = runIdentity . pathLens (const (Identity p))
511#endif
512
513setNeedLocalAddr :: Bool -> ServerSettings -> ServerSettings
514setNeedLocalAddr x y = y { serverNeedLocalAddr = x }
515
516getNeedLocalAddr :: ServerSettings -> Bool
517getNeedLocalAddr = serverNeedLocalAddr
518
519class HasAfterBind a where
520    afterBindLens :: Functor f => ((Socket -> IO ()) -> f (Socket -> IO ())) -> a -> f a
521instance HasAfterBind ServerSettings where
522    afterBindLens f ss = fmap (\p -> ss { serverAfterBind = p }) (f (serverAfterBind ss))
523#if !WINDOWS
524instance HasAfterBind ServerSettingsUnix where
525    afterBindLens f ss = fmap (\p -> ss { serverAfterBindUnix = p }) (f (serverAfterBindUnix ss))
526#endif
527
528getAfterBind :: HasAfterBind a => a -> (Socket -> IO ())
529getAfterBind = getConstant . afterBindLens Constant
530
531setAfterBind :: HasAfterBind a => (Socket -> IO ()) -> a -> a
532setAfterBind p = runIdentity . afterBindLens (const (Identity p))
533
534-- | Since 0.1.13
535class HasReadBufferSize a where
536    readBufferSizeLens :: Functor f => (Int -> f Int) -> a -> f a
537-- | Since 0.1.13
538instance HasReadBufferSize ServerSettings where
539    readBufferSizeLens f ss = fmap (\p -> ss { serverReadBufferSize = p }) (f (serverReadBufferSize ss))
540-- | Since 0.1.13
541instance HasReadBufferSize ClientSettings where
542    readBufferSizeLens f cs = fmap (\p -> cs { clientReadBufferSize = p }) (f (clientReadBufferSize cs))
543#if !WINDOWS
544-- | Since 0.1.13
545instance HasReadBufferSize ServerSettingsUnix where
546    readBufferSizeLens f ss = fmap (\p -> ss { serverReadBufferSizeUnix = p }) (f (serverReadBufferSizeUnix ss))
547-- | Since 0.1.14
548instance HasReadBufferSize ClientSettingsUnix where
549    readBufferSizeLens f ss = fmap (\p -> ss { clientReadBufferSizeUnix = p }) (f (clientReadBufferSizeUnix ss))
550#endif
551
552-- | Get buffer size used when reading from socket.
553--
554-- Since 0.1.13
555getReadBufferSize :: HasReadBufferSize a => a -> Int
556getReadBufferSize = getConstant . readBufferSizeLens Constant
557
558-- | Set buffer size used when reading from socket.
559--
560-- Since 0.1.13
561setReadBufferSize :: HasReadBufferSize a => Int -> a -> a
562setReadBufferSize p = runIdentity . readBufferSizeLens (const (Identity p))
563
564type ConnectionHandle = Socket -> NS.SockAddr -> Maybe NS.SockAddr -> IO ()
565
566runTCPServerWithHandle :: ServerSettings -> ConnectionHandle -> IO a
567runTCPServerWithHandle (ServerSettings port host msocket afterBind needLocalAddr _) handle =
568    case msocket of
569        Nothing -> E.bracket (bindPortTCP port host) NS.close inner
570        Just lsocket -> inner lsocket
571  where
572    inner lsocket = afterBind lsocket >> forever (serve lsocket)
573    serve lsocket = E.bracketOnError
574        (acceptSafe lsocket)
575        (\(socket, _) -> NS.close socket)
576        $ \(socket, addr) -> do
577            mlocal <- if needLocalAddr
578                        then fmap Just $ NS.getSocketName socket
579                        else return Nothing
580            _ <- E.mask $ \restore -> forkIO
581               $ restore (handle socket addr mlocal)
582                    `E.finally` NS.close socket
583            return ()
584
585
586
587-- | Run an @Application@ with the given settings. This function will create a
588-- new listening socket, accept connections on it, and spawn a new thread for
589-- each connection.
590runTCPServer :: ServerSettings -> (AppData -> IO ()) -> IO a
591runTCPServer settings app = runTCPServerWithHandle settings app'
592  where app' socket addr mlocal =
593          let ad = AppData
594                { appRead' = safeRecv socket $ getReadBufferSize settings
595                , appWrite' = sendAll socket
596                , appSockAddr' = addr
597                , appLocalAddr' = mlocal
598                , appCloseConnection' = NS.close socket
599                , appRawSocket' = Just socket
600                }
601          in
602            app ad
603
604-- | Run an @Application@ by connecting to the specified server.
605runTCPClient :: ClientSettings -> (AppData -> IO a) -> IO a
606runTCPClient (ClientSettings port host addrFamily readBufferSize) app = E.bracket
607    (getSocketFamilyTCP host port addrFamily)
608    (NS.close . fst)
609    (\(s, address) -> app AppData
610        { appRead' = safeRecv s readBufferSize
611        , appWrite' = sendAll s
612        , appSockAddr' = address
613        , appLocalAddr' = Nothing
614        , appCloseConnection' = NS.close s
615        , appRawSocket' = Just s
616        })
617
618appLocalAddr :: AppData -> Maybe NS.SockAddr
619appLocalAddr = appLocalAddr'
620
621appSockAddr :: AppData -> NS.SockAddr
622appSockAddr = appSockAddr'
623
624-- | Close the underlying connection. One possible use case is simulating
625-- connection failures in a test suite.
626--
627-- Since 0.1.6
628appCloseConnection :: AppData -> IO ()
629appCloseConnection = appCloseConnection'
630
631-- | Get the raw socket for this @AppData@, if available.
632--
633-- Since 0.1.12
634appRawSocket :: AppData -> Maybe NS.Socket
635appRawSocket = appRawSocket'
636
637class HasReadWrite a where
638    readLens :: Functor f => (IO ByteString -> f (IO ByteString)) -> a -> f a
639    writeLens :: Functor f => ((ByteString -> IO ()) -> f (ByteString -> IO ())) -> a -> f a
640instance HasReadWrite AppData where
641    readLens f a = fmap (\x -> a { appRead' = x }) (f (appRead' a))
642    writeLens f a = fmap (\x -> a { appWrite' = x }) (f (appWrite' a))
643#if !WINDOWS
644instance HasReadWrite AppDataUnix where
645    readLens f a = fmap (\x -> a { appReadUnix = x }) (f (appReadUnix a))
646    writeLens f a = fmap (\x -> a { appWriteUnix = x }) (f (appWriteUnix a))
647#endif
648
649appRead :: HasReadWrite a => a -> IO ByteString
650appRead = getConstant . readLens Constant
651
652appWrite :: HasReadWrite a => a -> ByteString -> IO ()
653appWrite = getConstant . writeLens Constant
654
655#if !WINDOWS
656-- | Run an @Application@ with the given settings. This function will create a
657-- new listening socket, accept connections on it, and spawn a new thread for
658-- each connection.
659runUnixServer :: ServerSettingsUnix -> (AppDataUnix -> IO ()) -> IO a
660runUnixServer (ServerSettingsUnix path afterBind readBufferSize) app = E.bracket
661    (bindPath path)
662    NS.close
663    (\socket -> do
664        afterBind socket
665        forever $ serve socket)
666  where
667    serve lsocket = E.bracketOnError
668        (acceptSafe lsocket)
669        (\(socket, _) -> NS.close socket)
670        $ \(socket, _) -> do
671            let ad = AppDataUnix
672                    { appReadUnix = safeRecv socket readBufferSize
673                    , appWriteUnix = sendAll socket
674                    }
675            _ <- E.mask $ \restore -> forkIO
676                $ restore (app ad)
677                    `E.finally` NS.close socket
678            return ()
679
680-- | Run an @Application@ by connecting to the specified server.
681runUnixClient :: ClientSettingsUnix -> (AppDataUnix -> IO a) -> IO a
682runUnixClient (ClientSettingsUnix path readBufferSize) app = E.bracket
683    (getSocketUnix path)
684    NS.close
685    (\sock -> app AppDataUnix
686        { appReadUnix = safeRecv sock readBufferSize
687        , appWriteUnix = sendAll sock
688        })
689#endif
690