diff --git a/Test/Apt.hs b/Test/Apt.hs new file mode 100644 --- /dev/null +++ b/Test/Apt.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Apt (aptTests) where + +import Test.HUnit +import Control.Exception +import Data.Text (Text) +import Debian.Apt.Index +import Debian.Control + +aptTests :: [Test] +aptTests = releaseIndexTests + +releaseIndexTests :: [Test] +releaseIndexTests = + [ testReleaseIndexes e ps i | (i, (e, ps)) <- zip [1..] + [ ( Left "Invalid release file: " + , [] ) + , ( Left "No indexes in release: No SHA256 Field, No SHA1 Field, No MD5Sum Field" + , [Paragraph []] ) + , ( Left "No indexes in release: No SHA256 Field, No SHA1 Field, No MD5Sum Field" + , [Paragraph [Field ("x", "foo")]] ) + , ( Left "No indexes in release: Invalid checksum line: \"abc\", Invalid checksum line: \"def\", Invalid checksum line: \"ghi\"" + , [Paragraph [Field ("SHA256", "abc"), Field ("SHA1", "def"), Field ("MD5Sum", "ghi")]] ) + , ( Left "No indexes in release: Invalid size field: \"123x\", No SHA1 Field, No MD5Sum Field" + , [Paragraph [Field ("SHA256", "abcde 123x file")]] ) + , ( Right [(CheckSums {md5sum = Nothing, sha1 = Nothing, sha256 = Just "abcde"}, 123, "file")] + , [Paragraph [Field ("SHA256", "abcde 123 file")]] ) + , ( Right [(CheckSums {md5sum = Just "abcde", sha1 = Nothing, sha256 = Nothing}, 123, "file")] + , [Paragraph [Field ("md5sum", "abcde 123 file")]] ) + ] + ] + +testReleaseIndexes :: Either String [(CheckSums, Integer, FilePath)] -> [Paragraph' Text] -> Int -> Test +testReleaseIndexes expected ps i = TestCase $ + either (assertError pfx) (assertEqual pfx) expected + $ indexesInRelease (const True) (Control ps) + where pfx = "indexesInRelease" <> show i + +assertError :: (Eq a, Show a) => String -> String -> a -> Assertion +assertError preface errExpected action = do + r <- try $ evaluate action + case r of + Left (ErrorCall err) -> assertEqual preface errExpected err + Right _ -> assertFailure $ preface <> " did not call error" diff --git a/Test/Main.hs b/Test/Main.hs --- a/Test/Main.hs +++ b/Test/Main.hs @@ -2,15 +2,17 @@ import Test.HUnit import System.Exit +import Apt import Changes import Control +import Dependencies import Versions import Debian.Sources -import Dependencies import Text.PrettyPrint +main :: IO () main = - do (c,st) <- runTestText putTextToShowS (TestList (versionTests ++ [sourcesListTests] ++ dependencyTests ++ changesTests ++ controlTests ++ prettyTests)) + do (c,st) <- runTestText putTextToShowS (TestList (versionTests ++ [sourcesListTests] ++ dependencyTests ++ changesTests ++ controlTests ++ prettyTests ++ aptTests)) putStrLn (st "") case (failures c) + (errors c) of 0 -> return () @@ -18,6 +20,7 @@ -- | I was converting from one pretty printing package to another and -- was unclear how this should work. +prettyTests :: [Test] prettyTests = [ TestCase (assertEqual "pretty0" diff --git a/debian.cabal b/debian.cabal --- a/debian.cabal +++ b/debian.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 Name: debian -Version: 4.0.4 +Version: 4.0.5 License: BSD-3-Clause License-File: debian/copyright Author: David Fox , Jeremy Shaw , Clifford Beshers @@ -9,7 +9,7 @@ Homepage: https://github.com/clinty/debian-haskell Build-Type: Simple Synopsis: Modules for working with the Debian package system -Tested-With: GHC ==9.2.3 || ==9.0.2 || ==8.10.7 || ==8.8.4 || ==8.6.5 || ==8.4.4 +Tested-With: GHC ==9.6.2 || ==9.4.7 || ==9.2.8 || ==9.0.2 || ==8.10.7 Description: This library includes modules covering some basic data types defined by the Debian policy manual - version numbers, control file syntax, etc. @@ -127,7 +127,8 @@ Hs-Source-Dirs: Test Main-Is: Main.hs Build-Depends: base, Cabal, debian, HUnit, parsec, pretty >= 1.1.2, regex-tdfa, text - other-modules: Changes + other-modules: Apt + , Changes , Control , Dependencies , Paths_debian diff --git a/src/Debian/Apt/Index.hs b/src/Debian/Apt/Index.hs --- a/src/Debian/Apt/Index.hs +++ b/src/Debian/Apt/Index.hs @@ -283,13 +283,18 @@ indexesInRelease filterp (Control [p]) = -- In a release file we should find one or more of the fields -- "SHA256", "SHA1", or "MD5Sum", each containing a list of triples - either error (filter (\(_,_,fp) -> filterp fp)) $ - msum [either Left (makeTuples makeSHA256) (maybe (Left "No SHA256 Field") makeTriples $ fieldValue "SHA256" p), - either Left (makeTuples makeSHA1) (maybe (Left "No SHA1 Field") makeTriples $ fieldValue "SHA1" p), - either Left (makeTuples makeMD5) (maybe (Left "No MD5Sum Field") makeTriples $ msum [fieldValue "MD5Sum" p, - fieldValue "Md5Sum" p, - fieldValue "MD5sum" p])] + case attempts of + (_, fps:_) -> filter (\(_,_,fp) -> filterp fp) fps + (errs, _) -> error $ "No indexes in release: " <> intercalate ", " errs where + attempts = partitionEithers + [ attempt makeSHA256 "SHA256" + , attempt makeSHA1 "SHA1" + , attempt makeMD5 "MD5Sum" ] + + attempt mksum fn = makeTuples mksum =<< makeTriples =<< + maybe (Left $ "No " <> fn <> " Field") Right (fieldValue fn p) + makeSHA256 s = CheckSums {md5sum = Nothing, sha1 = Nothing, sha256 = Just s} makeSHA1 s = CheckSums {md5sum = Nothing, sha1 = Just s, sha256 = Nothing} makeMD5 s = CheckSums {md5sum = Just s, sha1 = Nothing, sha256 = Nothing} diff --git a/src/Debian/Apt/Methods.hs b/src/Debian/Apt/Methods.hs --- a/src/Debian/Apt/Methods.hs +++ b/src/Debian/Apt/Methods.hs @@ -25,6 +25,7 @@ import Debian.URI (URI(..), parseURI, uriToString') import Control.Exception +import Control.Monad (liftM, unless) import Control.Monad.Except import Data.Maybe import Data.Time diff --git a/src/Debian/Control/ByteString.hs b/src/Debian/Control/ByteString.hs --- a/src/Debian/Control/ByteString.hs +++ b/src/Debian/Control/ByteString.hs @@ -30,6 +30,7 @@ import Data.Char(toLower, isSpace) import Data.List +import Control.Monad (MonadPlus(..), ap, liftM, unless) import Text.ParserCombinators.Parsec.Error import Text.ParserCombinators.Parsec.Pos