[RFC] Network.Socket: change get/setSocketOption

Bertram Felgenhauer bertram.felgenhauer at googlemail.com
Sun Jun 25 06:34:44 EDT 2006


Hi,

(This mail is related to
  http://permalink.gmane.org/gmane.comp.lang.haskell.libraries/3788 )

What I'm proposing is to make SocketOption a proper ADT and change
get- and setSocketOption to functions that take type constructors
instead of tags as arguments, i.e.

  getSocketOption :: Socket -> (a -> SocketOption) -> IO a
  setSocketOption :: Socket -> (a -> SocketOption) -> a -> IO ()

To make that work, the two functions are implemented in a type class.

I'll attach a patch bundle (in darcs send -o format) of two patches:
1) implement the infrastructure for this change. it is mostly backward
   compatible: As long as code doesn't explicitely mention the SocketOption
   type, it should work without modifications.
2) give the options more sensible types. -- this breaks existing code.
   For example,
      setSocketOption sock ReuseAddr 1
   becomes
      setSocketOption sock ReuseAddr True
   (the patch includes the necessary fixes for the network package)

What's missing is a solution for the problem that prompted this change,
namely setting  struct time_val  values.  To do that, I'd need some
Storable type that maps to struct time_val.  I think Network.* is not
the proper place to implement that.  Where should it go?

- Foreign.C.Types - not generally useful enough, I think.
- System.Time     - not portable enough?
- System.Posix.*  - seems to be the right place to me.

related stuff:
  http://cryp.to/hsdns/System/Posix/GetTimeOfDay.hsc
     -- quite close to what I'd like to have; conversions to, say,
        System.Time.ClockTime  would be useful though.
  http://www.haskell.org/~simonmar/time/NewTime.hsc
     -- looks like a new System.Time to me; the CTimeVal handling
        seems to be identical to System.Time though

Comments, questions and suggestions are welcome.

Bertram

P.S. thanks to heatsink on #haskell for the suggestion of passing
  constructors to the functions.  That simplified the code a lot at
  a small loss of safety, and made the interface more similar to the
  old one.
-------------- next part --------------

New patches:

[change getSocketOption and setSocketOption to allow multiple types
Bertram Felgenhauer <int-e at gmx.de>**20060625064441
 Network/Socket.hsc:
     change SocketOption to a proper ADT and put getSocketOption and
     setSocketOption into a type class.
] {
hunk ./Network/Socket.hsc 832
-    | Debug         {- SO_DEBUG     -}
+    | Debug         Int {- SO_DEBUG     -}
hunk ./Network/Socket.hsc 835
-    | ReuseAddr     {- SO_REUSEADDR -}
+    | ReuseAddr     Int {- SO_REUSEADDR -}
hunk ./Network/Socket.hsc 838
-    | Type          {- SO_TYPE      -}
+    | Type          Int {- SO_TYPE      -}
hunk ./Network/Socket.hsc 841
-    | SoError       {- SO_ERROR     -}
+    | SoError       Int {- SO_ERROR     -}
hunk ./Network/Socket.hsc 844
-    | DontRoute     {- SO_DONTROUTE -}
+    | DontRoute     Int {- SO_DONTROUTE -}
hunk ./Network/Socket.hsc 847
-    | Broadcast     {- SO_BROADCAST -}
+    | Broadcast     Int {- SO_BROADCAST -}
hunk ./Network/Socket.hsc 850
-    | SendBuffer    {- SO_SNDBUF    -}
+    | SendBuffer    Int {- SO_SNDBUF    -}
hunk ./Network/Socket.hsc 853
-    | RecvBuffer    {- SO_RCVBUF    -}
+    | RecvBuffer    Int {- SO_RCVBUF    -}
hunk ./Network/Socket.hsc 856
-    | KeepAlive     {- SO_KEEPALIVE -}
+    | KeepAlive     Int {- SO_KEEPALIVE -}
hunk ./Network/Socket.hsc 859
-    | OOBInline     {- SO_OOBINLINE -}
+    | OOBInline     Int {- SO_OOBINLINE -}
hunk ./Network/Socket.hsc 862
-    | TimeToLive    {- IP_TTL       -}
+    | TimeToLive    Int {- IP_TTL       -}
hunk ./Network/Socket.hsc 865
-    | MaxSegment    {- TCP_MAXSEG   -}
+    | MaxSegment    Int {- TCP_MAXSEG   -}
hunk ./Network/Socket.hsc 868
-    | NoDelay       {- TCP_NODELAY  -}
+    | NoDelay       Int {- TCP_NODELAY  -}
hunk ./Network/Socket.hsc 871
-    | Linger        {- SO_LINGER    -}
+    | Linger        Int {- SO_LINGER    -}
hunk ./Network/Socket.hsc 874
-    | ReusePort     {- SO_REUSEPORT -}
+    | ReusePort     Int {- SO_REUSEPORT -}
hunk ./Network/Socket.hsc 877
-    | RecvLowWater  {- SO_RCVLOWAT  -}
+    | RecvLowWater  Int {- SO_RCVLOWAT  -}
hunk ./Network/Socket.hsc 880
-    | SendLowWater  {- SO_SNDLOWAT  -}
+    | SendLowWater  Int {- SO_SNDLOWAT  -}
hunk ./Network/Socket.hsc 883
-    | RecvTimeOut   {- SO_RCVTIMEO  -}
+    | RecvTimeOut   Int {- SO_RCVTIMEO  -}
hunk ./Network/Socket.hsc 886
-    | SendTimeOut   {- SO_SNDTIMEO  -}
+    | SendTimeOut   Int {- SO_SNDTIMEO  -}
hunk ./Network/Socket.hsc 889
-    | UseLoopBack   {- SO_USELOOPBACK -}
+    | UseLoopBack   Int {- SO_USELOOPBACK -}
hunk ./Network/Socket.hsc 894
-socketOptLevel :: SocketOption -> CInt
+socketOptLevel :: (a -> SocketOption) -> CInt
hunk ./Network/Socket.hsc 896
-  case so of
+  case (so undefined) of
hunk ./Network/Socket.hsc 898
-    TimeToLive   -> #const IPPROTO_IP
+    TimeToLive   _ -> #const IPPROTO_IP
hunk ./Network/Socket.hsc 901
-    MaxSegment   -> #const IPPROTO_TCP
+    MaxSegment   _ -> #const IPPROTO_TCP
hunk ./Network/Socket.hsc 904
-    NoDelay      -> #const IPPROTO_TCP
+    NoDelay      _ -> #const IPPROTO_TCP
hunk ./Network/Socket.hsc 906
-    _            -> #const SOL_SOCKET
+    _              -> #const SOL_SOCKET
hunk ./Network/Socket.hsc 908
-packSocketOption :: SocketOption -> CInt
+packSocketOption :: (a -> SocketOption) -> CInt
hunk ./Network/Socket.hsc 910
-  case so of
+  case (so undefined) of
hunk ./Network/Socket.hsc 912
-    Debug         -> #const SO_DEBUG
+    Debug         _ -> #const SO_DEBUG
hunk ./Network/Socket.hsc 915
-    ReuseAddr     -> #const SO_REUSEADDR
+    ReuseAddr     _ -> #const SO_REUSEADDR
hunk ./Network/Socket.hsc 918
-    Type          -> #const SO_TYPE
+    Type          _ -> #const SO_TYPE
hunk ./Network/Socket.hsc 921
-    SoError       -> #const SO_ERROR
+    SoError       _ -> #const SO_ERROR
hunk ./Network/Socket.hsc 924
-    DontRoute     -> #const SO_DONTROUTE
+    DontRoute     _ -> #const SO_DONTROUTE
hunk ./Network/Socket.hsc 927
-    Broadcast     -> #const SO_BROADCAST
+    Broadcast     _ -> #const SO_BROADCAST
hunk ./Network/Socket.hsc 930
-    SendBuffer    -> #const SO_SNDBUF
+    SendBuffer    _ -> #const SO_SNDBUF
hunk ./Network/Socket.hsc 933
-    RecvBuffer    -> #const SO_RCVBUF
+    RecvBuffer    _ -> #const SO_RCVBUF
hunk ./Network/Socket.hsc 936
-    KeepAlive     -> #const SO_KEEPALIVE
+    KeepAlive     _ -> #const SO_KEEPALIVE
hunk ./Network/Socket.hsc 939
-    OOBInline     -> #const SO_OOBINLINE
+    OOBInline     _ -> #const SO_OOBINLINE
hunk ./Network/Socket.hsc 942
-    TimeToLive    -> #const IP_TTL
+    TimeToLive    _ -> #const IP_TTL
hunk ./Network/Socket.hsc 945
-    MaxSegment    -> #const TCP_MAXSEG
+    MaxSegment    _ -> #const TCP_MAXSEG
hunk ./Network/Socket.hsc 948
-    NoDelay       -> #const TCP_NODELAY
+    NoDelay       _ -> #const TCP_NODELAY
hunk ./Network/Socket.hsc 951
-    Linger	  -> #const SO_LINGER
+    Linger	  _ -> #const SO_LINGER
hunk ./Network/Socket.hsc 954
-    ReusePort     -> #const SO_REUSEPORT
+    ReusePort     _ -> #const SO_REUSEPORT
hunk ./Network/Socket.hsc 957
-    RecvLowWater  -> #const SO_RCVLOWAT
+    RecvLowWater  _ -> #const SO_RCVLOWAT
hunk ./Network/Socket.hsc 960
-    SendLowWater  -> #const SO_SNDLOWAT
+    SendLowWater  _ -> #const SO_SNDLOWAT
hunk ./Network/Socket.hsc 963
-    RecvTimeOut   -> #const SO_RCVTIMEO
+    RecvTimeOut   _ -> #const SO_RCVTIMEO
hunk ./Network/Socket.hsc 966
-    SendTimeOut   -> #const SO_SNDTIMEO
+    SendTimeOut   _ -> #const SO_SNDTIMEO
hunk ./Network/Socket.hsc 969
-    UseLoopBack   -> #const SO_USELOOPBACK
+    UseLoopBack   _ -> #const SO_USELOOPBACK
hunk ./Network/Socket.hsc 972
-setSocketOption :: Socket 
-		-> SocketOption -- Option Name
-		-> Int		-- Option Value
-		-> IO ()
-setSocketOption (MkSocket s _ _ _ _) so v = do
-   with (fromIntegral v) $ \ptr_v -> do
-   throwErrnoIfMinus1_ "setSocketOption" $
-       c_setsockopt s (socketOptLevel so) (packSocketOption so) ptr_v 
-	  (fromIntegral (sizeOf v))
-   return ()
+-- internal
+setSocketOption' :: Storable a => Socket
+		 -> (b -> SocketOption) -> a -> IO ()
+setSocketOption' (MkSocket s _ _ _ _) so v = do
+  with v $ \ptr_v -> do
+  throwErrnoIfMinus1_ "setSocketOption" $
+    c_setsockopt s (socketOptLevel so) (packSocketOption so) ptr_v
+      (fromIntegral (sizeOf v))
+  return ()
hunk ./Network/Socket.hsc 982
+getSocketOption' :: Storable a => Socket
+		 -> (b -> SocketOption) -> IO a
+getSocketOption' (MkSocket s _ _ _ _) so = do
+  let ptrT :: Ptr a -> a
+      ptrT _ = undefined
+  alloca $ \ptr_v ->
+    with (fromIntegral (sizeOf (ptrT ptr_v))) $ \ptr_sz -> do
+      throwErrnoIfMinus1 "getSocketOption" $
+        c_getsockopt s (socketOptLevel so) (packSocketOption so) ptr_v ptr_sz
+      peek ptr_v
hunk ./Network/Socket.hsc 993
-getSocketOption :: Socket
-		-> SocketOption  -- Option Name
-		-> IO Int	 -- Option Value
-getSocketOption (MkSocket s _ _ _ _) so = do
-   alloca $ \ptr_v ->
-     with (fromIntegral (sizeOf (undefined :: CInt))) $ \ptr_sz -> do
-       throwErrnoIfMinus1 "getSocketOption" $
-	 c_getsockopt s (socketOptLevel so) (packSocketOption so) ptr_v ptr_sz
-       fromIntegral `liftM` peek ptr_v
+-- public interface
+class QuerySocketOption a where
+  setSocketOption :: Socket
+		  -> (a -> SocketOption)	-- Option Name (Constructor)
+		  -> a				-- Option Value
+		  -> IO ()
+  getSocketOption :: Socket
+		  -> (a -> SocketOption)	-- Option Name (Constructor)
+		  -> IO a			-- Option Value
hunk ./Network/Socket.hsc 1003
+instance QuerySocketOption Int where
+  setSocketOption s so =
+    setSocketOption' s so . (fromIntegral :: Int -> CInt)
+  getSocketOption s so =
+    (fromIntegral :: CInt -> Int) `liftM` getSocketOption' s so
hunk ./Network/Socket.hsc 2018
-  c_getsockopt :: CInt -> CInt -> CInt -> Ptr CInt -> Ptr CInt -> IO CInt
+  c_getsockopt :: CInt -> CInt -> CInt -> Ptr a -> Ptr CInt -> IO CInt
hunk ./Network/Socket.hsc 2020
-  c_setsockopt :: CInt -> CInt -> CInt -> Ptr CInt -> CInt -> IO CInt
+  c_setsockopt :: CInt -> CInt -> CInt -> Ptr a -> CInt -> IO CInt
}

[give the individual socket options more sensible types
Bertram Felgenhauer <int-e at gmx.de>**20060625073221] {
hunk ./Network/Socket.hsc 174
-import Foreign.Marshal.Utils ( with )
+import Foreign.Marshal.Utils ( with, fromBool, toBool )
hunk ./Network/Socket.hsc 832
-    | Debug         Int {- SO_DEBUG     -}
+    | Debug         Bool {- SO_DEBUG     -}
hunk ./Network/Socket.hsc 835
-    | ReuseAddr     Int {- SO_REUSEADDR -}
+    | ReuseAddr     Bool {- SO_REUSEADDR -}
hunk ./Network/Socket.hsc 838
-    | Type          Int {- SO_TYPE      -}
+    | Type          SocketType {- SO_TYPE      -}
hunk ./Network/Socket.hsc 844
-    | DontRoute     Int {- SO_DONTROUTE -}
+    | DontRoute     Bool {- SO_DONTROUTE -}
hunk ./Network/Socket.hsc 847
-    | Broadcast     Int {- SO_BROADCAST -}
+    | Broadcast     Bool {- SO_BROADCAST -}
hunk ./Network/Socket.hsc 856
-    | KeepAlive     Int {- SO_KEEPALIVE -}
+    | KeepAlive     Bool {- SO_KEEPALIVE -}
hunk ./Network/Socket.hsc 859
-    | OOBInline     Int {- SO_OOBINLINE -}
+    | OOBInline     Bool {- SO_OOBINLINE -}
hunk ./Network/Socket.hsc 868
-    | NoDelay       Int {- TCP_NODELAY  -}
+    | NoDelay       Bool {- TCP_NODELAY  -}
hunk ./Network/Socket.hsc 871
-    | Linger        Int {- SO_LINGER    -}
+    | Linger        Bool {- SO_LINGER    -}
hunk ./Network/Socket.hsc 874
-    | ReusePort     Int {- SO_REUSEPORT -}
+    | ReusePort     Bool {- SO_REUSEPORT -}
hunk ./Network/Socket.hsc 883
-    | RecvTimeOut   Int {- SO_RCVTIMEO  -}
+    | RecvTimeOut   () {- SO_RCVTIMEO  -}
hunk ./Network/Socket.hsc 886
-    | SendTimeOut   Int {- SO_SNDTIMEO  -}
+    | SendTimeOut   () {- SO_SNDTIMEO  -}
hunk ./Network/Socket.hsc 889
-    | UseLoopBack   Int {- SO_USELOOPBACK -}
+    | UseLoopBack   Bool {- SO_USELOOPBACK -}
hunk ./Network/Socket.hsc 1009
+instance QuerySocketOption Bool where
+  setSocketOption s so =
+    setSocketOption' s so . (fromBool :: Bool -> CInt)
+  getSocketOption s so =
+    (toBool :: CInt -> Bool) `liftM` getSocketOption' s so
+
+instance QuerySocketOption SocketType where
+  setSocketOption s so =
+    setSocketOption' s so . packSocketType
+  getSocketOption s so =
+    unpackSocketType `liftM` getSocketOption' s so
+
+
hunk ./Network/Socket.hsc 1158
-unpackFamily	:: CInt -> Family
-packFamily	:: Family -> CInt
+unpackFamily	 :: CInt -> Family
+packFamily	 :: Family -> CInt
hunk ./Network/Socket.hsc 1161
-packSocketType	:: SocketType -> CInt
+unpackSocketType :: CInt -> SocketType
+packSocketType	 :: SocketType -> CInt
hunk ./Network/Socket.hsc 1759
+
+unpackSocketType stype = case stype of
+	0 -> NoSocketType
+#ifdef SOCK_STREAM
+	(#const SOCK_STREAM) -> Stream
+#endif
+#ifdef SOCK_DGRAM
+	(#const SOCK_DGRAM) -> Datagram
+#endif
+#ifdef SOCK_RAW
+	(#const SOCK_RAW) -> Raw
+#endif
+#ifdef SOCK_RDM
+	(#const SOCK_RDM) -> RDM
+#endif
+#ifdef SOCK_SEQPACKET
+	(#const SOCK_SEQPACKET) -> SeqPacket
+#endif
hunk ./Network.hs 141
-	    setSocketOption sock ReuseAddr 1
+	    setSocketOption sock ReuseAddr True
hunk ./Network.hs 153
-	    setSocketOption sock ReuseAddr 1
+	    setSocketOption sock ReuseAddr True
hunk ./Network.hs 165
-	    setSocketOption sock ReuseAddr 1
+	    setSocketOption sock ReuseAddr True
}

Context:

[initWinSock(): have defn match proto
sof at galois.com**20060613224903] 
[only GHC has rtsSupportsBoundThreads
Ross Paterson <ross at soi.city.ac.uk>**20060531200123] 
[add files used by configure
Ross Paterson <ross at soi.city.ac.uk>**20060518174356] 
[Import unsafePerformIO
Sven Panne <sven.panne at aedion.de>**20060507171832] 
[Import MVar type
Sven Panne <sven.panne at aedion.de>**20060507170308] 
[Add various address families
Simon Marlow <simonmar at microsoft.com>**20060503081915] 
[Fix for #265, build problem on AIX
Simon Marlow <simonmar at microsoft.com>**20060316143337
 Not the fix from the ticket, but this one at least doesn't require
 modifying the configure script.
] 
[workaround for non-thread-safety of some functions in Network.BSD
Simon Marlow <simonmar at microsoft.com>**20060126153014
 Various functions in Network.BSD are non-thread-safe,
 eg. getHostByName, because the underlying gethostbyname() provided by
 the C library uses static storage.  The workaround here is to use a
 giant lock around these functions.
 
 In some cases, even the API we provide is itself unsafe, relying on
 implicit state (eg. getHostEntry), but this commit makes no attempt to
 fix that.  We should deprecate this library in favour of a complete
 replacement at some point (before 6.6 would be nice).
 
 Thanks to Einar Kartunnen for the patch.
] 
[Fix Ticket 647, Socket bug on Mac OS X
wolfgang.thaller at gmx.net**20060121050509
 Patch kindly provided by Greg Wright
] 
[TAG Initial conversion from CVS complete
John Goerzen <jgoerzen at complete.org>**20060112154134] 
Patch bundle hash:
405bfc379a46d3ea5bafcb42aba517edf752c665


More information about the Libraries mailing list