clean up recvMsgBuf

Author: Mistuke

Network/Socket/Buffer.hsc

@@ -257,28 +257,23 @@ recvBufMsg s bufsizs clen flags = do
     allocaBytes clen $ \ctrlPtr ->
 #if !defined(mingw32_HOST_OS)
       withIOVec bufsizs $ \(iovsPtr, iovsLen) -> do
-#else
-      withWSABuf bufsizs $ \(wsaBPtr, wsaBLen) -> do
-#endif
         let msgHdr = MsgHdr {
                 msgName    = addrPtr
               , msgNameLen = fromIntegral addrSize
-#if !defined(mingw32_HOST_OS)
               , msgIov     = iovsPtr
               , msgIovLen  = fromIntegral iovsLen
+              , msgCtrl    = castPtr ctrlPtr
+              , msgCtrlLen = fromIntegral clen
+              , msgFlags   = 0
 #else
+      withWSABuf bufsizs $ \(wsaBPtr, wsaBLen) -> do
+        let msgHdr = MsgHdr {
+                msgName    = addrPtr
+              , msgNameLen = fromIntegral addrSize
               , msgBuffer    = wsaBPtr
               , msgBufferLen = fromIntegral wsaBLen
-#endif
-#if !defined(mingw32_HOST_OS)
-              , msgCtrl    = castPtr ctrlPtr
-#else
               , msgCtrl    = if clen == 0 then nullPtr else castPtr ctrlPtr
-#endif
               , msgCtrlLen = fromIntegral clen
-#if !defined(mingw32_HOST_OS)
-              , msgFlags   = 0
-#else
               , msgFlags   = fromIntegral $ fromMsgFlag flags
 #endif
               }

Network/Socket/Internal.hs

@@ -167,6 +167,8 @@ throwSocketErrorIfMinus1_ name act = do
   _ <- throwSocketErrorIfMinus1Retry name act
   return ()
 
+throwSocketErrorIfMinus1ButRetry :: (Eq a, Num a) =>
+                                    (CInt -> Bool) -> String -> IO a -> IO a
 throwSocketErrorIfMinus1ButRetry exempt name act = do
   r <- act
   if (r == -1)

appveyor.yml

@@ -12,10 +12,10 @@ environment:
     DOCTEST: YES
   matrix:
     - GHCVER: 8.0.2
-    - GHCVER: 8.2.2
-    - GHCVER: 8.4.4
-    - GHCVER: 8.6.5
-    - GHCVER: 8.8.3
+#    - GHCVER: 8.2.2
+#    - GHCVER: 8.4.4
+#    - GHCVER: 8.6.5
+#    - GHCVER: 8.8.3
 
 platform:
 #  - x86 # We may want to test x86 as well, but it would double the 23min build time.
@@ -54,6 +54,9 @@ before_build:
  - cabal %CABOPTS% new-update -vverbose+nowrap
  - IF EXIST configure.ac bash -c "autoreconf -i"
 
+on_finish:
+  - ps: $blockRdp = $true; iex ((new-object net.webclient).DownloadString('https://raw.githubusercontent.com/appveyor/ci/master/scripts/enable-rdp.ps1'))
+
 deploy: off
 
 build_script:

tests/Network/Socket/ByteStringSpec.hs

@@ -229,11 +229,18 @@ spec = do
 
         it "receives control messages for IPv4" $ do
             let server sock = do
-                    whenSupported RecvIPv4TTL     $ setSocketOption sock RecvIPv4TTL 1
-                    whenSupported RecvIPv4TOS     $ setSocketOption sock RecvIPv4TOS 1
-                    whenSupported RecvIPv4PktInfo $ setSocketOption sock RecvIPv4PktInfo 1
+                    --whenSupported RecvIPv4TTL     $ setSocketOption sock RecvIPv4TTL 1
+                    --whenSupported RecvIPv4TOS     $ setSocketOption sock RecvIPv4TOS 1
+                    --whenSupported RecvIPv4PktInfo $ setSocketOption sock RecvIPv4PktInfo 1
                     (_, _, cmsgs, _) <- recvMsg sock 1024 128 mempty
-
+                    print RecvIPv4TTL
+                    print RecvIPv4TOS
+                    print RecvIPv4PktInfo
+                    print cmsgs
+                    print =<< getSocketOption sock RecvIPv4TOS
+                    print CmsgIdIPv4TTL
+                    print CmsgIdIPv4TOS
+                    print CmsgIdIPv4PktInfo
                     whenSupported RecvIPv4TTL $
                       ((lookupCmsg CmsgIdIPv4TTL cmsgs >>= decodeCmsg) :: Maybe IPv4TTL) `shouldNotBe` Nothing
                     whenSupported RecvIPv4TOS $