GHC 9.8, 9.10, 9.12 support for Win32-network-0.1

.github/workflows/build.yml

@@ -13,8 +13,8 @@ jobs:
     strategy:
       fail-fast: false
       matrix:
-        ghc: ["8.10.7", "9.2.4", "9.4.2"]
-        cabal: ["3.8.1.0"]
+        ghc: ["9.6", "9.8", "9.10", "9.12"]
+        cabal: ["3.14.2.0"]
         os: [windows-latest, ubuntu-latest]
 
     steps:

.github/workflows/github-page.yml

@@ -30,11 +30,11 @@ jobs:
         EOF
 
     - name: Install Haskell
-      uses: haskell/actions/setup@v1
+      uses: haskell-actions/setup@v2
       id: setup-haskell
       with:
         ghc-version: ${{ matrix.ghc }}
-        cabal-version: 3.4.0.0
+        cabal-version: 3.10.2.0
 
     - name: Set up temp directory
       run: |
@@ -57,6 +57,9 @@ jobs:
     - name: Configure
       run: cabal configure --enable-documentation --enable-tests
 
+    - name: cabal build --dry-run
+      run: cabal build --dry-run all
+
     - name: build Haddock documentation 🔧
       run: |
         mkdir ./haddocks

ChangeLog.md

@@ -1,5 +1,9 @@
 # Revision history for Win32-named-pipes
 
+## 0.1.2.0
+
+* Support GHC-9.{8,10,12}, support `Win32` `>=2.14` and `<2.14`.
+
 ## 0.1.1.1
 
 * Relaxed bounds of bytestring package.

NOTICE

@@ -1,4 +1,4 @@
-Copyright 2019 Input Output (Hong Kong) Ltd.
+Copyright 2019-2023 Input Output Global Ing (IOG), 2023-2026 Intersect
 
    Licensed under the Apache License, Version 2.0 (the "License");
    you may not use this file except in compliance with the License.

Win32-network.cabal

@@ -1,19 +1,18 @@
-cabal-version: 2.4
-
+cabal-version:          3.0
 name:                   Win32-network
-version:                0.1.1.1
+version:                0.1.2.0
 synopsis:               Win32 network API
 license:                Apache-2.0
 license-files:          LICENSE NOTICE
 author:                 Duncan Coutts, Marcin Szamotulski
 maintainer:             duncan@well-typed.com, marcin.szamotulski@iohk.io
-copyright:              2019 Input Output (Hong Kong) Ltd.
+copyright:              2019-2023 Input Output Global Inc (IOG), 2023-2026 Intersect
 category:               System
 build-type:             Simple
 extra-source-files:     README.md
                         ChangeLog.md
                         include/Win32-network.h
-tested-with:            GHC==8.10.7, GHC==9.2.4, GHC==9.4.2
+tested-with:            GHC == {8.10, 9.2, 9.4, 9.6, 9.8}
 
 source-repository head
   type:                 git

demo/named-pipe-demo.hs

@@ -1,22 +1,24 @@
 {-# LANGUAGE BangPatterns        #-}
 {-# LANGUAGE CPP                 #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE PackageImports      #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Main where
 
 #if defined(mingw32_HOST_OS)
 import Data.Bits
 import Data.ByteString (ByteString)
-import qualified Data.ByteString.Char8 as BSC
+import Data.ByteString.Char8 qualified as BSC
 import Control.Concurrent (forkIO, threadDelay)
 import Control.Exception (finally)
 import System.IO hiding (hGetLine)
 import System.Exit
-import           System.Win32 (HANDLE)
-import qualified System.Win32.NamedPipes as Win32
-import qualified System.Win32 as Win32
-import qualified System.Win32.Async as Win32
-import           System.IOManager
+import System.Win32 (HANDLE)
+import "Win32-network" System.Win32.NamedPipes qualified as Win32
+import System.Win32 qualified as Win32
+import System.Win32.Async qualified as Win32
+import System.IOManager
 import System.Environment
 
 main :: IO ()

test/Test/Async/Handle.hs

@@ -1,6 +1,8 @@
 {-# LANGUAGE BangPatterns        #-}
+{-# LANGUAGE ImportQualifiedPost #-}
 {-# LANGUAGE NumericUnderscores  #-}
 {-# LANGUAGE NamedFieldPuns      #-}
+{-# LANGUAGE PackageImports      #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections       #-}
 {-# LANGUAGE TypeApplications    #-}
@@ -20,14 +22,14 @@ import           Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as BSL
 import qualified Data.ByteString.Char8 as BSC
-import           Data.Foldable (foldl', traverse_)
+import qualified Data.Foldable as Foldable
 import           GHC.IO.Exception ( IOException (..)
                                   , IOErrorType (..)
                                   )
 import           System.Win32 hiding (try)
 
 import           System.IOManager
-import           System.Win32.NamedPipes
+import "Win32-network" System.Win32.NamedPipes qualified as Win32.NamedPipes
 import           System.Win32.Async
 import           System.Win32.Async.Internal
 import           Test.Generators hiding (tests)
@@ -86,10 +88,10 @@ tests =
 --
 test_interruptible_connectNamedPipe :: IO ()
 test_interruptible_connectNamedPipe = withIOManager $ \ioManager ->
-    bracket (createNamedPipe pipeName
-                             (pIPE_ACCESS_DUPLEX .|. fILE_FLAG_OVERLAPPED)
-                             (pIPE_TYPE_BYTE .|. pIPE_READMODE_BYTE)
-                             pIPE_UNLIMITED_INSTANCES
+    bracket (Win32.NamedPipes.createNamedPipe pipeName
+                             (Win32.NamedPipes.pIPE_ACCESS_DUPLEX .|. Win32.NamedPipes.fILE_FLAG_OVERLAPPED)
+                             (Win32.NamedPipes.pIPE_TYPE_BYTE .|. Win32.NamedPipes.pIPE_READMODE_BYTE)
+                             Win32.NamedPipes.pIPE_UNLIMITED_INSTANCES
                              512
                              512
                              0
@@ -105,10 +107,10 @@ test_interruptible_connectNamedPipe = withIOManager $ \ioManager ->
 --
 test_interruptible_readHandle :: IO ()
 test_interruptible_readHandle = withIOManager $ \ioManager ->
-    bracket ((,) <$> createNamedPipe pipeName
-                                     (pIPE_ACCESS_DUPLEX .|. fILE_FLAG_OVERLAPPED)
-                                     (pIPE_TYPE_BYTE .|. pIPE_READMODE_BYTE)
-                                     pIPE_UNLIMITED_INSTANCES
+    bracket ((,) <$> Win32.NamedPipes.createNamedPipe pipeName
+                                     (Win32.NamedPipes.pIPE_ACCESS_DUPLEX .|. Win32.NamedPipes.fILE_FLAG_OVERLAPPED)
+                                     (Win32.NamedPipes.pIPE_TYPE_BYTE .|. Win32.NamedPipes.pIPE_READMODE_BYTE)
+                                     Win32.NamedPipes.pIPE_UNLIMITED_INSTANCES
                                      512
                                      512
                                      0
@@ -132,10 +134,10 @@ test_interruptible_readHandle = withIOManager $ \ioManager ->
 --
 test_interruptible_readHandle_2 :: IO ()
 test_interruptible_readHandle_2 = withIOManager $ \ioManager -> do
-    bracket ((,) <$> createNamedPipe pipeName
-                                     (pIPE_ACCESS_DUPLEX .|. fILE_FLAG_OVERLAPPED)
-                                     (pIPE_TYPE_BYTE .|. pIPE_READMODE_BYTE)
-                                     pIPE_UNLIMITED_INSTANCES
+    bracket ((,) <$> Win32.NamedPipes.createNamedPipe pipeName
+                                     (Win32.NamedPipes.pIPE_ACCESS_DUPLEX .|. Win32.NamedPipes.fILE_FLAG_OVERLAPPED)
+                                     (Win32.NamedPipes.pIPE_TYPE_BYTE .|. Win32.NamedPipes.pIPE_READMODE_BYTE)
+                                     Win32.NamedPipes.pIPE_UNLIMITED_INSTANCES
                                      512
                                      512
                                      0
@@ -167,10 +169,10 @@ test_interruptible_writeHandle = withIOManager $ \ioManager -> do
     syncVar <- newEmptyMVar
 
     bracket
-      ((,) <$> createNamedPipe pipeName
-                               (pIPE_ACCESS_DUPLEX .|. fILE_FLAG_OVERLAPPED)
-                               (pIPE_TYPE_BYTE .|. pIPE_READMODE_BYTE)
-                               pIPE_UNLIMITED_INSTANCES
+      ((,) <$> Win32.NamedPipes.createNamedPipe pipeName
+                               (Win32.NamedPipes.pIPE_ACCESS_DUPLEX .|. Win32.NamedPipes.fILE_FLAG_OVERLAPPED)
+                               (Win32.NamedPipes.pIPE_TYPE_BYTE .|. Win32.NamedPipes.pIPE_READMODE_BYTE)
+                               Win32.NamedPipes.pIPE_UNLIMITED_INSTANCES
                                1
                                1
                                0
@@ -217,10 +219,10 @@ test_closeIOCP = do
 --
 test_async_cancel :: IO ()
 test_async_cancel = withIOManager $ \ioManager -> do
-    h <- createNamedPipe pipeName
-                         (pIPE_ACCESS_DUPLEX .|. fILE_FLAG_OVERLAPPED)
-                         (pIPE_TYPE_BYTE .|. pIPE_READMODE_BYTE)
-                         pIPE_UNLIMITED_INSTANCES
+    h <- Win32.NamedPipes.createNamedPipe pipeName
+                         (Win32.NamedPipes.pIPE_ACCESS_DUPLEX .|. Win32.NamedPipes.fILE_FLAG_OVERLAPPED)
+                         (Win32.NamedPipes.pIPE_TYPE_BYTE .|. Win32.NamedPipes.pIPE_READMODE_BYTE)
+                         Win32.NamedPipes.pIPE_UNLIMITED_INSTANCES
                          maxBound
                          maxBound
                          0
@@ -301,10 +303,10 @@ test_connectNamedPipe_ERROR_PIPE_CONNECTED :: IO ()
 test_connectNamedPipe_ERROR_PIPE_CONNECTED =
     withIOManager $ \ioManager -> do
       hServer <-
-        createNamedPipe pname
-                        (pIPE_ACCESS_DUPLEX .|. fILE_FLAG_OVERLAPPED)
-                        (pIPE_TYPE_BYTE .|. pIPE_READMODE_BYTE)
-                        pIPE_UNLIMITED_INSTANCES
+        Win32.NamedPipes.createNamedPipe pname
+                        (Win32.NamedPipes.pIPE_ACCESS_DUPLEX .|. Win32.NamedPipes.fILE_FLAG_OVERLAPPED)
+                        (Win32.NamedPipes.pIPE_TYPE_BYTE .|. Win32.NamedPipes.pIPE_READMODE_BYTE)
+                        Win32.NamedPipes.pIPE_UNLIMITED_INSTANCES
                         maxBound
                         maxBound
                         0
@@ -335,10 +337,10 @@ test_ERROR_INVALID_HANDLE :: IO ()
 test_ERROR_INVALID_HANDLE =
     withIOManager $ \ioManager -> do
       hServer <-
-        createNamedPipe pname
-                        (pIPE_ACCESS_DUPLEX .|. fILE_FLAG_OVERLAPPED)
-                        (pIPE_TYPE_BYTE .|. pIPE_READMODE_BYTE)
-                        pIPE_UNLIMITED_INSTANCES
+        Win32.NamedPipes.createNamedPipe pname
+                        (Win32.NamedPipes.pIPE_ACCESS_DUPLEX .|. Win32.NamedPipes.fILE_FLAG_OVERLAPPED)
+                        (Win32.NamedPipes.pIPE_TYPE_BYTE .|. Win32.NamedPipes.pIPE_READMODE_BYTE)
+                        Win32.NamedPipes.pIPE_UNLIMITED_INSTANCES
                         maxBound
                         maxBound
                         0
@@ -382,10 +384,10 @@ test_ERROR_BROKEN_PIPE :: Int -> Property
 test_ERROR_BROKEN_PIPE _ =
     ioProperty $ withIOManager $ \ioManager -> do
       hServer <-
-        createNamedPipe pname
-                        (pIPE_ACCESS_DUPLEX .|. fILE_FLAG_OVERLAPPED)
-                        (pIPE_TYPE_BYTE .|. pIPE_READMODE_BYTE)
-                        pIPE_UNLIMITED_INSTANCES
+        Win32.NamedPipes.createNamedPipe pname
+                        (Win32.NamedPipes.pIPE_ACCESS_DUPLEX .|. Win32.NamedPipes.fILE_FLAG_OVERLAPPED)
+                        (Win32.NamedPipes.pIPE_TYPE_BYTE .|. Win32.NamedPipes.pIPE_READMODE_BYTE)
+                        Win32.NamedPipes.pIPE_UNLIMITED_INSTANCES
                         maxBound
                         maxBound
                         0
@@ -434,10 +436,10 @@ test_connectNamedPipe_ERROR_NO_DATA =
     withIOManager $ \ioManager -> do
 
       hServer <-
-        createNamedPipe pname
-                        (pIPE_ACCESS_DUPLEX .|. fILE_FLAG_OVERLAPPED)
-                        (pIPE_TYPE_BYTE .|. pIPE_READMODE_BYTE)
-                        pIPE_UNLIMITED_INSTANCES
+        Win32.NamedPipes.createNamedPipe pname
+                        (Win32.NamedPipes.pIPE_ACCESS_DUPLEX .|. Win32.NamedPipes.fILE_FLAG_OVERLAPPED)
+                        (Win32.NamedPipes.pIPE_TYPE_BYTE .|. Win32.NamedPipes.pIPE_READMODE_BYTE)
+                        Win32.NamedPipes.pIPE_UNLIMITED_INSTANCES
                         maxBound
                         maxBound
                         0
@@ -479,10 +481,10 @@ test_connectNamedPipe_ERROR_NO_DATA =
 --
 test_close_blocked_on_reading :: IO ()
 test_close_blocked_on_reading = withIOManager $ \ioManager -> do
-    h <- createNamedPipe pipeName
-                         (pIPE_ACCESS_DUPLEX .|. fILE_FLAG_OVERLAPPED)
-                         (pIPE_TYPE_BYTE .|. pIPE_READMODE_BYTE)
-                         pIPE_UNLIMITED_INSTANCES
+    h <- Win32.NamedPipes.createNamedPipe pipeName
+                         (Win32.NamedPipes.pIPE_ACCESS_DUPLEX .|. Win32.NamedPipes.fILE_FLAG_OVERLAPPED)
+                         (Win32.NamedPipes.pIPE_TYPE_BYTE .|. Win32.NamedPipes.pIPE_READMODE_BYTE)
+                         Win32.NamedPipes.pIPE_UNLIMITED_INSTANCES
                          maxBound
                          maxBound
                          0
@@ -545,10 +547,10 @@ prop_async_reads_and_writes (LargeNonEmptyBS bsIn bufSizeIn) (LargeNonEmptyBS bs
       -- fork a server
       _ <- forkIO $ handle (\e -> throwTo mainThread e >> ioError e) $
         bracket
-            (createNamedPipe pname
-                             (pIPE_ACCESS_DUPLEX .|. fILE_FLAG_OVERLAPPED)
-                             (pIPE_TYPE_BYTE .|. pIPE_READMODE_BYTE)
-                             pIPE_UNLIMITED_INSTANCES
+            (Win32.NamedPipes.createNamedPipe pname
+                             (Win32.NamedPipes.pIPE_ACCESS_DUPLEX .|. Win32.NamedPipes.fILE_FLAG_OVERLAPPED)
+                             (Win32.NamedPipes.pIPE_TYPE_BYTE .|. Win32.NamedPipes.pIPE_READMODE_BYTE)
+                             Win32.NamedPipes.pIPE_UNLIMITED_INSTANCES
                              (fromIntegral bufSizeIn)
                              (fromIntegral bufSizeOut)
                              0
@@ -616,10 +618,10 @@ handleToBinaryChannel h = BinaryChannel { readChannel, writeChannel, closeChanne
         let chunks :: [ByteString]
             chunks = BSL.toChunks (encode a)
             size   :: Int
-            size   = bool (+1) id b $ foldl' (\x y -> x + BS.length y) 0 chunks
+            size   = bool (+1) id b $ Foldable.foldl' (\x y -> x + BS.length y) 0 chunks
         -- send header: just a single chunk send payload
         _ <- writeHandle h (BSL.toStrict $ encode size)
-        traverse_ (\chunk -> writeHandle h chunk) chunks
+        Foldable.traverse_ (\chunk -> writeHandle h chunk) chunks
 
       readChannel b = do
         bs <- readLen [] 8
@@ -667,10 +669,10 @@ prop_PingPong n blocking (LargeNonEmptyBS bs bufSize) =
       let pname = pipeName ++ "-ping-pong"
 
       -- fork the PingPong server
-      h <- createNamedPipe pname
-                           (pIPE_ACCESS_DUPLEX .|. fILE_FLAG_OVERLAPPED)
-                           (pIPE_TYPE_BYTE .|. pIPE_READMODE_BYTE)
-                           pIPE_UNLIMITED_INSTANCES
+      h <- Win32.NamedPipes.createNamedPipe pname
+                           (Win32.NamedPipes.pIPE_ACCESS_DUPLEX .|. Win32.NamedPipes.fILE_FLAG_OVERLAPPED)
+                           (Win32.NamedPipes.pIPE_TYPE_BYTE .|. Win32.NamedPipes.pIPE_READMODE_BYTE)
+                           Win32.NamedPipes.pIPE_UNLIMITED_INSTANCES
                            (fromIntegral bufSize)
                            (fromIntegral bufSize)
                            0
@@ -724,10 +726,10 @@ prop_PingPongPipelined blocking (Positive bufSize) (NonEmpty bss0) =
           pname = pipeName ++ "-ping-pong-pipelined"
 
       -- fork the PingPong server
-      h <- createNamedPipe pname
-                           (pIPE_ACCESS_DUPLEX .|. fILE_FLAG_OVERLAPPED)
-                           (pIPE_TYPE_BYTE .|. pIPE_READMODE_BYTE)
-                           pIPE_UNLIMITED_INSTANCES
+      h <- Win32.NamedPipes.createNamedPipe pname
+                           (Win32.NamedPipes.pIPE_ACCESS_DUPLEX .|. Win32.NamedPipes.fILE_FLAG_OVERLAPPED)
+                           (Win32.NamedPipes.pIPE_TYPE_BYTE .|. Win32.NamedPipes.pIPE_READMODE_BYTE)
+                           Win32.NamedPipes.pIPE_UNLIMITED_INSTANCES
                            (fromIntegral bufSize)
                            maxBound
                            0

test/Test/Async/Socket.hs

@@ -1,10 +1,14 @@
+{-# LANGUAGE CPP                 #-}
 {-# LANGUAGE BangPatterns        #-}
 {-# LANGUAGE NamedFieldPuns      #-}
-{-# LANGUAGE NumericUnderscores  #-}
 {-# LANGUAGE RankNTypes          #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications    #-}
 
+#if MIN_VERSION_GLASGOW_HASKELL(9,8,0,0)
+{-# OPTIONS_GHC -Wno-x-partial #-}
+#endif
+
 module Test.Async.Socket (tests) where
 
 import           Control.Exception
@@ -16,7 +20,7 @@ import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as BL
 import           Data.Functor (void)
 import           Data.Function (on)
-import           Data.Foldable (foldl', traverse_)
+import qualified Data.Foldable as Foldable
 import           GHC.IO.Exception (IOException (..))
 
 import           System.IOManager
@@ -291,9 +295,9 @@ socketToBinaryChannel sock = BinaryChannel { readChannel, writeChannel, closeCha
       let chunks :: [ByteString]
           chunks = BL.toChunks (encode a)
           size   :: Int
-          size = bool (+1) id b $ foldl' (\x y -> x + BS.length y) 0 chunks
+          size = bool (+1) id b $ Foldable.foldl' (\x y -> x + BS.length y) 0 chunks
       _ <- Async.sendAll sock (BL.toStrict $ encode size)
-      traverse_ (\chunk -> Async.sendAll sock chunk) chunks
+      Foldable.traverse_ (\chunk -> Async.sendAll sock chunk) chunks
 
     closeChannel = Socket.close sock