Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Socket type and family as CInt patterns #459

Merged
merged 2 commits into from
May 25, 2020
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
21 changes: 16 additions & 5 deletions Network/Socket.hs
Original file line number Diff line number Diff line change
Expand Up @@ -134,9 +134,9 @@ module Network.Socket

-- * Socket options
, SocketOption(SockOpt
,Debug,ReuseAddr,Type,SoError,DontRoute,Broadcast
,SendBuffer,RecvBuffer,KeepAlive,OOBInline,TimeToLive
,MaxSegment,NoDelay,Cork,Linger,ReusePort
,Debug,ReuseAddr,SoDomain,Type,SoProtocol,SoError,DontRoute
,Broadcast,SendBuffer,RecvBuffer,KeepAlive,OOBInline
,TimeToLive,MaxSegment,NoDelay,Cork,Linger,ReusePort
,RecvLowWater,SendLowWater,RecvTimeOut,SendTimeOut
,UseLoopBack,UserTimeout,IPv6Only
,RecvIPv4TTL,RecvIPv4TOS,RecvIPv4PktInfo
Expand All @@ -160,11 +160,22 @@ module Network.Socket
, mkSocket
, socketToHandle
-- ** Types of Socket
, SocketType(..)
, SocketType(GeneralSocketType, UnsupportedSocketType, NoSocketType
, Stream, Datagram, Raw, RDM, SeqPacket)
, isSupportedSocketType
, getSocketType
-- ** Family
, Family(..)
, Family(GeneralFamily, UnsupportedFamily
,AF_UNSPEC,AF_UNIX,AF_INET,AF_INET6,AF_IMPLINK,AF_PUP,AF_CHAOS
,AF_NS,AF_NBS,AF_ECMA,AF_DATAKIT,AF_CCITT,AF_SNA,AF_DECnet
,AF_DLI,AF_LAT,AF_HYLINK,AF_APPLETALK,AF_ROUTE,AF_NETBIOS
,AF_NIT,AF_802,AF_ISO,AF_OSI,AF_NETMAN,AF_X25,AF_AX25,AF_OSINET
,AF_GOSSIP,AF_IPX,Pseudo_AF_XTP,AF_CTF,AF_WAN,AF_SDL,AF_NETWARE
,AF_NDD,AF_INTF,AF_COIP,AF_CNT,Pseudo_AF_RTIP,Pseudo_AF_PIP
,AF_SIP,AF_ISDN,Pseudo_AF_KEY,AF_NATM,AF_ARP,Pseudo_AF_HDRCMPLT
,AF_ENCAP,AF_LINK,AF_RAW,AF_RIF,AF_NETROM,AF_BRIDGE,AF_ATMPVC
,AF_ROSE,AF_NETBEUI,AF_SECURITY,AF_PACKET,AF_ASH,AF_ECONET
,AF_ATMSVC,AF_IRDA,AF_PPPOX,AF_WANPIPE,AF_BLUETOOTH,AF_CAN)
, isSupportedFamily
, packFamily
, unpackFamily
Expand Down
2 changes: 0 additions & 2 deletions Network/Socket/Imports.hs
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,6 @@ module Network.Socket.Imports (
, module Data.Maybe
, module Data.Monoid
, module Data.Ord
, module Data.Typeable
, module Data.Word
, module Foreign.C.String
, module Foreign.C.Types
Expand All @@ -24,7 +23,6 @@ import Data.List
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Typeable
import Data.Word
import Foreign.C.String
import Foreign.C.Types
Expand Down
12 changes: 5 additions & 7 deletions Network/Socket/Info.hsc
Original file line number Diff line number Diff line change
@@ -1,5 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

Expand Down Expand Up @@ -63,7 +62,7 @@ data AddrInfoFlag =
-- addresses are found, IPv6-mapped IPv4 addresses will be
-- returned. (Only some platforms support this.)
| AI_V4MAPPED
deriving (Eq, Read, Show, Typeable)
deriving (Eq, Read, Show)

aiFlagMapping :: [(AddrInfoFlag, CInt)]

Expand Down Expand Up @@ -106,7 +105,7 @@ data AddrInfo = AddrInfo {
, addrProtocol :: ProtocolNumber
, addrAddress :: SockAddr
, addrCanonName :: Maybe String
} deriving (Eq, Show, Typeable)
} deriving (Eq, Show)

instance Storable AddrInfo where
sizeOf _ = #const sizeof(struct addrinfo)
Expand All @@ -124,18 +123,17 @@ instance Storable AddrInfo where
then return Nothing
else Just <$> peekCString ai_canonname_ptr

socktype <- unpackSocketType' "AddrInfo.peek" ai_socktype
return $ AddrInfo {
addrFlags = unpackBits aiFlagMapping ai_flags
, addrFamily = unpackFamily ai_family
, addrSocketType = socktype
, addrSocketType = unpackSocketType ai_socktype
, addrProtocol = ai_protocol
, addrAddress = ai_addr
, addrCanonName = ai_canonname
}

poke p (AddrInfo flags family sockType protocol _ _) = do
c_stype <- packSocketTypeOrThrow "AddrInfo.poke" sockType
let c_stype = packSocketType sockType

(#poke struct addrinfo, ai_flags) p (packBits aiFlagMapping flags)
(#poke struct addrinfo, ai_family) p (packFamily family)
Expand Down Expand Up @@ -171,7 +169,7 @@ data NameInfoFlag =
-- looked up. Instead, a numeric representation of the
-- service is returned.
| NI_NUMERICSERV
deriving (Eq, Read, Show, Typeable)
deriving (Eq, Read, Show)

niFlagMapping :: [(NameInfoFlag, CInt)]

Expand Down
28 changes: 22 additions & 6 deletions Network/Socket/Options.hsc
Original file line number Diff line number Diff line change
@@ -1,5 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
Expand All @@ -9,8 +8,8 @@

module Network.Socket.Options (
SocketOption(SockOpt
,Debug,ReuseAddr,Type,SoError,DontRoute,Broadcast
,SendBuffer,RecvBuffer,KeepAlive,OOBInline,TimeToLive
,Debug,ReuseAddr,SoDomain,Type,SoProtocol,SoError,DontRoute
,Broadcast,SendBuffer,RecvBuffer,KeepAlive,OOBInline,TimeToLive
,MaxSegment,NoDelay,Cork,Linger,ReusePort
,RecvLowWater,SendLowWater,RecvTimeOut,SendTimeOut
,UseLoopBack,UserTimeout,IPv6Only
Expand Down Expand Up @@ -53,8 +52,7 @@ isSupportedSocketOption opt = opt /= SockOpt (-1) (-1)
--
-- Since: 3.0.1.0
getSocketType :: Socket -> IO SocketType
getSocketType s = (fromMaybe NoSocketType . unpackSocketType . fromIntegral)
<$> getSocketOption s Type
getSocketType s = unpackSocketType <$> getSockOpt s Type

#ifdef SOL_SOCKET
-- | SO_DEBUG
Expand All @@ -71,13 +69,31 @@ pattern ReuseAddr = SockOpt (#const SOL_SOCKET) (#const SO_REUSEADDR)
#else
pattern ReuseAddr = SockOpt (-1) (-1)
#endif
-- | SO_TYPE

-- | SO_DOMAIN, read-only
pattern SoDomain :: SocketOption
#ifdef SO_DOMAIN
pattern SoDomain = SockOpt (#const SOL_SOCKET) (#const SO_DOMAIN)
#else
pattern SoDomain = SockOpt (-1) (-1)
#endif

-- | SO_TYPE, read-only
pattern Type :: SocketOption
#ifdef SO_TYPE
pattern Type = SockOpt (#const SOL_SOCKET) (#const SO_TYPE)
#else
pattern Type = SockOpt (-1) (-1)
#endif

-- | SO_PROTOCOL, read-only
pattern SoProtocol :: SocketOption
#ifdef SO_PROTOCOL
pattern SoProtocol = SockOpt (#const SOL_SOCKET) (#const SO_PROTOCOL)
#else
pattern SoProtocol = SockOpt (-1) (-1)
#endif

-- | SO_ERROR
pattern SoError :: SocketOption
#ifdef SO_ERROR
Expand Down
2 changes: 0 additions & 2 deletions Network/Socket/Shutdown.hs
Original file line number Diff line number Diff line change
@@ -1,5 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}

#include "HsNetDef.h"

Expand Down Expand Up @@ -27,7 +26,6 @@ import Network.Socket.Types
data ShutdownCmd = ShutdownReceive
| ShutdownSend
| ShutdownBoth
deriving Typeable

sdownCmdToInt :: ShutdownCmd -> CInt
sdownCmdToInt ShutdownReceive = 0
Expand Down
2 changes: 1 addition & 1 deletion Network/Socket/Syscall.hs
Original file line number Diff line number Diff line change
Expand Up @@ -84,7 +84,7 @@ socket family stype protocol = E.bracketOnError create c_close $ \fd -> do
return s
where
create = do
c_stype <- modifyFlag <$> packSocketTypeOrThrow "socket" stype
let c_stype = modifyFlag $ packSocketType stype
throwSocketErrorIfMinus1Retry "Network.Socket.socket" $
c_socket (packFamily family) c_stype protocol

Expand Down
Loading