From 2a10e6c21ac2980dc6805ff7ac5e50eae5375dc2 Mon Sep 17 00:00:00 2001 From: qz Date: Thu, 24 Jan 2019 01:02:26 +0300 Subject: [PATCH 1/5] build with ghc-8.6.3 --- .../PostgreSQL/Protocol/Store/Encode.hs | 7 +++--- stack-ghc8.6.3.yaml | 22 +++++++++++++++++++ stack.yaml | 2 +- 3 files changed, 27 insertions(+), 4 deletions(-) create mode 100644 stack-ghc8.6.3.yaml diff --git a/src/Database/PostgreSQL/Protocol/Store/Encode.hs b/src/Database/PostgreSQL/Protocol/Store/Encode.hs index 1c0bf6f..c5fd321 100644 --- a/src/Database/PostgreSQL/Protocol/Store/Encode.hs +++ b/src/Database/PostgreSQL/Protocol/Store/Encode.hs @@ -28,13 +28,14 @@ import Data.Store.Core (Poke(..), unsafeEncodeWith, pokeStatePtr, data Encode = Encode {-# UNPACK #-} !Int !(Poke ()) +instance Semigroup Encode where + {-# INLINE (<>) #-} + (Encode len1 f1) <> (Encode len2 f2) = Encode (len1 + len2) (f1 *> f2) + instance Monoid Encode where {-# INLINE mempty #-} mempty = Encode 0 . Poke $ \_ offset -> pure (offset, ()) - {-# INLINE mappend #-} - (Encode len1 f1) `mappend` (Encode len2 f2) = Encode (len1 + len2) (f1 *> f2) - instance Show Encode where show (Encode len _) = "Encode instance of length " ++ show len diff --git a/stack-ghc8.6.3.yaml b/stack-ghc8.6.3.yaml new file mode 100644 index 0000000..1c4ca8b --- /dev/null +++ b/stack-ghc8.6.3.yaml @@ -0,0 +1,22 @@ +# This file was automatically generated by 'stack init' +# +resolver: lts-13.4 + +packages: +- '.' +# Dependency packages to be pulled from upstream that are not in the resolver +# (e.g., acme-missiles-0.3) +extra-deps: + - socket-0.8.2.0 + - socket-unix-0.2.0.0 +# <<<<<<< HEAD +# ======= +# - store-core-0.3 +# - QuickCheck-2.9.2 +# >>>>>>> QuickCheck tests for existing codecs + +# Override default flag values for local packages and extra-deps +flags: {} + +# Extra package databases containing global packages +extra-package-dbs: [] diff --git a/stack.yaml b/stack.yaml index a46c219..378b921 120000 --- a/stack.yaml +++ b/stack.yaml @@ -1 +1 @@ -stack-ghc8.0.2.yaml \ No newline at end of file +stack-ghc8.6.3.yaml \ No newline at end of file From 1a8c40e505e03fab28976a67e4f56b2ef3b178d6 Mon Sep 17 00:00:00 2001 From: qz Date: Thu, 24 Jan 2019 01:43:06 +0300 Subject: [PATCH 2/5] build for 8.2.2 & 8.4.4 with cpp --- .../PostgreSQL/Protocol/Store/Encode.hs | 9 +++++++- stack-ghc8.2.2.yaml | 22 +++++++++++++++++++ stack-ghc8.4.4.yaml | 22 +++++++++++++++++++ 3 files changed, 52 insertions(+), 1 deletion(-) create mode 100644 stack-ghc8.2.2.yaml create mode 100644 stack-ghc8.4.4.yaml diff --git a/src/Database/PostgreSQL/Protocol/Store/Encode.hs b/src/Database/PostgreSQL/Protocol/Store/Encode.hs index c5fd321..e3b2572 100644 --- a/src/Database/PostgreSQL/Protocol/Store/Encode.hs +++ b/src/Database/PostgreSQL/Protocol/Store/Encode.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} module Database.PostgreSQL.Protocol.Store.Encode ( Encode , getEncodeLen @@ -26,15 +27,21 @@ import Data.ByteString.Internal (toForeignPtr) import Data.Store.Core (Poke(..), unsafeEncodeWith, pokeStatePtr, pokeFromForeignPtr) +import qualified Data.Semigroup as Sem + data Encode = Encode {-# UNPACK #-} !Int !(Poke ()) -instance Semigroup Encode where +instance Sem.Semigroup Encode where {-# INLINE (<>) #-} (Encode len1 f1) <> (Encode len2 f2) = Encode (len1 + len2) (f1 *> f2) instance Monoid Encode where {-# INLINE mempty #-} mempty = Encode 0 . Poke $ \_ offset -> pure (offset, ()) +#if !(MIN_VERSION_base(4,11,0)) + mappend = (Sem.<>) +#endif + instance Show Encode where show (Encode len _) = "Encode instance of length " ++ show len diff --git a/stack-ghc8.2.2.yaml b/stack-ghc8.2.2.yaml new file mode 100644 index 0000000..9cd2430 --- /dev/null +++ b/stack-ghc8.2.2.yaml @@ -0,0 +1,22 @@ +# This file was automatically generated by 'stack init' +# +resolver: lts-11.22 + +packages: +- '.' +# Dependency packages to be pulled from upstream that are not in the resolver +# (e.g., acme-missiles-0.3) +extra-deps: + - socket-0.8.2.0 + - socket-unix-0.2.0.0 +# <<<<<<< HEAD +# ======= +# - store-core-0.3 +# - QuickCheck-2.9.2 +# >>>>>>> QuickCheck tests for existing codecs + +# Override default flag values for local packages and extra-deps +flags: {} + +# Extra package databases containing global packages +extra-package-dbs: [] diff --git a/stack-ghc8.4.4.yaml b/stack-ghc8.4.4.yaml new file mode 100644 index 0000000..02aa3cd --- /dev/null +++ b/stack-ghc8.4.4.yaml @@ -0,0 +1,22 @@ +# This file was automatically generated by 'stack init' +# +resolver: lts-12.26 + +packages: +- '.' +# Dependency packages to be pulled from upstream that are not in the resolver +# (e.g., acme-missiles-0.3) +extra-deps: + - socket-0.8.2.0 + - socket-unix-0.2.0.0 +# <<<<<<< HEAD +# ======= +# - store-core-0.3 +# - QuickCheck-2.9.2 +# >>>>>>> QuickCheck tests for existing codecs + +# Override default flag values for local packages and extra-deps +flags: {} + +# Extra package databases containing global packages +extra-package-dbs: [] From 14af3ff31f82db1af045c29afca8d5c52cf6b3a7 Mon Sep 17 00:00:00 2001 From: qz Date: Thu, 24 Jan 2019 01:49:38 +0300 Subject: [PATCH 3/5] travis env for 8.2/8.4/8.6 --- .travis.yml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.travis.yml b/.travis.yml index 3068f54..1a14421 100644 --- a/.travis.yml +++ b/.travis.yml @@ -10,6 +10,9 @@ os: env: - STACK_YAML=stack-ghc7.10.3.yaml - STACK_YAML=stack-ghc8.0.2.yaml + - STACK_YAML=stack-ghc8.2.2.yaml + - STACK_YAML=stack-ghc8.4.4.yaml + - STACK_YAML=stack-ghc8.6.3.yaml services: - postgresql From 96f9f1eba19b70f335dd4cbe2bc5f0612306c955 Mon Sep 17 00:00:00 2001 From: qz Date: Thu, 24 Jan 2019 04:57:51 +0300 Subject: [PATCH 4/5] tests fix, removed builds for 7.10 / 8.0, pg 10, travis xenial base image --- .travis.yml | 6 ++---- stack-ghc7.10.3.yaml | 15 --------------- stack-ghc8.0.2.yaml | 22 ---------------------- tests/Driver.hs | 2 +- tests_connection/test.hs | 2 +- 5 files changed, 4 insertions(+), 43 deletions(-) delete mode 100644 stack-ghc7.10.3.yaml delete mode 100644 stack-ghc8.0.2.yaml diff --git a/.travis.yml b/.travis.yml index 1a14421..2a0f9ef 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,5 +1,5 @@ # Use new container infrastructure to enable caching -dist: trusty +dist: xenial sudo: false # Do not choose a language; we provide our own build tools. @@ -8,8 +8,6 @@ language: generic os: - linux env: - - STACK_YAML=stack-ghc7.10.3.yaml - - STACK_YAML=stack-ghc8.0.2.yaml - STACK_YAML=stack-ghc8.2.2.yaml - STACK_YAML=stack-ghc8.4.4.yaml - STACK_YAML=stack-ghc8.6.3.yaml @@ -27,7 +25,7 @@ addons: apt: packages: - libgmp-dev - postgresql: "9.6" + postgresql: "10" before_install: # Download and unpack the stack executable diff --git a/stack-ghc7.10.3.yaml b/stack-ghc7.10.3.yaml deleted file mode 100644 index b1bf44d..0000000 --- a/stack-ghc7.10.3.yaml +++ /dev/null @@ -1,15 +0,0 @@ -resolver: lts-8.21 -compiler: ghc-7.10.3 -compiler-check: match-exact - -packages: -- '.' -extra-deps: - - socket-0.8.0.0 - - socket-unix-0.2.0.0 - -# Override default flag values for local packages and extra-deps -flags: {} - -# Extra package databases containing global packages -extra-package-dbs: [] diff --git a/stack-ghc8.0.2.yaml b/stack-ghc8.0.2.yaml deleted file mode 100644 index a62e6da..0000000 --- a/stack-ghc8.0.2.yaml +++ /dev/null @@ -1,22 +0,0 @@ -# This file was automatically generated by 'stack init' -# -resolver: lts-8.21 - -packages: -- '.' -# Dependency packages to be pulled from upstream that are not in the resolver -# (e.g., acme-missiles-0.3) -extra-deps: - - socket-0.8.0.0 - - socket-unix-0.2.0.0 -# <<<<<<< HEAD -# ======= -# - store-core-0.3 -# - QuickCheck-2.9.2 -# >>>>>>> QuickCheck tests for existing codecs - -# Override default flag values for local packages and extra-deps -flags: {} - -# Extra package databases containing global packages -extra-package-dbs: [] diff --git a/tests/Driver.hs b/tests/Driver.hs index aec7715..8afe8ad 100644 --- a/tests/Driver.hs +++ b/tests/Driver.hs @@ -5,7 +5,7 @@ import Data.Foldable import Control.Monad import Data.Maybe import Data.Int -import Data.Either +import Data.Either hiding (fromRight) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Char8 as BS diff --git a/tests_connection/test.hs b/tests_connection/test.hs index 751e74e..864297e 100644 --- a/tests_connection/test.hs +++ b/tests_connection/test.hs @@ -39,7 +39,7 @@ testConnection name confContent = testCase name $ withPghba confContent $ } pghbaFilename :: FilePath -pghbaFilename = "/etc/postgresql/9.5/main/pg_hba.conf" +pghbaFilename = "/etc/postgresql/10/main/pg_hba.conf" withPghba :: B.ByteString -> IO a -> IO a withPghba confContent action = do From f2ea8b7687f887cb5b45ebc19ac61727195b3fc4 Mon Sep 17 00:00:00 2001 From: qz Date: Thu, 24 Jan 2019 10:11:59 +0300 Subject: [PATCH 5/5] char type allows only 7bit values, tests for char encode/decode fixed --- src/Database/PostgreSQL/Protocol/Codecs/Encoders.hs | 4 +++- tests/Codecs/QuickCheck.hs | 13 ++++++++++--- 2 files changed, 13 insertions(+), 4 deletions(-) diff --git a/src/Database/PostgreSQL/Protocol/Codecs/Encoders.hs b/src/Database/PostgreSQL/Protocol/Codecs/Encoders.hs index c57247b..bb0370f 100644 --- a/src/Database/PostgreSQL/Protocol/Codecs/Encoders.hs +++ b/src/Database/PostgreSQL/Protocol/Codecs/Encoders.hs @@ -46,7 +46,9 @@ bytea = putByteString {-# INLINE char #-} char :: Char -> Encode -char = putWord8 . fromIntegral . ord +char c + | ord(c) >= 128 = error "Character code must be below 128" + | otherwise = (putWord8 . fromIntegral . ord) c {-# INLINE date #-} date :: Day -> Encode diff --git a/tests/Codecs/QuickCheck.hs b/tests/Codecs/QuickCheck.hs index bfed79c..551a60a 100644 --- a/tests/Codecs/QuickCheck.hs +++ b/tests/Codecs/QuickCheck.hs @@ -95,7 +95,8 @@ testCodecsEncodeDecode :: TestTree testCodecsEncodeDecode = testGroup "Codecs property 'encode . decode = id'" [ mkCodecTest "bool" PGT.bool PE.bool PD.bool , mkCodecTest "bytea" PGT.bytea PE.bytea PD.bytea - , mkCodecTest "char" PGT.char PE.char PD.char + , mkCodecTest "char" PGT.char (PE.char . unAsciiChar) + (fmap AsciiChar <$> PD.char) , mkCodecTest "date" PGT.date PE.date PD.date , mkCodecTest "float4" PGT.float4 PE.float4 PD.float4 , mkCodecTest "float8" PGT.float8 PE.float8 PD.float8 @@ -103,9 +104,9 @@ testCodecsEncodeDecode = testGroup "Codecs property 'encode . decode = id'" , mkCodecTest "int4" PGT.int4 PE.int4 PD.int4 , mkCodecTest "int8" PGT.int8 PE.int8 PD.int8 , mkCodecTest "interval" PGT.interval PE.interval PD.interval - , mkCodecTest "json" PGT.json (PE.bsJsonText . unJsonString ) + , mkCodecTest "json" PGT.json (PE.bsJsonText . unJsonString) (fmap JsonString <$> PD.bsJsonText) - , mkCodecTest "jsonb" PGT.jsonb (PE.bsJsonBytes .unJsonString) + , mkCodecTest "jsonb" PGT.jsonb (PE.bsJsonBytes . unJsonString) (fmap JsonString <$> PD.bsJsonBytes) , mkCodecTest "numeric" PGT.numeric PE.numeric PD.numeric , mkCodecTest "text" PGT.text PE.bsText PD.bsText @@ -145,6 +146,12 @@ testCodecsEncodePrint = testGroup -- Orphan instances -- +newtype AsciiChar = AsciiChar { unAsciiChar :: Char } + deriving (Show, Eq) + +instance Arbitrary AsciiChar where + arbitrary = AsciiChar <$> choose ('\0', '\127') + -- Helper to generate valid json strings newtype JsonString = JsonString { unJsonString :: B.ByteString } deriving (Show, Eq, IsString)