From 710b6cadba181a560febf59261e48d256b31cd27 Mon Sep 17 00:00:00 2001 From: archaephyrryx Date: Sun, 12 Jul 2020 15:13:41 -0400 Subject: [PATCH] Implement precedence-handling bijective read/show refactors and reimplements Network.Socket.ReadShow to allow for precedence-sensitive Read/Show instances built on an underlying bijective framework. Behavior conforms to derived read/show instances by default but short-circuits to fixed strings when input matches element of a list of paired elements defining a partial bijection. adds several flexible helper-functions to Network.Socket.ReadShow to allow for minimal-boilerplate implementations of bijective read/show for arbitrary types in future. Adds more descriptive documentation for non-obvious properties of Network.Socket.ReadShow types and functions reimplements instance declarations of read/show for types already using bijective read/show definitions Adds cases to Network.SocketSpec test suite to ensure that ReadShow-based Show instances produce expected output for each pattern-bijection type Adds quickcheck-dependent (updated cabal file) tests to ensure roundtrip equality for `read.show` for all types using ReadShow-based instances over arbitrary values, specifically biased towards pattern synonym values --- Network/Socket/Options.hsc | 26 +++-- Network/Socket/Posix/Cmsg.hsc | 24 ++--- Network/Socket/ReadShow.hs | 181 +++++++++++++++++++++------------- Network/Socket/Types.hsc | 62 ++++-------- Network/Socket/Win32/Cmsg.hsc | 22 ++--- network.cabal | 3 +- tests/Network/SocketSpec.hs | 157 +++++++++++++++++++++++++++++ 7 files changed, 324 insertions(+), 151 deletions(-) diff --git a/Network/Socket/Options.hsc b/Network/Socket/Options.hsc index 80364a84..51427421 100644 --- a/Network/Socket/Options.hsc +++ b/Network/Socket/Options.hsc @@ -390,8 +390,8 @@ getSockOpt s (SockOpt level opt) = do peek ptr -socketOptionPairs :: [Pair SocketOption String] -socketOptionPairs = +socketOptionBijection :: Bijection SocketOption String +socketOptionBijection = [ (UnsupportedSocketOption, "UnsupportedSocketOption") , (Debug, "Debug") , (ReuseAddr, "ReuseAddr") @@ -426,21 +426,19 @@ socketOptionPairs = , (RecvIPv6PktInfo, "RecvIPv6PktInfo") ] -socketOptionBijection :: Bijection SocketOption String -socketOptionBijection = Bijection{..} - where - cso = "CustomSockOpt" - unCSO = \(CustomSockOpt nm) -> nm - defFwd = defShow cso unCSO _show - defBwd = defRead cso CustomSockOpt _parse - pairs = socketOptionPairs - instance Show SocketOption where - show = forward socketOptionBijection + showsPrec = bijectiveShow socketOptionBijection def + where + defname = "SockOpt" + unwrap = \(CustomSockOpt nm) -> nm + def = defShow defname unwrap showIntInt -instance Read SocketOption where - readPrec = tokenize $ backward socketOptionBijection +instance Read SocketOption where + readPrec = bijectiveRead socketOptionBijection def + where + defname = "SockOpt" + def = defRead defname CustomSockOpt readIntInt foreign import CALLCONV unsafe "getsockopt" c_getsockopt :: CInt -> CInt -> CInt -> Ptr a -> Ptr CInt -> IO CInt diff --git a/Network/Socket/Posix/Cmsg.hsc b/Network/Socket/Posix/Cmsg.hsc index 9f6d7063..2511ed3e 100644 --- a/Network/Socket/Posix/Cmsg.hsc +++ b/Network/Socket/Posix/Cmsg.hsc @@ -229,8 +229,8 @@ instance Storable IPv6PktInfo where instance ControlMessage Fd where controlMessageId = CmsgIdFd -cmsgIdPairs :: [Pair CmsgId String] -cmsgIdPairs = +cmsgIdBijection :: Bijection CmsgId String +cmsgIdBijection = [ (UnsupportedCmsgId, "UnsupportedCmsgId") , (CmsgIdIPv4TTL, "CmsgIdIPv4TTL") , (CmsgIdIPv6HopLimit, "CmsgIdIPv6HopLimit") @@ -241,17 +241,17 @@ cmsgIdPairs = , (CmsgIdFd, "CmsgIdFd") ] -cmsgIdBijection :: Bijection CmsgId String -cmsgIdBijection = Bijection{..} - where +instance Show CmsgId where + showsPrec = bijectiveShow cmsgIdBijection def + where defname = "CmsgId" unId = \(CmsgId l t) -> (l,t) - defFwd = defShow defname unId _show - defBwd = defRead defname (uncurry CmsgId) _parse - pairs = cmsgIdPairs - -instance Show CmsgId where - show = forward cmsgIdBijection + def = defShow defname unId showIntInt instance Read CmsgId where - readPrec = tokenize $ backward cmsgIdBijection + readPrec = bijectiveRead cmsgIdBijection def + where + defname = "CmsgId" + def = defRead defname (uncurry CmsgId) readIntInt + + diff --git a/Network/Socket/ReadShow.hs b/Network/Socket/ReadShow.hs index a656dedd..a7ca9765 100644 --- a/Network/Socket/ReadShow.hs +++ b/Network/Socket/ReadShow.hs @@ -1,10 +1,16 @@ {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE PatternGuards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE RankNTypes #-} module Network.Socket.ReadShow where +import Text.Read ((<++)) import qualified Text.Read as P +import qualified Text.Read.Lex as P +import Control.Monad (mzero) -- type alias for individual correspondences of a (possibly partial) bijection type Pair a b = (a, b) @@ -19,77 +25,112 @@ eqFst x = \(x',_) -> x' == x eqSnd :: Eq b => b -> (a, b) -> Bool eqSnd y = \(_,y') -> y' == y --- | Return RHS element that is paired with provided LHS, --- or apply a default fallback function if the list is partial -lookForward :: Eq a => (a -> b) -> [Pair a b] -> a -> b -lookForward defFwd ps x - = case filter (eqFst x) ps of - (_,y):_ -> y - [] -> defFwd x - --- | Return LHS element that is paired with provided RHS, --- or apply a default fallback function if the list is partial -lookBackward :: Eq b => (b -> a) -> [Pair a b] -> b -> a -lookBackward defBwd ps y - = case filter (eqSnd y) ps of - (x,_):_ -> x - [] -> defBwd y - -data Bijection a b - = Bijection - { defFwd :: a -> b - , defBwd :: b -> a - , pairs :: [Pair a b] - } - --- | apply a bijection over an LHS-value -forward :: (Eq a) => Bijection a b -> a -> b -forward Bijection{..} = lookForward defFwd pairs - --- | apply a bijection over an RHS-value -backward :: (Eq b) => Bijection a b -> b -> a -backward Bijection{..} = lookBackward defBwd pairs - --- | show function for Int-like types that encodes negative numbers --- with leading '_' instead of '-' -_showInt :: (Show a, Num a, Ord a) => a -> String -_showInt n | n < 0 = let ('-':s) = show n in '_':s - | otherwise = show n - --- | parse function for Int-like types that interprets leading '_' --- as if it were '-' instead -_readInt :: (Read a) => String -> a -_readInt ('_':s) = read $ '-':s -_readInt s = read s - - --- | parse a quote-separated pair into a tuple of Int-like values --- should not be used if either type might have --- literal quote-characters in the Read pre-image -_parse :: (Read a, Read b) => String -> (a, b) -_parse xy = - let (xs, '\'':ys) = break (=='\'') xy - in (_readInt xs, _readInt ys) -{-# INLINE _parse #-} - --- | inverse function to _parse --- show a tuple of Int-like values as quote-separated strings -_show :: (Show a, Num a, Ord a, Show b, Num b, Ord b) => (a, b) -> String -_show (x, y) = _showInt x ++ "'" ++ _showInt y -{-# INLINE _show #-} - -defShow :: Eq a => String -> (a -> b) -> (b -> String) -> (a -> String) -defShow name unwrap sho = \x -> name ++ (sho . unwrap $ x) + +-- | Unified automorphic involution over @Either a b@ that converts between +-- LHS and RHS elements of a list of @Pair a b@ mappings and is the identity +-- function if no matching pair is found +-- +-- If list contains duplicate matches, short-circuits to the first matching @Pair@ +lookBetween :: (Eq a, Eq b) => [Pair a b] -> Either a b -> Either a b +lookBetween ps = \case + Left x | (_,y):_ <- filter (eqFst x) ps -> Right y + Right y | (x,_):_ <- filter (eqSnd y) ps -> Left x + z -> z + +-- Type alias for partial bijections between two types, consisting of a list +-- of individual correspondences that are checked in order and short-circuit +-- on first match +-- +-- Depending on how this is used, may not actually be a true bijection over +-- the partial types, as no overlap-checking is currently implemented. If +-- overlaps are unavoidable, the canonical short-circuit pair should appear +-- first to avoid round-trip inconsistencies. +type Bijection a b = [Pair a b] + +-- | Helper function for prefixing an optional constructor name before arbitrary values, +-- which only enforces high precedence on subsequent output if the constructor name is not +-- blank and space-separates for non-blank constructor names +namePrefix :: Int -> String -> (Int -> b -> ShowS) -> b -> ShowS +namePrefix i name f x + | null name = f i x + | otherwise = showParen (i > app_prec) $ showString name . showChar ' ' . f (app_prec+1) x +{-# INLINE namePrefix #-} + +-- | Helper function for defining bijective Show instances that represents +-- a common use-case where a constructor (or constructor-like pattern) name +-- (optionally) precedes an internal value with a separate show function +defShow :: Eq a => String -> (a -> b) -> (Int -> b -> ShowS) -> (Int -> a -> ShowS) +defShow name unwrap shoPrec = \i x -> namePrefix i name shoPrec (unwrap x) {-# INLINE defShow #-} -defRead :: Read a => String -> (b -> a) -> (String -> b) -> (String -> a) -defRead name wrap red = \s -> - case splitAt (length name) s of - (x, sn) | x == name -> wrap $ red sn - _ -> error $ "defRead: unable to parse " ++ show s +-- Helper function for stripping an optional constructor-name prefix before parsing +-- an arbitrary value, which only consumes an extra token and increases precedence +-- if the provided name prefix is non-blank +expectPrefix :: String -> P.ReadPrec a -> P.ReadPrec a +expectPrefix name pars + | null name = pars + | otherwise = do + P.lift $ P.expect $ P.Ident name + P.step pars +{-# INLINE expectPrefix #-} + +-- | Helper function for defining bijective Read instances that represent a +-- common use case where a constructor (or constructor-like pattern) name +-- (optionally) precedes an internal value with a separate parse function +defRead :: Eq a => String -> (b -> a) -> P.ReadPrec b -> P.ReadPrec a +defRead name wrap redPrec = expectPrefix name $ wrap <$> redPrec {-# INLINE defRead #-} --- | Apply a precedence-invariant one-token parse function within ReadPrec monad -tokenize :: (String -> a) -> P.ReadPrec a -tokenize f = P.lexP >>= \(P.Ident x) -> return $ f x -{-# INLINE tokenize #-} +-- | Alias for showsPrec that pairs well with `_readInt` +_showInt :: (Show a) => Int -> a -> ShowS +_showInt = showsPrec +{-# INLINE _showInt #-} + +-- | More descriptive alias for `safeInt` +_readInt :: (Bounded a, Integral a) => P.ReadPrec a +_readInt = safeInt +{-# INLINE _readInt #-} + +-- | show two elements of a tuple separated by a space character +-- inverse function to readIntInt when used on integer-like values +showIntInt :: (Show a, Show b) => Int -> (a, b) -> ShowS +showIntInt i (x, y) = _showInt i x . showChar ' ' . _showInt i y +{-# INLINE showIntInt #-} + +-- | consume and return two integer-like values from two consecutive lexical tokens +readIntInt :: (Bounded a, Integral a, Bounded b, Integral b) => P.ReadPrec (a, b) +readIntInt = do + x <- _readInt + y <- _readInt + return (x, y) +{-# INLINE readIntInt #-} + +bijectiveShow :: (Eq a) => Bijection a String -> (Int -> a -> ShowS) -> (Int -> a -> ShowS) +bijectiveShow bi def = \i x -> + case lookBetween bi (Left x) of + Right y -> showString y + _ -> def i x + +bijectiveRead :: (Eq a) => Bijection a String -> P.ReadPrec a -> P.ReadPrec a +bijectiveRead bi def = P.parens $ bijective <++ def + where + bijective = do + (P.Ident y) <- P.lexP + case lookBetween bi (Right y) of + Left x -> return x + _ -> mzero + +app_prec :: Int +app_prec = 10 +{-# INLINE app_prec #-} + +-- Parse integral values with type-specific overflow and underflow bounds-checks +safeInt :: forall a. (Bounded a, Integral a) => P.ReadPrec a +safeInt = do + i <- signed + if (i >= fromIntegral (minBound :: a) && i <= fromIntegral (maxBound :: a)) + then return $ fromIntegral i + else mzero + where + signed :: P.ReadPrec Integer + signed = P.readPrec diff --git a/Network/Socket/Types.hsc b/Network/Socket/Types.hsc index 61ab0792..be9b9c45 100644 --- a/Network/Socket/Types.hsc +++ b/Network/Socket/Types.hsc @@ -91,9 +91,7 @@ import GHC.IORef (IORef (..)) import GHC.STRef (STRef (..)) import GHC.IO (IO (..)) -import Text.Read ((<++)) import qualified Text.Read as P -import qualified Text.Read.Lex as P #if defined(DOMAIN_SOCKET_SUPPORT) import Foreign.Marshal.Array @@ -1316,8 +1314,8 @@ instance Storable In6Addr where ------------------------------------------------------------------------ -- Read and Show instance for pattern-based integral newtypes -socktypePairs :: [Pair SocketType String] -socktypePairs = +socktypeBijection :: Bijection SocketType String +socktypeBijection = [ (UnsupportedSocketType, "UnsupportedSocketType") , (Stream, "Stream") , (Datagram, "Datagram") @@ -1327,22 +1325,20 @@ socktypePairs = , (NoSocketType, "NoSocketType") ] -socktypeBijection :: Bijection SocketType String -socktypeBijection = Bijection{..} - where - gst = "GeneralSocketType" - defFwd = defShow gst packSocketType _showInt - defBwd = defRead gst unpackSocketType _readInt - pairs = socktypePairs - instance Show SocketType where - show = forward socktypeBijection + showsPrec = bijectiveShow socktypeBijection def + where + gst = "GeneralSocketType" + def = defShow gst packSocketType _showInt instance Read SocketType where - readPrec = tokenize $ backward socktypeBijection + readPrec = bijectiveRead socktypeBijection def + where + gst = "GeneralSocketType" + def = defRead gst unpackSocketType _readInt -familyPairs :: [Pair Family String] -familyPairs = +familyBijection :: Bijection Family String +familyBijection = [ (UnsupportedFamily, "UnsupportedFamily") , (AF_UNSPEC, "AF_UNSPEC") , (AF_UNIX, "AF_UNIX") @@ -1412,19 +1408,17 @@ familyPairs = , (AF_CAN, "AF_CAN") ] -familyBijection :: Bijection Family String -familyBijection = Bijection{..} - where - gf = "GeneralFamily" - defFwd = defShow gf packFamily _showInt - defBwd = defRead gf unpackFamily _readInt - pairs = familyPairs - instance Show Family where - show = forward familyBijection + showsPrec = bijectiveShow familyBijection def + where + gf = "GeneralFamily" + def = defShow gf packFamily _showInt instance Read Family where - readPrec = tokenize $ backward familyBijection + readPrec = bijectiveRead familyBijection def + where + gf = "GeneralFamily" + def = defRead gf unpackFamily _readInt -- Print "n" instead of "PortNum n". instance Show PortNumber where @@ -1434,22 +1428,6 @@ instance Show PortNumber where instance Read PortNumber where readPrec = safeInt -app_prec :: Int -app_prec = 10 - --- Accept negative values only in parens and check for overflow. -safeInt :: forall a. (Bounded a, Integral a) => P.ReadPrec a -safeInt = do - i <- P.parens unsigned <++ P.parens (P.prec app_prec negative) - if (i >= fromIntegral (minBound :: a) && i <= fromIntegral (maxBound :: a)) - then return $ fromIntegral i - else mzero - where - unsigned :: P.ReadPrec Integer - unsigned = P.lift P.readDecP - negative :: P.ReadPrec Integer - negative = P.readPrec - ------------------------------------------------------------------------ -- Helper functions diff --git a/Network/Socket/Win32/Cmsg.hsc b/Network/Socket/Win32/Cmsg.hsc index 128468a7..7148d7a7 100644 --- a/Network/Socket/Win32/Cmsg.hsc +++ b/Network/Socket/Win32/Cmsg.hsc @@ -190,8 +190,8 @@ instance Storable IPv6PktInfo where n :: ULONG <- (#peek IN6_PKTINFO, ipi6_ifindex) p return $ IPv6PktInfo (fromIntegral n) ha6 -cmsgIdPairs :: [Pair CmsgId String] -cmsgIdPairs = +cmsgIdBijection :: Bijection CmsgId String +cmsgIdBijection = [ (UnsupportedCmsgId, "UnsupportedCmsgId") , (CmsgIdIPv4TTL, "CmsgIdIPv4TTL") , (CmsgIdIPv6HopLimit, "CmsgIdIPv6HopLimit") @@ -202,17 +202,15 @@ cmsgIdPairs = , (CmsgIdFd, "CmsgIdFd") ] -cmsgIdBijection :: Bijection CmsgId String -cmsgIdBijection = Bijection{..} - where +instance Show CmsgId where + showsPrec = bijectiveShow cmsgIdBijection def + where defname = "CmsgId" unId = \(CmsgId l t) -> (l,t) - defFwd = defShow defname unId _show - defBwd = defRead defname (uncurry CmsgId) _parse - pairs = cmsgIdPairs - -instance Show CmsgId where - show = forward cmsgIdBijection + def = defShow defname unId showIntInt instance Read CmsgId where - readPrec = tokenize $ backward cmsgIdBijection + readPrec = bijectiveRead cmsgIdBijection def + where + defname = "CmsgId" + def = defRead defname (uncurry CmsgId) readIntInt diff --git a/network.cabal b/network.cabal index 5d3a7216..957f7ebf 100644 --- a/network.cabal +++ b/network.cabal @@ -144,7 +144,8 @@ test-suite spec HUnit, network, temporary, - hspec >= 2.6 + hspec >= 2.6, + QuickCheck test-suite doctests buildable: False diff --git a/tests/Network/SocketSpec.hs b/tests/Network/SocketSpec.hs index fd13a0d4..76d32972 100644 --- a/tests/Network/SocketSpec.hs +++ b/tests/Network/SocketSpec.hs @@ -7,14 +7,17 @@ import Control.Concurrent (threadDelay, forkIO) import Control.Concurrent.MVar (readMVar) import Control.Monad import Data.Maybe (fromJust) +import Data.List (nub) import Network.Socket import Network.Socket.ByteString import Network.Test.Common import System.Mem (performGC) import System.IO.Error (tryIOError, isAlreadyInUseError) import System.IO.Temp (withSystemTempDirectory) +import Foreign.C.Types () import Test.Hspec +import Test.QuickCheck main :: IO () main = hspec spec @@ -315,3 +318,157 @@ spec = do (tupleToHostAddress6 (0xff01, 0x1234, 0x2, 0x3, 0x4, 0x5, 0x6, 0x7)) 0 show addr `shouldBe` "[ff01:1234:2:3:4:5:6:7]:80" + describe "show Family" $ do + it "works for pattern synonyms" $ + let fam = AF_UNSPEC in + show fam `shouldBe` "AF_UNSPEC" + + it "works for unsupported" $ + let fam = GeneralFamily (-1) in + show fam `shouldBe` "UnsupportedFamily" + + it "works for positive values" $ + let fam = GeneralFamily 300 in + show fam `shouldBe` "GeneralFamily 300" + + it "works for negative values" $ + let fam = GeneralFamily (-300) in + show fam `shouldBe` "GeneralFamily (-300)" + + describe "show SocketType" $ do + it "works for pattern synonyms" $ + let socktype = NoSocketType in + show socktype `shouldBe` "NoSocketType" + + it "works for unsupported" $ + let socktype = GeneralSocketType (-1) in + show socktype `shouldBe` "UnsupportedSocketType" + + it "works for positive values" $ + let socktype = GeneralSocketType 300 in + show socktype `shouldBe` "GeneralSocketType 300" + + it "works for negative values" $ + let socktype = GeneralSocketType (-300) in + show socktype `shouldBe` "GeneralSocketType (-300)" + + describe "show SocketOptions" $ do + it "works for pattern synonyms" $ + let opt = ReuseAddr in + show opt `shouldBe` "ReuseAddr" + + it "works for unsupported" $ + let opt = SockOpt (-1) (-1) in + show opt `shouldBe` "UnsupportedSocketOption" + + it "works for positive values" $ + let opt = SockOpt 300 300 in + show opt `shouldBe` "SockOpt 300 300" + + it "works for negative values" $ + let opt = SockOpt (-300) (-300) in + show opt `shouldBe` "SockOpt (-300) (-300)" + + describe "show CmsgId" $ do + it "works for pattern synonyms" $ + let msgid = CmsgIdIPv6HopLimit in + show msgid `shouldBe` "CmsgIdIPv6HopLimit" + + it "works for unsupported" $ + let msgid = CmsgId (-1) (-1) in + show msgid `shouldBe` "UnsupportedCmsgId" + + it "works for positive values" $ + let msgid = CmsgId 300 300 in + show msgid `shouldBe` "CmsgId 300 300" + + it "works for negative values" $ + let msgid = CmsgId (-300) (-300) in + show msgid `shouldBe` "CmsgId (-300) (-300)" + + describe "bijective read-show roundtrip equality" $ do + it "holds for Family" $ forAll familyGen $ + \x -> (read . show $ x) == (x :: Family) + + it "holds for SocketType" $ forAll socktypeGen $ + \x -> (read . show $ x) == (x :: SocketType) + + it "holds for SocketOption" $ forAll sockoptGen $ + \x -> (read . show $ x) == (x :: SocketOption) + + it "holds for CmsgId" $ forAll cmsgidGen $ + \x -> (read . show $ x) == (x :: CmsgId) + + +-- Type-specific generators with strong bias towards pattern synonyms + +-- Generator combinator that biases elements of a given list and otherwise +-- applies a function to a given generator +biasedGen :: (Gen a -> Gen b) -> [b] -> Gen a -> Gen b +biasedGen f xs g = do + useBias <- (arbitrary :: Gen Bool) + if useBias + then elements xs + else f g + +familyGen :: Gen Family +familyGen = biasedGen (fmap GeneralFamily) familyPatterns arbitrary + +socktypeGen :: Gen SocketType +socktypeGen = biasedGen (fmap GeneralSocketType) socktypePatterns arbitrary + +sockoptGen :: Gen SocketOption +sockoptGen = biasedGen (\g -> SockOpt <$> g <*> g) sockoptPatterns arbitrary + +cmsgidGen :: Gen CmsgId +cmsgidGen = biasedGen (\g -> CmsgId <$> g <*> g) cmsgidPatterns arbitrary + +-- pruned lists of pattern synonym values for each type to generate values from + +familyPatterns :: [Family] +familyPatterns = nub + [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] + +socktypePatterns :: [SocketType] +socktypePatterns = nub + [ UnsupportedSocketType + , NoSocketType + , Stream + , Datagram + , Raw + , RDM + , SeqPacket + ] + +sockoptPatterns :: [SocketOption] +sockoptPatterns = nub + [UnsupportedSocketOption + ,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 + ,RecvIPv6HopLimit,RecvIPv6TClass,RecvIPv6PktInfo] + +cmsgidPatterns :: [CmsgId] +cmsgidPatterns = nub + [ UnsupportedCmsgId + , CmsgIdIPv4TTL + , CmsgIdIPv6HopLimit + , CmsgIdIPv4TOS + , CmsgIdIPv6TClass + , CmsgIdIPv4PktInfo + , CmsgIdIPv6PktInfo + , CmsgIdFd + ]