From a7a2fb8a8c31a72118fa608b9b3eb8946885ebb2 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Tue, 2 Jan 2024 18:36:55 +0100 Subject: [PATCH 1/2] build with ghc-9.{8,10,12} Updated `cabal` to `3.14.2.0`. --- .github/workflows/build.yml | 4 +- .github/workflows/github-page.yml | 7 +- NOTICE | 2 +- Win32-network.cabal | 7 +- demo/named-pipe-demo.hs | 14 ++-- test/Test/Async/Handle.hs | 114 +++++++++++++++--------------- test/Test/Async/Socket.hs | 12 ++-- 7 files changed, 85 insertions(+), 75 deletions(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index fffa4d0..778654c 100644 --- a/.github/workflows/build.yml +++ b/.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: diff --git a/.github/workflows/github-page.yml b/.github/workflows/github-page.yml index 1e4847f..eec9546 100644 --- a/.github/workflows/github-page.yml +++ b/.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 diff --git a/NOTICE b/NOTICE index 44a3c6d..8291a35 100644 --- a/NOTICE +++ b/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. diff --git a/Win32-network.cabal b/Win32-network.cabal index 5bd95fc..447f33c 100644 --- a/Win32-network.cabal +++ b/Win32-network.cabal @@ -1,5 +1,4 @@ -cabal-version: 2.4 - +cabal-version: 3.0 name: Win32-network version: 0.1.1.1 synopsis: Win32 network API @@ -7,13 +6,13 @@ 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 diff --git a/demo/named-pipe-demo.hs b/demo/named-pipe-demo.hs index a7342eb..41f0359 100644 --- a/demo/named-pipe-demo.hs +++ b/demo/named-pipe-demo.hs @@ -1,5 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE PackageImports #-} {-# LANGUAGE ScopedTypeVariables #-} module Main where @@ -7,16 +9,16 @@ 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 () diff --git a/test/Test/Async/Handle.hs b/test/Test/Async/Handle.hs index 5476a54..09d212a 100644 --- a/test/Test/Async/Handle.hs +++ b/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 diff --git a/test/Test/Async/Socket.hs b/test/Test/Async/Socket.hs index e59c19f..17d7ac5 100644 --- a/test/Test/Async/Socket.hs +++ b/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 From 34211407ec6e1618728a97903f6805dd8f61d8a3 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Thu, 12 Feb 2026 10:23:00 +0100 Subject: [PATCH 2/2] Bumped version --- ChangeLog.md | 4 ++++ Win32-network.cabal | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/ChangeLog.md b/ChangeLog.md index 6d7655a..527b23f 100644 --- a/ChangeLog.md +++ b/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. diff --git a/Win32-network.cabal b/Win32-network.cabal index 447f33c..b78bc9a 100644 --- a/Win32-network.cabal +++ b/Win32-network.cabal @@ -1,6 +1,6 @@ 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