Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-base64 for openSUSE:Factory checked in at 2021-02-16 22:37:00 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-base64 (Old) and /work/SRC/openSUSE:Factory/.ghc-base64.new.28504 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-base64" Tue Feb 16 22:37:00 2021 rev:3 rq:870445 version:0.4.2.3 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-base64/ghc-base64.changes 2020-12-22 11:35:31.805262663 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-base64.new.28504/ghc-base64.changes 2021-02-16 22:45:16.086328474 +0100 @@ -1,0 +2,9 @@ +Wed Jan 27 19:35:33 UTC 2021 - [email protected] + +- Update base64 to version 0.4.2.3. + ## 0.4.2.3 + + * Minor release for stackage, limiting memory usage in test suites. + * Transition to Github Actions CI + +------------------------------------------------------------------- Old: ---- base64-0.4.2.2.tar.gz base64.cabal New: ---- base64-0.4.2.3.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-base64.spec ++++++ --- /var/tmp/diff_new_pack.S0vaXF/_old 2021-02-16 22:45:16.710329295 +0100 +++ /var/tmp/diff_new_pack.S0vaXF/_new 2021-02-16 22:45:16.714329300 +0100 @@ -1,7 +1,7 @@ # # spec file for package ghc-base64 # -# Copyright (c) 2020 SUSE LLC +# Copyright (c) 2021 SUSE LLC # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,13 +19,12 @@ %global pkg_name base64 %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.4.2.2 +Version: 0.4.2.3 Release: 0 -Summary: Fast RFC 4648-compliant Base64 encoding +Summary: A modern RFC 4648-compliant Base64 library License: BSD-3-Clause URL: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz -Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/1.cabal#/%{pkg_name}.cabal BuildRequires: ghc-Cabal-devel BuildRequires: ghc-bytestring-devel BuildRequires: ghc-deepseq-devel @@ -44,9 +43,8 @@ %endif %description -RFC 4648-compliant padded and unpadded base64 and base64url encoding and -decoding. This library provides performant encoding and decoding primitives, as -well as support for textual values. +RFC 4648-compliant Base64 with an eye towards performance and modernity +(additional support for RFC 7049 standards). %package devel Summary: Haskell %{pkg_name} library development files @@ -60,7 +58,6 @@ %prep %autosetup -n %{pkg_name}-%{version} -cp -p %{SOURCE1} %{pkg_name}.cabal %build %ghc_lib_build ++++++ base64-0.4.2.2.tar.gz -> base64-0.4.2.3.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/base64-0.4.2.2/CHANGELOG.md new/base64-0.4.2.3/CHANGELOG.md --- old/base64-0.4.2.2/CHANGELOG.md 2001-09-09 03:46:40.000000000 +0200 +++ new/base64-0.4.2.3/CHANGELOG.md 2001-09-09 03:46:40.000000000 +0200 @@ -1,5 +1,10 @@ # Revision history for base64 +## 0.4.2.3 + +* Minor release for stackage, limiting memory usage in test suites. +* Transition to Github Actions CI + ## 0.4.2.2 * Add `NFData`, `Exception`, and `Generic` instances for `Base64Error` + `@since` annotations for new instances. ([#28](https://github.com/emilypi/base64/pull/28)) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/base64-0.4.2.2/base64.cabal new/base64-0.4.2.3/base64.cabal --- old/base64-0.4.2.2/base64.cabal 2001-09-09 03:46:40.000000000 +0200 +++ new/base64-0.4.2.3/base64.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -1,10 +1,9 @@ cabal-version: 2.0 name: base64 -version: 0.4.2.2 -synopsis: Fast RFC 4648-compliant Base64 encoding +version: 0.4.2.3 +synopsis: A modern RFC 4648-compliant Base64 library description: - RFC 4648-compliant padded and unpadded base64 and base64url encoding and decoding. This library provides - performant encoding and decoding primitives, as well as support for textual values. + RFC 4648-compliant Base64 with an eye towards performance and modernity (additional support for RFC 7049 standards) homepage: https://github.com/emilypi/base64 bug-reports: https://github.com/emilypi/base64/issues @@ -19,14 +18,7 @@ CHANGELOG.md README.md -tested-with: - GHC ==8.2.2 - || ==8.4.3 - || ==8.4.4 - || ==8.6.3 - || ==8.6.5 - || ==8.8.1 - || ==8.10.1 +tested-with: GHC ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.3 source-repository head type: git @@ -60,7 +52,7 @@ build-depends: base >=4.10 && <5 - , bytestring ^>=0.10 + , bytestring >=0.10 && <0.12 , deepseq >=1.4.3.0 && <1.4.5.0 , ghc-byteorder ^>=4.11.0.0 , text ^>=1.2 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/base64-0.4.2.2/test/Internal.hs new/base64-0.4.2.3/test/Internal.hs --- old/base64-0.4.2.2/test/Internal.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/base64-0.4.2.3/test/Internal.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,10 +1,5 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE EmptyDataDecls #-} -{-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE KindSignatures #-} {-# LANGUAGE PackageImports #-} +{-# LANGUAGE RankNTypes #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | -- Module : Main @@ -17,7 +12,19 @@ -- -- This module contains internal test harnesses for `base64` -- -module Internal where +module Internal +( Harness(..) +, b64 +, lb64 +, sb64 +, t64 +, tl64 +, ts64 +, TextHarness(..) +, tt64 +, ttl64 +, tts64 +) where import qualified Data.ByteString as BS @@ -29,8 +36,6 @@ import "base64" Data.ByteString.Lazy.Base64.URL as LB64U import "base64" Data.ByteString.Short.Base64 as SB64 import "base64" Data.ByteString.Short.Base64.URL as SB64U -import Data.Proxy -import Data.String import Data.Text (Text) import qualified Data.Text as T import "base64" Data.Text.Encoding.Base64 as T64 @@ -48,190 +53,168 @@ -- ------------------------------------------------------------------ -- -- Test Harnesses -data Impl - = B64 - | LB64 - | SB64 - | T64 - | TL64 - | TS64 - -b64 :: Proxy 'B64 -b64 = Proxy - -lb64 :: Proxy 'LB64 -lb64 = Proxy - -sb64 :: Proxy 'SB64 -sb64 = Proxy - -t64 :: Proxy 'T64 -t64 = Proxy - -tl64 :: Proxy 'TL64 -tl64 = Proxy - -ts64 :: Proxy 'TS64 -ts64 = Proxy - --- | This class provides the generic API definition for +-- | This dictionary provides the generic API definition for -- the base64 std alphabet -- -class - ( Eq bs - , Show bs - , Arbitrary bs - , CoArbitrary bs - , IsString bs - ) => Harness (a :: Impl) bs | a -> bs, bs -> a - where - - label :: String - encode :: bs -> bs - encodeUrl :: bs -> bs - encodeUrlNopad :: bs -> bs - - decode :: bs -> Either Text bs - decodeUrl :: bs -> Either Text bs - decodeUrlPad :: bs -> Either Text bs - decodeUrlNopad :: bs -> Either Text bs - - lenientUrl :: bs -> bs - lenient :: bs -> bs - - correct :: bs -> Bool - correctUrl :: bs -> Bool - validate :: bs -> Bool - validateUrl :: bs -> Bool - - -instance Harness 'B64 BS.ByteString where - label = "ByteString" - - encode = B64.encodeBase64' - decode = B64.decodeBase64 - lenient = B64.decodeBase64Lenient - correct = B64.isBase64 - validate = B64.isValidBase64 - encodeUrl = B64U.encodeBase64' - encodeUrlNopad = B64U.encodeBase64Unpadded' - decodeUrl = B64U.decodeBase64 - decodeUrlPad = B64U.decodeBase64Padded - decodeUrlNopad = B64U.decodeBase64Unpadded - lenientUrl = B64U.decodeBase64Lenient - correctUrl = B64U.isBase64Url - validateUrl = B64U.isValidBase64Url - -instance Harness 'LB64 LBS.ByteString where - label = "Lazy ByteString" - - encode = LB64.encodeBase64' - decode = LB64.decodeBase64 - lenient = LB64.decodeBase64Lenient - correct = LB64.isBase64 - validate = LB64.isValidBase64 - encodeUrl = LB64U.encodeBase64' - encodeUrlNopad = LB64U.encodeBase64Unpadded' - decodeUrl = LB64U.decodeBase64 - decodeUrlPad = LB64U.decodeBase64Padded - decodeUrlNopad = LB64U.decodeBase64Unpadded - lenientUrl = LB64U.decodeBase64Lenient - correctUrl = LB64U.isBase64Url - validateUrl = LB64U.isValidBase64Url - -instance Harness 'SB64 SBS.ShortByteString where - label = "Short ByteString" - - encode = SB64.encodeBase64' - decode = SB64.decodeBase64 - lenient = SB64.decodeBase64Lenient - correct = SB64.isBase64 - validate = SB64.isValidBase64 - encodeUrl = SB64U.encodeBase64' - encodeUrlNopad = SB64U.encodeBase64Unpadded' - decodeUrl = SB64U.decodeBase64 - decodeUrlPad = SB64U.decodeBase64Padded - decodeUrlNopad = SB64U.decodeBase64Unpadded - lenientUrl = SB64U.decodeBase64Lenient - correctUrl = SB64U.isBase64Url - validateUrl = SB64U.isValidBase64Url - -instance Harness 'T64 Text where - label = "Text" - - encode = T64.encodeBase64 - decode = T64.decodeBase64 - lenient = T64.decodeBase64Lenient - correct = T64.isBase64 - encodeUrl = T64U.encodeBase64 - encodeUrlNopad = T64U.encodeBase64Unpadded - decodeUrl = T64U.decodeBase64 - decodeUrlPad = T64U.decodeBase64Padded - decodeUrlNopad = T64U.decodeBase64Unpadded - lenientUrl = T64U.decodeBase64Lenient - correctUrl = T64U.isBase64Url - validateUrl = T64U.isValidBase64Url - validate = T64.isValidBase64 - -instance Harness 'TL64 TL.Text where - label = "Lazy Text" - - encode = TL64.encodeBase64 - decode = TL64.decodeBase64 - lenient = TL64.decodeBase64Lenient - correct = TL64.isBase64 - encodeUrl = TL64U.encodeBase64 - encodeUrlNopad = TL64U.encodeBase64Unpadded - decodeUrl = TL64U.decodeBase64 - decodeUrlPad = TL64U.decodeBase64Padded - decodeUrlNopad = TL64U.decodeBase64Unpadded - lenientUrl = TL64U.decodeBase64Lenient - correctUrl = TL64U.isBase64Url - validateUrl = TL64U.isValidBase64Url - validate = TL64.isValidBase64 - -instance Harness 'TS64 TS.ShortText where - label = "Short Text" - - encode = TS64.encodeBase64 - decode = TS64.decodeBase64 - lenient = TS64.decodeBase64Lenient - correct = TS64.isBase64 - encodeUrl = TS64U.encodeBase64 - encodeUrlNopad = TS64U.encodeBase64Unpadded - decodeUrl = TS64U.decodeBase64 - decodeUrlPad = TS64U.decodeBase64Padded - decodeUrlNopad = TS64U.decodeBase64Unpadded - lenientUrl = TS64U.decodeBase64Lenient - correctUrl = TS64U.isBase64Url - validateUrl = TS64U.isValidBase64Url - validate = TS64.isValidBase64 - -class Harness a cs - => TextHarness (a :: Impl) cs bs - | a -> cs, bs -> cs, cs -> a, cs -> bs where - decodeWith_ :: (bs -> Either err cs) -> bs -> Either (Base64Error err) cs - decodeUrlWith_ :: (bs -> Either err cs) -> bs -> Either (Base64Error err) cs - decodeUrlPaddedWith_ :: (bs -> Either err cs) -> bs -> Either (Base64Error err) cs - decodeUrlUnpaddedWith_ :: (bs -> Either err cs) -> bs -> Either (Base64Error err) cs - -instance TextHarness 'T64 Text BS.ByteString where - decodeWith_ = T64.decodeBase64With - decodeUrlWith_ = T64U.decodeBase64With - decodeUrlPaddedWith_ = T64U.decodeBase64PaddedWith - decodeUrlUnpaddedWith_ = T64U.decodeBase64UnpaddedWith - -instance TextHarness 'TL64 TL.Text LBS.ByteString where - decodeWith_ = TL64.decodeBase64With - decodeUrlWith_ = TL64U.decodeBase64With - decodeUrlPaddedWith_ = TL64U.decodeBase64PaddedWith - decodeUrlUnpaddedWith_ = TL64U.decodeBase64UnpaddedWith - -instance TextHarness 'TS64 TS.ShortText SBS.ShortByteString where - decodeWith_ = TS64.decodeBase64With - decodeUrlWith_ = TS64U.decodeBase64With - decodeUrlPaddedWith_ = TS64U.decodeBase64PaddedWith - decodeUrlUnpaddedWith_ = TS64U.decodeBase64UnpaddedWith +data Harness bs = Harness + { label :: String + , encode :: bs -> bs + , encodeUrl :: bs -> bs + , encodeUrlNopad :: bs -> bs + , decode :: bs -> Either Text bs + , decodeUrl :: bs -> Either Text bs + , decodeUrlPad :: bs -> Either Text bs + , decodeUrlNopad :: bs -> Either Text bs + , lenientUrl :: bs -> bs + , lenient :: bs -> bs + , correct :: bs -> Bool + , correctUrl :: bs -> Bool + , validate :: bs -> Bool + , validateUrl :: bs -> Bool + } + + +b64 :: Harness BS.ByteString +b64 = Harness + { label = "ByteString" + , encode = B64.encodeBase64' + , decode = B64.decodeBase64 + , lenient = B64.decodeBase64Lenient + , correct = B64.isBase64 + , validate = B64.isValidBase64 + , encodeUrl = B64U.encodeBase64' + , encodeUrlNopad = B64U.encodeBase64Unpadded' + , decodeUrl = B64U.decodeBase64 + , decodeUrlPad = B64U.decodeBase64Padded + , decodeUrlNopad = B64U.decodeBase64Unpadded + , lenientUrl = B64U.decodeBase64Lenient + , correctUrl = B64U.isBase64Url + , validateUrl = B64U.isValidBase64Url + } + +lb64 :: Harness LBS.ByteString +lb64 = Harness + { label = "Lazy ByteString" + , encode = LB64.encodeBase64' + , decode = LB64.decodeBase64 + , lenient = LB64.decodeBase64Lenient + , correct = LB64.isBase64 + , validate = LB64.isValidBase64 + , encodeUrl = LB64U.encodeBase64' + , encodeUrlNopad = LB64U.encodeBase64Unpadded' + , decodeUrl = LB64U.decodeBase64 + , decodeUrlPad = LB64U.decodeBase64Padded + , decodeUrlNopad = LB64U.decodeBase64Unpadded + , lenientUrl = LB64U.decodeBase64Lenient + , correctUrl = LB64U.isBase64Url + , validateUrl = LB64U.isValidBase64Url + } + +sb64 :: Harness SBS.ShortByteString +sb64 = Harness + { label = "Short ByteString" + , encode = SB64.encodeBase64' + , decode = SB64.decodeBase64 + , lenient = SB64.decodeBase64Lenient + , correct = SB64.isBase64 + , validate = SB64.isValidBase64 + , encodeUrl = SB64U.encodeBase64' + , encodeUrlNopad = SB64U.encodeBase64Unpadded' + , decodeUrl = SB64U.decodeBase64 + , decodeUrlPad = SB64U.decodeBase64Padded + , decodeUrlNopad = SB64U.decodeBase64Unpadded + , lenientUrl = SB64U.decodeBase64Lenient + , correctUrl = SB64U.isBase64Url + , validateUrl = SB64U.isValidBase64Url + } + +t64 :: Harness Text +t64 = Harness + { label = "Text" + , encode = T64.encodeBase64 + , decode = T64.decodeBase64 + , lenient = T64.decodeBase64Lenient + , correct = T64.isBase64 + , validate = T64.isValidBase64 + , encodeUrl = T64U.encodeBase64 + , encodeUrlNopad = T64U.encodeBase64Unpadded + , decodeUrl = T64U.decodeBase64 + , decodeUrlPad = T64U.decodeBase64Padded + , decodeUrlNopad = T64U.decodeBase64Unpadded + , lenientUrl = T64U.decodeBase64Lenient + , correctUrl = T64U.isBase64Url + , validateUrl = T64U.isValidBase64Url + } + +tl64 :: Harness TL.Text +tl64 = Harness + { label = "Lazy Text" + , encode = TL64.encodeBase64 + , decode = TL64.decodeBase64 + , lenient = TL64.decodeBase64Lenient + , correct = TL64.isBase64 + , validate = TL64.isValidBase64 + , encodeUrl = TL64U.encodeBase64 + , encodeUrlNopad = TL64U.encodeBase64Unpadded + , decodeUrl = TL64U.decodeBase64 + , decodeUrlPad = TL64U.decodeBase64Padded + , decodeUrlNopad = TL64U.decodeBase64Unpadded + , lenientUrl = TL64U.decodeBase64Lenient + , correctUrl = TL64U.isBase64Url + , validateUrl = TL64U.isValidBase64Url + } + +ts64 :: Harness TS.ShortText +ts64 = Harness + { label = "Short Text" + , encode = TS64.encodeBase64 + , decode = TS64.decodeBase64 + , lenient = TS64.decodeBase64Lenient + , correct = TS64.isBase64 + , validate = TS64.isValidBase64 + , encodeUrl = TS64U.encodeBase64 + , encodeUrlNopad = TS64U.encodeBase64Unpadded + , decodeUrl = TS64U.decodeBase64 + , decodeUrlPad = TS64U.decodeBase64Padded + , decodeUrlNopad = TS64U.decodeBase64Unpadded + , lenientUrl = TS64U.decodeBase64Lenient + , correctUrl = TS64U.isBase64Url + , validateUrl = TS64U.isValidBase64Url + } + +-- -------------------------------------------------------------------- -- +-- Text-specific harness + +data TextHarness bs cs = TextHarness + { decodeWith_ :: forall err. (bs -> Either err cs) -> bs -> Either (Base64Error err) cs + , decodeUrlWith_ :: forall err. (bs -> Either err cs) -> bs -> Either (Base64Error err) cs + , decodeUrlPaddedWith_ :: forall err. (bs -> Either err cs) -> bs -> Either (Base64Error err) cs + , decodeUrlUnpaddedWith_ :: forall err. (bs -> Either err cs) -> bs -> Either (Base64Error err) cs + } + +tt64 :: TextHarness BS.ByteString Text +tt64 = TextHarness + { decodeWith_ = T64.decodeBase64With + , decodeUrlWith_ = T64U.decodeBase64With + , decodeUrlPaddedWith_ = T64U.decodeBase64PaddedWith + , decodeUrlUnpaddedWith_ = T64U.decodeBase64UnpaddedWith + } + +ttl64 :: TextHarness LBS.ByteString TL.Text +ttl64 = TextHarness + { decodeWith_ = TL64.decodeBase64With + , decodeUrlWith_ = TL64U.decodeBase64With + , decodeUrlPaddedWith_ = TL64U.decodeBase64PaddedWith + , decodeUrlUnpaddedWith_ = TL64U.decodeBase64UnpaddedWith + } + +tts64 :: TextHarness SBS.ShortByteString TS.ShortText +tts64 = TextHarness + { decodeWith_ = TS64.decodeBase64With + , decodeUrlWith_ = TS64U.decodeBase64With + , decodeUrlPaddedWith_ = TS64U.decodeBase64PaddedWith + , decodeUrlUnpaddedWith_ = TS64U.decodeBase64UnpaddedWith + } -- ------------------------------------------------------------------ -- -- Quickcheck instances diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/base64-0.4.2.2/test/Main.hs new/base64-0.4.2.3/test/Main.hs --- old/base64-0.4.2.2/test/Main.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/base64-0.4.2.3/test/Main.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,9 +1,7 @@ -{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} -{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -- | -- Module : Main -- Copyright : (c) 2019-2020 Emily Pillmore @@ -44,6 +42,8 @@ import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck (testProperty) +import Data.String (IsString) +import Test.QuickCheck hiding (label) main :: IO () @@ -67,18 +67,18 @@ , mkTree t64 [ mkPropTree , mkUnitTree (c2w . T.last) T.length - , mkDecodeTree T.decodeUtf8' b64 + , mkDecodeTree T.decodeUtf8' tt64 b64 ] , mkTree tl64 [ mkPropTree , mkUnitTree (c2w . TL.last) (fromIntegral . TL.length) - , mkDecodeTree TL.decodeUtf8' lb64 + , mkDecodeTree TL.decodeUtf8' ttl64 lb64 ] , mkTree ts64 [ mkPropTree , mkUnitTree (c2w . T.last . TS.toText) TS.length , mkDecodeTree - (second TS.fromText . T.decodeUtf8' . SBS.fromShort) sb64 + (second TS.fromText . T.decodeUtf8' . SBS.fromShort) tts64 sb64 ] ] @@ -88,28 +88,34 @@ -- | Make a test tree for a given label -- mkTree - :: forall a b proxy - . Harness a b - => proxy a - -> [proxy a -> TestTree] + :: ( Arbitrary a + , IsString a + , Eq a + , Show a + ) + => Harness a + -> [Harness a -> TestTree] -> TestTree -mkTree a = testGroup (label @a) . fmap ($ a) +mkTree a = testGroup (label a) . fmap ($ a) -- | Make a test group with some name, lifting a test tree up to the correct -- type information via some Harness -- mkTests - :: forall a b proxy - . Harness a b + :: ( Arbitrary a + , IsString a + , Eq a + , Show a + ) => String - -> [proxy a -> TestTree] - -> proxy a + -> [Harness a -> TestTree] + -> Harness a -> TestTree mkTests context ts = testGroup context . (<*>) ts . pure -- | Make property tests for a given harness instance -- -mkPropTree :: forall a b proxy. Harness a b => proxy a -> TestTree +mkPropTree :: (Arbitrary a, IsString a, Eq a, Show a) => Harness a -> TestTree mkPropTree = mkTests "Property Tests" [ prop_roundtrip , prop_correctness @@ -120,11 +126,10 @@ -- | Make unit tests for a given harness instance -- mkUnitTree - :: forall a b proxy - . Harness a b - => (b -> Word8) - -> (b -> Int) - -> proxy a + :: (Arbitrary a, IsString a, Eq a, Show a) + => (a -> Word8) + -> (a -> Int) + -> Harness a -> TestTree mkUnitTree last_ length_ = mkTests "Unit tests" [ paddingTests last_ length_ @@ -137,24 +142,27 @@ -- | Make unit tests for textual 'decode*With' functions -- mkDecodeTree - :: forall t a b c e proxy - . ( TextHarness a b c - , Harness t c - , Show e - ) - => (c -> Either e b) - -> proxy t - -> proxy a + :: ( Arbitrary t + , Eq t + , IsString t + , Show t + , IsString a + , Show e + ) + => (a -> Either e t) + -> TextHarness a t + -> Harness a + -> Harness t -> TestTree -mkDecodeTree utf8 t = mkTests "Decoding tests" - [ decodeWithVectors utf8 t +mkDecodeTree utf8 t a = mkTests "Decoding tests" + [ decodeWithVectors utf8 t a ] -- ---------------------------------------------------------------- -- -- Property tests -prop_roundtrip :: forall a b proxy. Harness a b => proxy a -> TestTree -prop_roundtrip _ = testGroup "prop_roundtrip" +prop_roundtrip :: (Arbitrary a, IsString a, Eq a, Show a) => Harness a -> TestTree +prop_roundtrip Harness{..} = testGroup "prop_roundtrip" [ testProperty "prop_std_roundtrip" $ \(bs :: b) -> Right (encode bs) == decode (encode (encode bs)) , testProperty "prop_url_roundtrip" $ \(bs :: b) -> @@ -168,8 +176,8 @@ encodeUrl bs == lenientUrl (encodeUrl (encodeUrl bs)) ] -prop_correctness :: forall a b proxy. Harness a b => proxy a -> TestTree -prop_correctness _ = testGroup "prop_validity" +prop_correctness :: (Arbitrary a, IsString a, Eq a, Show a) => Harness a -> TestTree +prop_correctness Harness{..} = testGroup "prop_validity" [ testProperty "prop_std_valid" $ \(bs :: b) -> validate (encode bs) , testProperty "prop_url_valid" $ \(bs :: b) -> @@ -180,8 +188,8 @@ correctUrl (encodeUrl bs) ] -prop_url_padding :: forall a b proxy. Harness a b => proxy a -> TestTree -prop_url_padding _ = testGroup "prop_url_padding" +prop_url_padding :: (Arbitrary a, IsString a, Eq a, Show a) => Harness a -> TestTree +prop_url_padding Harness{..} = testGroup "prop_url_padding" [ testProperty "prop_url_nopad_roundtrip" $ \(bs :: b) -> Right (encodeUrlNopad bs) == decodeUrlNopad (encodeUrlNopad (encodeUrlNopad bs)) @@ -226,8 +234,8 @@ -- | RFC 4648 test vectors -- -rfcVectors :: forall a b proxy. Harness a b => proxy a -> TestTree -rfcVectors _ = testGroup "RFC 4648 Test Vectors" +rfcVectors :: (IsString a, Eq a, Show a) => Harness a -> TestTree +rfcVectors Harness{..} = testGroup "RFC 4648 Test Vectors" [ testGroup "std alphabet" [ testCaseStd "" "" , testCaseStd "f" "Zg==" @@ -252,7 +260,7 @@ testCaseStd s t = testCaseSteps (show $ if s == "" then "empty" else s) $ \step -> do step "encode is sound" - t @=? encode @a s + t @=? encode s step "decode is sound" Right s @=? decode (encode s) @@ -260,7 +268,7 @@ testCaseUrl s t = testCaseSteps (show $ if s == "" then "empty" else s) $ \step -> do step "encode is sound" - t @=? encodeUrl @a s + t @=? encodeUrl s step "decode is sound" Right s @=? decodeUrlPad t @@ -268,13 +276,15 @@ -- | Url-safe padding unit tests (stresses entire alphabet) -- paddingTests - :: forall a b proxy - . Harness a b - => (b -> Word8) - -> (b -> Int) - -> proxy a + :: ( IsString a + , Eq a + , Show a + ) + => (a -> Word8) + -> (a -> Int) + -> Harness a -> TestTree -paddingTests last_ length_ _ = testGroup "Padding tests" +paddingTests last_ length_ Harness{..} = testGroup "Padding tests" [ testGroup "URL decodePadding coherence" [ ptest "<" "PA==" , ptest "<<" "PDw=" @@ -293,20 +303,20 @@ ] , testGroup "url-safe padding case unit tests" [ testCase "stress arbitarily padded URL strings" $ do - decodeUrl @a "P" @=? Left "Base64-encoded bytestring has invalid size" - decodeUrl @a "PA" @=? Right "<" - decodeUrl @a "PDw" @=? Right "<<" - decodeUrl @a "PDw_" @=? Right "<<?" + decodeUrl "P" @=? Left "Base64-encoded bytestring has invalid size" + decodeUrl "PA" @=? Right "<" + decodeUrl "PDw" @=? Right "<<" + decodeUrl "PDw_" @=? Right "<<?" , testCase "stress padded URL strings" $ do - decodeUrlPad @a "=" @=? Left "Base64-encoded bytestring has invalid size" - decodeUrlPad @a "PA==" @=? Right "<" - decodeUrlPad @a "PDw=" @=? Right "<<" - decodeUrlPad @a "PDw_" @=? Right "<<?" + decodeUrlPad "=" @=? Left "Base64-encoded bytestring has invalid size" + decodeUrlPad "PA==" @=? Right "<" + decodeUrlPad "PDw=" @=? Right "<<" + decodeUrlPad "PDw_" @=? Right "<<?" , testCase "stress unpadded URL strings" $ do - decodeUrlNopad @a "P" @=? Left "Base64-encoded bytestring has invalid size" - decodeUrlNopad @a "PA" @=? Right "<" - decodeUrlNopad @a "PDw" @=? Right "<<" - decodeUrlNopad @a "PDw_" @=? Right "<<?" + decodeUrlNopad "P" @=? Left "Base64-encoded bytestring has invalid size" + decodeUrlNopad "PA" @=? Right "<" + decodeUrlNopad "PDw" @=? Right "<<" + decodeUrlNopad "PDw_" @=? Right "<<?" ] ] where @@ -347,179 +357,181 @@ -- | Offset test vectors. This stresses the invalid char + incorrect padding -- offset error messages -- -offsetVectors :: forall a b proxy. Harness a b => proxy a -> TestTree -offsetVectors _ = testGroup "Offset tests" +offsetVectors :: (IsString a, Eq a, Show a) => Harness a -> TestTree +offsetVectors Harness{..} = testGroup "Offset tests" [ testGroup "Invalid padding" [ testCase "Invalid staggered padding" $ do - decodeUrl @a "=A==" @=? Left "invalid padding at offset: 0" - decodeUrl @a "P===" @=? Left "invalid padding at offset: 1" + decodeUrl "=A==" @=? Left "invalid padding at offset: 0" + decodeUrl "P===" @=? Left "invalid padding at offset: 1" , testCase "Invalid character coverage - final chunk" $ do - decodeUrl @a "%D==" @=? Left "invalid character at offset: 0" - decodeUrl @a "P%==" @=? Left "invalid character at offset: 1" - decodeUrl @a "PD%=" @=? Left "invalid character at offset: 2" - decodeUrl @a "PA=%" @=? Left "invalid character at offset: 3" - decodeUrl @a "PDw%" @=? Left "invalid character at offset: 3" + decodeUrl "%D==" @=? Left "invalid character at offset: 0" + decodeUrl "P%==" @=? Left "invalid character at offset: 1" + decodeUrl "PD%=" @=? Left "invalid character at offset: 2" + decodeUrl "PA=%" @=? Left "invalid character at offset: 3" + decodeUrl "PDw%" @=? Left "invalid character at offset: 3" , testCase "Invalid character coverage - decode chunk" $ do - decodeUrl @a "%Dw_PDw_" @=? Left "invalid character at offset: 0" - decodeUrl @a "P%w_PDw_" @=? Left "invalid character at offset: 1" - decodeUrl @a "PD%_PDw_" @=? Left "invalid character at offset: 2" - decodeUrl @a "PDw%PDw_" @=? Left "invalid character at offset: 3" + decodeUrl "%Dw_PDw_" @=? Left "invalid character at offset: 0" + decodeUrl "P%w_PDw_" @=? Left "invalid character at offset: 1" + decodeUrl "PD%_PDw_" @=? Left "invalid character at offset: 2" + decodeUrl "PDw%PDw_" @=? Left "invalid character at offset: 3" , testCase "Invalid padding in body" $ do - decodeUrl @a "PD=_PDw_" @=? Left "invalid padding at offset: 2" - decodeUrl @a "PDw=PDw_" @=? Left "invalid padding at offset: 3" + decodeUrl "PD=_PDw_" @=? Left "invalid padding at offset: 2" + decodeUrl "PDw=PDw_" @=? Left "invalid padding at offset: 3" , testCase "Padding fails everywhere but end" $ do - decode @a "=eAoeAo=" @=? Left "invalid padding at offset: 0" - decode @a "e=AoeAo=" @=? Left "invalid padding at offset: 1" - decode @a "eA=oeAo=" @=? Left "invalid padding at offset: 2" - decode @a "eAo=eAo=" @=? Left "invalid padding at offset: 3" - decode @a "eAoe=Ao=" @=? Left "invalid padding at offset: 4" - decode @a "eAoeA=o=" @=? Left "invalid padding at offset: 5" + decode "=eAoeAo=" @=? Left "invalid padding at offset: 0" + decode "e=AoeAo=" @=? Left "invalid padding at offset: 1" + decode "eA=oeAo=" @=? Left "invalid padding at offset: 2" + decode "eAo=eAo=" @=? Left "invalid padding at offset: 3" + decode "eAoe=Ao=" @=? Left "invalid padding at offset: 4" + decode "eAoeA=o=" @=? Left "invalid padding at offset: 5" ] ] -canonicityTests :: forall a b proxy. Harness a b => proxy a -> TestTree -canonicityTests _ = testGroup "Canonicity unit tests" +canonicityTests :: (IsString a, Eq a, Show a) => Harness a -> TestTree +canonicityTests Harness{..} = testGroup "Canonicity unit tests" [ testCase "roundtrip for d ~ ZA==" $ do - decode @a "ZE==" @=? Left "non-canonical encoding detected at offset: 1" - decode @a "ZK==" @=? Left "non-canonical encoding detected at offset: 1" - decode @a "ZA==" @=? Right "d" + decode "ZE==" @=? Left "non-canonical encoding detected at offset: 1" + decode "ZK==" @=? Left "non-canonical encoding detected at offset: 1" + decode "ZA==" @=? Right "d" , testCase "roundtrip for f` ~ ZmA=" $ do - decode @a "ZmC=" @=? Left "non-canonical encoding detected at offset: 2" - decode @a "ZmD=" @=? Left "non-canonical encoding detected at offset: 2" - decode @a "ZmA=" @=? Right "f`" + decode "ZmC=" @=? Left "non-canonical encoding detected at offset: 2" + decode "ZmD=" @=? Left "non-canonical encoding detected at offset: 2" + decode "ZmA=" @=? Right "f`" , testCase "roundtrip for foo` ~ Zm9vYA==" $ do - decode @a "Zm9vYE==" @=? Left "non-canonical encoding detected at offset: 5" - decode @a "Zm9vYK==" @=? Left "non-canonical encoding detected at offset: 5" - decode @a "Zm9vYA==" @=? Right "foo`" + decode "Zm9vYE==" @=? Left "non-canonical encoding detected at offset: 5" + decode "Zm9vYK==" @=? Left "non-canonical encoding detected at offset: 5" + decode "Zm9vYA==" @=? Right "foo`" , testCase "roundtrip for foob` ~ Zm9vYmA=" $ do - decode @a "Zm9vYmC=" @=? Left "non-canonical encoding detected at offset: 6" - decode @a "Zm9vYmD=" @=? Left "non-canonical encoding detected at offset: 6" - decode @a "Zm9vYmA=" @=? Right "foob`" + decode "Zm9vYmC=" @=? Left "non-canonical encoding detected at offset: 6" + decode "Zm9vYmD=" @=? Left "non-canonical encoding detected at offset: 6" + decode "Zm9vYmA=" @=? Right "foob`" ] -- | Unit test trees for the `decode*With` family of text-valued functions -- decodeWithVectors - :: forall t a b c e proxy - . ( TextHarness a c b - , Harness t b - , Show e - ) - => (b -> Either e c) + :: ( IsString a + , IsString t + , Eq t + , Show e + , Show t + ) + => (a -> Either e t) -- ^ utf8 - -> proxy t + -> TextHarness a t -- ^ witness to the bytestring-ey dictionaries - -> proxy a + -> Harness a -- ^ witness to the text dictionaries + -> Harness t -> TestTree -decodeWithVectors utf8 _ _ = testGroup "DecodeWith* unit tests" +decodeWithVectors utf8 TextHarness{..} h t = testGroup "DecodeWith* unit tests" [ testGroup "decodeWith negative tests" [ testCase "decodeWith non-utf8 inputs on decodeUtf8" $ do - case decodeWith_ @a utf8 "\1079743" of + case decodeWith_ utf8 "\1079743" of Left (DecodeError _) -> return () _ -> assertFailure "decoding phase" , testCase "decodeWith valid utf8 inputs on decodeUtf8" $ do - case decodeWith_ @a utf8 (encode @t "\1079743") of + case decodeWith_ utf8 (encode h "\1079743") of Left (ConversionError _) -> return () _ -> assertFailure "conversion phase" , testCase "decodeUrlWith non-utf8 inputs on decodeUtf8" $ do - case decodeUrlWith_ @a utf8 "\1079743" of + case decodeUrlWith_ utf8 "\1079743" of Left (DecodeError _) -> return () _ -> assertFailure "decoding phase" , testCase "decodeUrlWith valid utf8 inputs on decodeUtf8" $ do - case decodeUrlWith_ @a utf8 (encodeUrl @t "\1079743") of + case decodeUrlWith_ utf8 (encodeUrl h "\1079743") of Left (ConversionError _) -> return () _ -> assertFailure "conversion phase" , testCase "decodeUrlPaddedWith non-utf8 inputs on decodeUtf8" $ do - case decodeUrlPaddedWith_ @a utf8 "\1079743" of + case decodeUrlPaddedWith_ utf8 "\1079743" of Left (DecodeError _) -> return () _ -> assertFailure "decoding phase" , testCase "decodePaddedWith valid utf8 inputs on decodeUtf8" $ do - case decodeUrlPaddedWith_ @a utf8 (encodeUrl @t "\1079743") of + case decodeUrlPaddedWith_ utf8 (encodeUrl h "\1079743") of Left (ConversionError _) -> return () _ -> assertFailure "conversion phase" , testCase "decodeUnpaddedWith non-utf8 inputs on decodeUtf8" $ do - case decodeUrlUnpaddedWith_ @a utf8 "\1079743" of + case decodeUrlUnpaddedWith_ utf8 "\1079743" of Left (DecodeError _) -> return () _ -> assertFailure "decoding phase" , testCase "decodeUnpaddedWith valid utf8 inputs on decodeUtf8" $ do - case decodeUrlUnpaddedWith_ @a utf8 (encodeUrlNopad @t "\1079743") of + case decodeUrlUnpaddedWith_ utf8 (encodeUrlNopad h "\1079743") of Left (ConversionError _) -> return () _ -> assertFailure "conversion phase" ] , testGroup "decodeWith positive tests" [ testCase "decodeWith utf8 inputs on decodeUtf8" $ do - a <- either (assertFailure . show) pure $ decode @a "Zm9vYmFy" - b <- either (assertFailure . show) pure $ decodeWith_ @a utf8 "Zm9vYmFy" + a <- either (assertFailure . show) pure $ decode t "Zm9vYmFy" + b <- either (assertFailure . show) pure $ decodeWith_ utf8 "Zm9vYmFy" a @=? b , testCase "decodeUrlWith utf8 inputs on decodeUtf8" $ do - a <- either (assertFailure . show) pure $ decodeUrl @a "PDw_Pz4-" - b <- either (assertFailure . show) pure $ decodeUrlWith_ @a utf8 "PDw_Pz4-" + a <- either (assertFailure . show) pure $ decodeUrl t "PDw_Pz4-" + b <- either (assertFailure . show) pure $ decodeUrlWith_ utf8 "PDw_Pz4-" a @=? b , testCase "decodeUrlPaddedWith utf8 inputs on decodeUtf8" $ do - a <- either (assertFailure . show) pure $ decodeUrlPad @a "PDw_Pz4-" - b <- either (assertFailure . show) pure $ decodeUrlPaddedWith_ @a utf8 "PDw_Pz4-" + a <- either (assertFailure . show) pure $ decodeUrlPad t "PDw_Pz4-" + b <- either (assertFailure . show) pure $ decodeUrlPaddedWith_ utf8 "PDw_Pz4-" a @=? b , testCase "decodeUrlUnpaddedWith utf8 inputs on decodeUtf8" $ do - a <- either (assertFailure . show) pure $ decodeUrlNopad @a "PDw_Pz4-" - b <- either (assertFailure . show) pure $ decodeUrlUnpaddedWith_ @a utf8 "PDw_Pz4-" + a <- either (assertFailure . show) pure $ decodeUrlNopad t "PDw_Pz4-" + b <- either (assertFailure . show) pure $ decodeUrlUnpaddedWith_ utf8 "PDw_Pz4-" a @=? b ] ] -- | Validity unit tests for the URL workflow -- -validityTests :: forall a b proxy. Harness a b => proxy a -> TestTree -validityTests _ = testGroup "Validity and correctness unit tests" +validityTests :: IsString a => Harness a -> TestTree +validityTests Harness{..} = testGroup "Validity and correctness unit tests" [ testGroup "Validity unit tests" [ testCase "Padding tests" $ do - not (validateUrl @a "P") @? "P" - validateUrl @a "PA" @? "PA" - validateUrl @a "PDw" @? "PDw" - validateUrl @a "PDw_" @? "PDw_" - validateUrl @a "PA==" @? "PA==" - validateUrl @a "PDw=" @? "PDw=" - validateUrl @a "PDw_" @? "PDw_" + not (validateUrl "P") @? "P" + validateUrl "PA" @? "PA" + validateUrl "PDw" @? "PDw" + validateUrl "PDw_" @? "PDw_" + validateUrl "PA==" @? "PA==" + validateUrl "PDw=" @? "PDw=" + validateUrl "PDw_" @? "PDw_" , testCase "Canonicity tests" $ do - validateUrl @a "ZK==" @? "ZK==" - validateUrl @a "ZE==" @? "ZE==" + validateUrl "ZK==" @? "ZK==" + validateUrl "ZE==" @? "ZE==" - validateUrl @a "ZA==" @? "ZA==" - validateUrl @a "ZK==" @? "ZK==" - validateUrl @a "ZK" @? "ZK" - - validateUrl @a "ZmA=" @? "ZmA=" - validateUrl @a "ZmC=" @? "ZmC=" - validateUrl @a "ZmE" @? "ZmE" - - validateUrl @a "Zm9vYmA=" @? "Zm9vYmA=" - validateUrl @a "Zm9vYmC=" @? "Zm9vYmC=" - validateUrl @a "Zm9vYmC" @? "Zm9vYmC" + validateUrl "ZA==" @? "ZA==" + validateUrl "ZK==" @? "ZK==" + validateUrl "ZK" @? "ZK" + + validateUrl "ZmA=" @? "ZmA=" + validateUrl "ZmC=" @? "ZmC=" + validateUrl "ZmE" @? "ZmE" + + validateUrl "Zm9vYmA=" @? "Zm9vYmA=" + validateUrl "Zm9vYmC=" @? "Zm9vYmC=" + validateUrl "Zm9vYmC" @? "Zm9vYmC" ] , testGroup "Correctness unit tests" [ testCase "Padding tests" $ do - not (validateUrl @a "P") @? "P" - correctUrl @a "PA" @? "PA" - correctUrl @a "PDw" @? "PDw" - correctUrl @a "PDw_" @? "PDw_" - correctUrl @a "PA==" @? "PA==" - correctUrl @a "PDw=" @? "PDw=" - correctUrl @a "PDw_" @? "PDw_" + not (validateUrl "P") @? "P" + correctUrl "PA" @? "PA" + correctUrl "PDw" @? "PDw" + correctUrl "PDw_" @? "PDw_" + correctUrl "PA==" @? "PA==" + correctUrl "PDw=" @? "PDw=" + correctUrl "PDw_" @? "PDw_" , testCase "Canonicity tests" $ do - not (correctUrl @a "ZK==") @? "ZK==" - not (correctUrl @a "ZE==") @? "ZE==" - correctUrl @a "ZA==" @? "ZA==" - - correctUrl @a "ZmA=" @? "ZmA=" - not (correctUrl @a "ZmC=") @? "ZmC=" - not (correctUrl @a "ZmD") @? "ZmD" - - correctUrl @a "Zm9vYmA=" @? "Zm9vYmA=" - not (correctUrl @a "Zm9vYmC=") @? "Zm9vYmC=" - not (correctUrl @a "Zm9vYmC") @? "Zm9vYmC" + not (correctUrl "ZK==") @? "ZK==" + not (correctUrl "ZE==") @? "ZE==" + correctUrl "ZA==" @? "ZA==" + + correctUrl "ZmA=" @? "ZmA=" + not (correctUrl "ZmC=") @? "ZmC=" + not (correctUrl "ZmD") @? "ZmD" + + correctUrl "Zm9vYmA=" @? "Zm9vYmA=" + not (correctUrl "Zm9vYmC=") @? "Zm9vYmC=" + not (correctUrl "Zm9vYmC") @? "Zm9vYmC" ] ]
