Updates Haskell LTS version to 18.28

.gitignore

@@ -1,5 +1,5 @@
 .stack-work/
-*.cabal
+!/copied_dependencies/NoTrace-0.3.0.4/NoTrace.cabal
 *~
 *.class
 TAGS

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
 

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.

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 ()

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: "

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: []

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

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
+