diff --git a/.travis.yml b/.travis.yml index 3068f54..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,9 @@ 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 services: - postgresql @@ -24,7 +25,7 @@ addons: apt: packages: - libgmp-dev - postgresql: "9.6" + postgresql: "10" before_install: # Download and unpack the stack executable 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/src/Database/PostgreSQL/Protocol/Store/Encode.hs b/src/Database/PostgreSQL/Protocol/Store/Encode.hs index 1c0bf6f..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,14 +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 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 - {-# 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-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.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: [] diff --git a/stack-ghc8.0.2.yaml b/stack-ghc8.6.3.yaml similarity index 92% rename from stack-ghc8.0.2.yaml rename to stack-ghc8.6.3.yaml index a62e6da..1c4ca8b 100644 --- a/stack-ghc8.0.2.yaml +++ b/stack-ghc8.6.3.yaml @@ -1,13 +1,13 @@ # This file was automatically generated by 'stack init' # -resolver: lts-8.21 +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.0.0 + - socket-0.8.2.0 - socket-unix-0.2.0.0 # <<<<<<< HEAD # ======= 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 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) 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