August 2017 - openSUSE Commits - openSUSE Mailing Lists

commit ghc-yesod-test for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-yesod-test for openSUSE:Factory checked in at 2017-08-31 21:02:17 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-yesod-test (Old) and /work/SRC/openSUSE:Factory/.ghc-yesod-test.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-yesod-test" Thu Aug 31 21:02:17 2017 rev:5 rq:513550 version:1.5.8 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-yesod-test/ghc-yesod-test.changes 2017-07-06 00:03:53.474142697 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-yesod-test.new/ghc-yesod-test.changes 2017-08-31 21:02:18.914085426 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:05:16 UTC 2017 - psimons(a)suse.com + +- Update to version 1.5.8. + +------------------------------------------------------------------- Old: ---- yesod-test-1.5.7.tar.gz New: ---- yesod-test-1.5.8.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-yesod-test.spec ++++++ --- /var/tmp/diff_new_pack.3wCk6p/_old 2017-08-31 21:02:19.921943821 +0200 +++ /var/tmp/diff_new_pack.3wCk6p/_new 2017-08-31 21:02:19.937941573 +0200 @@ -19,7 +19,7 @@ %global pkg_name yesod-test %bcond_with tests Name: ghc-%{pkg_name} -Version: 1.5.7 +Version: 1.5.8 Release: 0 Summary: Integration testing for WAI/Yesod Applications License: MIT ++++++ yesod-test-1.5.7.tar.gz -> yesod-test-1.5.8.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yesod-test-1.5.7/ChangeLog.md new/yesod-test-1.5.8/ChangeLog.md --- old/yesod-test-1.5.7/ChangeLog.md 2017-06-22 18:16:04.000000000 +0200 +++ new/yesod-test-1.5.8/ChangeLog.md 2017-07-20 12:41:52.000000000 +0200 @@ -1,3 +1,7 @@ +## 1.5.8 +* Added implicit parameter HasCallStack to assertions. +[#1421](https://github.com/yesodweb/yesod/pull/1421) + ## 1.5.7 * Add clickOn. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yesod-test-1.5.7/Yesod/Test.hs new/yesod-test-1.5.8/Yesod/Test.hs --- old/yesod-test-1.5.7/Yesod/Test.hs 2017-06-22 18:16:04.000000000 +0200 +++ new/yesod-test-1.5.8/Yesod/Test.hs 2017-07-20 12:41:52.000000000 +0200 @@ -4,6 +4,8 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE ConstraintKinds #-} {-| Yesod.Test is a pragmatic framework for testing web applications built @@ -150,6 +152,16 @@ import Control.Applicative ((<$>)) import Text.Show.Pretty (ppShow) import Data.Monoid (mempty) +#if MIN_VERSION_base(4,9,0) +import GHC.Stack (HasCallStack) +#elif MIN_VERSION_base(4,8,1) +import GHC.Stack (CallStack) +type HasCallStack = (?callStack :: CallStack) +#else +import GHC.Exts (Constraint) +type HasCallStack = (() :: Constraint) +#endif + -- | The state used in a single test case defined using 'yit' -- @@ -330,7 +342,7 @@ -- In case they are not equal, error mesasge includes the two values. -- -- @since 1.5.2 -assertEq :: (Eq a, Show a) => String -> a -> a -> YesodExample site () +assertEq :: (HasCallStack, Eq a, Show a) => String -> a -> a -> YesodExample site () assertEq m a b = liftIO $ HUnit.assertBool msg (a == b) where msg = "Assertion: " ++ m ++ "\n" ++ @@ -342,24 +354,24 @@ -- In case they are equal, error mesasge includes the values. -- -- @since 1.5.6 -assertNotEq :: (Eq a, Show a) => String -> a -> a -> YesodExample site () +assertNotEq :: (HasCallStack, Eq a, Show a) => String -> a -> a -> YesodExample site () assertNotEq m a b = liftIO $ HUnit.assertBool msg (a /= b) where msg = "Assertion: " ++ m ++ "\n" ++ "Both arguments: " ++ ppShow a ++ "\n" {-# DEPRECATED assertEqual "Use assertEq instead" #-} -assertEqual :: (Eq a) => String -> a -> a -> YesodExample site () +assertEqual :: (HasCallStack, Eq a) => String -> a -> a -> YesodExample site () assertEqual = assertEqualNoShow -- | Asserts that the two given values are equal. -- -- @since 1.5.2 -assertEqualNoShow :: (Eq a) => String -> a -> a -> YesodExample site () +assertEqualNoShow :: (HasCallStack, Eq a) => String -> a -> a -> YesodExample site () assertEqualNoShow msg a b = liftIO $ HUnit.assertBool msg (a == b) -- | Assert the last response status is as expected. -statusIs :: Int -> YesodExample site () +statusIs :: HasCallStack => Int -> YesodExample site () statusIs number = withResponse $ \ SResponse { simpleStatus = s } -> liftIO $ flip HUnit.assertBool (H.statusCode s == number) $ concat [ "Expected status was ", show number @@ -367,7 +379,7 @@ ] -- | Assert the given header key/value pair was returned. -assertHeader :: CI BS8.ByteString -> BS8.ByteString -> YesodExample site () +assertHeader :: HasCallStack => CI BS8.ByteString -> BS8.ByteString -> YesodExample site () assertHeader header value = withResponse $ \ SResponse { simpleHeaders = h } -> case lookup header h of Nothing -> failure $ T.pack $ concat @@ -387,7 +399,7 @@ ] -- | Assert the given header was not included in the response. -assertNoHeader :: CI BS8.ByteString -> YesodExample site () +assertNoHeader :: HasCallStack => CI BS8.ByteString -> YesodExample site () assertNoHeader header = withResponse $ \ SResponse { simpleHeaders = h } -> case lookup header h of Nothing -> return () @@ -400,14 +412,14 @@ -- | Assert the last response is exactly equal to the given text. This is -- useful for testing API responses. -bodyEquals :: String -> YesodExample site () +bodyEquals :: HasCallStack => String -> YesodExample site () bodyEquals text = withResponse $ \ res -> liftIO $ HUnit.assertBool ("Expected body to equal " ++ text) $ (simpleBody res) == encodeUtf8 (TL.pack text) -- | Assert the last response has the given text. The check is performed using the response -- body in full text form. -bodyContains :: String -> YesodExample site () +bodyContains :: HasCallStack => String -> YesodExample site () bodyContains text = withResponse $ \ res -> liftIO $ HUnit.assertBool ("Expected body to contain " ++ text) $ (simpleBody res) `contains` text @@ -415,7 +427,7 @@ -- | Assert the last response doesn't have the given text. The check is performed using the response -- body in full text form. -- @since 1.5.3 -bodyNotContains :: String -> YesodExample site () +bodyNotContains :: HasCallStack => String -> YesodExample site () bodyNotContains text = withResponse $ \ res -> liftIO $ HUnit.assertBool ("Expected body not to contain " ++ text) $ not $ contains (simpleBody res) text @@ -425,7 +437,7 @@ -- | Queries the HTML using a CSS selector, and all matched elements must contain -- the given string. -htmlAllContain :: Query -> String -> YesodExample site () +htmlAllContain :: HasCallStack => Query -> String -> YesodExample site () htmlAllContain query search = do matches <- htmlQuery query case matches of @@ -437,7 +449,7 @@ -- element contains the given string. -- -- Since 0.3.5 -htmlAnyContain :: Query -> String -> YesodExample site () +htmlAnyContain :: HasCallStack => Query -> String -> YesodExample site () htmlAnyContain query search = do matches <- htmlQuery query case matches of @@ -450,7 +462,7 @@ -- inverse of htmlAnyContains). -- -- Since 1.2.2 -htmlNoneContain :: Query -> String -> YesodExample site () +htmlNoneContain :: HasCallStack => Query -> String -> YesodExample site () htmlNoneContain query search = do matches <- htmlQuery query case DL.filter (DL.isInfixOf search) (map (TL.unpack . decodeUtf8) matches) of @@ -460,7 +472,7 @@ -- | Performs a CSS query on the last response and asserts the matched elements -- are as many as expected. -htmlCount :: Query -> Int -> YesodExample site () +htmlCount :: HasCallStack => Query -> Int -> YesodExample site () htmlCount query count = do matches <- fmap DL.length $ htmlQuery query liftIO $ flip HUnit.assertBool (matches == count) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yesod-test-1.5.7/yesod-test.cabal new/yesod-test-1.5.8/yesod-test.cabal --- old/yesod-test-1.5.7/yesod-test.cabal 2017-06-22 18:16:04.000000000 +0200 +++ new/yesod-test-1.5.8/yesod-test.cabal 2017-07-20 12:41:52.000000000 +0200 @@ -1,5 +1,5 @@ name: yesod-test -version: 1.5.7 +version: 1.5.8 license: MIT license-file: LICENSE author: Nubis <nubis(a)woobiz.com.ar>

1 0

commit ghc-yesod-static for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-yesod-static for openSUSE:Factory checked in at 2017-08-31 21:02:14 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-yesod-static (Old) and /work/SRC/openSUSE:Factory/.ghc-yesod-static.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-yesod-static" Thu Aug 31 21:02:14 2017 rev:8 rq:513549 version:1.5.3.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-yesod-static/ghc-yesod-static.changes 2017-06-21 13:56:48.430624082 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-yesod-static.new/ghc-yesod-static.changes 2017-08-31 21:02:14.746670957 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:08:13 UTC 2017 - psimons(a)suse.com + +- Update to version 1.5.3.1. + +------------------------------------------------------------------- Old: ---- yesod-static-1.5.3.tar.gz New: ---- yesod-static-1.5.3.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-yesod-static.spec ++++++ --- /var/tmp/diff_new_pack.ehtWkY/_old 2017-08-31 21:02:15.598551266 +0200 +++ /var/tmp/diff_new_pack.ehtWkY/_new 2017-08-31 21:02:15.610549580 +0200 @@ -19,7 +19,7 @@ %global pkg_name yesod-static %bcond_with tests Name: ghc-%{pkg_name} -Version: 1.5.3 +Version: 1.5.3.1 Release: 0 Summary: Static file serving subsite for Yesod Web Framework License: MIT @@ -36,8 +36,8 @@ BuildRequires: ghc-conduit-devel BuildRequires: ghc-conduit-extra-devel BuildRequires: ghc-containers-devel -BuildRequires: ghc-cryptohash-conduit-devel -BuildRequires: ghc-cryptohash-devel +BuildRequires: ghc-cryptonite-conduit-devel +BuildRequires: ghc-cryptonite-devel BuildRequires: ghc-css-text-devel BuildRequires: ghc-data-default-devel BuildRequires: ghc-directory-devel @@ -47,6 +47,7 @@ BuildRequires: ghc-hashable-devel BuildRequires: ghc-hjsmin-devel BuildRequires: ghc-http-types-devel +BuildRequires: ghc-memory-devel BuildRequires: ghc-mime-types-devel BuildRequires: ghc-old-time-devel BuildRequires: ghc-process-devel ++++++ yesod-static-1.5.3.tar.gz -> yesod-static-1.5.3.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yesod-static-1.5.3/ChangeLog.md new/yesod-static-1.5.3.1/ChangeLog.md --- old/yesod-static-1.5.3/ChangeLog.md 2017-06-07 15:01:59.000000000 +0200 +++ new/yesod-static-1.5.3.1/ChangeLog.md 2017-07-23 06:27:05.000000000 +0200 @@ -1,3 +1,7 @@ +## 1.5.3.1 + +* Switch to cryptonite + ## 1.5.3 * Add `staticFilesMap` function diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yesod-static-1.5.3/Yesod/Static.hs new/yesod-static-1.5.3.1/Yesod/Static.hs --- old/yesod-static-1.5.3/Yesod/Static.hs 2017-06-07 15:01:59.000000000 +0200 +++ new/yesod-static-1.5.3.1/Yesod/Static.hs 2017-07-23 06:13:24.000000000 +0200 @@ -81,7 +81,7 @@ import Control.Monad.Catch (MonadThrow) import Control.Monad.Trans.State -import qualified Data.Byteable as Byteable +import qualified Data.ByteArray as ByteArray import qualified Data.ByteString.Base64 import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy as L @@ -420,7 +420,7 @@ base64md5File :: FilePath -> IO String base64md5File = fmap (base64 . encode) . hashFile - where encode d = Byteable.toBytes (d :: Digest MD5) + where encode d = ByteArray.convert (d :: Digest MD5) base64md5 :: L.ByteString -> String base64md5 lbs = @@ -428,7 +428,7 @@ $ runIdentity $ sourceList (L.toChunks lbs) $$ sinkHash where - encode d = Byteable.toBytes (d :: Digest MD5) + encode d = ByteArray.convert (d :: Digest MD5) base64 :: S.ByteString -> String base64 = map tr diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yesod-static-1.5.3/yesod-static.cabal new/yesod-static-1.5.3.1/yesod-static.cabal --- old/yesod-static-1.5.3/yesod-static.cabal 2017-06-07 15:01:59.000000000 +0200 +++ new/yesod-static-1.5.3.1/yesod-static.cabal 2017-07-23 06:26:50.000000000 +0200 @@ -1,5 +1,5 @@ name: yesod-static -version: 1.5.3 +version: 1.5.3.1 license: MIT license-file: LICENSE author: Michael Snoyman <michael(a)snoyman.com> @@ -44,8 +44,9 @@ , unix-compat >= 0.2 , conduit >= 0.5 , conduit-extra - , cryptohash-conduit >= 0.1 - , cryptohash >= 0.11 + , cryptonite-conduit >= 0.1 + , cryptonite >= 0.11 + , memory , data-default , mime-types >= 0.1 , hjsmin @@ -112,8 +113,9 @@ , http-types , unix-compat , conduit - , cryptohash-conduit - , cryptohash + , cryptonite-conduit + , cryptonite + , memory , data-default , mime-types , hjsmin

1 0

commit ghc-yesod-job-queue for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-yesod-job-queue for openSUSE:Factory checked in at 2017-08-31 21:02:10 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-yesod-job-queue (Old) and /work/SRC/openSUSE:Factory/.ghc-yesod-job-queue.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-yesod-job-queue" Thu Aug 31 21:02:10 2017 rev:2 rq:513548 version:0.3.0.4 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-yesod-job-queue/ghc-yesod-job-queue.changes 2017-05-09 18:08:07.278742014 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-yesod-job-queue.new/ghc-yesod-job-queue.changes 2017-08-31 21:02:13.326870442 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:07:15 UTC 2017 - psimons(a)suse.com + +- Update to version 0.3.0.4. + +------------------------------------------------------------------- Old: ---- yesod-job-queue-0.3.0.2.tar.gz New: ---- yesod-job-queue-0.3.0.4.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-yesod-job-queue.spec ++++++ --- /var/tmp/diff_new_pack.CbpMW6/_old 2017-08-31 21:02:14.170751874 +0200 +++ /var/tmp/diff_new_pack.CbpMW6/_new 2017-08-31 21:02:14.186749627 +0200 @@ -18,7 +18,7 @@ %global pkg_name yesod-job-queue Name: ghc-%{pkg_name} -Version: 0.3.0.2 +Version: 0.3.0.4 Release: 0 Summary: Background jobs library for Yesod License: BSD-3-Clause ++++++ yesod-job-queue-0.3.0.2.tar.gz -> yesod-job-queue-0.3.0.4.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yesod-job-queue-0.3.0.2/Yesod/JobQueue/Types.hs new/yesod-job-queue-0.3.0.4/Yesod/JobQueue/Types.hs --- old/yesod-job-queue-0.3.0.2/Yesod/JobQueue/Types.hs 2016-12-02 10:39:39.000000000 +0100 +++ new/yesod-job-queue-0.3.0.4/Yesod/JobQueue/Types.hs 2017-05-16 19:46:56.000000000 +0200 @@ -1,3 +1,4 @@ +{-# OPTIONS_HADDOCK prune #-} {-# LANGUAGE TemplateHaskell #-} module Yesod.JobQueue.Types where diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yesod-job-queue-0.3.0.2/Yesod/JobQueue.hs new/yesod-job-queue-0.3.0.4/Yesod/JobQueue.hs --- old/yesod-job-queue-0.3.0.2/Yesod/JobQueue.hs 2016-12-02 10:39:39.000000000 +0100 +++ new/yesod-job-queue-0.3.0.4/Yesod/JobQueue.hs 2017-05-09 04:25:28.000000000 +0200 @@ -33,7 +33,7 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Control (MonadBaseControl) import Control.Monad.Trans.Reader (ReaderT, runReaderT) -import Data.Aeson (ToJSON(toJSON), Value(String), (.=), object) +import Data.Aeson (Value, (.=), object) import Data.Aeson.TH (defaultOptions, deriveToJSON) import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BSC @@ -69,8 +69,7 @@ , jobId :: U.UUID , startTime :: UTCTime } deriving (Eq) -instance ToJSON U.UUID where - toJSON = String . T.pack . U.toString + $(deriveToJSON defaultOptions ''RunningJob) -- | Manage the running jobs diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yesod-job-queue-0.3.0.2/yesod-job-queue.cabal new/yesod-job-queue-0.3.0.4/yesod-job-queue.cabal --- old/yesod-job-queue-0.3.0.2/yesod-job-queue.cabal 2017-05-03 12:15:41.000000000 +0200 +++ new/yesod-job-queue-0.3.0.4/yesod-job-queue.cabal 2017-05-16 19:46:56.000000000 +0200 @@ -1,5 +1,5 @@ name: yesod-job-queue -version: 0.3.0.2 +version: 0.3.0.4 synopsis: Background jobs library for Yesod. description: Background jobs library for Yesod @@ -45,10 +45,10 @@ , TypeSynonymInstances , ViewPatterns build-depends: base >= 4.7 && < 5 - , aeson - , api-field-json-th + , aeson >= 1.1 + , api-field-json-th >= 0.1 , bytestring - , cron + , cron >= 0.5.0 && < 0.6 , file-embed , hedis , lens @@ -61,9 +61,9 @@ , uuid , yesod >= 1.4 && < 1.5 , yesod-core - , yesod-persistent + , yesod-persistent >= 1.4 && < 1.5 - ghc-options: -Wall -fwarn-tabs -O2 + ghc-options: -Wall -fwarn-tabs default-language: Haskell2010 executable yesod-job-queue-example @@ -83,7 +83,7 @@ , GeneralizedNewtypeDeriving , DeriveGeneric -- other-modules: - ghc-options: -Wall -fwarn-tabs -O2 + ghc-options: -Wall -fwarn-tabs build-depends: base >= 4.7 && < 5 , yesod @@ -95,7 +95,7 @@ , classy-prelude-yesod , hedis - ghc-options: -threaded -O2 -rtsopts -with-rtsopts=-N + ghc-options: -threaded -rtsopts -with-rtsopts=-N default-language: Haskell2010 test-suite yesod-job-queue-test

1 0

commit ghc-yesod-form for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-yesod-form for openSUSE:Factory checked in at 2017-08-31 21:02:08 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-yesod-form (Old) and /work/SRC/openSUSE:Factory/.ghc-yesod-form.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-yesod-form" Thu Aug 31 21:02:08 2017 rev:8 rq:513547 version:1.4.13 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-yesod-form/ghc-yesod-form.changes 2017-06-04 01:59:37.105985606 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-yesod-form.new/ghc-yesod-form.changes 2017-08-31 21:02:08.683522842 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:05:38 UTC 2017 - psimons(a)suse.com + +- Update to version 1.4.13. + +------------------------------------------------------------------- Old: ---- yesod-form-1.4.12.tar.gz New: ---- yesod-form-1.4.13.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-yesod-form.spec ++++++ --- /var/tmp/diff_new_pack.Xt7C1F/_old 2017-08-31 21:02:09.587395846 +0200 +++ /var/tmp/diff_new_pack.Xt7C1F/_new 2017-08-31 21:02:09.587395846 +0200 @@ -19,7 +19,7 @@ %global pkg_name yesod-form %bcond_with tests Name: ghc-%{pkg_name} -Version: 1.4.12 +Version: 1.4.13 Release: 0 Summary: Form handling support for Yesod Web Framework License: MIT ++++++ yesod-form-1.4.12.tar.gz -> yesod-form-1.4.13.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yesod-form-1.4.12/ChangeLog.md new/yesod-form-1.4.13/ChangeLog.md --- old/yesod-form-1.4.12/ChangeLog.md 2017-05-13 23:23:44.000000000 +0200 +++ new/yesod-form-1.4.13/ChangeLog.md 2017-07-20 12:41:52.000000000 +0200 @@ -1,3 +1,7 @@ +## 1.4.13 + +* Fixed `textareaField` `writeHtmlEscapedChar` trim "\r" + ## 1.4.12 * Password field does not remember its previous value diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yesod-form-1.4.12/Yesod/Form/Fields.hs new/yesod-form-1.4.13/Yesod/Form/Fields.hs --- old/yesod-form-1.4.12/Yesod/Form/Fields.hs 2017-04-12 09:57:39.000000000 +0200 +++ new/yesod-form-1.4.13/Yesod/Form/Fields.hs 2017-07-20 12:41:52.000000000 +0200 @@ -106,6 +106,10 @@ import Yesod.Persist.Core +#if !MIN_VERSION_base(4,8,0) +import Data.Monoid +#endif + defaultFormMessage :: FormMessage -> Text defaultFormMessage = englishFormMessage @@ -226,6 +230,7 @@ . unTextarea where -- Taken from blaze-builder and modified with newline handling. + writeHtmlEscapedChar '\r' = mempty writeHtmlEscapedChar '\n' = writeByteString " " writeHtmlEscapedChar c = B.writeHtmlEscapedChar c diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yesod-form-1.4.12/yesod-form.cabal new/yesod-form-1.4.13/yesod-form.cabal --- old/yesod-form-1.4.12/yesod-form.cabal 2017-05-13 23:23:29.000000000 +0200 +++ new/yesod-form-1.4.13/yesod-form.cabal 2017-07-20 12:41:52.000000000 +0200 @@ -1,5 +1,5 @@ name: yesod-form -version: 1.4.12 +version: 1.4.13 license: MIT license-file: LICENSE author: Michael Snoyman <michael(a)snoyman.com>

1 0

commit ghc-yesod-core for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-yesod-core for openSUSE:Factory checked in at 2017-08-31 21:02:05 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-yesod-core (Old) and /work/SRC/openSUSE:Factory/.ghc-yesod-core.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-yesod-core" Thu Aug 31 21:02:05 2017 rev:14 rq:513546 version:1.4.35.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-yesod-core/ghc-yesod-core.changes 2017-06-21 13:56:42.971394153 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-yesod-core.new/ghc-yesod-core.changes 2017-08-31 21:02:07.083747614 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:07:14 UTC 2017 - psimons(a)suse.com + +- Update to version 1.4.35.1. + +------------------------------------------------------------------- Old: ---- yesod-core-1.4.35.tar.gz yesod-core.cabal New: ---- yesod-core-1.4.35.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-yesod-core.spec ++++++ --- /var/tmp/diff_new_pack.onLI8E/_old 2017-08-31 21:02:08.259582406 +0200 +++ /var/tmp/diff_new_pack.onLI8E/_new 2017-08-31 21:02:08.283579035 +0200 @@ -19,14 +19,13 @@ %global pkg_name yesod-core %bcond_with tests Name: ghc-%{pkg_name} -Version: 1.4.35 +Version: 1.4.35.1 Release: 0 Summary: Creation of type-safe, RESTful web applications License: MIT Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{ve… -Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/1.cabal… BuildRequires: ghc-Cabal-devel BuildRequires: ghc-aeson-devel BuildRequires: ghc-auto-update-devel @@ -105,7 +104,6 @@ %prep %setup -q -n %{pkg_name}-%{version} -cp -p %{SOURCE1} %{pkg_name}.cabal %build %ghc_lib_build ++++++ yesod-core-1.4.35.tar.gz -> yesod-core-1.4.35.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yesod-core-1.4.35/ChangeLog.md new/yesod-core-1.4.35.1/ChangeLog.md --- old/yesod-core-1.4.35/ChangeLog.md 2017-06-05 10:33:22.000000000 +0200 +++ new/yesod-core-1.4.35.1/ChangeLog.md 2017-07-20 12:58:03.000000000 +0200 @@ -1,3 +1,7 @@ +## 1.4.35.1 + +* TH fix for GHC 8.2 + ## 1.4.35 * Contexts can be included in generated TH instances. [1365](https://github.com/yesodweb/yesod/issues/1365) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yesod-core-1.4.35/Yesod/Routes/TH/RenderRoute.hs new/yesod-core-1.4.35.1/Yesod/Routes/TH/RenderRoute.hs --- old/yesod-core-1.4.35/Yesod/Routes/TH/RenderRoute.hs 2017-06-05 10:33:22.000000000 +0200 +++ new/yesod-core-1.4.35.1/Yesod/Routes/TH/RenderRoute.hs 2017-07-20 12:41:52.000000000 +0200 @@ -160,7 +160,7 @@ (cons, decs) <- mkRouteCons ress #if MIN_VERSION_template_haskell(2,12,0) did <- DataInstD [] ''Route [typ] Nothing cons <$> fmap (pure . DerivClause Nothing) (mapM conT (clazzes False)) - let sds = fmap (\t -> StandaloneDerivD cxt $ ConT t `AppT` ( ConT ''Route `AppT` typ)) (clazzes True) + let sds = fmap (\t -> StandaloneDerivD Nothing cxt $ ConT t `AppT` ( ConT ''Route `AppT` typ)) (clazzes True) #elif MIN_VERSION_template_haskell(2,11,0) did <- DataInstD [] ''Route [typ] Nothing cons <$> mapM conT (clazzes False) let sds = fmap (\t -> StandaloneDerivD cxt $ ConT t `AppT` ( ConT ''Route `AppT` typ)) (clazzes True) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yesod-core-1.4.35/yesod-core.cabal new/yesod-core-1.4.35.1/yesod-core.cabal --- old/yesod-core-1.4.35/yesod-core.cabal 2017-06-05 10:33:22.000000000 +0200 +++ new/yesod-core-1.4.35.1/yesod-core.cabal 2017-07-20 12:57:56.000000000 +0200 @@ -1,5 +1,5 @@ name: yesod-core -version: 1.4.35 +version: 1.4.35.1 license: MIT license-file: LICENSE author: Michael Snoyman <michael(a)snoyman.com>

1 0

commit ghc-xml-conduit for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-xml-conduit for openSUSE:Factory checked in at 2017-08-31 21:02:01 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-xml-conduit (Old) and /work/SRC/openSUSE:Factory/.ghc-xml-conduit.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-xml-conduit" Thu Aug 31 21:02:01 2017 rev:12 rq:513545 version:1.5.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-xml-conduit/ghc-xml-conduit.changes 2017-03-03 17:52:46.271322152 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-xml-conduit.new/ghc-xml-conduit.changes 2017-08-31 21:02:04.524107249 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:07:43 UTC 2017 - psimons(a)suse.com + +- Update to version 1.5.1. + +------------------------------------------------------------------- Old: ---- xml-conduit-1.4.0.4.tar.gz New: ---- xml-conduit-1.5.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-xml-conduit.spec ++++++ --- /var/tmp/diff_new_pack.g1jony/_old 2017-08-31 21:02:05.611954404 +0200 +++ /var/tmp/diff_new_pack.g1jony/_new 2017-08-31 21:02:05.639950470 +0200 @@ -19,7 +19,7 @@ %global pkg_name xml-conduit %bcond_with tests Name: ghc-%{pkg_name} -Version: 1.4.0.4 +Version: 1.5.1 Release: 0 Summary: Pure-Haskell utilities for dealing with XML with the conduit package License: MIT ++++++ xml-conduit-1.4.0.4.tar.gz -> xml-conduit-1.5.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/xml-conduit-1.4.0.4/ChangeLog.md new/xml-conduit-1.5.1/ChangeLog.md --- old/xml-conduit-1.4.0.4/ChangeLog.md 2017-02-13 20:32:23.000000000 +0100 +++ new/xml-conduit-1.5.1/ChangeLog.md 2017-05-21 00:05:14.000000000 +0200 @@ -1,3 +1,17 @@ +## 1.5.1 + +* New render setting, `rsXMLDeclaration`; setting it to `False` omits the XML declaration. + +## 1.5.0 + +* `tag` function no longer throws an exception when attributes don't match [#93](https://github.com/snoyberg/xml/pull/93) +* Add `many_` combinator to avoid building results in memory [#94](https://github.com/snoyberg/xml/pull/94) +* Turn some functions from `Consumer Event m a` to `ConduitM Event o m a` to allow yielding values +* Replace `takeAllTreesContent` with `takeAnyTreeContent`, that only consumes one tree +* Introduce `NameMatcher` type to refactor tag parsers +* Add a couple of `take*` functions to stream events rather than parse them +* Rename `ignore*` functions to comply with naming convention + ## 1.4.0.3 * Compatibility with blaze-markup-0.8.0.0 [#95](https://github.com/snoyberg/xml/issues/95) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/xml-conduit-1.4.0.4/Text/XML/Stream/Parse.hs new/xml-conduit-1.5.1/Text/XML/Stream/Parse.hs --- old/xml-conduit-1.4.0.4/Text/XML/Stream/Parse.hs 2017-02-13 20:32:23.000000000 +0100 +++ new/xml-conduit-1.5.1/Text/XML/Stream/Parse.hs 2017-05-21 00:05:14.000000000 +0200 @@ -1,11 +1,16 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PatternGuards #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE TupleSections #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeFamilies #-} -- | This module provides both a native Haskell solution for parsing XML -- documents into a stream of events, and a set of parser combinators for -- dealing with a stream of events. @@ -29,10 +34,12 @@ -- > data Person = Person Int Text -- > deriving Show -- > --- > parsePerson = tagName "person" (requireAttr "age") $ \age -> do +-- > parsePerson :: MonadThrow m => Consumer Event m (Maybe Person) +-- > parsePerson = tag' "person" (requireAttr "age") $ \age -> do -- > name <- content -- > return $ Person (read $ unpack age) name -- > +-- > parsePeople :: MonadThrow m => Sink Event m (Maybe [Person]) -- > parsePeople = tagNoAttr "people" $ many parsePerson -- > -- > main = do @@ -42,7 +49,7 @@ -- -- will produce: -- --- > [Person {age = 25, name = "Michael"},Person {age = 2, name = "Eliezer"}] +-- > [Person 25 "Michael",Person 2 "Eliezer"] -- -- This module also supports streaming results using 'yield'. -- This allows parser results to be processed using conduits @@ -53,21 +60,23 @@ -- See http://stackoverflow.com/q/21367423/2597135 for a related discussion. -- -- > {-# LANGUAGE OverloadedStrings #-} +-- > import Control.Monad (void) +-- > import Control.Monad.Trans.Class (lift) -- > import Control.Monad.Trans.Resource -- > import Data.Conduit +-- > import qualified Data.Conduit.List as CL -- > import Data.Text (Text, unpack) +-- > import Data.XML.Types (Event) -- > import Text.XML.Stream.Parse --- > import Text.XML (Name) --- > import Control.Monad.Trans.Class (lift) --- > import Control.Monad (void) --- > import qualified Data.Conduit.List as CL -- > -- > data Person = Person Int Text deriving Show -- > --- > parsePerson = tagName "person" (requireAttr "age") $ \age -> do +-- > parsePerson :: MonadThrow m => Consumer Event m (Maybe Person) +-- > parsePerson = tag' "person" (requireAttr "age") $ \age -> do -- > name <- content -- > return $ Person (read $ unpack age) name -- > +-- > parsePeople :: MonadThrow m => Conduit Event m Person -- > parsePeople = void $ tagNoAttr "people" $ manyYield parsePerson -- > -- > main = runResourceT $ @@ -98,23 +107,29 @@ , decodeHtmlEntities -- * Event parsing , tag - , tagPredicate - , tagName + , tag' , tagNoAttr , tagIgnoreAttrs - , tagPredicateIgnoreAttrs , content , contentMaybe -- * Ignoring tags/trees , ignoreTag - , ignoreTagName - , ignoreAnyTagName - , ignoreAllTags + , ignoreEmptyTag , ignoreTree - , ignoreTreeName - , ignoreAnyTreeName - , ignoreAllTrees + , ignoreTreeContent + , ignoreAnyTreeContent , ignoreAllTreesContent + -- * Streaming events + , takeContent + , takeTree + , takeTreeContent + , takeAnyTreeContent + , takeAllTreesContent + -- * Tag name matching + , NameMatcher(..) + , matching + , anyOf + , anyName -- * Attribute parsing , AttrParser , attr @@ -127,70 +142,69 @@ , orE , choose , many + , many_ , manyIgnore , many' , force -- * Streaming combinators , manyYield - , manyIgnoreYield , manyYield' - , takeAllTreesContent + , manyIgnoreYield -- * Exceptions , XmlException (..) -- * Other types , PositionRange , EventPos ) where -import qualified Control.Applicative as A +import Blaze.ByteString.Builder (fromWord32be, toByteString) import Control.Applicative ((<$>)) +import Control.Applicative (Alternative (empty, (<|>)), + Applicative (..), (<$>)) +import qualified Control.Applicative as A +import Control.Arrow ((***)) +import Control.Exception (Exception (..), SomeException) +import Control.Monad (ap, guard, liftM, void) import Control.Monad.Fix (fix) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Maybe (MaybeT (..)) import Control.Monad.Trans.Resource (MonadResource, MonadThrow (..), monadThrow) import Data.Attoparsec.Text (Parser, anyChar, char, manyTill, skipWhile, string, takeWhile, takeWhile1, try) import qualified Data.Attoparsec.Text as AT -import Data.Conduit.Attoparsec (PositionRange, conduitParser) -import Data.List (intercalate) -import Data.XML.Types (Content (..), Event (..), - ExternalID (..), - Instruction (..), Name (..)) - -import Blaze.ByteString.Builder (fromWord32be, toByteString) -import Control.Applicative (Alternative (empty, (<|>)), - Applicative (..), (<$>)) -import Control.Arrow ((***)) -import Control.Exception (Exception (..), SomeException) -import Control.Monad (ap, guard, liftM, void) -import Control.Monad.Trans.Class (lift) import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import Data.Char (isSpace) import Data.Conduit +import Data.Conduit.Attoparsec (PositionRange, conduitParser) import Data.Conduit.Binary (sourceFile) -import qualified Data.Conduit.Internal as CI import qualified Data.Conduit.List as CL import qualified Data.Conduit.Text as CT import Data.Default (Default (..)) +import Data.List (intercalate) import Data.List (foldl') import qualified Data.Map as Map import Data.Maybe (fromMaybe, isNothing) +import Data.String (IsString (..)) import Data.Text (Text, pack) import qualified Data.Text as T -import qualified Data.Text as TS import Data.Text.Encoding (decodeUtf32BEWith, decodeUtf8With) import Data.Text.Encoding.Error (ignore, lenientDecode) import Data.Text.Read (Reader, decimal, hexadecimal) import Data.Typeable (Typeable) import Data.Word (Word32) +import Data.XML.Types (Content (..), Event (..), + ExternalID (..), + Instruction (..), Name (..)) import Prelude hiding (takeWhile) import Text.XML.Stream.Token type Ents = [(Text, Text)] tokenToEvent :: ParseSettings -> Ents -> [NSLevel] -> Token -> (Ents, [NSLevel], [Event]) -tokenToEvent _ es n (TokenBeginDocument _) = (es, n, []) +tokenToEvent _ es n (TokenXMLDeclaration _) = (es, n, []) tokenToEvent _ es n (TokenInstruction i) = (es, n, [EventInstruction i]) tokenToEvent ps es n (TokenBeginElement name as isClosed _) = (es, n', if isClosed then [begin, end] else [begin]) @@ -259,7 +273,7 @@ -- first checks for BOMs, removing them as necessary, and then check for the -- equivalent of <?xml for each of UTF-8, UTF-16LE/BE, and UTF-32LE/BE. It -- defaults to assuming UTF-8. -detectUtf :: MonadThrow m => Conduit S.ByteString m TS.Text +detectUtf :: MonadThrow m => Conduit S.ByteString m T.Text detectUtf = conduit id where @@ -295,7 +309,7 @@ checkXMLDecl :: MonadThrow m => S.ByteString -> Maybe CT.Codec - -> Conduit S.ByteString m TS.Text + -> Conduit S.ByteString m T.Text checkXMLDecl bs (Just codec) = leftover bs >> CT.decode codec checkXMLDecl bs0 Nothing = loop [] (AT.parse (parseToken decodeXmlEntities)) bs0 @@ -304,7 +318,7 @@ case parser $ decodeUtf8With lenientDecode nextChunk of AT.Fail{} -> fallback AT.Partial f -> await >>= maybe fallback (loop chunks f) - AT.Done _ (TokenBeginDocument attrs) -> findEncoding attrs + AT.Done _ (TokenXMLDeclaration attrs) -> findEncoding attrs AT.Done{} -> fallback where chunks = nextChunk : chunks0 @@ -313,7 +327,7 @@ findEncoding [] = fallback findEncoding ((TName _ "encoding", [ContentText enc]):_) = - case TS.toLower enc of + case T.toLower enc of "iso-8859-1" -> complete CT.iso8859_1 "utf-8" -> complete CT.utf8 _ -> complete CT.utf8 @@ -339,7 +353,7 @@ -> Conduit S.ByteString m EventPos parseBytesPos ps = detectUtf =$= parseTextPos ps -dropBOM :: Monad m => Conduit TS.Text m TS.Text +dropBOM :: Monad m => Conduit T.Text m T.Text dropBOM = await >>= maybe (return ()) push where @@ -362,13 +376,13 @@ -- Since 1.2.4 parseText' :: MonadThrow m => ParseSettings - -> Conduit TS.Text m Event + -> Conduit T.Text m Event parseText' = mapOutput snd . parseTextPos {-# DEPRECATED parseText "Please use 'parseText'' or 'parseTextPos'." #-} parseText :: MonadThrow m => ParseSettings - -> Conduit TS.Text m EventPos + -> Conduit T.Text m EventPos parseText = parseTextPos -- | Same as 'parseText'', but includes the position of each event. @@ -376,7 +390,7 @@ -- Since 1.2.4 parseTextPos :: MonadThrow m => ParseSettings - -> Conduit TS.Text m EventPos + -> Conduit T.Text m EventPos parseTextPos de = dropBOM =$= tokenize @@ -420,7 +434,7 @@ , psRetainNamespaces = False } -conduitToken :: MonadThrow m => ParseSettings -> Conduit TS.Text m (PositionRange, Token) +conduitToken :: MonadThrow m => ParseSettings -> Conduit T.Text m (PositionRange, Token) conduitToken = conduitParser . parseToken . psDecodeEntities parseToken :: DecodeEntities -> Parser Token @@ -440,7 +454,7 @@ char' '?' char' '>' newline <|> return () - return $ TokenBeginDocument as + return $ TokenXMLDeclaration as else do skipSpace x <- T.pack <$> manyTill anyChar (try $ string "?>") @@ -559,22 +573,18 @@ -> Bool -- break on double quote -> Bool -- break on single quote -> Parser Content -parseContent de breakDouble breakSingle = - parseEntity <|> parseText' - where - parseEntity = do - char' '&' - t <- takeWhile1 (/= ';') - char' ';' - return $ de t - parseText' = do - bs <- takeWhile1 valid - return $ ContentText bs - valid '"' = not breakDouble - valid '\'' = not breakSingle - valid '&' = False -- amp - valid '<' = False -- lt - valid _ = True +parseContent de breakDouble breakSingle = parseEntity <|> parseTextContent where + parseEntity = do + char' '&' + t <- takeWhile1 (/= ';') + char' ';' + return $ de t + parseTextContent = ContentText <$> takeWhile1 valid + valid '"' = not breakDouble + valid '\'' = not breakSingle + valid '&' = False -- amp + valid '<' = False -- lt + valid _ = True skipSpace :: Parser () skipSpace = skipWhile isXMLSpace @@ -598,8 +608,7 @@ char' :: Char -> Parser () char' = void . char -data ContentType = - Ignore | IsContent Text | IsError String | NotContent +data ContentType = Ignore | IsContent Text | IsError String | NotContent -- | Grabs the next piece of content if available. This function skips over any -- comments and instructions and concatenates all content until the next start @@ -639,64 +648,66 @@ content :: MonadThrow m => Consumer Event m Text content = fromMaybe T.empty <$> contentMaybe --- | The most generic way to parse a tag. It takes a predicate for checking if --- this is the correct tag name, an 'AttrParser' for handling attributes, and --- then a parser for dealing with content. + +isWhitespace :: Event -> Bool +isWhitespace EventBeginDocument = True +isWhitespace EventEndDocument = True +isWhitespace EventBeginDoctype{} = True +isWhitespace EventEndDoctype = True +isWhitespace EventInstruction{} = True +isWhitespace (EventContent (ContentText t)) = T.all isSpace t +isWhitespace EventComment{} = True +isWhitespace (EventCDATA t) = T.all isSpace t +isWhitespace _ = False + + +-- | The most generic way to parse a tag. It takes a 'NameMatcher' to check whether +-- this is a correct tag name, an 'AttrParser' to handle attributes, and +-- then a parser to deal with content. -- --- 'Events' are consumed if and only if the predicate holds. +-- 'Events' are consumed if and only if the tag name and its attributes match. -- -- This function automatically absorbs its balancing closing tag, and will -- throw an exception if not all of the attributes or child elements are -- consumed. If you want to allow extra attributes, see 'ignoreAttrs'. -- -- This function automatically ignores comments, instructions and whitespace. -{-# DEPRECATED tag "The signature of this function will change in next release." #-} tag :: MonadThrow m - => (Name -> Maybe a) -- ^ Check if this is a correct tag name - -- and return a value that can be used to get an @AttrParser@. - -- If this returns @Nothing@, the function will also return @Nothing@ + => NameMatcher a -- ^ Check if this is a correct tag name + -- and return a value that can be used to get an @AttrParser@. + -- If this fails, the function will return @Nothing@ -> (a -> AttrParser b) -- ^ Given the value returned by the name checker, this function will -- be used to get an @AttrParser@ appropriate for the specific tag. - -> (b -> CI.ConduitM Event o m c) -- ^ Handler function to handle the attributes and children - -- of a tag, given the value return from the @AttrParser@ - -> CI.ConduitM Event o m (Maybe c) -tag checkName attrParser f = do - (x, leftovers) <- dropWS [] - res <- case x of - Just (EventBeginElement name as) -> - case checkName name of - Just y -> - case runAttrParser' (attrParser y) as of - Left e -> lift $ monadThrow e - Right z -> do - z' <- f z - (a, _leftovers') <- dropWS [] - case a of - Just (EventEndElement name') - | name == name' -> return (Just z') - _ -> lift $ monadThrow $ InvalidEndElement name a - Nothing -> return Nothing - _ -> return Nothing - - case res of - -- Did not parse, put back all of the leading whitespace events and the - -- final observed event generated by dropWS - Nothing -> mapM_ leftover leftovers - -- Parse succeeded, discard all of those whitespace events and the - -- first parsed event - Just _ -> return () + -- If the @AttrParser@ fails, the function will also return @Nothing@ + -> (b -> ConduitM Event o m c) -- ^ Handler function to handle the attributes and children + -- of a tag, given the value return from the @AttrParser@ + -> ConduitM Event o m (Maybe c) +tag nameMatcher attrParser f = do + (x, leftovers) <- dropWS [] + res <- case x of + Just (EventBeginElement name as) -> case runNameMatcher nameMatcher name of + Just y -> case runAttrParser' (attrParser y) as of + Left _ -> return Nothing + Right z -> do + z' <- f z + (a, _leftovers') <- dropWS [] + case a of + Just (EventEndElement name') + | name == name' -> return (Just z') + _ -> lift $ monadThrow $ InvalidEndElement name a + Nothing -> return Nothing + _ -> return Nothing + + case res of + -- Did not parse, put back all of the leading whitespace events and the + -- final observed event generated by dropWS + Nothing -> mapM_ leftover leftovers + -- Parse succeeded, discard all of those whitespace events and the + -- first parsed event + Just _ -> return () - return res + return res where - isWhitespace EventBeginDocument = True - isWhitespace EventEndDocument = True - isWhitespace EventBeginDoctype{} = True - isWhitespace EventEndDoctype = True - isWhitespace EventInstruction{} = True - isWhitespace (EventContent (ContentText t)) = T.all isSpace t - isWhitespace EventComment{} = True - isWhitespace _ = False - -- Drop Events until we encounter a non-whitespace element. Return all of -- the events consumed here (including the first non-whitespace event) so -- that the calling function can treat them as leftovers if the parse fails @@ -713,125 +724,72 @@ Right ([], x) -> Right x Right (attr, _) -> Left $ toException $ UnparsedAttributes attr --- | A simplified version of 'tag' which matches against boolean predicates. -{-# DEPRECATED tagPredicate "This function will be removed in next release." #-} -tagPredicate :: MonadThrow m - => (Name -> Bool) -- ^ Name predicate that returns @True@ if the name matches the parser - -> AttrParser a -- ^ The attribute parser to be used for tags matching the predicate - -> (a -> CI.ConduitM Event o m b) -- ^ Handler function to handle the attributes and children - -- of a tag, given the value return from the @AttrParser@ - -> CI.ConduitM Event o m (Maybe b) -tagPredicate p attrParser = tag (guard . p) (const attrParser) - --- | A simplified version of 'tag' which matches for specific tag names instead --- of taking a predicate function. This is often sufficient, and when combined --- with OverloadedStrings and the IsString instance of 'Name', can prove to be --- very concise. --- . --- Note that @Name@ is namespace sensitive. When using the @IsString@ instance of name, --- use --- > "{http://a/b}c" :: Name --- to match the tag @c@ in the XML namespace @http://a/b@ -{-# DEPRECATED tagName "This function will be removed in next release." #-} -tagName :: MonadThrow m - => Name -- ^ The tag name this parser matches to (includes namespaces) - -> AttrParser a -- ^ The attribute parser to be used for tags matching the predicate - -> (a -> CI.ConduitM Event o m b) -- ^ Handler function to handle the attributes and children - -- of a tag, given the value return from the @AttrParser@ - -> CI.ConduitM Event o m (Maybe b) -tagName name = tagPredicate (== name) +-- | A simplified version of 'tag' where the 'NameMatcher' result isn't forwarded to the attributes parser. +-- +-- Since 1.5.0 +tag' :: MonadThrow m + => NameMatcher a -> AttrParser b -> (b -> ConduitM Event o m c) + -> ConduitM Event o m (Maybe c) +tag' a b = tag a (const b) -- | A further simplified tag parser, which requires that no attributes exist. -{-# DEPRECATED tagNoAttr "The signature of this function will change in next release." #-} tagNoAttr :: MonadThrow m - => Name -- ^ The name this parser matches to - -> CI.ConduitM Event o m a -- ^ Handler function to handle the children of the matched tag - -> CI.ConduitM Event o m (Maybe a) -tagNoAttr name f = tagName name (return ()) $ const f + => NameMatcher a -- ^ Check if this is a correct tag name + -> ConduitM Event o m b -- ^ Handler function to handle the children of the matched tag + -> ConduitM Event o m (Maybe b) +tagNoAttr name f = tag' name (return ()) $ const f -- | A further simplified tag parser, which ignores all attributes, if any exist -{-# DEPRECATED tagIgnoreAttrs "The signature of this function will change in next release." #-} tagIgnoreAttrs :: MonadThrow m - => Name -- ^ The name this parser matches to - -> CI.ConduitM Event o m a -- ^ Handler function to handle the children of the matched tag - -> CI.ConduitM Event o m (Maybe a) -tagIgnoreAttrs name f = tagName name ignoreAttrs $ const f + => NameMatcher a -- ^ Check if this is a correct tag name + -> ConduitM Event o m b -- ^ Handler function to handle the children of the matched tag + -> ConduitM Event o m (Maybe b) +tagIgnoreAttrs name f = tag' name ignoreAttrs $ const f --- | A further simplified tag parser, which ignores all attributes, if any exist -{-# DEPRECATED tagPredicateIgnoreAttrs "This function will be removed in next release." #-} -tagPredicateIgnoreAttrs :: MonadThrow m - => (Name -> Bool) -- ^ The name predicate this parser matches to - -> CI.ConduitM Event o m a -- ^ Handler function to handle the children of the matched tag - -> CI.ConduitM Event o m (Maybe a) -tagPredicateIgnoreAttrs namePred f = tagPredicate namePred ignoreAttrs $ const f --- | Ignore an empty tag and all of its attributes by predicate. +-- | Ignore an empty tag and all of its attributes. -- This does not ignore the tag recursively -- (i.e. it assumes there are no child elements). --- This functions returns 'Just' if the tag matched. -{-# DEPRECATED ignoreTag "The signature of this function will change in next release." #-} +-- This function returns @Just ()@ if the tag matched. +-- +-- Since 1.5.0 +ignoreEmptyTag :: MonadThrow m + => NameMatcher a -- ^ Check if this is a correct tag name + -> ConduitM Event o m (Maybe ()) +ignoreEmptyTag nameMatcher = tagIgnoreAttrs nameMatcher (return ()) + + +{-# DEPRECATED ignoreTag "Please use 'ignoreEmptyTag'." #-} ignoreTag :: MonadThrow m - => (Name -> Bool) -- ^ The predicate name to match to + => NameMatcher a -- ^ Check if this is a correct tag name -> ConduitM Event o m (Maybe ()) -ignoreTag namePred = tagPredicateIgnoreAttrs namePred (return ()) +ignoreTag = ignoreEmptyTag --- | Like 'ignoreTag', but matches an exact name -{-# DEPRECATED ignoreTagName "This function will be removed in next release." #-} -ignoreTagName :: MonadThrow m - => Name -- ^ The name to match to - -> ConduitM Event o m (Maybe ()) -ignoreTagName name = ignoreTag (== name) - --- | Like 'ignoreTagName', but matches any name from a list of names. -{-# DEPRECATED ignoreAnyTagName "This function will be removed in next release." #-} -ignoreAnyTagName :: MonadThrow m - => [Name] -- ^ The name to match to - -> ConduitM Event o m (Maybe ()) -ignoreAnyTagName names = ignoreTag (`elem` names) - --- | Like 'ignoreTag', but matches all tag name. --- --- > ignoreAllTags = ignoreTag (const True) -{-# DEPRECATED ignoreAllTags "This function will be removed in next release." #-} -ignoreAllTags :: MonadThrow m => ConduitM Event o m (Maybe ()) -ignoreAllTags = ignoreTag $ const True --- | Ignore an empty tag, its attributes and its children subtree recursively. +-- | Ignore a tag, its attributes and its children subtrees recursively. -- Both content and text events are ignored. --- This functions returns 'Just' if the tag matched. -{-# DEPRECATED ignoreTree "The signature of this function will change in next release." #-} -ignoreTree :: MonadThrow m - => (Name -> Bool) -- ^ The predicate name to match to - -> ConduitM Event o m (Maybe ()) -ignoreTree namePred = - tagPredicateIgnoreAttrs namePred (void $ many ignoreAllTreesContent) +-- This function returns @Just ()@ if the tag matched. +-- +-- Since 1.5.0 +ignoreTreeContent :: MonadThrow m + => NameMatcher a -- ^ Check if this is a correct tag name + -> ConduitM Event o m (Maybe ()) +ignoreTreeContent namePred = tagIgnoreAttrs namePred (void $ many ignoreAnyTreeContent) --- | Like 'ignoreTagName', but also ignores non-empty tabs -{-# DEPRECATED ignoreTreeName "This function will be removed in next release." #-} -ignoreTreeName :: MonadThrow m - => Name - -> ConduitM Event o m (Maybe ()) -ignoreTreeName name = ignoreTree (== name) - --- | Like 'ignoreTagName', but matches any name from a list of names. -{-# DEPRECATED ignoreAnyTreeName "This function will be removed in next release." #-} -ignoreAnyTreeName :: MonadThrow m - => [Name] -- ^ The name to match to - -> ConduitM Event o m (Maybe ()) -ignoreAnyTreeName names = ignoreTree (`elem` names) - --- | Like 'ignoreAllTags', but ignores entire subtrees. --- --- > ignoreAllTrees = ignoreTree (const True) -{-# DEPRECATED ignoreAllTrees "This function will be removed in next release." #-} -ignoreAllTrees :: MonadThrow m => ConduitM Event o m (Maybe ()) -ignoreAllTrees = ignoreTree $ const True +{-# DEPRECATED ignoreTree "Please use 'ignoreTreeContent'." #-} +ignoreTree :: MonadThrow m + => NameMatcher a -- ^ Check if this is a correct tag name + -> ConduitM Event o m (Maybe ()) +ignoreTree = ignoreTreeContent + +-- | Like 'ignoreTreeContent', but matches any name and also ignores content events. +ignoreAnyTreeContent :: MonadThrow m => ConduitM Event o m (Maybe ()) +ignoreAnyTreeContent = (void <$> contentMaybe) `orE` ignoreTreeContent anyName --- | Like 'ignoreAllTrees', but also ignores all content events -{-# DEPRECATED ignoreAllTreesContent "This function will be renamed into @ignoreAnyTreeContent@ in next release." #-} +{-# DEPRECATED ignoreAllTreesContent "Please use 'ignoreAnyTreeContent'." #-} ignoreAllTreesContent :: MonadThrow m => ConduitM Event o m (Maybe ()) -ignoreAllTreesContent = (void <$> contentMaybe) `orE` ignoreAllTrees +ignoreAllTreesContent = ignoreAnyTreeContent -- | Get the value of the first parser which returns 'Just'. If no parsers -- succeed (i.e., return @Just@), this function returns 'Nothing'. @@ -891,7 +849,7 @@ #if MIN_VERSION_base(4, 8, 0) displayException (XmlException msg (Just event)) = "Error while parsing XML event " ++ show event ++ ": " ++ msg displayException (XmlException msg _) = "Error while parsing XML: " ++ msg - displayException (InvalidEndElement name (Just event)) = "Error while parsing XML event: expected </" ++ TS.unpack (nameLocalName name) ++ ">, got " ++ show event + displayException (InvalidEndElement name (Just event)) = "Error while parsing XML event: expected </" ++ T.unpack (nameLocalName name) ++ ">, got " ++ show event displayException (InvalidEndElement name _) = "Error while parsing XML event: expected </" ++ show name ++ ">, got nothing" displayException (InvalidEntity msg (Just event)) = "Error while parsing XML entity " ++ show event ++ ": " ++ msg displayException (InvalidEntity msg _) = "Error while parsing XML entity: " ++ msg @@ -899,6 +857,48 @@ displayException (UnparsedAttributes attrs) = show (length attrs) ++ " remaining unparsed attributes: \n" ++ intercalate "\n" (show <$> attrs) #endif + +-- | A @NameMatcher@ describes which names a tag parser is allowed to match. +-- +-- Since 1.5.0 +newtype NameMatcher a = NameMatcher { runNameMatcher :: Name -> Maybe a } + +deriving instance Functor NameMatcher + +instance Applicative NameMatcher where + pure a = NameMatcher $ const $ pure a + NameMatcher f <*> NameMatcher a = NameMatcher $ \name -> f name <*> a name + +-- | 'NameMatcher's can be combined with @\<|\>@ +instance Alternative NameMatcher where + empty = NameMatcher $ const Nothing + NameMatcher f <|> NameMatcher g = NameMatcher (\a -> f a <|> g a) + +-- | Match a single 'Name' in a concise way. +-- Note that 'Name' is namespace sensitive: when using the 'IsString' instance, +-- use @"{http:\/\/a\/b}c"@ to match the tag @c@ in the XML namespace @http://a/b@ +instance (a ~ Name) => IsString (NameMatcher a) where + fromString s = matching (== fromString s) + +-- | @matching f@ matches @name@ iff @f name@ is true. Returns the matched 'Name'. +-- +-- Since 1.5.0 +matching :: (Name -> Bool) -> NameMatcher Name +matching f = NameMatcher $ \name -> if f name then Just name else Nothing + +-- | Matches any 'Name'. Returns the matched 'Name'. +-- +-- Since 1.5.0 +anyName :: NameMatcher Name +anyName = matching (const True) + +-- | Matches any 'Name' from the given list. Returns the matched 'Name'. +-- +-- Since 1.5.0 +anyOf :: [Name] -> NameMatcher Name +anyOf values = matching (`elem` values) + + -- | A monad for parsing attributes. By default, it requires you to deal with -- all attributes present on an element, and will throw an exception if there -- are unhandled attributes. Use the 'requireAttr', 'attr' et al @@ -967,32 +967,37 @@ -- | Keep parsing elements as long as the parser returns 'Just'. many :: Monad m - => Consumer Event m (Maybe a) - -> Consumer Event m [a] + => ConduitM Event o m (Maybe a) + -> ConduitM Event o m [a] many i = manyIgnore i $ return Nothing +-- | Like 'many' but discards the results without building an intermediate list. +-- +-- Since 1.5.0 +many_ :: MonadThrow m + => ConduitM Event o m (Maybe a) + -> ConduitM Event o m () +many_ consumer = manyIgnoreYield (return Nothing) (void <$> consumer) + -- | Keep parsing elements as long as the parser returns 'Just' -- or the ignore parser returns 'Just'. manyIgnore :: Monad m - => Consumer Event m (Maybe a) - -> Consumer Event m (Maybe ()) - -> Consumer Event m [a] -manyIgnore i ignored = - go id - where - go front = i >>= - maybe (onFail front) (\y -> go $ front . (:) y) - -- onFail is called if the main parser fails - onFail front = - ignored >>= maybe (return $ front []) (const $ go front) + => ConduitM Event o m (Maybe a) + -> ConduitM Event o m (Maybe b) + -> ConduitM Event o m [a] +manyIgnore i ignored = go id where + go front = i >>= maybe (onFail front) (\y -> go $ front . (:) y) + -- onFail is called if the main parser fails + onFail front = ignored >>= maybe (return $ front []) (const $ go front) -- | Like @many@, but any tags and content the consumer doesn't match on -- are silently ignored. many' :: MonadThrow m - => Consumer Event m (Maybe a) - -> Consumer Event m [a] + => ConduitM Event o m (Maybe a) + -> ConduitM Event o m [a] many' consumer = manyIgnore consumer ignoreAllTreesContent + -- | Like 'many', but uses 'yield' so the result list can be streamed -- to downstream conduits without waiting for 'manyYield' to finish manyYield :: Monad m @@ -1001,70 +1006,98 @@ manyYield consumer = fix $ \loop -> consumer >>= maybe (return ()) (\x -> yield x >> loop) --- | Like @manyIgnore@, but uses 'yield' so the result list can be streamed --- to downstream conduits without waiting for 'manyYield' to finish +-- | Like 'manyIgnore', but uses 'yield' so the result list can be streamed +-- to downstream conduits without waiting for 'manyIgnoreYield' to finish manyIgnoreYield :: MonadThrow m => ConduitM Event b m (Maybe b) -- ^ Consuming parser that generates the result stream - -> Consumer Event m (Maybe ()) -- ^ Ignore parser that consumes elements to be ignored + -> ConduitM Event b m (Maybe ()) -- ^ Ignore parser that consumes elements to be ignored -> Conduit Event m b manyIgnoreYield consumer ignoreParser = fix $ \loop -> consumer >>= maybe (onFail loop) (\x -> yield x >> loop) where onFail loop = ignoreParser >>= maybe (return ()) (const loop) --- | Like @many'@, but uses 'yield' so the result list can be streamed --- to downstream conduits without waiting for 'manyYield' to finish +-- | Like 'many'', but uses 'yield' so the result list can be streamed +-- to downstream conduits without waiting for 'manyYield'' to finish manyYield' :: MonadThrow m => ConduitM Event b m (Maybe b) -> Conduit Event m b manyYield' consumer = manyIgnoreYield consumer ignoreAllTreesContent --- | Like 'ignoreAllTreesContent', but stream the corresponding 'Event's rather than ignoring them. --- Incomplete elements (without a closing-tag) will trigger an 'XmlException'. +-- | Stream a content 'Event'. If next event isn't a content, nothing is consumed. -- --- >>> runResourceT $ parseLBS def "text<a></a>" $$ takeAllTreesContent =$= consume --- Just [ EventContent (ContentText "text"), EventBeginElement "a" [], EventEndElement "a"] +-- Returns @Just ()@ if a content 'Event' was consumed, @Nothing@ otherwise. -- --- >>> runResourceT $ parseLBS def "</a>" $$ takeAllTreesContent =$= consume --- Just [ ] +-- Since 1.5.0 +takeContent :: MonadThrow m => ConduitM Event Event m (Maybe ()) +takeContent = do + event <- await + case event of + Just e@(EventContent ContentText{}) -> yield e >> return (Just ()) + Just e@EventCDATA{} -> yield e >> return (Just ()) + Just e -> if isWhitespace e then yield e >> takeContent else leftover e >> return Nothing + _ -> return Nothing + +-- | Stream 'Event's corresponding to a single element that matches given 'NameMatcher' and 'AttrParser', from the opening- to the closing-tag. -- --- >>> runResourceT $ parseLBS def "<c></c></a>text" $$ takeAllTreesContent =$= consume --- Just [ EventBeginElement "b" [], EventBeginElement "c" [], EventEndElement "c", EventEndElement "b" ] +-- If next 'Event' isn't an element, nothing is consumed. +-- +-- If an opening-tag is consumed but no matching closing-tag is found, an 'XmlException' is thrown. +-- +-- This function automatically ignores comments, instructions and whitespace. -- --- Since 1.4.0 -{-# DEPRECATED takeAllTreesContent "This function will be removed in next release." #-} -takeAllTreesContent :: MonadThrow m => Conduit Event m Event -takeAllTreesContent = do +-- Returns @Just ()@ if an element was consumed, 'Nothing' otherwise. +-- +-- Since 1.5.0 +takeTree :: MonadThrow m => NameMatcher a -> AttrParser b -> ConduitM Event Event m (Maybe ()) +takeTree nameMatcher attrParser = do event <- await case event of - Just e@EventBeginDoctype{} -> do - yield e - takeAllTreesContent - endEvent <- await - case endEvent of - Just e@EventEndDoctype -> yield e >> takeAllTreesContent - _ -> lift $ monadThrow $ XmlException "Expected end of doctype" endEvent - Just e@EventBeginDocument -> do - yield e - takeAllTreesContent - endEvent <- await - case endEvent of - Just e@EventEndDocument -> yield e >> takeAllTreesContent - _ -> lift $ monadThrow $ XmlException "Expected end of document" endEvent - Just e@(EventBeginElement name _) -> do - yield e - takeAllTreesContent - endEvent <- await - case endEvent of - Just e@(EventEndElement name') | name == name' -> yield e >> takeAllTreesContent - _ -> lift $ monadThrow $ InvalidEndElement name endEvent - Just e@EventComment{} -> yield e >> takeAllTreesContent - Just e@EventContent{} -> yield e >> takeAllTreesContent - Just e@EventInstruction{} -> yield e >> takeAllTreesContent - Just e@EventCDATA{} -> yield e >> takeAllTreesContent - Just e -> leftover e - _ -> return () + Just e@(EventBeginElement name as) -> case runNameMatcher nameMatcher name of + Just _ -> case runAttrParser attrParser as of + Right _ -> do + yield e + whileJust takeAnyTreeContent + endEvent <- await + case endEvent of + Just e'@(EventEndElement name') | name == name' -> yield e' >> return (Just ()) + _ -> lift $ monadThrow $ InvalidEndElement name endEvent + _ -> leftover e >> return Nothing + _ -> leftover e >> return Nothing + + Just e -> if isWhitespace e then yield e >> takeTree nameMatcher attrParser else leftover e >> return Nothing + _ -> return Nothing + where + whileJust f = fix $ \loop -> f >>= maybe (return ()) (const loop) +-- | Like 'takeTree', but can also stream a content 'Event'. +-- +-- Since 1.5.0 +takeTreeContent :: MonadThrow m + => NameMatcher a + -> AttrParser b + -> ConduitM Event Event m (Maybe ()) +takeTreeContent nameMatcher attrParser = runMaybeT $ MaybeT (takeTree nameMatcher attrParser) <|> MaybeT takeContent + +-- | Like 'takeTreeContent', without checking for tag name or attributes. +-- +-- >>> runResourceT $ parseLBS def "text<a></a>" $$ takeAnyTreeContent =$= consume +-- Just [ EventContent (ContentText "text") ] +-- +-- >>> runResourceT $ parseLBS def "</a>" $$ takeAnyTreeContent =$= consume +-- Just [ ] +-- +-- >>> runResourceT $ parseLBS def "<c></c></a>text" $$ takeAnyTreeContent =$= consume +-- Just [ EventBeginElement "b" [], EventBeginElement "c" [], EventEndElement "c", EventEndElement "b" ] +-- +-- Since 1.5.0 +takeAnyTreeContent :: MonadThrow m + => ConduitM Event Event m (Maybe ()) +takeAnyTreeContent = takeTreeContent anyName ignoreAttrs + +{-# DEPRECATED takeAllTreesContent "Please use 'takeAnyTreeContent'." #-} +takeAllTreesContent :: MonadThrow m => ConduitM Event Event m (Maybe ()) +takeAllTreesContent = takeAnyTreeContent type DecodeEntities = Text -> Content diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/xml-conduit-1.4.0.4/Text/XML/Stream/Render.hs new/xml-conduit-1.5.1/Text/XML/Stream/Render.hs --- old/xml-conduit-1.4.0.4/Text/XML/Stream/Render.hs 2017-02-13 20:32:23.000000000 +0100 +++ new/xml-conduit-1.5.1/Text/XML/Stream/Render.hs 2017-05-21 00:05:14.000000000 +0200 @@ -18,6 +18,7 @@ , rsNamespaces , rsAttrOrder , rsUseCDATA + , rsXMLDeclaration , orderAttrs -- * Event rendering , tag @@ -83,6 +84,12 @@ -- Default: @False@ -- -- @since 1.3.3 + , rsXMLDeclaration :: Bool + -- ^ Determines whether the XML declaration will be output. + -- + -- Default: @True@ + -- + -- @since 1.5.1 } instance Default RenderSettings where @@ -91,6 +98,7 @@ , rsNamespaces = [] , rsAttrOrder = const Map.toList , rsUseCDATA = const False + , rsXMLDeclaration = True } -- | Convenience function to create an ordering function suitable for @@ -139,7 +147,7 @@ renderEvent' = renderEvent yield' settings renderEvent :: Monad m => (Flush Builder -> Producer m o) -> RenderSettings -> Conduit (Flush Event) m o -renderEvent yield' RenderSettings { rsPretty = isPretty, rsNamespaces = namespaces0, rsUseCDATA = useCDATA } = +renderEvent yield' RenderSettings { rsPretty = isPretty, rsNamespaces = namespaces0, rsUseCDATA = useCDATA, rsXMLDeclaration = useXMLDecl } = loop [] where loop nslevels = await >>= maybe (return ()) (go nslevels) @@ -159,34 +167,35 @@ yield' $ Chunk token loop nslevels' _ -> do - let (token, nslevels') = eventToToken nslevels useCDATA e + let (token, nslevels') = eventToToken nslevels useCDATA useXMLDecl e yield' $ Chunk token loop nslevels' -eventToToken :: Stack -> (Content -> Bool) -> Event -> (Builder, [NSLevel]) -eventToToken s _ EventBeginDocument = - (tokenToBuilder $ TokenBeginDocument +eventToToken :: Stack -> (Content -> Bool) -> Bool -> Event -> (Builder, [NSLevel]) +eventToToken s _ True EventBeginDocument = + (tokenToBuilder $ TokenXMLDeclaration [ ("version", [ContentText "1.0"]) , ("encoding", [ContentText "UTF-8"]) ] , s) -eventToToken s _ EventEndDocument = (mempty, s) -eventToToken s _ (EventInstruction i) = (tokenToBuilder $ TokenInstruction i, s) -eventToToken s _ (EventBeginDoctype n meid) = (tokenToBuilder $ TokenDoctype n meid [], s) -eventToToken s _ EventEndDoctype = (mempty, s) -eventToToken s _ (EventCDATA t) = (tokenToBuilder $ TokenCDATA t, s) -eventToToken s _ (EventEndElement name) = +eventToToken s _ False EventBeginDocument = (mempty, s) +eventToToken s _ _ EventEndDocument = (mempty, s) +eventToToken s _ _ (EventInstruction i) = (tokenToBuilder $ TokenInstruction i, s) +eventToToken s _ _ (EventBeginDoctype n meid) = (tokenToBuilder $ TokenDoctype n meid [], s) +eventToToken s _ _ EventEndDoctype = (mempty, s) +eventToToken s _ _ (EventCDATA t) = (tokenToBuilder $ TokenCDATA t, s) +eventToToken s _ _ (EventEndElement name) = (tokenToBuilder $ TokenEndElement $ nameToTName sl name, s') where (sl:s') = s -eventToToken s useCDATA (EventContent c) +eventToToken s useCDATA _ (EventContent c) | useCDATA c = case c of ContentText txt -> (tokenToBuilder $ TokenCDATA txt, s) ContentEntity txt -> (tokenToBuilder $ TokenCDATA txt, s) | otherwise = (tokenToBuilder $ TokenContent c, s) -eventToToken s _ (EventComment t) = (tokenToBuilder $ TokenComment t, s) -eventToToken _ _ EventBeginElement{} = error "eventToToken on EventBeginElement" -- mkBeginToken False s name attrs +eventToToken s _ _ (EventComment t) = (tokenToBuilder $ TokenComment t, s) +eventToToken _ _ _ EventBeginElement{} = error "eventToToken on EventBeginElement" -- mkBeginToken False s name attrs type Stack = [NSLevel] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/xml-conduit-1.4.0.4/Text/XML/Stream/Token.hs new/xml-conduit-1.5.1/Text/XML/Stream/Token.hs --- old/xml-conduit-1.4.0.4/Text/XML/Stream/Token.hs 2017-02-13 20:32:23.000000000 +0100 +++ new/xml-conduit-1.5.1/Text/XML/Stream/Token.hs 2017-05-21 00:05:14.000000000 +0200 @@ -27,7 +27,7 @@ oneSpace :: Builder oneSpace = copyByteString " " -data Token = TokenBeginDocument [TAttribute] +data Token = TokenXMLDeclaration [TAttribute] | TokenInstruction Instruction | TokenBeginElement TName [TAttribute] Bool Int -- ^ indent | TokenEndElement TName @@ -37,7 +37,7 @@ | TokenCDATA Text deriving Show tokenToBuilder :: Token -> Builder -tokenToBuilder (TokenBeginDocument attrs) = +tokenToBuilder (TokenXMLDeclaration attrs) = fromByteString "<?xml" `mappend` foldAttrs oneSpace attrs (fromByteString "?>") tokenToBuilder (TokenInstruction (Instruction target data_)) = mconcat diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/xml-conduit-1.4.0.4/Text/XML.hs new/xml-conduit-1.5.1/Text/XML.hs --- old/xml-conduit-1.4.0.4/Text/XML.hs 2017-02-13 20:32:23.000000000 +0100 +++ new/xml-conduit-1.5.1/Text/XML.hs 2017-05-21 00:05:14.000000000 +0200 @@ -63,6 +63,7 @@ , R.rsNamespaces , R.rsAttrOrder , R.rsUseCDATA + , R.rsXMLDeclaration , R.orderAttrs -- * Conversion , toXMLDocument diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/xml-conduit-1.4.0.4/test/main.hs new/xml-conduit-1.5.1/test/main.hs --- old/xml-conduit-1.4.0.4/test/main.hs 2017-02-13 20:32:23.000000000 +0100 +++ new/xml-conduit-1.5.1/test/main.hs 2017-05-21 00:05:14.000000000 +0200 @@ -1,36 +1,37 @@ {-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} import Control.Exception (Exception, toException) import Control.Monad.IO.Class (liftIO) +import qualified Data.ByteString.Char8 as S +import qualified Data.ByteString.Lazy.Char8 as L import Data.Typeable (Typeable) import Data.XML.Types -import Test.HUnit hiding (Test) import Test.Hspec -import qualified Data.ByteString.Char8 as S -import qualified Data.ByteString.Lazy.Char8 as L -import qualified Text.XML.Unresolved as D -import qualified Text.XML.Stream.Parse as P +import Test.HUnit hiding (Test) import qualified Text.XML as Res import qualified Text.XML.Cursor as Cu import Text.XML.Stream.Parse (def) +import qualified Text.XML.Stream.Parse as P +import qualified Text.XML.Unresolved as D + +import Control.Applicative ((<$>)) +import Control.Monad +import Control.Monad.Trans.Class (lift) +import qualified Data.Set as Set +import Data.Text (Text) +import qualified Data.Text as T +import Text.XML.Cursor (($.//), ($/), ($//), ($|), + (&.//), (&/), (&//)) -import Text.XML.Cursor ((&/), (&//), (&.//), ($|), ($/), ($//), ($.//)) -import Data.Text(Text) -import Control.Monad -import Control.Applicative ((<$>)) -import Control.Monad.Trans.Class (lift) -import qualified Data.Text as T -import qualified Data.Set as Set - -import Data.Conduit ((=$=)) -import qualified Data.Conduit as C -import Control.Monad.Trans.Resource (runResourceT) +import Control.Monad.Trans.Resource (runResourceT) import qualified Control.Monad.Trans.Resource as C -import qualified Data.Conduit.List as CL -import qualified Data.Map as Map -import Text.Blaze (toMarkup) -import Text.Blaze.Renderer.String (renderMarkup) +import Data.Conduit ((=$=)) +import qualified Data.Conduit as C +import qualified Data.Conduit.List as CL +import qualified Data.Map as Map +import Text.Blaze (toMarkup) +import Text.Blaze.Renderer.String (renderMarkup) main :: IO () main = hspec $ do @@ -41,13 +42,16 @@ it "has working many function" testMany it "has working many' function" testMany' it "has working manyYield function" testManyYield - it "has working takeAllTreesContent function" testTakeAllTreesContent + it "has working takeContent function" testTakeContent + it "has working takeTree function" testTakeTree + it "has working takeAnyTreeContent function" testTakeAnyTreeContent it "has working orE" testOrE it "is idempotent to parse and pretty render a document" documentParsePrettyRender it "ignores the BOM" parseIgnoreBOM it "strips duplicated attributes" stripDuplicateAttributes it "displays comments" testRenderComments it "conduit parser" testConduitParser + it "can omit the XML declaration" omitXMLDeclaration describe "XML Cursors" $ do it "has correct parent" cursorParent it "has correct ancestor" cursorAncestor @@ -135,7 +139,7 @@ combinators :: Assertion combinators = runResourceT $ P.parseLBS def input C.$$ do - P.force "need hello" $ P.tagName "hello" (P.requireAttr "world") $ \world -> do + P.force "need hello" $ P.tag' "hello" (P.requireAttr "world") $ \world -> do liftIO $ world @?= "true" P.force "need child1" $ P.tagNoAttr "{mynamespace}child1" $ return () P.force "need child2" $ P.tagNoAttr "child2" $ return () @@ -382,8 +386,49 @@ , "</hello>" ] -testTakeAllTreesContent :: Assertion -testTakeAllTreesContent = do +testTakeContent :: Assertion +testTakeContent = do + result <- runResourceT $ P.parseLBS def input C.$$ rootParser + result @?= Just + [ EventContent (ContentText "Hello world !") + ] + where + rootParser = P.tagNoAttr "root" $ void (P.takeContent >> P.takeContent) =$= CL.consume + input = L.concat + [ "<?xml version='1.0'?>" + , "<!DOCTYPE foo []>\n" + , "<root>" + , "Hello world !" + , "</root>" + ] + +testTakeTree :: Assertion +testTakeTree = do + result <- runResourceT $ P.parseLBS def input C.$$ rootParser + result @?= + [ EventBeginDocument + , EventBeginDoctype "foo" Nothing + , EventEndDoctype + , EventBeginElement "a" [] + , EventBeginElement "em" [] + , EventContent (ContentText "Hello world !") + , EventEndElement "em" + , EventEndElement "a" + ] + where + rootParser = void (P.takeTree "a" P.ignoreAttrs) =$= CL.consume + input = L.concat + [ "<?xml version='1.0'?>" + , "<!DOCTYPE foo []>\n" + , "<a>" + , "Hello world !" + , "</a>" + , "" + , "" + ] + +testTakeAnyTreeContent :: Assertion +testTakeAnyTreeContent = do result <- runResourceT $ P.parseLBS def input C.$$ rootParser result @?= Just [ EventBeginElement "b" [] @@ -393,10 +438,9 @@ , EventEndElement "em" , EventContent (ContentText " !") , EventEndElement "b" - , EventContent (ContentText " Welcome !") ] where - rootParser = P.tagNoAttr "root" $ P.takeAllTreesContent =$= CL.consume + rootParser = P.tagNoAttr "root" $ (P.takeAnyTreeContent >> void P.ignoreAnyTreeContent) =$= CL.consume input = L.concat [ "<?xml version='1.0'?>" , "<!DOCTYPE foo []>\n" @@ -449,13 +493,17 @@ P.force "need hello" $ P.tagNoAttr "hello" $ do x <- P.tagNoAttr "failure" (return 1) `P.orE` P.tagNoAttr "success" (return 2) + y <- P.tag' "success" (P.requireAttr "failure") (const $ return 1) `P.orE` + P.tag' "success" (P.requireAttr "success") (const $ return 2) liftIO $ x @?= Just (2 :: Int) + liftIO $ y @?= Just (2 :: Int) where input = L.concat [ "<?xml version='1.0'?>" , "<!DOCTYPE foo []>\n" , "<hello>" , "<success/>" + , "<success success=\"0\"/>" , "</hello>" ] @@ -480,6 +528,14 @@ ma <- P.tagNoAttr "item" (return 1) maybe (return ()) (\a -> C.yield a >> f) ma +omitXMLDeclaration :: Assertion +omitXMLDeclaration = Res.renderLBS settings input @?= spec + where + settings = def { Res.rsXMLDeclaration = False } + input = Res.Document (Prologue [] Nothing []) + (Res.Element "foo" Map.empty [Res.NodeContent "bar"]) + [] + spec = "<foo>bar</foo>" name :: [Cu.Cursor] -> [Text] name [] = [] @@ -760,7 +816,7 @@ rs = def { Res.rsAttrOrder = \name m -> case name of "foo" -> reverse $ Map.toAscList m - _ -> Map.toAscList m + _ -> Map.toAscList m } attrs = Map.fromList [("a", "a"), ("b", "b"), ("c", "c")] doc = Res.Document (Res.Prologue [] Nothing []) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/xml-conduit-1.4.0.4/xml-conduit.cabal new/xml-conduit-1.5.1/xml-conduit.cabal --- old/xml-conduit-1.4.0.4/xml-conduit.cabal 2017-02-13 20:32:23.000000000 +0100 +++ new/xml-conduit-1.5.1/xml-conduit.cabal 2017-05-21 00:05:14.000000000 +0200 @@ -1,5 +1,5 @@ name: xml-conduit -version: 1.4.0.4 +version: 1.5.1 license: MIT license-file: LICENSE author: Michael Snoyman <michael(a)snoyman.com>, Aristid Breitkreuz <aristidb(a)googlemail.com>

1 0

commit ghc-xlsx for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-xlsx for openSUSE:Factory checked in at 2017-08-31 21:01:57 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-xlsx (Old) and /work/SRC/openSUSE:Factory/.ghc-xlsx.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-xlsx" Thu Aug 31 21:01:57 2017 rev:4 rq:513544 version:0.6.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-xlsx/ghc-xlsx.changes 2017-03-03 17:52:36.200744528 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-xlsx.new/ghc-xlsx.changes 2017-08-31 21:01:59.840765268 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:07:01 UTC 2017 - psimons(a)suse.com + +- Update to version 0.6.0. + +------------------------------------------------------------------- Old: ---- xlsx-0.4.3.tar.gz New: ---- xlsx-0.6.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-xlsx.spec ++++++ --- /var/tmp/diff_new_pack.dLjsyg/_old 2017-08-31 21:02:00.808629281 +0200 +++ /var/tmp/diff_new_pack.dLjsyg/_new 2017-08-31 21:02:00.808629281 +0200 @@ -19,7 +19,7 @@ %global pkg_name xlsx %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.4.3 +Version: 0.6.0 Release: 0 Summary: Simple and incomplete Excel file parser/writer License: MIT ++++++ xlsx-0.4.3.tar.gz -> xlsx-0.6.0.tar.gz ++++++ ++++ 5956 lines of diff (skipped)

1 0

commit ghc-x509-validation for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-x509-validation for openSUSE:Factory checked in at 2017-08-31 21:01:54 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-x509-validation (Old) and /work/SRC/openSUSE:Factory/.ghc-x509-validation.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-x509-validation" Thu Aug 31 21:01:54 2017 rev:8 rq:513543 version:1.6.8 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-x509-validation/ghc-x509-validation.changes 2016-11-05 21:27:11.000000000 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-x509-validation.new/ghc-x509-validation.changes 2017-08-31 21:01:55.537369905 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:04:39 UTC 2017 - psimons(a)suse.com + +- Update to version 1.6.8. + +------------------------------------------------------------------- Old: ---- x509-validation-1.6.5.tar.gz New: ---- x509-validation-1.6.8.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-x509-validation.spec ++++++ --- /var/tmp/diff_new_pack.UMiqgi/_old 2017-08-31 21:01:56.873182220 +0200 +++ /var/tmp/diff_new_pack.UMiqgi/_new 2017-08-31 21:01:56.897178848 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-x509-validation # -# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -17,8 +17,9 @@ %global pkg_name x509-validation +%bcond_with tests Name: ghc-%{pkg_name} -Version: 1.6.5 +Version: 1.6.8 Release: 0 Summary: X.509 Certificate and CRL validation License: BSD-3-Clause @@ -41,6 +42,10 @@ BuildRequires: ghc-x509-devel BuildRequires: ghc-x509-store-devel BuildRoot: %{_tmppath}/%{name}-%{version}-build +%if %{with tests} +BuildRequires: ghc-tasty-devel +BuildRequires: ghc-tasty-hunit-devel +%endif %description X.509 Certificate and CRL validation. @@ -66,6 +71,9 @@ %install %ghc_lib_install +%check +%cabal_test + %post devel %ghc_pkg_recache ++++++ x509-validation-1.6.5.tar.gz -> x509-validation-1.6.8.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/x509-validation-1.6.5/Data/X509/Validation/Signature.hs new/x509-validation-1.6.8/Data/X509/Validation/Signature.hs --- old/x509-validation-1.6.5/Data/X509/Validation/Signature.hs 2016-09-15 22:15:59.000000000 +0200 +++ new/x509-validation-1.6.8/Data/X509/Validation/Signature.hs 2017-06-26 18:12:09.000000000 +0200 @@ -15,12 +15,12 @@ ) where import qualified Crypto.PubKey.RSA.PKCS15 as RSA +import qualified Crypto.PubKey.RSA.PSS as PSS import qualified Crypto.PubKey.DSA as DSA import qualified Crypto.PubKey.ECC.Types as ECC import qualified Crypto.PubKey.ECC.Prim as ECC import qualified Crypto.PubKey.ECC.ECDSA as ECDSA import Crypto.Hash -import Crypto.Number.Basic (numBits) import Crypto.Number.Serialize (os2ip) import Data.ByteString (ByteString) @@ -70,6 +70,19 @@ -> ByteString -- ^ Signature to verify -> SignatureVerification verifySignature (SignatureALG_Unknown _) _ _ _ = SignatureFailed SignatureUnimplemented +verifySignature (SignatureALG hashALG PubKeyALG_RSAPSS) pubkey cdata signature = case verifyF pubkey of + Nothing -> SignatureFailed SignatureUnimplemented + Just f -> if f cdata signature + then SignaturePass + else SignatureFailed SignatureInvalid + where + verifyF (PubKeyRSA key) + | hashALG == HashSHA256 = Just $ PSS.verify (PSS.defaultPSSParams SHA256) key + | hashALG == HashSHA384 = Just $ PSS.verify (PSS.defaultPSSParams SHA384) key + | hashALG == HashSHA512 = Just $ PSS.verify (PSS.defaultPSSParams SHA512) key + | hashALG == HashSHA224 = Just $ PSS.verify (PSS.defaultPSSParams SHA224) key + | otherwise = Nothing + verifyF _ = Nothing verifySignature (SignatureALG hashALG pubkeyALG) pubkey cdata signature | pubkeyToAlg pubkey == pubkeyALG = case verifyF pubkey of Nothing -> SignatureFailed SignatureUnimplemented @@ -80,9 +93,9 @@ where verifyF (PubKeyRSA key) = Just $ rsaVerify hashALG key verifyF (PubKeyDSA key) - | hashALG == HashSHA1 = Just $ \a b -> case dsaToSignature a of - Nothing -> False - Just dsaSig -> DSA.verify SHA1 key dsaSig b + | hashALG == HashSHA1 = Just $ dsaVerify SHA1 key + | hashALG == HashSHA224 = Just $ dsaVerify SHA224 key + | hashALG == HashSHA256 = Just $ dsaVerify SHA256 key | otherwise = Nothing verifyF (PubKeyEC key) = verifyECDSA hashALG key verifyF _ = Nothing @@ -98,6 +111,11 @@ _ -> Nothing + dsaVerify hsh key b a = + case dsaToSignature a of + Nothing -> False + Just dsaSig -> DSA.verify hsh key dsaSig b + rsaVerify HashMD2 = RSA.verify (Just MD2) rsaVerify HashMD5 = RSA.verify (Just MD5) rsaVerify HashSHA1 = RSA.verify (Just SHA1) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/x509-validation-1.6.5/Data/X509/Validation.hs new/x509-validation-1.6.8/Data/X509/Validation.hs --- old/x509-validation-1.6.5/Data/X509/Validation.hs 2016-10-03 09:36:01.000000000 +0200 +++ new/x509-validation-1.6.8/Data/X509/Validation.hs 2017-06-26 18:12:09.000000000 +0200 @@ -45,7 +45,11 @@ import Data.Maybe import Data.List --- | Possible reason of certificate and chain failure +-- | Possible reason of certificate and chain failure. +-- +-- The values 'InvalidName' and 'InvalidWildcard' are internal-only and are +-- never returned by the validation functions. 'NameMismatch' is returned +-- instead. data FailedReason = UnknownCriticalExtension -- ^ certificate contains an unknown critical extension | Expired -- ^ validity ends before checking time @@ -118,10 +122,12 @@ -- BEWARE, it's easy to change behavior leading to compromised security. data ValidationHooks = ValidationHooks { - -- | check the the issuer 'DistinguishedName' match the subject 'DistinguishedName' - -- of a certificate. + -- | check whether a given issuer 'DistinguishedName' matches the subject + -- 'DistinguishedName' of a candidate issuer certificate. hookMatchSubjectIssuer :: DistinguishedName -> Certificate -> Bool - -- | validate that the parametrized time valide with the certificate in argument + -- | check whether the certificate in the second argument is valid at the + -- time provided in the first argument. Return an empty list for success + -- or else one or more failure reasons. , hookValidateTime :: DateTime -> Certificate -> [FailedReason] -- | validate the certificate leaf name with the DNS named used to connect , hookValidateName :: HostName -> Certificate -> [FailedReason] @@ -326,8 +332,13 @@ unAltName _ = Nothing -- | Validate that the fqhn is matched by at least one name in the certificate. --- The name can be either one of the alternative names if the SubjectAltName --- extension is present or the common name. +-- If the subjectAltname extension is present, then the certificate commonName +-- is ignored, and only the DNS names, if any, in the subjectAltName are +-- considered. Otherwise, the commonName from the subjectDN is used. +-- +-- Note that DNS names in the subjectAltName are in IDNA A-label form. If the +-- destination hostname is a UTF-8 name, it must be provided to the TLS context +-- in (non-transitional) IDNA2008 A-label form. validateCertificateName :: HostName -> Certificate -> [FailedReason] validateCertificateName fqhn cert | not $ null altNames = diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/x509-validation-1.6.5/Tests/Certificate.hs new/x509-validation-1.6.8/Tests/Certificate.hs --- old/x509-validation-1.6.5/Tests/Certificate.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/x509-validation-1.6.8/Tests/Certificate.hs 2017-07-22 08:57:25.000000000 +0200 @@ -0,0 +1,304 @@ +{-# LANGUAGE GADTs #-} +-- | Types and functions used to build test certificates. +module Certificate + ( + -- * Hash algorithms + hashMD2 + , hashMD5 + , hashSHA1 + , hashSHA224 + , hashSHA256 + , hashSHA384 + , hashSHA512 + -- * Key and signature utilities + , Alg(..) + , Keys + , generateKeys + -- * Certificate utilities + , Pair(..) + , mkDn + , mkExtension + , leafStdExts + -- * Certificate creation functions + , Auth(..) + , mkCertificate + , mkCA + , mkLeaf + ) where + +import Control.Applicative + +import Crypto.Hash.Algorithms +import Crypto.Number.Generate +import Crypto.Number.Serialize + +import qualified Crypto.PubKey.DSA as DSA +import qualified Crypto.PubKey.ECC.ECDSA as ECDSA +import qualified Crypto.PubKey.ECC.Prim as ECC +import qualified Crypto.PubKey.ECC.Types as ECC +import qualified Crypto.PubKey.RSA as RSA +import qualified Crypto.PubKey.RSA.PKCS15 as RSA +import qualified Crypto.PubKey.RSA.PSS as PSS + +import qualified Data.ByteString as B + +import Data.ASN1.BinaryEncoding (DER(..)) +import Data.ASN1.Encoding +import Data.ASN1.Types +import Data.Maybe (catMaybes) +import Data.String (fromString) +import Data.X509 + +import Data.Hourglass + + +-- Crypto utilities -- + +-- | Hash algorithms supported in certificates. +-- +-- This relates the typed hash algorithm @hash@ to the 'HashALG' value. +data GHash hash = GHash { getHashALG :: HashALG, getHashAlgorithm :: hash } + +hashMD2 :: GHash MD2 +hashMD5 :: GHash MD5 +hashSHA1 :: GHash SHA1 +hashSHA224 :: GHash SHA224 +hashSHA256 :: GHash SHA256 +hashSHA384 :: GHash SHA384 +hashSHA512 :: GHash SHA512 + +hashMD2 = GHash HashMD2 MD2 +hashMD5 = GHash HashMD5 MD5 +hashSHA1 = GHash HashSHA1 SHA1 +hashSHA224 = GHash HashSHA224 SHA224 +hashSHA256 = GHash HashSHA256 SHA256 +hashSHA384 = GHash HashSHA384 SHA384 +hashSHA512 = GHash HashSHA512 SHA512 + +-- | Signature and hash algorithms instantiated with parameters. +data Alg pub priv where + AlgRSA :: (HashAlgorithm hash, RSA.HashAlgorithmASN1 hash) + => Int + -> GHash hash + -> Alg RSA.PublicKey RSA.PrivateKey + + AlgRSAPSS :: HashAlgorithm hash + => Int + -> PSS.PSSParams hash B.ByteString B.ByteString + -> GHash hash + -> Alg RSA.PublicKey RSA.PrivateKey + + AlgDSA :: HashAlgorithm hash + => DSA.Params + -> GHash hash + -> Alg DSA.PublicKey DSA.PrivateKey + + AlgEC :: HashAlgorithm hash + => ECC.CurveName + -> GHash hash + -> Alg ECDSA.PublicKey ECDSA.PrivateKey + +-- | Types of public and private keys used by a signature algorithm. +type Keys pub priv = (Alg pub priv, pub, priv) + +-- | Generates random keys for a signature algorithm. +generateKeys :: Alg pub priv -> IO (Keys pub priv) +generateKeys alg@(AlgRSA bits _) = generateRSAKeys alg bits +generateKeys alg@(AlgRSAPSS bits _ _) = generateRSAKeys alg bits +generateKeys alg@(AlgDSA params _) = do + x <- DSA.generatePrivate params + let y = DSA.calculatePublic params x + return (alg, DSA.PublicKey params y, DSA.PrivateKey params x) +generateKeys alg@(AlgEC name _) = do + d <- generateBetween 1 (n - 1) + let p = ECC.pointBaseMul curve d + return (alg, ECDSA.PublicKey curve p, ECDSA.PrivateKey curve d) + where + curve = ECC.getCurveByName name + n = ECC.ecc_n . ECC.common_curve $ curve + +generateRSAKeys :: Alg RSA.PublicKey RSA.PrivateKey + -> Int + -> IO (Alg RSA.PublicKey RSA.PrivateKey, RSA.PublicKey, RSA.PrivateKey) +generateRSAKeys alg bits = addAlg <$> RSA.generate size e + where + addAlg (pub, priv) = (alg, pub, priv) + size = bits `div` 8 + e = 3 + +getPubKey :: Alg pub priv -> pub -> PubKey +getPubKey (AlgRSA _ _) key = PubKeyRSA key +getPubKey (AlgRSAPSS _ _ _) key = PubKeyRSA key +getPubKey (AlgDSA _ _) key = PubKeyDSA key +getPubKey (AlgEC name _) key = PubKeyEC (PubKeyEC_Named name pub) + where + ECC.Point x y = ECDSA.public_q key + pub = SerializedPoint bs + bs = B.cons 4 (i2ospOf_ bytes x `B.append` i2ospOf_ bytes y) + bits = ECC.curveSizeBits (ECC.getCurveByName name) + bytes = (bits + 7) `div` 8 + +getSignatureALG :: Alg pub priv -> SignatureALG +getSignatureALG (AlgRSA _ hash) = SignatureALG (getHashALG hash) PubKeyALG_RSA +getSignatureALG (AlgRSAPSS _ _ hash) = SignatureALG (getHashALG hash) PubKeyALG_RSAPSS +getSignatureALG (AlgDSA _ hash) = SignatureALG (getHashALG hash) PubKeyALG_DSA +getSignatureALG (AlgEC _ hash) = SignatureALG (getHashALG hash) PubKeyALG_EC + +doSign :: Alg pub priv -> priv -> B.ByteString -> IO B.ByteString +doSign (AlgRSA _ hash) key msg = do + result <- RSA.signSafer (Just $ getHashAlgorithm hash) key msg + case result of + Left err -> error ("doSign(AlgRSA): " ++ show err) + Right sigBits -> return sigBits +doSign (AlgRSAPSS _ params _) key msg = do + result <- PSS.signSafer params key msg + case result of + Left err -> error ("doSign(AlgRSAPSS): " ++ show err) + Right sigBits -> return sigBits +doSign (AlgDSA _ hash) key msg = do + sig <- DSA.sign key (getHashAlgorithm hash) msg + return $ encodeASN1' DER + [ Start Sequence + , IntVal (DSA.sign_r sig) + , IntVal (DSA.sign_s sig) + , End Sequence + ] +doSign (AlgEC _ hash) key msg = do + sig <- ECDSA.sign key (getHashAlgorithm hash) msg + return $ encodeASN1' DER + [ Start Sequence + , IntVal (ECDSA.sign_r sig) + , IntVal (ECDSA.sign_s sig) + , End Sequence + ] + + +-- Certificate utilities -- + +-- | Holds together a certificate and its private key for convenience. +-- +-- Contains also the crypto algorithm that both are issued from. This is +-- useful when signing another certificate. +data Pair pub priv = Pair + { pairAlg :: Alg pub priv + , pairSignedCert :: SignedCertificate + , pairKey :: priv + } + +-- | Builds a DN with a single component. +mkDn :: String -> DistinguishedName +mkDn cn = DistinguishedName [(getObjectID DnCommonName, fromString cn)] + +-- | Used to build a certificate extension. +mkExtension :: Extension a => Bool -> a -> ExtensionRaw +mkExtension crit ext = ExtensionRaw (extOID ext) crit (extEncodeBs ext) + +-- | Default extensions in leaf certificates. +leafStdExts :: [ExtensionRaw] +leafStdExts = [ku, eku] + where + ku = mkExtension False $ ExtKeyUsage + [ KeyUsage_digitalSignature , KeyUsage_keyEncipherment ] + eku = mkExtension False $ ExtExtendedKeyUsage + [ KeyUsagePurpose_ServerAuth , KeyUsagePurpose_ClientAuth ] + + +-- Authority signing a certificate -- +-- +-- When the certificate is self-signed, issuer and subject are the same. So +-- they have identical signature algorithms. The purpose of the GADT is to +-- hold this constraint only in the self-signed case. + +-- | Authority signing a certificate, itself or another certificate. +data Auth pubI privI pubS privS where + Self :: (pubI ~ pubS, privI ~ privS) => Auth pubI privI pubS privS + CA :: Pair pubI privI -> Auth pubI privI pubS privS + +foldAuth :: a + -> (Pair pubI privI -> a) + -> Auth pubI privI pubS privS + -> a +foldAuth x _ Self = x -- no constraint used +foldAuth _ f (CA p) = f p + +foldAuthPriv :: privS + -> (Pair pubI privI -> privI) + -> Auth pubI privI pubS privS + -> privI +foldAuthPriv x _ Self = x -- uses constraint privI ~ privS +foldAuthPriv _ f (CA p) = f p + +foldAuthPubPriv :: k pubS privS + -> (Pair pubI privI -> k pubI privI) + -> Auth pubI privI pubS privS + -> k pubI privI +foldAuthPubPriv x _ Self = x -- uses both constraints +foldAuthPubPriv _ f (CA p) = f p + + +-- Certificate creation functions -- + +-- | Builds a certificate using the supplied keys and signs it with an +-- authority (itself or another certificate). +mkCertificate :: Int -- ^ Certificate version + -> Integer -- ^ Serial number + -> DistinguishedName -- ^ Subject DN + -> (DateTime, DateTime) -- ^ Certificate validity period + -> [ExtensionRaw] -- ^ Extensions to include + -> Auth pubI privI pubS privS -- ^ Authority signing the new certificate + -> Keys pubS privS -- ^ Keys for the new certificate + -> IO (Pair pubS privS) -- ^ The new certificate/key pair +mkCertificate version serial dn validity exts auth (algS, pubKey, privKey) = do + signedCert <- objectToSignedExactF signatureFunction cert + return Pair { pairAlg = algS + , pairSignedCert = signedCert + , pairKey = privKey + } + + where + pairCert = signedObject . getSigned . pairSignedCert + + cert = Certificate + { certVersion = version + , certSerial = serial + , certSignatureAlg = signAlgI + , certIssuerDN = issuerDN + , certValidity = validity + , certSubjectDN = dn + , certPubKey = getPubKey algS pubKey + , certExtensions = extensions + } + + signingKey = foldAuthPriv privKey pairKey auth + algI = foldAuthPubPriv algS pairAlg auth + + signAlgI = getSignatureALG algI + issuerDN = foldAuth dn (certSubjectDN . pairCert) auth + extensions = Extensions (if null exts then Nothing else Just exts) + + signatureFunction objRaw = do + sigBits <- doSign algI signingKey objRaw + return (sigBits, signAlgI) + +-- | Builds a CA certificate using the supplied keys and signs it with an +-- authority (itself or another certificate). +mkCA :: Integer -- ^ Serial number + -> String -- ^ Common name + -> (DateTime, DateTime) -- ^ CA validity period + -> Maybe ExtBasicConstraints -- ^ CA basic constraints + -> Maybe ExtKeyUsage -- ^ CA key usage + -> Auth pubI privI pubS privS -- ^ Authority signing the new certificate + -> Keys pubS privS -- ^ Keys for the new certificate + -> IO (Pair pubS privS) -- ^ The new CA certificate/key pair +mkCA serial cn validity bc ku = + let exts = catMaybes [ mkExtension True <$> bc, mkExtension False <$> ku ] + in mkCertificate 2 serial (mkDn cn) validity exts + +-- | Builds a leaf certificate using the supplied keys and signs it with an +-- authority (itself or another certificate). +mkLeaf :: String -- ^ Common name + -> (DateTime, DateTime) -- ^ Certificate validity period + -> Auth pubI privI pubS privS -- ^ Authority signing the new certificate + -> Keys pubS privS -- ^ Keys for the new certificate + -> IO (Pair pubS privS) -- ^ The new leaf certificate/key pair +mkLeaf cn validity = mkCertificate 2 100 (mkDn cn) validity leafStdExts diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/x509-validation-1.6.5/Tests/Tests.hs new/x509-validation-1.6.8/Tests/Tests.hs --- old/x509-validation-1.6.5/Tests/Tests.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/x509-validation-1.6.8/Tests/Tests.hs 2017-06-26 18:12:09.000000000 +0200 @@ -0,0 +1,595 @@ +-- | Validation test suite. +module Main (main) where + +import Control.Applicative +import Control.Monad (unless) + +import Crypto.Hash.Algorithms + +import qualified Crypto.PubKey.DSA as DSA +import qualified Crypto.PubKey.ECC.Types as ECC +import qualified Crypto.PubKey.RSA.PSS as PSS + +import Data.Default.Class +import Data.Monoid +import Data.String (fromString) +import Data.X509 +import Data.X509.CertificateStore +import Data.X509.Validation + +import Data.Hourglass +import System.Hourglass + +import Test.Tasty +import Test.Tasty.HUnit + +import Certificate + + +-- Runtime data, dynamically generated and shared by all test cases -- + +data RData pub priv = RData + { rootStore :: CertificateStore + , past :: (DateTime, DateTime) + , present :: (DateTime, DateTime) + , future :: (DateTime, DateTime) + , pastDate :: DateTime + , presentDate :: DateTime + , futureDate :: DateTime + , root :: Pair pub priv + , intermediate :: Pair pub priv + , intermediate0 :: Pair pub priv + , intermediatePast :: Pair pub priv + , intermediateFuture :: Pair pub priv + , keys1 :: Keys pub priv + , keys2 :: Keys pub priv + , keys3 :: Keys pub priv + } + +mkDateTime :: Date -> DateTime +mkDateTime d = DateTime d (TimeOfDay 0 0 0 0) + +mkStore :: [Pair pub priv] -> CertificateStore +mkStore ps = makeCertificateStore (map pairSignedCert ps) + +initData :: Alg pub priv -> IO (RData pub priv) +initData alg = do + today <- timeGetDate <$> timeCurrent + + let m3 = mkDateTime $ today `dateAddPeriod` mempty { periodYears = -3 } + let m2 = mkDateTime $ today `dateAddPeriod` mempty { periodYears = -2 } + let m1 = mkDateTime $ today `dateAddPeriod` mempty { periodYears = -1 } + let n1 = mkDateTime $ today `dateAddPeriod` mempty { periodYears = 1 } + let n2 = mkDateTime $ today `dateAddPeriod` mempty { periodYears = 2 } + let n3 = mkDateTime $ today `dateAddPeriod` mempty { periodYears = 3 } + + -- two-year validity periods in past, present and future + let vPast = (m3, m1) -- Year-3 .. Year-1 + let vPresent = (m1, n1) -- Year-1 .. Year+1 + let vFuture = (n1, n3) -- Year+1 .. Year+3 + + -- CA basic constraints and key usage extensions + let bc = Just $ ExtBasicConstraints True Nothing + let bc0 = Just $ ExtBasicConstraints True (Just 0) + let ku = Nothing + + -- Root CAs in past, present and future. Need distinct DNs because the + -- certificate store contains all 3 simultaneously. + rootPast <- generateKeys alg >>= mkCA 1 "RootCA - R1" vPast bc ku Self + rootPresent <- generateKeys alg >>= mkCA 2 "RootCA - R2" vPresent bc ku Self + rootFuture <- generateKeys alg >>= mkCA 3 "RootCA - R3" vFuture bc ku Self + + -- Intermediate CAs in past, present and future. Also includes a CA with + -- a depth constraint. + pIntermediateP <- generateKeys alg >>= mkCA 11 "IntermediateCA" vPast bc ku (CA rootPast) + pIntermediate <- generateKeys alg >>= mkCA 12 "IntermediateCA" vPresent bc ku (CA rootPresent) + pIntermediate0 <- generateKeys alg >>= mkCA 12 "IntermediateCA" vPresent bc0 ku (CA rootPresent) + pIntermediateF <- generateKeys alg >>= mkCA 13 "IntermediateCA" vFuture bc ku (CA rootFuture) + + -- Additional keys to be reused in test cases. This removes the cost of + -- generating individual keys. A key should be used only once per case. + k1 <- generateKeys alg + k2 <- generateKeys alg + k3 <- generateKeys alg + + return RData + { rootStore = mkStore [ rootPast, rootPresent, rootFuture ] + , past = vPast + , present = vPresent + , future = vFuture + , pastDate = m2 -- Year-2 + , presentDate = mkDateTime today + , futureDate = n2 -- Year+2 + , root = rootPresent + , intermediate = pIntermediate + , intermediate0 = pIntermediate0 + , intermediatePast = pIntermediateP + , intermediateFuture = pIntermediateF + , keys1 = k1 + , keys2 = k2 + , keys3 = k3 + } + +freeData :: RData pub priv -> IO () +freeData _ = return () + + +-- Test utilities -- + +-- | Asserts order-insensitive equality for lists. This also ignores +-- duplicate elements. +assertEqualList :: (Eq a, Show a) => String -- ^ The message prefix + -> [a] -- ^ The expected value + -> [a] -- ^ The actual value + -> Assertion +assertEqualList preface expected actual = + unless (actual `same` expected) (assertFailure msg) + where + a `same` b = all (`elem` b) a && all (`elem` a) b + msg = (if null preface then "" else preface ++ "\n") ++ + " expected: " ++ show expected ++ "\n but got: " ++ show actual + +-- | Asserts the validation result of a certificate chain. +assertValidationResult :: RData pub priv -- ^ Common test resources (CA store) + -> ValidationChecks -- ^ Checks to do + -> HostName -- ^ Connection identification + -> [Pair pub priv] -- ^ Certificate chain to validate + -> [FailedReason] -- ^ Expected validation result + -> Assertion +assertValidationResult rd checks hostname ps expected = do + actual <- validate HashSHA256 defaultHooks checks store def ident chain + assertEqualList "Unexpected validation result" expected actual + where + store = rootStore rd + ident = (hostname, fromString ":443") + chain = CertificateChain (map pairSignedCert ps) + +-- | Simplified access to test resource from 'withResource'. +testWithRes :: IO r -> TestName -> (r -> Assertion) -> TestTree +testWithRes res caseName f = testCase caseName (res >>= f) + + +-- Test cases -- + +-- | Tests a leaf certificate signed by an intermediate CA, but using a chain +-- where the intermediate CA may use a different key. This tests the signature +-- of the leaf certificate provided both CAs have the same subject DN. +testSignature :: IO (RData pub priv) -- ^ Common test resources + -> TestName -- ^ Case name + -> (RData pub priv -> Pair pub priv) -- ^ CA to use for signature + -> (RData pub priv -> Pair pub priv) -- ^ CA to use for validation + -> [FailedReason] -- ^ Expected validation result + -> TestTree +testSignature res caseName f g expected = testWithRes res caseName $ \rd -> do + pair <- mkLeaf "signature" (present rd) (CA $ f rd) (keys1 rd) + assertValidationResult rd defaultChecks "signature" [pair, g rd] expected + +-- | Tests an empty certificate chain. +testEmpty :: IO (RData pub priv) -- ^ Common test resources + -> TestName -- ^ Case name + -> [FailedReason] -- ^ Expected validation result + -> TestTree +testEmpty res caseName expected = testWithRes res caseName $ \rd -> + assertValidationResult rd defaultChecks "empty" [] expected + +-- | Tests a certificate chain where the intermediate CA is missing. +testIncompleteChain :: IO (RData pub priv) -- ^ Common test resources + -> TestName -- ^ Case name + -> [FailedReason] -- ^ Expected validation result + -> TestTree +testIncompleteChain res caseName expected = testWithRes res caseName $ \rd -> do + pair <- mkLeaf "incomplete" (present rd) (CA $ intermediate rd) (keys1 rd) + assertValidationResult rd defaultChecks "incomplete" [pair] expected + +-- | Tests a self-signed certificate. +testSelfSigned :: IO (RData pub priv) -- ^ Common test resources + -> TestName -- ^ Case name + -> [FailedReason] -- ^ Expected validation result + -> TestTree +testSelfSigned res caseName expected = testWithRes res caseName $ \rd -> do + pair <- mkLeaf "self-signed" (present rd) Self (keys1 rd) + assertValidationResult rd defaultChecks "self-signed" [pair] expected + +-- | Tests key usage of intermediate CA, with or without 'checkCAConstraints'. +testCAKeyUsage :: IO (RData pub priv) -- ^ Common test resources + -> TestName -- ^ Case name + -> Bool -- ^ Value for 'checkCAConstraints' + -> ExtKeyUsageFlag -- ^ Intermediate CA key usage + -> [FailedReason] -- ^ Expected validation result + -> TestTree +testCAKeyUsage res caseName check flag expected = testWithRes res caseName $ \rd -> do + ca <- mkCA 20 "KeyUsageCA" (present rd) bc ku (CA $ root rd) (keys1 rd) + pair <- mkLeaf "ca-key-usage" (present rd) (CA ca) (keys2 rd) + assertValidationResult rd checks "ca-key-usage" [pair, ca] expected + where + checks = defaultChecks { checkCAConstraints = check } + bc = Just (ExtBasicConstraints True Nothing) + ku = Just (ExtKeyUsage [flag]) + +-- | Tests CA flag of intermediate CA, with or without 'checkCAConstraints'. +testNotCA :: IO (RData pub priv) -- ^ Common test resources + -> TestName -- ^ Case name + -> Bool -- ^ Value for 'checkCAConstraints' + -> [FailedReason] -- ^ Expected validation result + -> TestTree +testNotCA res caseName check expected = testWithRes res caseName $ \rd -> do + ca <- mkCA 20 "NotCA" (present rd) bc Nothing (CA $ root rd) (keys1 rd) + pair <- mkLeaf "not-ca" (present rd) (CA ca) (keys2 rd) + assertValidationResult rd checks "not-ca" [pair, ca] expected + where + checks = defaultChecks { checkCAConstraints = check } + bc = Just (ExtBasicConstraints False Nothing) + +-- | Tests an intermediate CA without basic constraints, with or without +-- 'checkCAConstraints'. +testNoBasic :: IO (RData pub priv) -- ^ Common test resources + -> TestName -- ^ Case name + -> Bool -- ^ Value for 'checkCAConstraints' + -> [FailedReason] -- ^ Expected validation result + -> TestTree +testNoBasic res caseName check expected = testWithRes res caseName $ \rd -> do + ca <- mkCA 20 "NoBC" (present rd) bc Nothing (CA $ root rd) (keys1 rd) + pair <- mkLeaf "no-bc" (present rd) (CA ca) (keys2 rd) + assertValidationResult rd checks "no-bc" [pair, ca] expected + where + checks = defaultChecks { checkCAConstraints = check } + bc = Nothing + +-- | Tests basic constraints depth, with or without 'checkCAConstraints'. +testBadDepth :: IO (RData pub priv) -- ^ Common test resources + -> TestName -- ^ Case name + -> Bool -- ^ Value for 'checkCAConstraints' + -> [FailedReason] -- ^ Expected validation result + -> TestTree +testBadDepth res caseName check expected = testWithRes res caseName $ \rd -> do + -- a new CA signed by intermediate0 should fail because of the depth limit + ca <- mkCA 20 "TooDeep" (present rd) bc Nothing (CA $ intermediate0 rd) (keys1 rd) + pair <- mkLeaf "bad-depth" (present rd) (CA ca) (keys2 rd) + assertValidationResult rd checks "bad-depth" [pair, ca, intermediate0 rd] expected + where + checks = defaultChecks { checkCAConstraints = check } + bc = Just (ExtBasicConstraints True Nothing) + +-- | Tests a non-V3 leaf certificate, with or without 'checkLeafV3'. +testLeafNotV3 :: IO (RData pub priv) -- ^ Common test resources + -> TestName -- ^ Case name + -> Bool -- ^ Value for 'checkLeafV3' + -> [FailedReason] -- ^ Expected validation result + -> TestTree +testLeafNotV3 res caseName check expected = testWithRes res caseName $ \rd -> do + pair <- mkCertificate 1 100 dn (present rd) leafStdExts (CA $ intermediate rd) (keys1 rd) + assertValidationResult rd checks "leaf-not-v3" [pair, intermediate rd] expected + where + checks = defaultChecks { checkLeafV3 = check } + dn = mkDn "leaf-not-v3" + +-- | Tests a certificate chain containing a non-related certificate, with or +-- without 'checkStrictOrdering'. +testStrictOrdering :: IO (RData pub priv) -- ^ Common test resources + -> TestName -- ^ Case name + -> Bool -- ^ Value for 'checkStrictOrdering' + -> [FailedReason] -- ^ Expected validation result + -> TestTree +testStrictOrdering res caseName check expected = testWithRes res caseName $ \rd -> do + ca <- mkCA 20 "CA" (present rd) bc Nothing (CA $ intermediate rd) (keys1 rd) + extra <- mkCA 21 "Extra" (present rd) bc Nothing (CA $ intermediate rd) (keys2 rd) + pair <- mkLeaf "strict-ordering" (present rd) (CA ca) (keys3 rd) + assertValidationResult rd checks "strict-ordering" [pair, ca, extra, intermediate rd] expected + where + checks = defaultChecks { checkStrictOrdering = check } + bc = Just (ExtBasicConstraints True Nothing) + +-- | Tests validity of leaf certificate. +testLeafDates :: IO (RData pub priv) -- ^ Common test resources + -> TestName -- ^ Case name + -> Bool -- ^ Value for 'checkTimeValidity' + -> (RData pub priv -> (DateTime, DateTime)) -- ^ Validity period to use + -> [FailedReason] -- ^ Expected validation result + -> TestTree +testLeafDates res caseName check f expected = testWithRes res caseName $ \rd -> do + pair <- mkLeaf "leaf-dates" (f rd) (CA $ intermediate rd) (keys1 rd) + assertValidationResult rd checks "leaf-dates" [pair, intermediate rd] expected + where + checks = defaultChecks { checkTimeValidity = check } + +-- | Tests validity of intermediate CA. +testIntermediateDates :: IO (RData pub priv) -- ^ Common test resources + -> TestName -- ^ Case name + -> Bool -- ^ Value for 'checkTimeValidity' + -> (RData pub priv -> Pair pub priv) -- ^ Intermediate CA to use + -> [FailedReason] -- ^ Expected validation result + -> TestTree +testIntermediateDates res caseName check f expected = testWithRes res caseName $ \rd -> do + pair <- mkLeaf "intermediate-dates" (present rd) (CA $ f rd) (keys1 rd) + assertValidationResult rd checks "intermediate-dates" [pair, f rd] expected + where + checks = defaultChecks { checkTimeValidity = check } + +-- | Tests validity of leaf certificate and intermediate CA, +-- using 'checkAtTime'. +testTimeshift :: IO (RData pub priv) -- ^ Common test resources + -> TestName -- ^ Case name + -> (RData pub priv -> (DateTime, DateTime)) -- ^ Leaf validity period + -> (RData pub priv -> Pair pub priv) -- ^ Intermediate CA to use + -> (RData pub priv -> DateTime) -- ^ Value for 'checkAtTime' + -> [FailedReason] -- ^ Expected validation result + -> TestTree +testTimeshift res caseName f g h expected = testWithRes res caseName $ \rd -> do + let checks = defaultChecks { checkAtTime = Just $ h rd } + pair <- mkLeaf "timeshift" (f rd) (CA $ g rd) (keys1 rd) + assertValidationResult rd checks "timeshift" [pair, g rd] expected + +-- | Tests an empty DistinguishedName. +testNoCommonName :: IO (RData pub priv) -- ^ Common test resources + -> TestName -- ^ Case name + -> [FailedReason] -- ^ Expected validation result + -> TestTree +testNoCommonName res caseName expected = testWithRes res caseName $ \rd -> do + pair <- mkCertificate 2 100 dn (present rd) leafStdExts (CA $ intermediate rd) (keys1 rd) + assertValidationResult rd defaultChecks "no-cn" [pair, intermediate rd] expected + where + dn = DistinguishedName [] + +-- | Tests certificate CommonName against expected hostname, with or without +-- 'checkFQHN'. +testCommonName :: IO (RData pub priv) -- ^ Common test resources + -> String -- ^ Certificate CommonName + -> HostName -- ^ Connection identification + -> Bool -- ^ Value for 'checkFQHN' + -> [FailedReason] -- ^ Expected validation result + -> TestTree +testCommonName res cn hostname check expected = testWithRes res caseName $ \rd -> do + pair <- mkLeaf cn (present rd) (CA $ intermediate rd) (keys1 rd) + assertValidationResult rd checks hostname [pair, intermediate rd] expected + where + caseName = if null hostname then "empty" else hostname + checks = defaultChecks { checkFQHN = check } + +-- | Tests certificate SubjectAltName against expected hostname, with or +-- without 'checkFQHN'. +testSubjectAltName :: IO (RData pub priv) -- ^ Common test resources + -> String -- ^ Certificate SubjectAltName + -> HostName -- ^ Connection identification + -> Bool -- ^ Value for 'checkFQHN' + -> [FailedReason] -- ^ Expected validation result + -> TestTree +testSubjectAltName res san hostname check expected = testWithRes res caseName $ \rd -> do + pair <- mkCertificate 2 100 dn (present rd) (ext:leafStdExts) (CA $ intermediate rd) (keys1 rd) + assertValidationResult rd checks hostname [pair, intermediate rd] expected + where + caseName = if null hostname then "empty" else hostname + checks = defaultChecks { checkFQHN = check } + dn = mkDn "cn-not-used" -- this CN value is to be tested too + -- (to make sure CN is *not* considered when a + -- SubjectAltName exists) + ext = mkExtension False $ + -- wraps test value with other values + ExtSubjectAltName [ AltNameDNS "dummy1" + , AltNameRFC822 "test(a)example.com" + , AltNameDNS san + , AltNameDNS "dummy2" + ] + +-- | Tests 'checkLeafKeyUsage'. +testLeafKeyUsage :: IO (RData pub priv) -- ^ Common test resources + -> TestName -- ^ Case name + -> [ExtKeyUsageFlag] -- ^ Certificate flags + -> [ExtKeyUsageFlag] -- ^ Flags required for validation + -> [FailedReason] -- ^ Expected validation result + -> TestTree +testLeafKeyUsage res caseName cFlags vFlags expected = testWithRes res caseName $ \rd -> do + pair <- mkCertificate 2 100 dn (present rd) exts (CA $ intermediate rd) (keys1 rd) + assertValidationResult rd checks "key-usage" [pair, intermediate rd] expected + where + checks = defaultChecks { checkLeafKeyUsage = vFlags } + dn = mkDn "key-usage" + exts = if null cFlags then [] else [mkExtension False (ExtKeyUsage cFlags)] + +-- | Tests 'checkLeafKeyPurpose'. +testLeafKeyPurpose :: IO (RData pub priv) -- ^ Common test resources + -> TestName -- ^ Case name + -> [ExtKeyUsagePurpose] -- ^ Certificate flags + -> [ExtKeyUsagePurpose] -- ^ Flags required for validation + -> [FailedReason] -- ^ Expected validation result + -> TestTree +testLeafKeyPurpose res caseName cFlags vFlags expected = testWithRes res caseName $ \rd -> do + pair <- mkCertificate 2 100 dn (present rd) exts (CA $ intermediate rd) (keys1 rd) + assertValidationResult rd checks "key-purpose" [pair, intermediate rd] expected + where + checks = defaultChecks { checkLeafKeyPurpose = vFlags } + dn = mkDn "key-purpose" + exts = if null cFlags then [] else [mkExtension False (ExtExtendedKeyUsage cFlags)] + +-- | Tests validation with multiple failure reasons in exhaustive mode. +testExhaustive :: IO (RData pub priv) -- ^ Common test resources + -> String -- ^ Certificate CommonName + -> HostName -- ^ Connection identification + -> [FailedReason] -- ^ Expected validation result + -> TestTree +testExhaustive res cn hostname expected = testWithRes res caseName $ \rd -> do + -- build an expired self-signed certificate with an invalid signature: + -- the certificate is actually signed by a clone using a different key + p1 <- mkLeaf cn (past rd) Self (keys1 rd) + p2 <- mkLeaf cn (past rd) (CA p1) (keys2 rd) + assertValidationResult rd checks hostname [p2] expected + where + caseName = if null hostname then "empty" else hostname + checks = defaultChecks { checkExhaustive = True } + + +-- | All validation test cases. +treeWithAlg :: TestName -> Alg pub priv -> TestTree +treeWithAlg groupName alg = withResource (initData alg) freeData $ \res -> + testGroup groupName + [ testGroup "signature" + [ testSignature res "valid" intermediate intermediate [] + , testSignature res "invalid" intermediate intermediate0 [InvalidSignature SignatureInvalid] + ] + , testGroup "chain" + [ testEmpty res "empty" [EmptyChain] + , testIncompleteChain res "incomplete" [UnknownCA] + , testSelfSigned res "self-signed" [SelfSigned] + , testGroup "leaf-not-v3" + [ testLeafNotV3 res "v3-disallowed" True [LeafNotV3] + , testLeafNotV3 res "v3-allowed" False [] + ] + , testGroup "strict-ordering" + [ testStrictOrdering res "enabled" True [UnknownCA] + , testStrictOrdering res "disabled" False [] + ] + ] + , testGroup "ca-constraints" + [ testGroup "enabled" + [ testCAKeyUsage res "cert-sign" True KeyUsage_keyCertSign [] + , testCAKeyUsage res "crl-sign" True KeyUsage_cRLSign [NotAllowedToSign] + , testNotCA res "not-ca" True [NotAnAuthority] + , testNoBasic res "no-basic" True [NotAnAuthority] + , testBadDepth res "bad-depth" True [AuthorityTooDeep] + ] + , testGroup "disabled" + [ testCAKeyUsage res "cert-sign" False KeyUsage_keyCertSign [] + , testCAKeyUsage res "crl-sign" False KeyUsage_cRLSign [] + , testNotCA res "not-ca" False [] + , testNoBasic res "no-basic" False [] + , testBadDepth res "bad-depth" False [] + ] + ] + , testGroup "dates" + [ testGroup "leaf" + [ testGroup "enabled" + [ testLeafDates res "past" True past [Expired] + , testLeafDates res "present" True present [] + , testLeafDates res "future" True future [InFuture] + ] + , testGroup "disabled" + [ testLeafDates res "past" False past [] + , testLeafDates res "present" False present [] + , testLeafDates res "future" False future [] + ] + ] + , testGroup "intermediate" + [ testGroup "enabled" + [ testIntermediateDates res "past" True intermediatePast [Expired] + , testIntermediateDates res "present" True intermediate [] + , testIntermediateDates res "future" True intermediateFuture [InFuture] + ] + , testGroup "disabled" + [ testIntermediateDates res "past" False intermediatePast [] + , testIntermediateDates res "present" False intermediate [] + , testIntermediateDates res "future" False intermediateFuture [] + ] + ] + , testGroup "timeshift" + [ testGroup "at-past" + [ testTimeshift res "past" past intermediatePast pastDate [] + , testTimeshift res "present" present intermediate pastDate [InFuture] + , testTimeshift res "future" future intermediateFuture pastDate [InFuture] + ] + , testGroup "at-present" + [ testTimeshift res "past" past intermediatePast presentDate [Expired] + , testTimeshift res "present" present intermediate presentDate [] + , testTimeshift res "future" future intermediateFuture presentDate [InFuture] + ] + , testGroup "in-future" + [ testTimeshift res "past" past intermediatePast futureDate [Expired] + , testTimeshift res "present" present intermediate futureDate [Expired] + , testTimeshift res "future" future intermediateFuture futureDate [] + ] + ] + ] + , testGroup "CommonName" + [ testNoCommonName res "no-common-name" [NoCommonName] + , testGroup "simple" + [ testCommonName res "www.example.com" "www.example.com" True [] + , testCommonName res "www.example.com" "www2.example.com" True [NameMismatch "www2.example.com"] + , testCommonName res "www.example.com" "WWW.EXAMPLE.COM" True [] + , testCommonName res "www.example.com" "www.EXAMPLE.COM" True [] + , testCommonName res "www.example.com" "WWW.example.com" True [] + , testCommonName res "www..example.com" "www..example.com" True [NameMismatch "www..example.com"] -- InvalidName "www..example.com" + , testCommonName res "" "" True [NameMismatch ""] -- InvalidName "" + ] + , testGroup "wildcard" + [ testCommonName res "*.example.com" "example.com" True [NameMismatch "example.com"] + , testCommonName res "*.example.com" "www.example.com" True [] + , testCommonName res "*.example.com" "www.EXAMPLE.com" True [] + , testCommonName res "*.example.com" "www2.example.com" True [] + , testCommonName res "*.example.com" "www.m.example.com" True [NameMismatch "www.m.example.com"] + , testCommonName res "*" "single" True [NameMismatch "single"] -- InvalidWildcard + ] + , testGroup "disabled" + [ testCommonName res "www.example.com" "www.example.com" False [] + , testCommonName res "www.example.com" "www2.example.com" False [] + , testCommonName res "www.example.com" "WWW.EXAMPLE.COM" False [] + , testCommonName res "www.example.com" "www.EXAMPLE.COM" False [] + , testCommonName res "www.example.com" "WWW.example.com" False [] + , testCommonName res "www..example.com" "www..example.com" False [] + , testCommonName res "" "" False [] + ] + ] + , testGroup "SubjectAltName" + [ testGroup "simple" + [ testSubjectAltName res "www.example.com" "www.example.com" True [] + , testSubjectAltName res "www.example.com" "www2.example.com" True [NameMismatch "www2.example.com"] + , testSubjectAltName res "www.example.com" "WWW.EXAMPLE.COM" True [] + , testSubjectAltName res "www.example.com" "www.EXAMPLE.COM" True [] + , testSubjectAltName res "www.example.com" "WWW.example.com" True [] + , testSubjectAltName res "www..example.com" "www..example.com" True [NameMismatch "www..example.com"] -- InvalidName "www..example.com" + , testSubjectAltName res "" "" True [NameMismatch ""] -- InvalidName "" + ] + , testGroup "wildcard" + [ testSubjectAltName res "*.example.com" "example.com" True [NameMismatch "example.com"] + , testSubjectAltName res "*.example.com" "www.example.com" True [] + , testSubjectAltName res "*.example.com" "www.EXAMPLE.com" True [] + , testSubjectAltName res "*.example.com" "www2.example.com" True [] + , testSubjectAltName res "*.example.com" "www.m.example.com" True [NameMismatch "www.m.example.com"] + , testSubjectAltName res "*" "single" True [NameMismatch "single"] -- InvalidWildcard + ] + , testSubjectAltName res "www.example.com" "cn-not-used" True [NameMismatch "cn-not-used"] + , testGroup "disabled" + [ testSubjectAltName res "www.example.com" "www.example.com" False [] + , testSubjectAltName res "www.example.com" "www2.example.com" False [] + , testSubjectAltName res "www.example.com" "WWW.EXAMPLE.COM" False [] + , testSubjectAltName res "www.example.com" "www.EXAMPLE.COM" False [] + , testSubjectAltName res "www.example.com" "WWW.example.com" False [] + , testSubjectAltName res "www..example.com" "www..example.com" False [] + , testSubjectAltName res "" "" False [] + ] + ] + , testGroup "key-usage" + [ testLeafKeyUsage res "none" [] [u2, u3] [] + , testLeafKeyUsage res "valid" [u1, u2, u3] [u2, u3] [] + , testLeafKeyUsage res "invalid" [u1, u3] [u2, u3] [LeafKeyUsageNotAllowed] + ] + , testGroup "key-purpose" + [ testLeafKeyPurpose res "none" [] [p2, p3] [] + , testLeafKeyPurpose res "valid" [p1, p2, p3] [p2, p3] [] + , testLeafKeyPurpose res "invalid" [p1, p3] [p2, p3] [LeafKeyPurposeNotAllowed] + ] + , testExhaustive res "exhaustive2" "exhaustive" + [ SelfSigned + , Expired + , InvalidSignature SignatureInvalid + , NameMismatch "exhaustive" + ] + ] + where + (u1, u2, u3) = (KeyUsage_keyEncipherment, KeyUsage_dataEncipherment, KeyUsage_keyAgreement) + (p1, p2, p3) = (KeyUsagePurpose_ClientAuth, KeyUsagePurpose_CodeSigning, KeyUsagePurpose_EmailProtection) + +-- | Runs the test suite. +main :: IO () +main = defaultMain $ testGroup "Validation" + [ treeWithAlg "RSA" (AlgRSA 2048 hashSHA256) + , treeWithAlg "RSAPSS" (AlgRSAPSS 2048 pssParams hashSHA224) + , treeWithAlg "DSA" (AlgDSA dsaParams hashSHA1) + , treeWithAlg "ECDSA" (AlgEC curveName hashSHA512) + ] + where + pssParams = PSS.defaultPSSParams SHA224 + -- DSA parameters were generated using 'openssl dsaparam -C 2048' + dsaParams = DSA.Params + { DSA.params_p = 0x9994B9B1FC22EC3A5F607B5130D314F35FC8D387015A6D8FA2B56D3CC1F13FE330A631DBC765CEFFD6986BDEB8512580BBAD93D56EE7A8997DB9C65C29313FBC5077DB6F1E9D9E6D3499F997F09C8CF8ECC9E5F38DC34C3D656CFDF463893DDF9E246E223D7E5C4E86F54426DDA5DE112FCEDBFB5B6D6F7C76ED190EA1A7761CA561E8E5803F9D616DAFF25E2CCD4011A6D78D5CE8ED28CC2D865C7EC01508BA96FBD1F8BB5E517B6A5208A90AC2D3DCAE50281C02510B86C16D449465CD4B3754FD91AA19031282122A25C68292F033091FCB9DEBDE0D220F81F7EE4AB6581D24BE48204AF3DA52BDB944DA53B76148055395B30954735DC911574D360C953B + , DSA.params_g = 0x10E51AEA37880C5E52DD477ED599D55050C47012D038B9E4B3199C9DE9A5B873B1ABC8B954F26AFEA6C028BCE1783CFE19A88C64E4ED6BFD638802A78457A5C25ABEA98BE9C6EF18A95504C324315EABE7C1EA50E754591E3EFD3D33D4AE47F82F8978ABC871C135133767ACC60683F065430C749C43893D73596B12D5835A78778D0140B2F63B32A5658308DD5BA6BBC49CF6692929FA6A966419404F9A2C216860E3F339EDDB49AD32C294BDB4C9C6BB0D1CC7B691C65968C3A0A5106291CD3810147C8A16B4BFE22968AD9D3890733F4AA9ACD8687A5B981653A4B1824004639956E8C1EDAF31A8224191E8ABD645D2901F5B164B4B93F98039A6EAEC6088 + , DSA.params_q = 0xE1FDFADD32F46B5035EEB3DB81F9974FBCA69BE2223E62FCA8C77989B2AACDF7 + } + curveName = ECC.SEC_p384r1 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/x509-validation-1.6.5/x509-validation.cabal new/x509-validation-1.6.8/x509-validation.cabal --- old/x509-validation-1.6.5/x509-validation.cabal 2016-10-03 09:47:58.000000000 +0200 +++ new/x509-validation-1.6.8/x509-validation.cabal 2017-07-22 08:58:06.000000000 +0200 @@ -1,5 +1,5 @@ Name: x509-validation -Version: 1.6.5 +version: 1.6.8 Description: X.509 Certificate and CRL validation License: BSD3 License-file: LICENSE @@ -11,9 +11,10 @@ Category: Data stability: experimental Homepage: http://github.com/vincenthz/hs-certificate -Cabal-Version: >=1.6 +Cabal-Version: >= 1.10 Library + Default-Language: Haskell2010 Build-Depends: base >= 3 && < 5 , bytestring , memory @@ -25,8 +26,8 @@ , pem >= 0.1 && < 0.3 , asn1-types >= 0.3 && < 0.4 , asn1-encoding >= 0.9 && < 0.10 - , x509 >= 1.6.2 && < 1.7 - , x509-store >= 1.6 && < 1.7 + , x509 >= 1.6.5 + , x509-store >= 1.6 , cryptonite >= 0.8 Exposed-modules: Data.X509.Validation Other-modules: Data.X509.Validation.Signature @@ -35,6 +36,26 @@ Data.X509.Validation.Types ghc-options: -Wall +Test-Suite test-x509-validation + Default-Language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: Tests + Main-is: Tests.hs + Other-modules: Certificate + Build-Depends: base >= 3 && < 5 + , bytestring + , data-default-class + , tasty + , tasty-hunit + , hourglass + , asn1-types + , asn1-encoding + , x509 >= 1.7.1 + , x509-store + , x509-validation + , cryptonite + ghc-options: -Wall + source-repository head type: git location: git://github.com/vincenthz/hs-certificate

1 0

commit ghc-x509-system for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-x509-system for openSUSE:Factory checked in at 2017-08-31 21:01:52 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-x509-system (Old) and /work/SRC/openSUSE:Factory/.ghc-x509-system.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-x509-system" Thu Aug 31 21:01:52 2017 rev:7 rq:513542 version:1.6.5 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-x509-system/ghc-x509-system.changes 2016-11-05 21:27:05.000000000 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-x509-system.new/ghc-x509-system.changes 2017-08-31 21:01:52.405809896 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:07:15 UTC 2017 - psimons(a)suse.com + +- Update to version 1.6.5. + +------------------------------------------------------------------- Old: ---- x509-system-1.6.4.tar.gz New: ---- x509-system-1.6.5.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-x509-system.spec ++++++ --- /var/tmp/diff_new_pack.i3zrRO/_old 2017-08-31 21:01:53.925596362 +0200 +++ /var/tmp/diff_new_pack.i3zrRO/_new 2017-08-31 21:01:53.949592991 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-x509-system # -# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -18,7 +18,7 @@ %global pkg_name x509-system Name: ghc-%{pkg_name} -Version: 1.6.4 +Version: 1.6.5 Release: 0 Summary: Handle per-operating-system X.509 accessors and storage License: BSD-3-Clause ++++++ x509-system-1.6.4.tar.gz -> x509-system-1.6.5.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/x509-system-1.6.4/x509-system.cabal new/x509-system-1.6.5/x509-system.cabal --- old/x509-system-1.6.4/x509-system.cabal 2016-10-03 09:47:13.000000000 +0200 +++ new/x509-system-1.6.5/x509-system.cabal 2017-07-21 19:18:45.000000000 +0200 @@ -1,5 +1,5 @@ Name: x509-system -Version: 1.6.4 +version: 1.6.5 Description: System X.509 handling License: BSD3 License-file: LICENSE @@ -11,9 +11,10 @@ Category: Data stability: experimental Homepage: http://github.com/vincenthz/hs-certificate -Cabal-Version: >=1.8 +Cabal-Version: >= 1.10 Library + Default-Language: Haskell2010 Build-Depends: base >= 3 && < 5 , bytestring , mtl @@ -22,8 +23,8 @@ , filepath , process , pem >= 0.1 && < 0.3 - , x509 >= 1.6 && < 1.7 - , x509-store >= 1.6.2 && < 1.7 + , x509 >= 1.6 + , x509-store >= 1.6.2 Exposed-modules: System.X509 System.X509.Unix System.X509.MacOS

1 0

commit ghc-x509-store for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-x509-store for openSUSE:Factory checked in at 2017-08-31 21:01:49 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-x509-store (Old) and /work/SRC/openSUSE:Factory/.ghc-x509-store.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-x509-store" Thu Aug 31 21:01:49 2017 rev:6 rq:513541 version:1.6.3 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-x509-store/ghc-x509-store.changes 2016-11-05 21:26:59.000000000 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-x509-store.new/ghc-x509-store.changes 2017-08-31 21:01:50.186121767 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:05:37 UTC 2017 - psimons(a)suse.com + +- Update to version 1.6.3. + +------------------------------------------------------------------- Old: ---- x509-store-1.6.2.tar.gz New: ---- x509-store-1.6.3.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-x509-store.spec ++++++ --- /var/tmp/diff_new_pack.QRLE1d/_old 2017-08-31 21:01:51.873884632 +0200 +++ /var/tmp/diff_new_pack.QRLE1d/_new 2017-08-31 21:01:51.897881260 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-x509-store # -# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -18,7 +18,7 @@ %global pkg_name x509-store Name: ghc-%{pkg_name} -Version: 1.6.2 +Version: 1.6.3 Release: 0 Summary: X.509 collection accessing and storing methods License: BSD-3-Clause ++++++ x509-store-1.6.2.tar.gz -> x509-store-1.6.3.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/x509-store-1.6.2/x509-store.cabal new/x509-store-1.6.3/x509-store.cabal --- old/x509-store-1.6.2/x509-store.cabal 2016-10-03 09:36:19.000000000 +0200 +++ new/x509-store-1.6.3/x509-store.cabal 2017-07-21 19:18:36.000000000 +0200 @@ -1,5 +1,5 @@ Name: x509-store -Version: 1.6.2 +version: 1.6.3 Description: X.509 collection accessing and storing methods for certificate, crl, exception list License: BSD3 License-file: LICENSE @@ -11,9 +11,10 @@ Category: Data stability: experimental Homepage: http://github.com/vincenthz/hs-certificate -Cabal-Version: >=1.8 +Cabal-Version: >= 1.10 Library + Default-Language: Haskell2010 Build-Depends: base >= 3 && < 5 , bytestring , mtl @@ -24,7 +25,7 @@ , asn1-types >= 0.3 && < 0.4 , asn1-encoding >= 0.9 && < 0.10 , cryptonite - , x509 >= 1.6 && < 1.7 + , x509 >= 1.6 Exposed-modules: Data.X509.CertificateStore Data.X509.File Data.X509.Memory

1 0