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