diff --git a/Network/Socket.hs b/Network/Socket.hs
index 71b23f28..1c42b1ac 100644
--- a/Network/Socket.hs
+++ b/Network/Socket.hs
@@ -197,6 +197,8 @@ module Network.Socket (
     socketToFd,
     fdSocket,
     mkSocket,
+    labelSocket,
+    socketLabel,
     socketToHandle,
 
     -- ** Types of Socket
diff --git a/Network/Socket/ByteString.hs b/Network/Socket/ByteString.hs
index d1cca055..42424e94 100644
--- a/Network/Socket/ByteString.hs
+++ b/Network/Socket/ByteString.hs
@@ -42,6 +42,7 @@ import Data.ByteString (ByteString)
 
 import Network.Socket.ByteString.IO hiding (recvFrom, sendAllTo, sendTo)
 import qualified Network.Socket.ByteString.IO as G
+import Network.Socket.SockAddr (annotateWithSocket)
 import Network.Socket.Types
 
 -- ----------------------------------------------------------------------------
@@ -72,7 +73,7 @@ import Network.Socket.Types
 -- Returns the number of bytes sent. Applications are responsible for
 -- ensuring that all data has been sent.
 sendTo :: Socket -> ByteString -> SockAddr -> IO Int
-sendTo = G.sendTo
+sendTo s bs sa = G.sendTo s bs sa `annotateWithSocket` (s, Just sa)
 
 -- | Send data to the socket. The recipient can be specified
 -- explicitly, so the socket need not be in a connected state.  Unlike
@@ -81,11 +82,11 @@ sendTo = G.sendTo
 -- raised, and there is no way to determine how much data, if any, was
 -- successfully sent.
 sendAllTo :: Socket -> ByteString -> SockAddr -> IO ()
-sendAllTo = G.sendAllTo
+sendAllTo s bs sa = G.sendAllTo s bs sa `annotateWithSocket` (s, Just sa)
 
 -- | Receive data from the socket.  The socket need not be in a
 -- connected state.  Returns @(bytes, address)@ where @bytes@ is a
 -- 'ByteString' representing the data received and @address@ is a
 -- 'SockAddr' representing the address of the sending socket.
 recvFrom :: Socket -> Int -> IO (ByteString, SockAddr)
-recvFrom = G.recvFrom
+recvFrom s len = G.recvFrom s len `annotateWithSocket` (s, Nothing)
diff --git a/Network/Socket/ByteString/IO.hsc b/Network/Socket/ByteString/IO.hsc
index d4fcbca0..243bfef2 100644
--- a/Network/Socket/ByteString/IO.hsc
+++ b/Network/Socket/ByteString/IO.hsc
@@ -57,6 +57,7 @@ import Network.Socket.Internal
 import System.Posix.Types (Fd(..))
 
 import Network.Socket.Flag
+import Network.Socket.SockAddr (annotateWithSocket)
 
 #if !defined(mingw32_HOST_OS)
 import Network.Socket.Posix.Cmsg
@@ -78,8 +79,10 @@ import Network.Socket.Win32.MsgHdr (MsgHdr(..))
 send :: Socket     -- ^ Connected socket
      -> ByteString  -- ^ Data to send
      -> IO Int      -- ^ Number of bytes sent
-send s xs = unsafeUseAsCStringLen xs $ \(str, len) ->
-    sendBuf s (castPtr str) len
+send s xs = send' `annotateWithSocket` (s, Nothing)
+  where
+    send' = unsafeUseAsCStringLen xs $ \(str, len) ->
+      sendBuf s (castPtr str) len
 
 waitWhen0 :: Int -> Socket -> IO ()
 waitWhen0 0 s = when rtsSupportsBoundThreads $
@@ -145,11 +148,12 @@ sendMany :: Socket       -- ^ Connected socket
          -> [ByteString]  -- ^ Data to send
          -> IO ()
 sendMany _ [] = return ()
-sendMany s cs = do
-    sent <- sendManyInner
-    waitWhen0 sent s
-    when (sent >= 0) $ sendMany s $ remainingChunks sent cs
+sendMany s cs = sendMany' `annotateWithSocket` (s, Nothing)
   where
+    sendMany' = do
+        sent <- sendManyInner
+        waitWhen0 sent s
+        when (sent >= 0) $ sendMany s $ remainingChunks sent cs
     sendManyInner =
 #if !defined(mingw32_HOST_OS)
       fmap fromIntegral . withIOVecfromBS cs $ \(iovsPtr, iovsLen) ->
@@ -178,11 +182,12 @@ sendManyTo :: Socket       -- ^ Socket
            -> SockAddr      -- ^ Recipient address
            -> IO ()
 sendManyTo _ [] _    = return ()
-sendManyTo s cs addr = do
-    sent <- fromIntegral <$> sendManyToInner
-    waitWhen0 sent s
-    when (sent >= 0) $ sendManyTo s (remainingChunks sent cs) addr
+sendManyTo s cs addr = sendManyTo' `annotateWithSocket` (s, Nothing)
   where
+    sendManyTo' =  do
+        sent <- fromIntegral <$> sendManyToInner
+        waitWhen0 sent s
+        when (sent >= 0) $ sendManyTo s (remainingChunks sent cs) addr
     sendManyToInner =
       withSockAddr addr $ \addrPtr addrSize ->
 #if !defined(mingw32_HOST_OS)
@@ -225,11 +230,11 @@ sendManyWithFds :: Socket       -- ^ Socket
                 -> [ByteString] -- ^ Data to send
                 -> [Fd]         -- ^ File descriptors
                 -> IO ()
-sendManyWithFds s bss fds =
-    void $
+sendManyWithFds s bss fds = sendManyWithFds' `annotateWithSocket` (s, Nothing)
+  where
+    sendManyWithFds' = void $
         withBufSizs bss $ \bufsizs ->
             sendBufMsg s addr bufsizs cmsgs flags
-  where
     addr = NullSockAddr
     cmsgs = encodeCmsg . (:[]) <$> fds
     flags = mempty
@@ -257,8 +262,8 @@ recv :: Socket        -- ^ Connected socket
      -> Int            -- ^ Maximum number of bytes to receive
      -> IO ByteString  -- ^ Data received
 recv s nbytes
-    | nbytes < 0 = ioError (mkInvalidRecvArgError "Network.Socket.ByteString.recv")
-    | otherwise  = createAndTrim nbytes $ \ptr -> recvBuf s ptr nbytes
+    | nbytes < 0 = ioError (mkInvalidRecvArgError "Network.Socket.ByteString.recv") `annotateWithSocket` (s, Nothing)
+    | otherwise  = createAndTrim nbytes $ \ptr -> recvBuf s ptr nbytes `annotateWithSocket` (s, Nothing)
 
 -- | Receive data from the socket.  The socket need not be in a
 -- connected state.  Returns @(bytes, address)@ where @bytes@ is a
@@ -323,8 +328,10 @@ sendMsg :: Socket       -- ^ Socket
         -> MsgFlag      -- ^ Message flags
         -> IO Int       -- ^ The length actually sent
 sendMsg _ _    []  _ _ = return 0
-sendMsg s addr bss cmsgs flags = withBufSizs bss $ \bufsizs ->
-    sendBufMsg s addr bufsizs cmsgs flags
+sendMsg s addr bss cmsgs flags = sendMsg' `annotateWithSocket` (s, Just addr)
+  where
+    sendMsg' = withBufSizs bss $ \bufsizs ->
+      sendBufMsg s addr bufsizs cmsgs flags
 
 -- | Receive data from the socket using recvmsg(2).
 recvMsg :: Socket  -- ^ Socket
@@ -336,10 +343,12 @@ recvMsg :: Socket  -- ^ Socket
                    --   'MSG_CTRUNC' is returned
         -> MsgFlag -- ^ Message flags
         -> IO (SockAddr, ByteString, [Cmsg], MsgFlag) -- ^ Source address, received data, control messages and message flags
-recvMsg s siz clen flags = do
-    bs@(PS fptr _ _) <- create siz $ \ptr -> zeroMemory ptr (fromIntegral siz)
-    withForeignPtr fptr $ \ptr -> do
-        (addr,len,cmsgs,flags') <- recvBufMsg s [(ptr,siz)] clen flags
-        let bs' | len < siz = PS fptr 0 len
-                | otherwise = bs
-        return (addr, bs', cmsgs, flags')
+recvMsg s siz clen flags = recvMsg' `annotateWithSocket` (s, Nothing)
+  where
+    recvMsg' = do
+        bs@(PS fptr _ _) <- create siz $ \ptr -> zeroMemory ptr (fromIntegral siz)
+        withForeignPtr fptr $ \ptr -> do
+            (addr,len,cmsgs,flags') <- recvBufMsg s [(ptr,siz)] clen flags
+            let bs' | len < siz = PS fptr 0 len
+                    | otherwise = bs
+            return (addr, bs', cmsgs, flags')
diff --git a/Network/Socket/Internal.hs b/Network/Socket/Internal.hs
index 138bed70..7dc3c94b 100644
--- a/Network/Socket/Internal.hs
+++ b/Network/Socket/Internal.hs
@@ -37,6 +37,7 @@ module Network.Socket.Internal
 #if defined(mingw32_HOST_OS)
     , throwSocketErrorIfMinus1ButRetry
 #endif
+    , annotateIOException
     -- ** Guards that wait and retry if the operation would block
     -- | These guards are based on 'throwSocketErrorIfMinus1RetryMayBlock'.
     -- They wait for socket readiness if the action fails with @EWOULDBLOCK@
@@ -78,6 +79,65 @@ import Network.Socket.Cbits
 import Network.Socket.Imports
 import Network.Socket.Types
 
+import qualified Foreign.C.Error as C
+import GHC.IO.Exception (IOException (..))
+import System.IO.Error (modifyIOError)
+
+annotateIOException :: IO a -> String -> IO a
+annotateIOException io anno = modifyIOError f io
+  where
+    f ioe = ioe { ioe_description = ioe_description ioe ++ " " ++ errname ++ anno }
+      where
+         errname = case ioe_errno ioe of
+           Nothing -> ""
+           Just n -> "[" ++ showErrno n ++ "] "
+
+showErrno :: CInt -> String
+showErrno n = case lookup (C.Errno n) errnoNames of
+  Nothing -> show n
+  Just name -> name
+
+errnoNames :: [(C.Errno, String)]
+errnoNames = [
+    (C.eACCES,          "EACCES")
+  , (C.eADDRINUSE,      "EADDRINUSE")
+  , (C.eADDRNOTAVAIL,   "EADDRNOTAVAIL")
+  , (C.eAFNOSUPPORT,    "EAFNOSUPPORT")
+  , (C.eAGAIN,          "EAGAIN")
+  , (C.eBADF,           "EBADF")
+  , (C.eCONNABORTED,    "ECONNABORTED")
+  , (C.eCONNRESET,      "ECONNRESET")
+  , (C.eDESTADDRREQ,    "EDESTADDRREQ")
+  , (C.eEXIST,          "EEXIST")
+  , (C.eFAULT,          "EFAULT")
+  , (C.eINTR,           "EINTR")
+  , (C.eINVAL,          "EINVAL")
+  , (C.eIO,             "EIO")
+  , (C.eISCONN,         "EISCONN")
+  , (C.eISDIR,          "EISDIR")
+  , (C.eLOOP,           "ELOOP")
+  , (C.eMFILE,          "EMFILE")
+  , (C.eMSGSIZE,        "EMSGSIZE")
+  , (C.eNAMETOOLONG,    "ENAMETOOLONG")
+  , (C.eNETDOWN,        "ENETDOWN")
+  , (C.eNETUNREACH,     "ENETUNREACH")
+  , (C.eMFILE,          "EMFILE")
+  , (C.eNFILE,          "ENFILE")
+  , (C.eNOBUFS,         "ENOBUFS")
+  , (C.eNOENT,          "ENOENT")
+  , (C.eNOMEM,          "ENOMEM")
+  , (C.eNOTCONN,        "ENOTCONN")
+  , (C.eNOTDIR,         "ENOTDIR")
+  , (C.eNOTSOCK,        "ENOTSOCK")
+  , (C.eOPNOTSUPP,      "EOPNOTSUPP")
+  , (C.ePIPE,           "EPIPE")
+  , (C.ePROTONOSUPPORT, "EPROTONOSUPPORT")
+  , (C.ePROTOTYPE,      "EPROTOTYPE")
+  , (C.eROFS,           "EROFS")
+  , (C.eTIMEDOUT,       "ETIMEDOUT")
+  , (C.eWOULDBLOCK,     "EWOULDBLOCK")
+  ]
+
 -- ---------------------------------------------------------------------
 -- Guards for socket operations that may fail
 
diff --git a/Network/Socket/Shutdown.hs b/Network/Socket/Shutdown.hs
index 0479e319..88762ec3 100644
--- a/Network/Socket/Shutdown.hs
+++ b/Network/Socket/Shutdown.hs
@@ -40,9 +40,12 @@ sdownCmdToInt ShutdownBoth    = 2
 -- 'ShutdownSend', further sends are disallowed.  If it is
 -- 'ShutdownBoth', further sends and receives are disallowed.
 shutdown :: Socket -> ShutdownCmd -> IO ()
-shutdown s stype = void $ withFdSocket s $ \fd ->
-  throwSocketErrorIfMinus1Retry_ "Network.Socket.shutdown" $
-    c_shutdown fd $ sdownCmdToInt stype
+shutdown s stype = shutdown' `annotateIOException` show s
+  where
+    shutdown' =
+      void $ withFdSocket s $ \fd ->
+        throwSocketErrorIfMinus1Retry_ "Network.Socket.shutdown" $
+          c_shutdown fd $ sdownCmdToInt stype
 
 foreign import CALLCONV unsafe "shutdown"
   c_shutdown :: CInt -> CInt -> IO CInt
@@ -54,7 +57,7 @@ foreign import CALLCONV unsafe "shutdown"
 --
 --   Since: 3.1.1.0
 gracefulClose :: Socket -> Int -> IO ()
-gracefulClose s tmout0 = sendRecvFIN `E.finally` close s
+gracefulClose s tmout0 = (sendRecvFIN `E.finally` close s) `annotateIOException` show s
   where
     sendRecvFIN = do
         -- Sending TCP FIN.
diff --git a/Network/Socket/SockAddr.hs b/Network/Socket/SockAddr.hs
index 2ea0d24f..f47ab69f 100644
--- a/Network/Socket/SockAddr.hs
+++ b/Network/Socket/SockAddr.hs
@@ -10,6 +10,7 @@ module Network.Socket.SockAddr (
     recvBufFrom,
     sendBufMsg,
     recvBufMsg,
+    annotateWithSocket,
 ) where
 
 import Control.Exception (IOException, throwIO, try)
@@ -19,6 +20,7 @@ import System.IO.Error (isAlreadyInUseError, isDoesNotExistError)
 import qualified Network.Socket.Buffer as G
 import Network.Socket.Flag
 import Network.Socket.Imports
+import Network.Socket.Internal
 import qualified Network.Socket.Name as G
 import qualified Network.Socket.Syscall as G
 #if !defined(mingw32_HOST_OS)
@@ -30,15 +32,21 @@ import Network.Socket.Types
 
 -- | Getting peer's 'SockAddr'.
 getPeerName :: Socket -> IO SockAddr
-getPeerName = G.getPeerName
+-- annotateWithSocket calls getPeerName.
+-- So, use annotateIOException directly instead of annotateWithSocket.
+getPeerName s = G.getPeerName s `annotateIOException` show s
 
 -- | Getting my 'SockAddr'.
 getSocketName :: Socket -> IO SockAddr
-getSocketName = G.getSocketName
+getSocketName s = G.getSocketName s `annotateIOException` show s
 
 -- | Connect to a remote socket at address.
 connect :: Socket -> SockAddr -> IO ()
-connect = G.connect
+connect s sa = connect' `annotateWithSocket` (s, Just sa)
+  where
+    connect' = do
+        G.connect s sa
+        labelSocket s (\label -> label ++ " " ++ show sa)
 
 -- | Bind the socket to an address. The socket must not already be
 -- bound.  The 'Family' passed to @bind@ must be the
@@ -46,7 +54,10 @@ connect = G.connect
 -- 'defaultPort' is passed then the system assigns the next available
 -- use port.
 bind :: Socket -> SockAddr -> IO ()
-bind s sa = case sa of
+bind s sa = bind' s sa `annotateWithSocket` (s, Just sa)
+
+bind' :: Socket -> SockAddr -> IO ()
+bind' s sa = case sa of
     SockAddrUnix p -> do
         -- gracefully handle the fact that UNIX systems don't clean up closed UNIX
         -- domain sockets, inspired by https://stackoverflow.com/a/13719866
@@ -64,7 +75,9 @@ bind s sa = case sa of
                         -- socket not actually in use, remove it and retry bind
                         void (try $ removeFile p :: IO (Either IOError ()))
                         G.bind s sa
-    _ -> G.bind s sa
+    _ -> do
+        G.bind s sa
+        labelSocket s (\label -> label ++ " " ++ show sa)
 
 -- | Accept a connection.  The socket must be bound to an address and
 -- listening for connections.  The return value is a pair @(conn,
@@ -73,14 +86,20 @@ bind s sa = case sa of
 -- to the socket on the other end of the connection.
 -- On Unix, FD_CLOEXEC is set to the new 'Socket'.
 accept :: Socket -> IO (Socket, SockAddr)
-accept = G.accept
+accept s = accept' `annotateWithSocket` (s, Nothing)
+  where
+    accept' = do
+        r@(news, sa) <- G.accept s
+        label <- socketLabel s
+        labelSocket news (\_ -> label ++ " " ++ show sa)
+        return r
 
 -- | Send data to the socket.  The recipient can be specified
 -- explicitly, so the socket need not be in a connected state.
 -- Returns the number of bytes sent.  Applications are responsible for
 -- ensuring that all data has been sent.
 sendBufTo :: Socket -> Ptr a -> Int -> SockAddr -> IO Int
-sendBufTo = G.sendBufTo
+sendBufTo s ptr len sa = G.sendBufTo s ptr len sa `annotateWithSocket` (s, Just sa)
 
 -- | Receive data from the socket, writing it into buffer instead of
 -- creating a new string.  The socket need not be in a connected
@@ -95,7 +114,7 @@ sendBufTo = G.sendBufTo
 -- NOTE: blocking on Windows unless you compile with -threaded (see
 -- GHC ticket #1129)
 recvBufFrom :: Socket -> Ptr a -> Int -> IO (Int, SockAddr)
-recvBufFrom = G.recvBufFrom
+recvBufFrom s ptr len = G.recvBufFrom s ptr len `annotateWithSocket` (s, Nothing)
 
 -- | Send data to the socket using sendmsg(2).
 sendBufMsg
@@ -111,7 +130,8 @@ sendBufMsg
     -- ^ Message flags
     -> IO Int
     -- ^ The length actually sent
-sendBufMsg = G.sendBufMsg
+sendBufMsg s sa dats cmgs flag =
+    G.sendBufMsg s sa dats cmgs flag `annotateWithSocket` (s, Just sa)
 
 -- | Receive data from the socket using recvmsg(2).
 recvBufMsg
@@ -129,4 +149,14 @@ recvBufMsg
     -- ^ Message flags
     -> IO (SockAddr, Int, [Cmsg], MsgFlag)
     -- ^ Source address, received data, control messages and message flags
-recvBufMsg = G.recvBufMsg
+recvBufMsg s bufs len flag = G.recvBufMsg s bufs len flag `annotateWithSocket` (s, Nothing)
+
+------------------------------------------------------------------------
+
+annotateWithSocket :: IO a -> (Socket, Maybe SockAddr) -> IO a
+annotateWithSocket io (s, mpeersa) = do
+    label <- socketLabel s
+    let label' = case mpeersa of
+            Nothing -> "<" ++ label ++ ">"
+            Just peersa -> "<" ++ label ++ "> " ++ show peersa
+    annotateIOException io label'
diff --git a/Network/Socket/Syscall.hs b/Network/Socket/Syscall.hs
index c7494b49..8b1fb8af 100644
--- a/Network/Socket/Syscall.hs
+++ b/Network/Socket/Syscall.hs
@@ -75,22 +75,23 @@ socket :: Family         -- Family Name (usually AF_INET)
        -> SocketType     -- Socket Type (usually Stream)
        -> ProtocolNumber -- Protocol Number (getProtocolByName to find value)
        -> IO Socket      -- Unconnected Socket
-socket family stype protocol = E.bracketOnError create c_close $ \fd -> do
-    -- Let's ensure that the socket (file descriptor) is closed even on
-    -- asynchronous exceptions.
-    setNonBlock fd
-    s <- mkSocket fd
-    -- This socket is not managed by the IO manager yet.
-    -- So, we don't have to call "close" which uses "closeFdWith".
-    unsetIPv6Only s
-    setDontFragment s
-    return s
+socket family stype protocol =
+    E.bracketOnError create c_close setProp `annotateIOException` (show stype ++ " " ++ show protocol)
   where
+    setProp fd = do
+        -- Let's ensure that the socket (file descriptor) is closed even on
+        -- asynchronous exceptions.
+        setNonBlock fd
+        s <- mkSocket fd
+        -- This socket is not managed by the IO manager yet.
+        -- So, we don't have to call "close" which uses "closeFdWith".
+        unsetIPv6Only s
+        setDontFragment s
+        return s
     create = do
         let c_stype = modifyFlag $ packSocketType stype
         throwSocketErrorIfMinus1Retry "Network.Socket.socket" $
             c_socket (packFamily family) c_stype protocol
-
 #ifdef HAVE_ADVANCED_SOCKET_FLAGS
     modifyFlag c_stype = c_stype .|. sockNonBlock
 #else
@@ -141,7 +142,7 @@ socket family stype protocol = E.bracketOnError create c_close $ \fd -> do
 bind :: SocketAddress sa => Socket -> sa -> IO ()
 bind s sa = withSocketAddress sa $ \p_sa siz -> void $ withFdSocket s $ \fd -> do
   let sz = fromIntegral siz
-  throwSocketErrorIfMinus1Retry "Network.Socket.bind" $ c_bind fd p_sa sz
+  throwSocketErrorIfMinus1Retry "Network.Socket.bind" (c_bind fd p_sa sz)
 
 -----------------------------------------------------------------------------
 -- Connecting a socket
@@ -181,9 +182,11 @@ connectLoop s p_sa sz = withFdSocket s $ \fd -> loop fd
 -- specifies the maximum number of queued connections and should be at
 -- least 1; the maximum value is system-dependent (usually 5).
 listen :: Socket -> Int -> IO ()
-listen s backlog = withFdSocket s $ \fd -> do
-    throwSocketErrorIfMinus1Retry_ "Network.Socket.listen" $
-        c_listen fd $ fromIntegral backlog
+listen s backlog = withFdSocket s listen' `annotateIOException` show s
+  where
+    listen' fd =
+        throwSocketErrorIfMinus1Retry_ "Network.Socket.listen" $
+            c_listen fd $ fromIntegral backlog
 
 -----------------------------------------------------------------------------
 -- Accept
diff --git a/Network/Socket/Types.hsc b/Network/Socket/Types.hsc
index 850a0644..7a4c4eb5 100644
--- a/Network/Socket/Types.hsc
+++ b/Network/Socket/Types.hsc
@@ -21,6 +21,8 @@ module Network.Socket.Types (
     , fdSocket
     , mkSocket
     , invalidateSocket
+    , labelSocket
+    , socketLabel
     , close
     , close'
     , c_close
@@ -84,7 +86,7 @@ module Network.Socket.Types (
     , In6Addr(..)
     ) where
 
-import Data.IORef (IORef, newIORef, readIORef, atomicModifyIORef', mkWeakIORef)
+import Data.IORef (IORef, newIORef, readIORef, atomicModifyIORef', mkWeakIORef, modifyIORef')
 import Foreign.C.Error (throwErrno)
 import Foreign.Marshal.Alloc
 import GHC.Conc (closeFdWith)
@@ -108,13 +110,16 @@ import Network.Socket.ReadShow
 -----------------------------------------------------------------------------
 
 -- | Basic type for a socket.
-data Socket = Socket (IORef CInt) CInt {- for Show -}
+data Socket = Socket
+    (IORef CInt)
+    CInt {- for Show -}
+    (IORef String) {- for IOException annotation -}
 
 instance Show Socket where
-    show (Socket _ ofd) = "<socket: " ++ show ofd ++ ">"
+    show (Socket _ ofd _) = "<socket: " ++ show ofd ++ ">"
 
 instance Eq Socket where
-    Socket ref1 _ == Socket ref2 _ = ref1 == ref2
+    Socket ref1 _ _ == Socket ref2 _ _ = ref1 == ref2
 
 {-# DEPRECATED fdSocket "Use withFdSocket or unsafeFdSocket instead" #-}
 -- | Currently, this is an alias of `unsafeFdSocket`.
@@ -144,7 +149,7 @@ fdSocket = unsafeFdSocket
 --
 --   A safer option is to use 'withFdSocket' instead.
 unsafeFdSocket :: Socket -> IO CInt
-unsafeFdSocket (Socket ref _) = readIORef ref
+unsafeFdSocket (Socket ref _ _) = readIORef ref
 
 -- | Ensure that the given 'Socket' stays alive (i.e. not garbage-collected)
 --   at the given place in the sequence of IO actions. This function can be
@@ -155,7 +160,7 @@ unsafeFdSocket (Socket ref _) = readIORef ref
 -- > -- using fd with blocking operations such as accept(2)
 -- > touchSocket sock
 touchSocket :: Socket -> IO ()
-touchSocket (Socket ref _) = touch ref
+touchSocket (Socket ref _ _) = touch ref
 
 touch :: IORef a -> IO ()
 touch (IORef (STRef mutVar)) =
@@ -176,7 +181,7 @@ touch (IORef (STRef mutVar)) =
 --
 -- Since: 3.1.0.0
 withFdSocket :: Socket -> (CInt -> IO r) -> IO r
-withFdSocket (Socket ref _) f = do
+withFdSocket (Socket ref _ _) f = do
   fd <- readIORef ref
   -- Should we throw an exception if the socket is already invalid?
   -- That will catch some mistakes but certainly not all.
@@ -217,7 +222,8 @@ foreign import ccall unsafe "dup"
 mkSocket :: CInt -> IO Socket
 mkSocket fd = do
     ref <- newIORef fd
-    let s = Socket ref fd
+    anno <- newIORef $ "sock " ++ show fd
+    let s = Socket ref fd anno
     void $ mkWeakIORef ref $ close s
     return s
 
@@ -233,10 +239,20 @@ invalidateSocket ::
    -> (CInt -> IO a)
    -> (CInt -> IO a)
    -> IO a
-invalidateSocket (Socket ref _) errorAction normalAction = do
+invalidateSocket (Socket ref _ _) errorAction normalAction = do
     oldfd <- atomicModifyIORef' ref $ \cur -> (invalidSocket, cur)
     if oldfd == invalidSocket then errorAction oldfd else normalAction oldfd
 
+-- | Labeling a socket. The function in the second argument takes the
+-- old label and returns the new label. The initial value of the label
+-- is "sock \<CInt\>".
+labelSocket :: Socket -> (String -> String) -> IO ()
+labelSocket (Socket _ _ ref) = modifyIORef' ref
+
+-- | Read the label of a socket.
+socketLabel :: Socket -> IO String
+socketLabel (Socket _ _ ref) = readIORef ref
+
 -----------------------------------------------------------------------------
 
 -- | Close the socket. This function does not throw exceptions even if
@@ -269,7 +285,8 @@ close' s = invalidateSocket s (\_ -> return ()) $ \oldfd -> do
     closeFd :: Fd -> IO ()
     closeFd fd = do
         ret <- c_close $ fromIntegral fd
-        when (ret == -1) $ throwErrno "Network.Socket.close'"
+        label <- socketLabel s
+        when (ret == -1) $ throwErrno $ "Network.Socket.close' <" ++ label ++ ">"
 
 #if defined(mingw32_HOST_OS)
 foreign import CALLCONV unsafe "closesocket"