diff --git a/.gitignore b/.gitignore index 3940279..6f7d02b 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,5 @@ .stack-work/ -*.cabal +!/copied_dependencies/NoTrace-0.3.0.4/NoTrace.cabal *~ *.class TAGS diff --git a/package.yaml b/package.yaml index f703b14..f3f8b4b 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: text-via-sockets -version: 0.1.0.0 +version: 0.1.1.0 github: "capitanbatata/text-via-sockets" license: BSD3 author: "Damian Nadales" @@ -30,7 +30,6 @@ library: dependencies: - bytestring - stm - - NoTrace - retry - exceptions - text @@ -70,7 +69,6 @@ tests: - QuickCheck - quickcheck-text - async - - NoTrace - text - text-via-sockets diff --git a/src/Copied_dependencies/Debug/LICENSE b/src/Copied_dependencies/Debug/LICENSE new file mode 100644 index 0000000..b939533 --- /dev/null +++ b/src/Copied_dependencies/Debug/LICENSE @@ -0,0 +1,20 @@ +The MIT License (MIT) + +Copyright (c) 2013 Cindy Wang + +Permission is hereby granted, free of charge, to any person obtaining a copy of +this software and associated documentation files (the "Software"), to deal in +the Software without restriction, including without limitation the rights to +use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of +the Software, and to permit persons to whom the Software is furnished to do so, +subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS +FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR +COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER +IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN +CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/src/Copied_dependencies/Debug/NoTrace.hs b/src/Copied_dependencies/Debug/NoTrace.hs new file mode 100644 index 0000000..bfbd529 --- /dev/null +++ b/src/Copied_dependencies/Debug/NoTrace.hs @@ -0,0 +1,70 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Copied_dependencies.Debug.NoTrace +-- Copyright : (c) Cindy Wang (CindyLinz) 2013 +-- License : MIT +-- +-- Maintainer : Cindy Wang (CindyLinz) +-- Stability : provisional +-- Portability : portable +-- +-- This module introduce functions that have identical types with functions in the "Debug.Trace" module. +-- +-- You might write some programs like this: +-- +-- > import Debug.Trace +-- > +-- > fib 0 = 1 +-- > fib 1 = 1 +-- > fib n = ("fib " ++ show n) `trace` fib (n - 1) + fib (n - 2) +-- +-- And after you finish the debugging process, just change the line +-- +-- > import Copied_dependencies.Debug.Trace +-- +-- into +-- +-- > import Copied_dependencies.Debug.NoTrace +-- +-- Then all the tracing functions are silently removed. +------------------------------------------------------------------------------- +module Copied_dependencies.Debug.NoTrace where + +trace :: String -> a -> a +trace _ = id + +traceId :: String -> String +traceId = id + +traceShow :: Show a => a -> b -> b +traceShow _ = id + +traceShowId :: Show a => a -> a +traceShowId = id + +traceStack :: String -> a -> a +traceStack _ = id + +traceIO :: String -> IO () +traceIO _ = return () + +traceM :: Monad m => String -> m () +traceM _ = return () + +traceShowM :: (Show a, Monad m) => a -> m () +traceShowM _ = return () + +putTraceMsg :: String -> IO () +putTraceMsg _ = return () + +traceEvent :: String -> a -> a +traceEvent _ = id + +traceEventIO :: String -> IO () +traceEventIO _ = return () + +traceMarker :: String -> a -> a +traceMarker _ = id + +traceMarkerIO :: String -> IO () +traceMarkerIO _ = return () diff --git a/src/Network/TextViaSockets.hs b/src/Network/TextViaSockets.hs index 812b120..f8a3e6a 100644 --- a/src/Network/TextViaSockets.hs +++ b/src/Network/TextViaSockets.hs @@ -18,7 +18,11 @@ module Network.TextViaSockets ( Connection () -- * Connect to a server , connectTo + -- * Same as connectTo, + -- but only creates the socket without setting up a connection + , connectToSocket -- * Start a server + , listenOn , acceptOn , acceptOnSocket , getFreeSocket @@ -31,8 +35,7 @@ module Network.TextViaSockets , close ) where -import Network.Socket hiding (recv, close, send) -import qualified Network.Socket as Socket +import Network.Socket hiding (close) import Network.Socket.ByteString import Data.Text (Text) import qualified Data.Text as T @@ -49,12 +52,11 @@ import Control.Exception.Base import Data.Foldable import Control.Retry import Control.Monad.Catch (Handler) -import Data.Monoid #ifdef DEBUG import Debug.Trace #else -import Debug.NoTrace +import Copied_dependencies.Debug.NoTrace #endif -- | A connection for sending and receiving @Text@ lines. @@ -105,12 +107,38 @@ retryCnect act = recovering connectRetryPolicy [ioExceptionHandler] (const act) -- reached. acceptOn :: PortNumber -> IO Connection acceptOn p = retryCnect $ do - sock <- socket AF_INET Stream 0 + addr <- resolvePort p + sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) traceIO $ "TextViaSockets: Accepting a connection on port " ++ show p setSocketOption sock ReuseAddr 1 - bind sock (SockAddrInet p iNADDR_ANY) + bind sock (addrAddress addr) acceptOnSocket sock +-- | Accept byte-streams by serving on the given port number. +-- This function will start listening, but will not block. +listenOn :: PortNumber -> IO Socket +listenOn p = do + addr <- resolvePort p + sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) + traceIO $ "TextViaSockets: Accepting a connection on port " ++ show p + setSocketOption sock ReuseAddr 1 + bind sock (addrAddress addr) + listen sock 1 -- Only one queued connection. + return sock + + +-- | Resolves a portnumber to the SockAddr object needed for many functions from the Network.Socket library +-- Implementation is based on example code from the Network.Socket library. +resolvePort :: PortNumber -> IO AddrInfo +resolvePort port = do + let hints = defaultHints { + addrFamily = AF_INET + , addrSocketType = Stream + } + addr:_ <- getAddrInfo (Just hints) Nothing (Just $ show port) + return addr + + -- | Like @acceptOn@ but it takes a bound socket as parameter. acceptOnSocket :: Socket -> IO Connection acceptOnSocket sock = retryCnect $ do @@ -126,9 +154,10 @@ acceptOnSocket sock = retryCnect $ do -- | Get a free socket from the operating system. getFreeSocket :: IO Socket getFreeSocket = retryCnect $ do - sock <- socket AF_INET Stream 0 + addr <- resolvePort defaultPort + sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) setSocketOption sock ReuseAddr 1 - bind sock (SockAddrInet aNY_PORT iNADDR_ANY) + bind sock (addrAddress addr) return sock -- | Connect to the given host and service name (usually a port number). @@ -137,7 +166,18 @@ getFreeSocket = retryCnect $ do -- an exponential back-off strategy, until the maximum number of tries is -- reached. connectTo :: HostName -> ServiceName -> IO Connection -connectTo hn sn = withSocketsDo $ retryCnect $ do +connectTo hn sn = do + sock <-connectToSocket hn sn + mkConnection sock Nothing + + +-- | Connect to the given host and service name (usually a port number). +-- +-- If the connection cannot be established, this action will be retried using +-- an exponential back-off strategy, until the maximum number of tries is +-- reached. +connectToSocket :: HostName -> ServiceName -> IO Socket +connectToSocket hn sn = withSocketsDo $ retryCnect $ do -- Open the socket. traceIO $ "TextViaSockets: Connecting to " ++ show hn' ++ " on " ++ show sn addrinfos <- getAddrInfo Nothing (Just hn') (Just sn) @@ -147,7 +187,7 @@ connectTo hn sn = withSocketsDo $ retryCnect $ do pn <- socketPort sock traceIO $ "TextViaSockets: Connected to " ++ show hn' ++ " on " ++ show pn ++ " (" ++ show sock ++ ")" - mkConnection sock Nothing + return sock where -- Replace "localhost" to prevent errors on Windows systems where -- "localhost" does not resolve to "127.0.0.1" @@ -239,21 +279,11 @@ close :: Connection -> IO () close Connection{connSock, serverSock, socketReaderTid} = tryClose `catch` handler where tryClose = do - closeIfOpen connSock + close' connSock traceIO $ "TextViaSockets: Closing server socket " ++ show serverSock - traverse_ closeIfOpen serverSock + traverse_ close' serverSock killThread socketReaderTid traceIO "TextViaSockets: Connection closed" - closeIfOpen sock = do - let MkSocket _ _ _ _ stMV = sock - st <- readMVar stMV - case st of - Closed -> return () - _ -> do - pn <- socketPort sock - traceIO $ "TextViaSockets: Closing connection on " ++ show pn - ++ " (" ++ show sock ++ ")" - Socket.close sock handler :: IOException -> IO () handler ex = do traceIO $ "TextViaSockets: exception while closing the socket: " diff --git a/stack.yaml b/stack.yaml index 57ee885..dd6e34e 100644 --- a/stack.yaml +++ b/stack.yaml @@ -15,7 +15,7 @@ # resolver: # name: custom-snapshot # location: "./custom-snapshot.yaml" -resolver: lts-10.0 +resolver: lts-18.28 # User packages to be built. # Various formats can be used as shown in the example below. @@ -37,6 +37,8 @@ resolver: lts-10.0 # will not be run. This is useful for tweaking upstream packages. packages: - . +extra-deps: +# - copied_dependencies/NoTrace-0.3.0.4 # Dependency packages to be pulled from upstream that are not in the resolver # (e.g., acme-missiles-0.3) # extra-deps: [] diff --git a/stack.yaml.lock b/stack.yaml.lock new file mode 100644 index 0000000..da10c3e --- /dev/null +++ b/stack.yaml.lock @@ -0,0 +1,12 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: [] +snapshots: +- completed: + sha256: 428ec8d5ce932190d3cbe266b9eb3c175cd81e984babf876b64019e2cbe4ea68 + size: 590100 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/28.yaml + original: lts-18.28 diff --git a/test/Network/TextViaSocketsSpec.hs b/test/Network/TextViaSocketsSpec.hs index 08298e1..e6828b7 100644 --- a/test/Network/TextViaSocketsSpec.hs +++ b/test/Network/TextViaSocketsSpec.hs @@ -4,6 +4,7 @@ module Network.TextViaSocketsSpec (spec) where import Control.Concurrent import Data.Text (Text) import Network.Socket hiding (close) +import qualified Network.Socket (close) import Control.Exception.Base hiding (assert) import Control.Concurrent.Async import qualified Data.Text as T @@ -18,7 +19,7 @@ import Network.TextViaSockets #ifdef DEBUG import Debug.Trace #else -import Debug.NoTrace +import Copied_dependencies.Debug.NoTrace #endif -- | Timeout token. @@ -149,3 +150,14 @@ spec = do close svrConn close svrConn close cliConn + describe "Creating:" $ do + it "multiple sockets can be created" $ do + sock1 <- getFreeSocket + sock2 <- getFreeSocket + (SockAddrInet port1 host1) <- getSocketName sock1 + (SockAddrInet port2 host2) <- getSocketName sock2 + (port1,port2,host1,host2) `shouldSatisfy` (\(p1,p2,h1,h2)-> p1 /= p2 || h1 /= h2) + print (port1,port2,host1,host2) + Network.Socket.close sock1 + Network.Socket.close sock2 + diff --git a/text-via-sockets.cabal b/text-via-sockets.cabal new file mode 100644 index 0000000..195d792 --- /dev/null +++ b/text-via-sockets.cabal @@ -0,0 +1,119 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.35.2. +-- +-- see: https://github.com/sol/hpack + +name: text-via-sockets +version: 0.1.1.0 +synopsis: Send and receive text lines using sockets. +description: Please see the README on Github at +category: Network +homepage: https://github.com/capitanbatata/text-via-sockets#readme +bug-reports: https://github.com/capitanbatata/text-via-sockets/issues +author: Damian Nadales +maintainer: damian.nadales@gmail.com +copyright: Copyright: (c) 2017 Damian Nadales +license: BSD3 +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + ChangeLog.md + +source-repository head + type: git + location: https://github.com/capitanbatata/text-via-sockets + +flag debug + description: Enable debug + manual: True + default: False + +library + exposed-modules: + Copied_dependencies.Debug.NoTrace + Network.TextViaSockets + other-modules: + Paths_text_via_sockets + hs-source-dirs: + src + default-extensions: + OverloadedStrings + ghc-options: -O -Werror -Wall + build-depends: + base >=4.7 && <5 + , bytestring + , exceptions + , network + , retry + , stm + , text + default-language: Haskell2010 + if flag(debug) + cpp-options: -DDEBUG + +test-suite no-resources-leak-test + type: exitcode-stdio-1.0 + main-is: Main.hs + other-modules: + Paths_text_via_sockets + hs-source-dirs: + test/endurance/no-resources-leak + default-extensions: + OverloadedStrings + ghc-options: -O -Werror -Wall -threaded -rtsopts -with-rtsopts=-N -with-rtsopts=-T -Werror -Wall -O + build-depends: + async + , base >=4.7 && <5 + , ekg + , network + , text-via-sockets + default-language: Haskell2010 + if flag(debug) + cpp-options: -DDEBUG + +test-suite text-via-sockets-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Network.TextViaSocketsSpec + Paths_text_via_sockets + hs-source-dirs: + test + default-extensions: + OverloadedStrings + ghc-options: -O -Werror -Wall -threaded -rtsopts -with-rtsopts=-N -Werror -Wall -O + build-depends: + QuickCheck + , async + , base >=4.7 && <5 + , hspec + , network + , quickcheck-text + , text + , text-via-sockets + default-language: Haskell2010 + if flag(debug) + cpp-options: -DDEBUG + +benchmark text-via-sockets-bench + type: exitcode-stdio-1.0 + main-is: Main.hs + other-modules: + Paths_text_via_sockets + hs-source-dirs: + bench + default-extensions: + OverloadedStrings + ghc-options: -O -Werror -Wall -threaded -rtsopts -with-rtsopts=-N -Werror -Wall -O + build-depends: + async + , base >=4.7 && <5 + , criterion + , network + , text + , text-via-sockets + default-language: Haskell2010 + if flag(debug) + cpp-options: -DDEBUG