codec-rpm (empty) → 0.1.0
raw patch · 22 files changed
+4089/−0 lines, 22 filesdep +HUnitdep +attoparsecdep +attoparsec-binarysetup-changed
Dependencies added: HUnit, attoparsec, attoparsec-binary, base, bytestring, codec-rpm, conduit, conduit-combinators, conduit-extra, hspec, hspec-attoparsec, mtl, parsec, pretty, resourcet, text
Files
- ChangeLog.md +3/−0
- Codec/RPM/Internal/Numbers.hs +43/−0
- Codec/RPM/Parse.hs +167/−0
- Codec/RPM/Tags.hs +852/−0
- Codec/RPM/Types.hs +137/−0
- Codec/RPM/Version.hs +265/−0
- LICENSE +502/−0
- Makefile +13/−0
- README.md +70/−0
- Setup.hs +17/−0
- codec-rpm.cabal +70/−0
- examples/inspect.hs +31/−0
- examples/rpm2json.hs +135/−0
- examples/unrpm.hs +91/−0
- tests/Codec/RPM/ParseSpec.hs +213/−0
- tests/Codec/RPM/Parse_parseRPMSpec.hs +193/−0
- tests/Codec/RPM/Tags_TagSpec.hs +34/−0
- tests/Codec/RPM/Tags_findSpec.hs +163/−0
- tests/Codec/RPM/Tags_mkTagSpec.hs +707/−0
- tests/Codec/RPM/TypesSpec.hs +16/−0
- tests/Codec/RPM/VersionSpec.hs +366/−0
- tests/Spec.hs +1/−0
+ ChangeLog.md view
@@ -0,0 +1,3 @@+## 0.1.0++* Initial release.
+ Codec/RPM/Internal/Numbers.hs view
@@ -0,0 +1,43 @@+-- Copyright (C) 2016 Red Hat, Inc.+--+-- This library is free software; you can redistribute it and/or+-- modify it under the terms of the GNU Lesser General Public+-- License as published by the Free Software Foundation; either+-- version 2.1 of the License, or (at your option) any later version.+--+-- This library is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU+-- Lesser General Public License for more details.+--+-- You should have received a copy of the GNU Lesser General Public+-- License along with this library; if not, see <http://www.gnu.org/licenses/>.++module Codec.RPM.Internal.Numbers(asWord16,+ asWord32,+ asWord64)+ where++import Data.Bits((.|.), shift)+import qualified Data.ByteString as BS+import Data.Word++asWord16 :: BS.ByteString -> Word16+asWord16 bs = fromIntegral (bs `BS.index` 0) `shift` 8 .|.+ fromIntegral (bs `BS.index` 1)++asWord32 :: BS.ByteString -> Word32+asWord32 bs = fromIntegral (bs `BS.index` 0) `shift` 24 .|.+ fromIntegral (bs `BS.index` 1) `shift` 16 .|.+ fromIntegral (bs `BS.index` 2) `shift` 8 .|.+ fromIntegral (bs `BS.index` 3)++asWord64 :: BS.ByteString -> Word64+asWord64 bs = fromIntegral (bs `BS.index` 0) `shift` 56 .|.+ fromIntegral (bs `BS.index` 1) `shift` 48 .|.+ fromIntegral (bs `BS.index` 2) `shift` 40 .|.+ fromIntegral (bs `BS.index` 3) `shift` 32 .|.+ fromIntegral (bs `BS.index` 4) `shift` 24 .|.+ fromIntegral (bs `BS.index` 5) `shift` 16 .|.+ fromIntegral (bs `BS.index` 6) `shift` 8 .|.+ fromIntegral (bs `BS.index` 7)
+ Codec/RPM/Parse.hs view
@@ -0,0 +1,167 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE FlexibleContexts #-}++-- |+-- Module: Codec.RPM.Parse+-- Copyright: (c) 2016-2017 Red Hat, Inc.+-- License: LGPL+--+-- Maintainer: https://github.com/weldr+-- Stability: stable+-- Portability: portable+--+-- A module for creating 'RPM' records from various data sources.++module Codec.RPM.Parse(+#ifdef TEST+ parseLead,+ parseSectionHeader,+ parseOneTag,+ parseSection,+#endif+ parseRPM,+ parseRPMC)+ where++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative((<$>))+#endif+import Control.Monad(void)+import Control.Monad.Except(MonadError, throwError)+import Conduit((.|), Conduit, awaitForever, yield)+import Data.Attoparsec.Binary+import Data.Attoparsec.ByteString(Parser, anyWord8, count, take, takeByteString, word8)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as C+import Data.Conduit.Attoparsec(ParseError(..), conduitParserEither)+import Data.Maybe(mapMaybe)+import Prelude hiding(take)++import Codec.RPM.Internal.Numbers(asWord32)+import Codec.RPM.Tags(Tag, mkTag)+import Codec.RPM.Types(Header(..), Lead(..), RPM(..), SectionHeader(..))++-- "a <$> b <$> c" looks better than "a . b <$> c"+{-# ANN parseLead "HLint: ignore Functor law" #-}+parseLead :: Parser Lead+parseLead = do+ -- Verify this is an RPM by checking the first four bytes.+ void $ word32be 0xedabeedb++ rpmMajor <- anyWord8+ rpmMinor <- anyWord8+ rpmType <- anyWord16be+ rpmArchNum <- anyWord16be+ rpmName <- C.unpack <$> BS.takeWhile (/= 0) <$> take 66+ rpmOSNum <- anyWord16be+ rpmSigType <- anyWord16be++ -- Skip 16 reserved bytes at the end of the lead.+ void $ take 16+ + return Lead { rpmMajor,+ rpmMinor,+ rpmType,+ rpmArchNum,+ rpmName,+ rpmOSNum,+ rpmSigType }++parseSectionHeader :: Parser SectionHeader+parseSectionHeader = do+ -- Verify this is a header section header by checking the first three bytes.+ void $ word8 0x8e >> word8 0xad >> word8 0xe8++ sectionVersion <- anyWord8+ -- Skip four reserved bytes.+ void $ take 4+ sectionCount <- anyWord32be+ sectionSize <- anyWord32be++ return SectionHeader { sectionVersion,+ sectionCount,+ sectionSize }++parseOneTag :: C.ByteString -> C.ByteString -> Maybe Tag+parseOneTag store bs | BS.length bs < 16 = Nothing+ | otherwise = let+ tag = fromIntegral . asWord32 $ BS.take 4 bs+ ty = fromIntegral . asWord32 $ BS.take 4 (BS.drop 4 bs)+ off = fromIntegral . asWord32 $ BS.take 4 (BS.drop 8 bs)+ cnt = fromIntegral . asWord32 $ BS.take 4 (BS.drop 12 bs)+ in+ mkTag store tag ty off cnt++parseSection :: Parser Header+parseSection = do+ headerSectionHeader <- parseSectionHeader+ -- Grab the tags as a list of bytestrings. We need the store before we can process the tags, as+ -- that's where all the values for the tags are kept. However, grabbing each individual tag here+ -- makes it a lot easier to process them later.+ rawTags <- count (fromIntegral $ sectionCount headerSectionHeader) (take 16)+ headerStore <- take (fromIntegral $ sectionSize headerSectionHeader)++ -- Now that we've got the store, process each tag by looking up its values in the store.+ -- NOTE: mapMaybe will reject tags which are Nothing+ let headerTags = mapMaybe (parseOneTag headerStore) rawTags++ return Header { headerSectionHeader,+ headerTags,+ headerStore }++-- | A parser (in the attoparsec sense of the term) that constructs 'RPM' records. The parser+-- can be run against a 'ByteString' of RPM data using any of the usual functions. 'parse' and+-- 'parseOnly' are especially useful:+--+-- > import Data.Attoparsec.ByteString(parse)+-- > import qualified Data.ByteString as BS+-- > s <- BS.readFile "some.rpm"+-- > result <- parse parseRPM s+--+-- The 'Result' can then be examined directly or converted using 'maybeResult' (for converting+-- it into a 'Maybe RPM') or 'eitherResult' (for converting it into an 'Either String RPM').+-- In the latter case, the String contains any parse error that occurred when reading the+-- RPM data.+parseRPM :: Parser RPM+parseRPM = do+ -- First comes the (mostly useless) lead.+ rpmLead <- parseLead+ -- Then comes the signature, which is like a regular section except it's also padded.+ sig <- parseSection+ void $ take (signaturePadding sig)+ -- And then comes the real header. There could be several, but for now there's only ever one.+ hdr <- parseSection+ rpmArchive <- takeByteString+ return RPM { rpmLead,+ rpmSignatures=[sig],+ rpmHeaders=[hdr],+ rpmArchive }+ where+ signaturePadding :: Header -> Int+ signaturePadding hdr = let+ remainder = (sectionSize . headerSectionHeader) hdr `mod` 8+ in+ if remainder > 0 then fromIntegral $ 8 - remainder else 0++-- | Like 'parseRPM', but puts the result into a 'Conduit' as an 'Either', containing either a+-- 'ParseError' or an 'RPM'. The result can be extracted with 'runExceptT', like so:+--+-- > import Conduit((.|), runConduitRes, sourceFile)+-- > import Control.Monad.Except(runExceptT)+-- > result <- runExceptT $ runConduitRes $ sourceFile "some.rpm" .| parseRPMC .| someConsumer+--+-- On success, the 'RPM' record will be passed down the conduit for futher processing or+-- consumption. Functions can be written to extract just one element out of the 'RPM' and+-- pass it along. For instance:+--+-- > payloadC :: MonadError e m => Conduit RPM m BS.ByteStrin+-- > payloadC = awaitForever (yield . rpmArchive)+--+-- On error, the rest of the conduit will be skipped and the 'ParseError' will be returned+-- as the result to be dealt with.+parseRPMC :: MonadError String m => Conduit C.ByteString m RPM+parseRPMC =+ conduitParserEither parseRPM .| consumer+ where+ consumer = awaitForever $ either (throwError . errorMessage) (yield . snd)
+ Codec/RPM/Tags.hs view
@@ -0,0 +1,852 @@+{-# LANGUAGE DeriveDataTypeable #-}++-- |+-- Module: Codec.RPM.Tags+-- Copyright: (c) 2016-2017 Red Hat, Inc.+-- License: LGPL+--+-- Maintainer: https://github.com/weldr+-- Stability: stable+-- Portability: portable++module Codec.RPM.Tags(+ -- * Types+ Tag(..),+ Null(..),+ -- * Tag finding functions+ findTag,+ findByteStringTag,+ findStringTag,+ findStringListTag,+ findWord16Tag,+ findWord16ListTag,+ findWord32Tag,+ findWord32ListTag,+ -- * Tag making functions+ mkTag,+ -- * Tag inspection functions+ tagValue)+ where++import Data.Bits((.&.), shiftR)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as C+import Data.Data(Data, cast, gmapQi, showConstr, toConstr)+import Data.List(find)+import Data.Maybe(fromMaybe, listToMaybe)+import Data.Typeable(Typeable)+import Data.Word+import Text.PrettyPrint.HughesPJClass(Pretty(..))+import Text.PrettyPrint(text)++import Codec.RPM.Internal.Numbers++{-# ANN module "HLint: ignore Use camelCase" #-}++-- The character lists are actually lists of characters, ignore the suggestions+-- to use String instead+{-# ANN module "HLint: ignore Use String" #-}++-- | A very large data type that holds all the possibilities for the various tags that can+-- be contained in an 'RPM' 'Header'. Each tag describes one piece of metadata. Most tags+-- include some typed value, such as a 'String' or 'Word32'. Many tags contain lists of+-- these values, for instance any tag involving files or changelog entries. Some tags+-- contain no useful value at all.+--+-- Because there are so many possibilities for tags and each 'RPM' likely contains dozens+-- of tags, it is unwieldy to write functions that pattern match on tags and take some+-- action. This module therefore provides a variety of find*Tag functions for searching+-- the list of tags by name and returning a 'Maybe' value. The name provided to each should+-- be the constructor you are looking for in this data type.+--+-- To find the list of all files in the RPM, you would therefore do:+--+-- > findStringTag "FileNames" tags+data Tag = DEPRECATED Tag+ | INTERNAL Tag+ | OBSOLETE Tag+ | UNIMPLEMENTED Tag+ | UNUSED Tag++ | HeaderImage Null+ | HeaderSignatures Null+ | HeaderImmutable Null+ | HeaderRegions Null+ | HeaderI18NTable [String]++ | SigBase Null+ | SigSize Word32+ | SigLEMD5_1 Null+ | SigPGP BS.ByteString+ | SigLEMD5_2 Null+ | SigMD5 BS.ByteString+ | SigGPG BS.ByteString+ | SigPGP5 Null+ | SigBadSHA1_1 Null+ | SigBadSHA1_2 Null+ | PubKeys [String]+ | DSAHeader BS.ByteString+ | RSAHeader BS.ByteString+ | SHA1Header String+ | LongSigSize Word64+ | LongArchiveSize Word64++ | Name String+ | Version String+ | Release String+ | Epoch Word32+ | Summary BS.ByteString+ | Description BS.ByteString+ | BuildTime Word32+ | BuildHost String+ | InstallTime Word32+ | Size Word32+ | Distribution String+ | Vendor String+ | GIF BS.ByteString+ | XPM BS.ByteString+ | License String+ | Packager String+ | Group BS.ByteString+ | ChangeLog [String]+ | Source [String]+ | Patch [String]+ | URL String+ | OS String+ | Arch String+ | PreIn String+ | PostIn String+ | PreUn String+ | PostUn String+ | OldFileNames [String]+ | FileSizes [Word32]+ | FileStates [Char]+ | FileModes [Word16]+ | FileUIDs [Word32]+ | FileGIDs [Word32]+ | FileRDevs [Word16]+ | FileMTimes [Word32]+ | FileMD5s [String]+ | FileLinkTos [String]+ | FileFlags [Word32]+ | Root Null+ | FileUserName [String]+ | FileGroupName [String]+ | Exclude Null+ | Exclusive Null+ | Icon BS.ByteString+ | SourceRPM String+ | FileVerifyFlags [Word32]+ | ArchiveSize Word32+ | ProvideName [String]+ | RequireFlags [Word32]+ | RequireName [String]+ | RequireVersion [String]+ | NoSource [Word32]+ | NoPatch [Word32]+ | ConflictFlags [Word32]+ | ConflictName [String]+ | ConflictVersion [String]+ | DefaultPrefix String+ | BuildRoot String+ | InstallPrefix String+ | ExcludeArch [String]+ | ExcludeOS [String]+ | ExclusiveArch [String]+ | ExclusiveOS [String]+ | AutoReqProv String+ | RPMVersion String+ | TriggerScripts [String]+ | TriggerName [String]+ | TriggerVersion [String]+ | TriggerFlags [Word32]+ | TriggerIndex [Word32]+ | VerifyScript String+ | ChangeLogTime [Word32]+ | ChangeLogName [String]+ | ChangeLogText [String]+ | BrokenMD5 Null+ | PreReq Null+ | PreInProg [String]+ | PostInProg [String]+ | PreUnProg [String]+ | PostUnProg [String]+ | BuildArchs [String]+ | ObsoleteName [String]+ | VerifyScriptProg [String]+ | TriggerScriptProg [String]+ | DocDir Null+ | Cookie String+ | FileDevices [Word32]+ | FileINodes [Word32]+ | FileLangs [String]+ | Prefixes [String]+ | InstPrefixes [String]+ | TriggerIn Null+ | TriggerUn Null+ | TriggerPostUn Null+ | AutoReq Null+ | AutoProv Null+ | Capability Word32+ | SourcePackage Word32+ | OldOrigFileNames Null+ | BuildPreReq Null+ | BuildRequires Null+ | BuildConflicts Null+ | BuildMacros Null+ | ProvideFlags [Word32]+ | ProvideVersion [String]+ | ObsoleteFlags [Word32]+ | ObsoleteVersion [String]+ | DirIndexes [Word32]+ | BaseNames [String]+ | DirNames [String]+ | OrigDirIndexes [Word32]+ | OrigBaseNames [String]+ | OrigDirNames [String]+ | OptFlags String+ | DistURL String+ | PayloadFormat String+ | PayloadCompressor String+ | PayloadFlags String+ | InstallColor Word32+ | InstallTID Word32+ | RemoveTID Word32+ | SHA1RHN Null+ | RHNPlatform String+ | Platform String+ | PatchesName [String]+ | PatchesFlags [Word32]+ | PatchesVersion [String]+ | CacheCTime Word32+ | CachePkgPath String+ | CachePkgSize Word32+ | CachePkgMTime Word32+ | FileColors [Word32]+ | FileClass [Word32]+ | ClassDict [String]+ | FileDependsX [Word32]+ | FileDependsN [Word32]+ | DependsDict [(Word32, Word32)]+ | SourcePkgID BS.ByteString+ | FileContexts [String]+ | FSContexts [String]+ | ReContexts [String]+ | Policies [String]+ | PreTrans String+ | PostTrans String+ | PreTransProg [String]+ | PostTransProg [String]+ | DistTag String+ | OldSuggestsName [String]+ | OldSuggestsVersion [String]+ | OldSuggestsFlags [Word32]+ | OldEnhancesName [String]+ | OldEnhancesVersion [String]+ | OldEnhancesFlags [Word32]+ | Priority [Word32]+ | CVSID String+ | BLinkPkgID [String]+ | BLinkHdrID [String]+ | BLinkNEVRA [String]+ | FLinkPkgID [String]+ | FLinkHdrID [String]+ | FLinkNEVRA [String]+ | PackageOrigin String+ | TriggerPreIn Null+ | BuildSuggests Null+ | BuildEnhances Null+ | ScriptStates [Word32]+ | ScriptMetrics [Word32]+ | BuildCPUClock Word32+ | FileDigestAlgos [Word32]+ | Variants [String]+ | XMajor Word32+ | XMinor Word32+ | RepoTag String+ | Keywords [String]+ | BuildPlatforms [String]+ | PackageColor Word32+ | PackagePrefColor Word32+ | XattrsDict [String]+ | FileXattrsx [Word32]+ | DepAttrsDict [String]+ | ConflictAttrsx [Word32]+ | ObsoleteAttrsx [Word32]+ | ProvideAttrsx [Word32]+ | RequireAttrsx [Word32]+ | BuildProvides Null+ | BuildObsoletes Null+ | DBInstance Word32+ | NVRA String++ | FileNames [String]+ | FileProvide [String]+ | FileRequire [String]+ | FSNames [String]+ | FSSizes [Word64]+ | TriggerConds [String]+ | TriggerType [String]+ | OrigFileNames [String]+ | LongFileSizes [Word64]+ | LongSize Word64+ | FileCaps [String]+ | FileDigestAlgo Word32+ | BugURL String+ | EVR String+ | NVR String+ | NEVR String+ | NEVRA String+ | HeaderColor Word32+ | Verbose Word32+ | EpochNum Word32+ | PreInFlags Word32+ | PostInFlags Word32+ | PreUnFlags Word32+ | PostUnFlags Word32+ | PreTransFlags Word32+ | PostTransFlags Word32+ | VerifyScriptFlags Word32+ | TriggerScriptFlags [Word32]+ | Collections [String]+ | PolicyNames [String]+ | PolicyTypes [String]+ | PolicyTypesIndexes [Word32]+ | PolicyFlags [Word32]+ | PolicyVCS String+ | OrderName [String]+ | OrderVersion [String]+ | OrderFlags [Word32]+ | MSSFManifest [String]+ | MSSFDomain [String]+ | InstFileNames [String]+ | RequireNEVRs [String]+ | ProvideNEVRs [String]+ | ObsoleteNEVRs [String]+ | ConflictNEVRs [String]+ | FileNLinks [Word32]+ | RecommendName [String]+ | RecommendVersion [String]+ | RecommendFlags [Word32]+ | SuggestName [String]+ | SuggestVersion [String]+ | SuggestFlags [Word32]+ | SupplementName [String]+ | SupplementVersion [String]+ | SupplementFlags [Word32]+ | EnhanceName [String]+ | EnhanceVersion [String]+ | EnhanceFlags [Word32]+ | RecommendNEVRs [String]+ | SuggestNEVRs [String]+ | SupplementNEVRs [String]+ | EnhanceNEVRs [String]+ | Encoding String+ | FileTriggerIn Null+ | FileTriggerUn Null+ | FileTriggerPostUn Null+ | FileTriggerScripts [String]+ | FileTriggerScriptProg [String]+ | FileTriggerScriptFlags [Word32]+ | FileTriggerName [String]+ | FileTriggerIndex [Word32]+ | FileTriggerVersion [String]+ | FileTriggerFlags [Word32]+ | TransFileTriggerIn Null+ | TransFileTriggerUn Null+ | TransFileTriggerPostUn Null+ | TransFileTriggerScripts [String]+ | TransFileTriggerScriptProg [String]+ | TransFileTriggerScriptFlags [Word32]+ | TransFileTriggerName [String]+ | TransFileTriggerIndex [Word32]+ | TransFileTriggerVersion [String]+ | TransFileTriggerFlags [Word32]+ | RemovePathPostFixes String+ | FileTriggerPriorities [Word32]+ | TransFileTriggerPriorities [Word32]+ | FileTriggerConds [String]+ | FileTriggerType [String]+ | TransFileTriggerConds [String]+ | TransFileTriggerType [String]+ | FileSignatures [String]+ | FileSignatureLength Word32+ deriving(Eq, Show, Data, Typeable)++instance Pretty Tag where+ -- This is a lot quicker than having to provide a Pretty instance that takes every+ -- single Tag into account.+ pPrint = text . show++-- | Some 'Tag's do not contain any value, likely because support for that tag has been+-- removed. RPM never removes a tag from its list of known values, however, so we must+-- still recognize them. These tags have a special value of 'Null', which contains no+-- value.+data Null = Null+ deriving(Eq, Show, Data, Typeable)++-- | Attempt to create a 'Tag' based on various parameters.+mkTag :: BS.ByteString -- ^ The 'headerStore' containing the value of the potential 'Tag'.+ -> Int -- ^ The number of the 'Tag', as read out of the store. Valid numbers+ -- may be found in lib/rpmtag.h in the RPM source, though most+ -- users will not need to know this since it will be read from the+ -- store.+ -> Word32 -- ^ What is the type of this tag's value? Valid numbers may be found+ -- in the rpmTagType_e enum in lib/rpmtag.h in the RPM source, though+ -- most users will not need to know this since it will be read from+ -- the store. Here, it is used as a simple form of type checking.+ -> Word32 -- ^ How far into the 'headerStore' is this 'Tag's value stored?+ -> Word32 -- ^ How many values are stored for this 'Tag'?+ -> Maybe Tag+mkTag store tag ty offset count = case tag of+ 61 -> maker mkNull >>= Just . HeaderImage+ 62 -> maker mkNull >>= Just . HeaderSignatures+ 63 -> maker mkNull >>= Just . HeaderImmutable+ 64 -> maker mkNull >>= Just . HeaderRegions+ 100 -> maker mkStringArray >>= Just . HeaderI18NTable++ 256 -> maker mkNull >>= Just . SigBase+ 257 -> maker mkWord32 >>= listToMaybe >>= Just . SigSize+ 258 -> maker mkNull >>= Just . INTERNAL . OBSOLETE . SigLEMD5_1+ 259 -> maker mkBinary >>= Just . SigPGP+ 260 -> maker mkNull >>= Just . INTERNAL . OBSOLETE . SigLEMD5_2+ 261 -> maker mkBinary >>= Just . SigMD5+ 262 -> maker mkBinary >>= Just . SigGPG+ 263 -> maker mkNull >>= Just . INTERNAL . OBSOLETE . SigPGP5+ 264 -> maker mkNull >>= Just . INTERNAL . OBSOLETE . SigBadSHA1_1+ 265 -> maker mkNull >>= Just . INTERNAL . OBSOLETE . SigBadSHA1_2+ 266 -> maker mkStringArray >>= Just . PubKeys+ 267 -> maker mkBinary >>= Just . DSAHeader+ 268 -> maker mkBinary >>= Just . RSAHeader+ 269 -> maker mkString >>= Just . SHA1Header+ 270 -> maker mkWord64 >>= listToMaybe >>= Just . LongSigSize+ 271 -> maker mkWord64 >>= listToMaybe >>= Just . LongArchiveSize++ 1000 -> maker mkString >>= Just . Name+ 1001 -> maker mkString >>= Just . Version+ 1002 -> maker mkString >>= Just . Release+ 1003 -> maker mkWord32 >>= listToMaybe >>= Just . Epoch+ 1004 -> maker mkI18NString >>= Just . Summary+ 1005 -> maker mkI18NString >>= Just . Description+ 1006 -> maker mkWord32 >>= listToMaybe >>= Just . BuildTime+ 1007 -> maker mkString >>= Just . BuildHost+ 1008 -> maker mkWord32 >>= listToMaybe >>= Just . InstallTime+ 1009 -> maker mkWord32 >>= listToMaybe >>= Just . Size+ 1010 -> maker mkString >>= Just . Distribution+ 1011 -> maker mkString >>= Just . Vendor+ 1012 -> maker mkBinary >>= Just . GIF+ 1013 -> maker mkBinary >>= Just . XPM+ 1014 -> maker mkString >>= Just . License+ 1015 -> maker mkString >>= Just . Packager+ 1016 -> maker mkI18NString >>= Just . Group+ 1017 -> maker mkStringArray >>= Just . INTERNAL . ChangeLog+ 1018 -> maker mkStringArray >>= Just . Source+ 1019 -> maker mkStringArray >>= Just . Patch+ 1020 -> maker mkString >>= Just . URL+ 1021 -> maker mkString >>= Just . OS+ 1022 -> maker mkString >>= Just . Arch+ 1023 -> maker mkString >>= Just . PreIn+ 1024 -> maker mkString >>= Just . PostIn+ 1025 -> maker mkString >>= Just . PreUn+ 1026 -> maker mkString >>= Just . PostUn+ 1027 -> maker mkStringArray >>= Just . OBSOLETE . OldFileNames+ 1028 -> maker mkWord32 >>= Just . FileSizes+ 1029 -> maker mkChar >>= Just . FileStates+ 1030 -> maker mkWord16 >>= Just . FileModes+ 1031 -> maker mkWord32 >>= Just . INTERNAL . OBSOLETE . FileUIDs+ 1032 -> maker mkWord32 >>= Just . INTERNAL . OBSOLETE . FileGIDs+ 1033 -> maker mkWord16 >>= Just . FileRDevs+ 1034 -> maker mkWord32 >>= Just . FileMTimes+ 1035 -> maker mkStringArray >>= Just . FileMD5s+ 1036 -> maker mkStringArray >>= Just . FileLinkTos+ 1037 -> maker mkWord32 >>= Just . FileFlags+ 1038 -> maker mkNull >>= Just . INTERNAL . OBSOLETE . Root+ 1039 -> maker mkStringArray >>= Just . FileUserName+ 1040 -> maker mkStringArray >>= Just . FileGroupName+ 1041 -> maker mkNull >>= Just . INTERNAL . OBSOLETE . Exclude+ 1042 -> maker mkNull >>= Just . INTERNAL . OBSOLETE . Exclusive+ 1043 -> maker mkBinary >>= Just . Icon+ 1044 -> maker mkString >>= Just . SourceRPM+ 1045 -> maker mkWord32 >>= Just . FileVerifyFlags+ 1046 -> maker mkWord32 >>= listToMaybe >>= Just . ArchiveSize+ 1047 -> maker mkStringArray >>= Just . ProvideName+ 1048 -> maker mkWord32 >>= Just . RequireFlags+ 1049 -> maker mkStringArray >>= Just . RequireName+ 1050 -> maker mkStringArray >>= Just . RequireVersion+ 1051 -> maker mkWord32 >>= Just . NoSource+ 1052 -> maker mkWord32 >>= Just . NoPatch+ 1053 -> maker mkWord32 >>= Just . ConflictFlags+ 1054 -> maker mkStringArray >>= Just . ConflictName+ 1055 -> maker mkStringArray >>= Just . ConflictVersion+ 1056 -> maker mkString >>= Just . INTERNAL . DEPRECATED . DefaultPrefix+ 1057 -> maker mkString >>= Just . INTERNAL . OBSOLETE . BuildRoot+ 1058 -> maker mkString >>= Just . INTERNAL . DEPRECATED . InstallPrefix+ 1059 -> maker mkStringArray >>= Just . ExcludeArch+ 1060 -> maker mkStringArray >>= Just . ExcludeOS+ 1061 -> maker mkStringArray >>= Just . ExclusiveArch+ 1062 -> maker mkStringArray >>= Just . ExclusiveOS+ 1063 -> maker mkString >>= Just . INTERNAL . AutoReqProv+ 1064 -> maker mkString >>= Just . RPMVersion+ 1065 -> maker mkStringArray >>= Just . TriggerScripts+ 1066 -> maker mkStringArray >>= Just . TriggerName+ 1067 -> maker mkStringArray >>= Just . TriggerVersion+ 1068 -> maker mkWord32 >>= Just . TriggerFlags+ 1069 -> maker mkWord32 >>= Just . TriggerIndex+ 1079 -> maker mkString >>= Just . VerifyScript+ 1080 -> maker mkWord32 >>= Just . ChangeLogTime+ 1081 -> maker mkStringArray >>= Just . ChangeLogName+ 1082 -> maker mkStringArray >>= Just . ChangeLogText+ 1083 -> maker mkNull >>= Just . INTERNAL . OBSOLETE . BrokenMD5+ 1084 -> maker mkNull >>= Just . INTERNAL . PreReq+ 1085 -> maker mkStringArray >>= Just . PreInProg+ 1086 -> maker mkStringArray >>= Just . PostInProg+ 1087 -> maker mkStringArray >>= Just . PreUnProg+ 1088 -> maker mkStringArray >>= Just . PostUnProg+ 1089 -> maker mkStringArray >>= Just . BuildArchs+ 1090 -> maker mkStringArray >>= Just . ObsoleteName+ 1091 -> maker mkStringArray >>= Just . VerifyScriptProg+ 1092 -> maker mkStringArray >>= Just . TriggerScriptProg+ 1093 -> maker mkNull >>= Just . INTERNAL . DocDir+ 1094 -> maker mkString >>= Just . Cookie+ 1095 -> maker mkWord32 >>= Just . FileDevices+ 1096 -> maker mkWord32 >>= Just . FileINodes+ 1097 -> maker mkStringArray >>= Just . FileLangs+ 1098 -> maker mkStringArray >>= Just . Prefixes+ 1099 -> maker mkStringArray >>= Just . InstPrefixes+ 1100 -> maker mkNull >>= Just . INTERNAL . TriggerIn+ 1101 -> maker mkNull >>= Just . INTERNAL . TriggerUn+ 1102 -> maker mkNull >>= Just . INTERNAL . TriggerPostUn+ 1103 -> maker mkNull >>= Just . INTERNAL . AutoReq+ 1104 -> maker mkNull >>= Just . INTERNAL . AutoProv+ 1105 -> maker mkWord32 >>= listToMaybe >>= Just . INTERNAL . OBSOLETE . Capability+ 1106 -> maker mkWord32 >>= listToMaybe >>= Just . SourcePackage+ 1107 -> maker mkNull >>= Just . INTERNAL . OBSOLETE . OldOrigFileNames+ 1108 -> maker mkNull >>= Just . INTERNAL . BuildPreReq+ 1109 -> maker mkNull >>= Just . INTERNAL . BuildRequires+ 1110 -> maker mkNull >>= Just . INTERNAL . BuildConflicts+ 1111 -> maker mkNull >>= Just . INTERNAL . UNUSED . BuildMacros+ 1112 -> maker mkWord32 >>= Just . ProvideFlags+ 1113 -> maker mkStringArray >>= Just . ProvideVersion+ 1114 -> maker mkWord32 >>= Just . ObsoleteFlags+ 1115 -> maker mkStringArray >>= Just . ObsoleteVersion+ 1116 -> maker mkWord32 >>= Just . DirIndexes+ 1117 -> maker mkStringArray >>= Just . BaseNames+ 1118 -> maker mkStringArray >>= Just . DirNames+ 1119 -> maker mkWord32 >>= Just . OrigDirIndexes+ 1120 -> maker mkStringArray >>= Just . OrigBaseNames+ 1121 -> maker mkStringArray >>= Just . OrigDirNames+ 1122 -> maker mkString >>= Just . OptFlags+ 1123 -> maker mkString >>= Just . DistURL+ 1124 -> maker mkString >>= Just . PayloadFormat+ 1125 -> maker mkString >>= Just . PayloadCompressor+ 1126 -> maker mkString >>= Just . PayloadFlags+ 1127 -> maker mkWord32 >>= listToMaybe >>= Just . InstallColor+ 1128 -> maker mkWord32 >>= listToMaybe >>= Just . InstallTID+ 1129 -> maker mkWord32 >>= listToMaybe >>= Just . RemoveTID+ 1130 -> maker mkNull >>= Just . INTERNAL . OBSOLETE . SHA1RHN+ 1131 -> maker mkString >>= Just . INTERNAL . OBSOLETE . RHNPlatform+ 1132 -> maker mkString >>= Just . Platform+ 1133 -> maker mkStringArray >>= Just . DEPRECATED . PatchesName+ 1134 -> maker mkWord32 >>= Just . DEPRECATED . PatchesFlags+ 1135 -> maker mkStringArray >>= Just . DEPRECATED . PatchesVersion+ 1136 -> maker mkWord32 >>= listToMaybe >>= Just . INTERNAL . OBSOLETE . CacheCTime+ 1137 -> maker mkString >>= Just . INTERNAL . OBSOLETE . CachePkgPath+ 1138 -> maker mkWord32 >>= listToMaybe >>= Just . INTERNAL . OBSOLETE . CachePkgSize+ 1139 -> maker mkWord32 >>= listToMaybe >>= Just . INTERNAL . OBSOLETE . CachePkgMTime+ 1140 -> maker mkWord32 >>= Just . FileColors+ 1141 -> maker mkWord32 >>= Just . FileClass+ 1142 -> maker mkStringArray >>= Just . ClassDict+ 1143 -> maker mkWord32 >>= Just . FileDependsX+ 1144 -> maker mkWord32 >>= Just . FileDependsN+ 1145 -> maker mkWord32 >>= Just . DependsDict . map (\x -> ((x `shiftR` 24) .&. 0xff, x .&. 0x00ffffff))+ 1146 -> maker mkBinary >>= Just . SourcePkgID+ 1147 -> maker mkStringArray >>= Just . OBSOLETE . FileContexts+ 1148 -> maker mkStringArray >>= Just . FSContexts+ 1149 -> maker mkStringArray >>= Just . ReContexts+ 1150 -> maker mkStringArray >>= Just . Policies+ 1151 -> maker mkString >>= Just . PreTrans+ 1152 -> maker mkString >>= Just . PostTrans+ 1153 -> maker mkStringArray >>= Just . PreTransProg+ 1154 -> maker mkStringArray >>= Just . PostTransProg+ 1155 -> maker mkString >>= Just . DistTag+ 1156 -> maker mkStringArray >>= Just . OBSOLETE . OldSuggestsName+ 1157 -> maker mkStringArray >>= Just . OBSOLETE . OldSuggestsVersion+ 1158 -> maker mkWord32 >>= Just . OBSOLETE . OldSuggestsFlags+ 1159 -> maker mkStringArray >>= Just . OBSOLETE . OldEnhancesName+ 1160 -> maker mkStringArray >>= Just . OBSOLETE . OldEnhancesVersion+ 1161 -> maker mkWord32 >>= Just . OBSOLETE . OldEnhancesFlags+ 1162 -> maker mkWord32 >>= Just . UNIMPLEMENTED . Priority+ 1163 -> maker mkString >>= Just . UNIMPLEMENTED . CVSID+ 1164 -> maker mkStringArray >>= Just . UNIMPLEMENTED . BLinkPkgID+ 1165 -> maker mkStringArray >>= Just . UNIMPLEMENTED . BLinkHdrID+ 1166 -> maker mkStringArray >>= Just . UNIMPLEMENTED . BLinkNEVRA+ 1167 -> maker mkStringArray >>= Just . UNIMPLEMENTED . FLinkPkgID+ 1168 -> maker mkStringArray >>= Just . UNIMPLEMENTED . FLinkHdrID+ 1169 -> maker mkStringArray >>= Just . UNIMPLEMENTED . FLinkNEVRA+ 1170 -> maker mkString >>= Just . UNIMPLEMENTED . PackageOrigin+ 1171 -> maker mkNull >>= Just . INTERNAL . TriggerPreIn+ 1172 -> maker mkNull >>= Just . INTERNAL . UNIMPLEMENTED . BuildSuggests+ 1173 -> maker mkNull >>= Just . INTERNAL . UNIMPLEMENTED . BuildEnhances+ 1174 -> maker mkWord32 >>= Just . UNIMPLEMENTED . ScriptStates+ 1175 -> maker mkWord32 >>= Just . UNIMPLEMENTED . ScriptMetrics+ 1176 -> maker mkWord32 >>= listToMaybe >>= Just . UNIMPLEMENTED . BuildCPUClock+ 1177 -> maker mkWord32 >>= Just . UNIMPLEMENTED . FileDigestAlgos+ 1178 -> maker mkStringArray >>= Just . UNIMPLEMENTED . Variants+ 1179 -> maker mkWord32 >>= listToMaybe >>= Just . UNIMPLEMENTED . XMajor+ 1180 -> maker mkWord32 >>= listToMaybe >>= Just . UNIMPLEMENTED . XMinor+ 1181 -> maker mkString >>= Just . UNIMPLEMENTED . RepoTag+ 1182 -> maker mkStringArray >>= Just . UNIMPLEMENTED . Keywords+ 1183 -> maker mkStringArray >>= Just . UNIMPLEMENTED . BuildPlatforms+ 1184 -> maker mkWord32 >>= listToMaybe >>= Just . UNIMPLEMENTED . PackageColor+ 1185 -> maker mkWord32 >>= listToMaybe >>= Just . UNIMPLEMENTED . PackagePrefColor+ 1186 -> maker mkStringArray >>= Just . UNIMPLEMENTED . XattrsDict+ 1187 -> maker mkWord32 >>= Just . UNIMPLEMENTED . FileXattrsx+ 1188 -> maker mkStringArray >>= Just . UNIMPLEMENTED . DepAttrsDict+ 1189 -> maker mkWord32 >>= Just . UNIMPLEMENTED . ConflictAttrsx+ 1190 -> maker mkWord32 >>= Just . UNIMPLEMENTED . ObsoleteAttrsx+ 1191 -> maker mkWord32 >>= Just . UNIMPLEMENTED . ProvideAttrsx+ 1192 -> maker mkWord32 >>= Just . UNIMPLEMENTED . RequireAttrsx+ 1193 -> maker mkNull >>= Just . UNIMPLEMENTED . BuildProvides+ 1194 -> maker mkNull >>= Just . UNIMPLEMENTED . BuildObsoletes+ 1195 -> maker mkWord32 >>= listToMaybe >>= Just . DBInstance+ 1196 -> maker mkString >>= Just . NVRA++ 5000 -> maker mkStringArray >>= Just . FileNames+ 5001 -> maker mkStringArray >>= Just . FileProvide+ 5002 -> maker mkStringArray >>= Just . FileRequire+ 5003 -> maker mkStringArray >>= Just . UNIMPLEMENTED . FSNames+ 5004 -> maker mkWord64 >>= Just . UNIMPLEMENTED . FSSizes+ 5005 -> maker mkStringArray >>= Just . TriggerConds+ 5006 -> maker mkStringArray >>= Just . TriggerType+ 5007 -> maker mkStringArray >>= Just . OrigFileNames+ 5008 -> maker mkWord64 >>= Just . LongFileSizes+ 5009 -> maker mkWord64 >>= listToMaybe >>= Just . LongSize+ 5010 -> maker mkStringArray >>= Just . FileCaps+ 5011 -> maker mkWord32 >>= listToMaybe >>= Just . FileDigestAlgo+ 5012 -> maker mkString >>= Just . BugURL+ 5013 -> maker mkString >>= Just . EVR+ 5014 -> maker mkString >>= Just . NVR+ 5015 -> maker mkString >>= Just . NEVR+ 5016 -> maker mkString >>= Just . NEVRA+ 5017 -> maker mkWord32 >>= listToMaybe >>= Just . HeaderColor+ 5018 -> maker mkWord32 >>= listToMaybe >>= Just . Verbose+ 5019 -> maker mkWord32 >>= listToMaybe >>= Just . EpochNum+ 5020 -> maker mkWord32 >>= listToMaybe >>= Just . PreInFlags+ 5021 -> maker mkWord32 >>= listToMaybe >>= Just . PostInFlags+ 5022 -> maker mkWord32 >>= listToMaybe >>= Just . PreUnFlags+ 5023 -> maker mkWord32 >>= listToMaybe >>= Just . PostUnFlags+ 5024 -> maker mkWord32 >>= listToMaybe >>= Just . PreTransFlags+ 5025 -> maker mkWord32 >>= listToMaybe >>= Just . PostTransFlags+ 5026 -> maker mkWord32 >>= listToMaybe >>= Just . VerifyScriptFlags+ 5027 -> maker mkWord32 >>= Just . TriggerScriptFlags+ 5029 -> maker mkStringArray >>= Just . UNIMPLEMENTED . Collections+ 5030 -> maker mkStringArray >>= Just . PolicyNames+ 5031 -> maker mkStringArray >>= Just . PolicyTypes+ 5032 -> maker mkWord32 >>= Just . PolicyTypesIndexes+ 5033 -> maker mkWord32 >>= Just . PolicyFlags+ 5034 -> maker mkString >>= Just . PolicyVCS+ 5035 -> maker mkStringArray >>= Just . OrderName+ 5036 -> maker mkStringArray >>= Just . OrderVersion+ 5037 -> maker mkWord32 >>= Just . OrderFlags+ 5038 -> maker mkStringArray >>= Just . UNIMPLEMENTED . MSSFManifest+ 5039 -> maker mkStringArray >>= Just . UNIMPLEMENTED . MSSFDomain+ 5040 -> maker mkStringArray >>= Just . InstFileNames+ 5041 -> maker mkStringArray >>= Just . RequireNEVRs+ 5042 -> maker mkStringArray >>= Just . ProvideNEVRs+ 5043 -> maker mkStringArray >>= Just . ObsoleteNEVRs+ 5044 -> maker mkStringArray >>= Just . ConflictNEVRs+ 5045 -> maker mkWord32 >>= Just . FileNLinks+ 5046 -> maker mkStringArray >>= Just . RecommendName+ 5047 -> maker mkStringArray >>= Just . RecommendVersion+ 5048 -> maker mkWord32 >>= Just . RecommendFlags+ 5049 -> maker mkStringArray >>= Just . SuggestName+ 5050 -> maker mkStringArray >>= Just . SuggestVersion+ 5051 -> maker mkWord32 >>= Just . SuggestFlags+ 5052 -> maker mkStringArray >>= Just . SupplementName+ 5053 -> maker mkStringArray >>= Just . SupplementVersion+ 5054 -> maker mkWord32 >>= Just . SupplementFlags+ 5055 -> maker mkStringArray >>= Just . EnhanceName+ 5056 -> maker mkStringArray >>= Just . EnhanceVersion+ 5057 -> maker mkWord32 >>= Just . EnhanceFlags+ 5058 -> maker mkStringArray >>= Just . RecommendNEVRs+ 5059 -> maker mkStringArray >>= Just . SuggestNEVRs+ 5060 -> maker mkStringArray >>= Just . SupplementNEVRs+ 5061 -> maker mkStringArray >>= Just . EnhanceNEVRs+ 5062 -> maker mkString >>= Just . Encoding+ 5063 -> maker mkNull >>= Just . INTERNAL . FileTriggerIn+ 5064 -> maker mkNull >>= Just . INTERNAL . FileTriggerUn+ 5065 -> maker mkNull >>= Just . INTERNAL . FileTriggerPostUn+ 5066 -> maker mkStringArray >>= Just . FileTriggerScripts+ 5067 -> maker mkStringArray >>= Just . FileTriggerScriptProg+ 5068 -> maker mkWord32 >>= Just . FileTriggerScriptFlags+ 5069 -> maker mkStringArray >>= Just . FileTriggerName+ 5070 -> maker mkWord32 >>= Just . FileTriggerIndex+ 5071 -> maker mkStringArray >>= Just . FileTriggerVersion+ 5072 -> maker mkWord32 >>= Just . FileTriggerFlags+ 5073 -> maker mkNull >>= Just . INTERNAL . TransFileTriggerIn+ 5074 -> maker mkNull >>= Just . INTERNAL . TransFileTriggerUn+ 5075 -> maker mkNull >>= Just . INTERNAL . TransFileTriggerPostUn+ 5076 -> maker mkStringArray >>= Just . TransFileTriggerScripts+ 5077 -> maker mkStringArray >>= Just . TransFileTriggerScriptProg+ 5078 -> maker mkWord32 >>= Just . TransFileTriggerScriptFlags+ 5079 -> maker mkStringArray >>= Just . TransFileTriggerName+ 5080 -> maker mkWord32 >>= Just . TransFileTriggerIndex+ 5081 -> maker mkStringArray >>= Just . TransFileTriggerVersion+ 5082 -> maker mkWord32 >>= Just . TransFileTriggerFlags+ 5083 -> maker mkString >>= Just . INTERNAL . RemovePathPostFixes+ 5084 -> maker mkWord32 >>= Just . FileTriggerPriorities+ 5085 -> maker mkWord32 >>= Just . TransFileTriggerPriorities+ 5086 -> maker mkStringArray >>= Just . FileTriggerConds+ 5087 -> maker mkStringArray >>= Just . FileTriggerType+ 5088 -> maker mkStringArray >>= Just . TransFileTriggerConds+ 5089 -> maker mkStringArray >>= Just . TransFileTriggerType+ 5090 -> maker mkStringArray >>= Just . FileSignatures+ 5091 -> maker mkWord32 >>= listToMaybe >>= Just . FileSignatureLength++ _ -> Nothing+ where+ maker fn = fn store ty offset count++mkNull :: BS.ByteString -> Word32 -> Word32 -> Word32 -> Maybe Null+mkNull _ ty _ _ | ty == 0 = Just Null+ | otherwise = Nothing++mkChar :: BS.ByteString -> Word32 -> Word32 -> Word32 -> Maybe [Char]+mkChar store ty offset count | fromIntegral (BS.length store) - offset < count = Nothing+ | ty == 1 = Just $ C.unpack $ BS.take count' start+ | otherwise = Nothing+ where+ count' = fromIntegral count+ start = BS.drop (fromIntegral offset) store++mkWord16 :: BS.ByteString -> Word32 -> Word32 -> Word32 -> Maybe [Word16]+mkWord16 store ty offset count | fromIntegral (BS.length store) - offset < (2*count) = Nothing+ | ty == 3 = Just $ readWords store 2 asWord16 offsets+ | otherwise = Nothing+ where+ offsets = map (\n -> offset + (n*2)) [0 .. count-1]++mkWord32 :: BS.ByteString -> Word32 -> Word32 -> Word32 -> Maybe [Word32]+mkWord32 store ty offset count | fromIntegral (BS.length store) - offset < (4*count) = Nothing+ | ty == 4 = Just $ readWords store 4 asWord32 offsets+ | otherwise = Nothing+ where+ offsets = map (\n -> offset + (n*4)) [0 .. count-1]++mkWord64 :: BS.ByteString -> Word32 -> Word32 -> Word32 -> Maybe [Word64]+mkWord64 store ty offset count | fromIntegral (BS.length store) - offset < (8*count) = Nothing+ | ty == 5 = Just $ readWords store 8 asWord64 offsets+ | otherwise = Nothing+ where+ offsets = map (\n -> offset + (n*8)) [0 .. count-1]++mkString :: BS.ByteString -> Word32 -> Word32 -> Word32 -> Maybe String+mkString store ty offset count | fromIntegral (BS.length store) - offset < count = Nothing+ | ty == 6 = Just $ C.unpack $ BS.takeWhile (/= 0) start+ | otherwise = Nothing+ where+ start = BS.drop (fromIntegral offset) store++mkBinary :: BS.ByteString -> Word32 -> Word32 -> Word32 -> Maybe BS.ByteString+mkBinary store ty offset count | fromIntegral (BS.length store) - offset < count = Nothing+ | ty == 7 = Just $ BS.take count' start+ | otherwise = Nothing+ where+ count' = fromIntegral count+ start = BS.drop (fromIntegral offset) store++mkStringArray :: BS.ByteString -> Word32 -> Word32 -> Word32 -> Maybe [String]+mkStringArray store ty offset count | fromIntegral (BS.length store) - offset < count = Nothing+ | ty == 8 = Just $ map C.unpack $ readStrings start count+ | otherwise = Nothing+ where+ start = BS.drop (fromIntegral offset) store++mkI18NString :: BS.ByteString -> Word32 -> Word32 -> Word32 -> Maybe BS.ByteString+mkI18NString store ty offset count | fromIntegral (BS.length store) - offset < count = Nothing+ | ty == 9 = Just $ BS.takeWhile (/= 0) start+ | otherwise = Nothing+ where+ start = BS.drop (fromIntegral offset) store++-- I don't know how to split a ByteString up into chunks of a given size, so here's what I'm doing. Take+-- a list of offsets of where in the ByteString to read. Skip to each of those offsets, grab size bytes, and+-- convert those bytes into the type using the given conversion function. Return that list.+{-# ANN readWords "HLint: ignore Eta reduce" #-}+readWords :: BS.ByteString -> Int -> (BS.ByteString -> a) -> [Word32] -> [a]+readWords bs size conv offsets = map (\offset -> conv $ BS.take size $ BS.drop (fromIntegral offset) bs) offsets++readStrings :: BS.ByteString -> Word32 -> [BS.ByteString]+readStrings bytestring count = take (fromIntegral count) $ BS.split 0 bytestring++-- | Given the name of a 'Tag' and a list of 'Tag's (say, from the 'Header' of some 'RPM'),+-- find the match and return it as a 'Maybe'. This is the most generic of the various finding+-- functions - it will return any match regardless of its type. You are expected to know what+-- type you are looking for.+findTag :: String -> [Tag] -> Maybe Tag+findTag name = find (\t -> name == showConstr (toConstr t))++-- | Given the name of a 'Tag' and a list of 'Tag's, find the match, convert it into a+-- 'ByteString', and return it as a 'Maybe'. If the value of the 'Tag' cannot be converted+-- into a 'ByteString' (say, because it is of the wrong type), 'Nothing' will be returned.+-- Thus, this should only be used on tags whose value is known - see the definition of 'Tag'+-- for the possibilities.+findByteStringTag :: String -> [Tag] -> Maybe BS.ByteString+findByteStringTag name tags = findTag name tags >>= \t -> tagValue t :: Maybe BS.ByteString++-- | Given the name of a 'Tag' and a list of 'Tag's, find the match, convert it into a+-- 'String', and return it as a 'Maybe'. If the value of the 'Tag' cannot be converted+-- into a 'String' (say, because it is of the wrong type), 'Nothing' will be returned.+-- Thus, this should only be used on tags whose value is known - see the definition of+-- 'Tag' for the possibilities.+findStringTag :: String -> [Tag] -> Maybe String+findStringTag name tags = findTag name tags >>= \t -> tagValue t :: Maybe String++-- | Given the name of a 'Tag' and a list of 'Tag's, find all matches, convert them into+-- 'String's, and return a list. If no results are found or the value of a single 'Tag'+-- cannot be converted into a 'String' (say, because it is of the wrong type), an empty+-- list will be returned. Thus, this should only be used on tags whose value is known -+-- see the definition of 'Tag' for the possibilities.+findStringListTag :: String -> [Tag] -> [String]+findStringListTag name tags = fromMaybe [] $ findTag name tags >>= \t -> tagValue t :: Maybe [String]++-- | Given the name of a 'Tag' and a list of 'Tag's, find the match, convert it into a+-- 'Word16', and return it as a 'Maybe'. If the value of the 'Tag' cannot be converted+-- into a 'Word16' (say, because it is of the wrong type), 'Nothing' will be returned.+-- Thus, this should only be used on tags whose value is known - see the definition of 'Tag'+-- for the possibilities.+findWord16Tag :: String -> [Tag] -> Maybe Word16+findWord16Tag name tags = findTag name tags >>= \t -> tagValue t :: Maybe Word16++-- | Given the name of a 'Tag' and a list of 'Tag's, find all matches, convert them into+-- 'Word16's, and return a list. If no results are found or the value of a single 'Tag'+-- cannot be converted into a 'Word16' (say, because it is of the wrong type), an empty+-- list will be returned. Thus, this should only be used on tags whose value is known -+-- see the definition of 'Tag' for the possibilities.+findWord16ListTag :: String -> [Tag] -> [Word16]+findWord16ListTag name tags = fromMaybe [] $ findTag name tags >>= \t -> tagValue t :: Maybe [Word16]++-- | Given the name of a 'Tag' and a list of 'Tag's, find the match, convert it into a+-- 'Word16', and return it as a 'Maybe'. If the value of the 'Tag' cannot be converted+-- into a 'Word16' (say, because it is of the wrong type), 'Nothing' will be returned.+-- Thus, this should only be used on tags whose value is known - see the definition of 'Tag'+-- for the possibilities.+findWord32Tag :: String -> [Tag] -> Maybe Word32+findWord32Tag name tags = findTag name tags >>= \t -> tagValue t :: Maybe Word32++-- | Given the name of a 'Tag' and a list of 'Tag's, find all matches, convert them into+-- 'Word32's, and return a list. If no results are found or the value of a single 'Tag'+-- cannot be converted into a 'Word32' (say, because it is of the wrong type), an empty+-- list will be returned. Thus, this should only be used on tags whose value is known -+-- see the definition of 'Tag' for the possibilities.+findWord32ListTag :: String -> [Tag] -> [Word32]+findWord32ListTag name tags = fromMaybe [] $ findTag name tags >>= \t -> tagValue t :: Maybe [Word32]++-- | Given a 'Tag', return its value. This is a helper function to be used with 'findTag',+-- essentially as a type-safe way to cast the value into a known type. It is used internally+-- in all the type-specific find*Tag functions but can also be used on its own. A function+-- to find the "Epoch" tag could be written as follows:+--+-- > epoch = findTag "Epoch" tags >>= \t -> tagValue t :: Maybe Word32+tagValue :: Typeable a => Tag -> Maybe a+tagValue = gmapQi 0 cast
+ Codec/RPM/Types.hs view
@@ -0,0 +1,137 @@+{-# LANGUAGE RecordWildCards #-}++-- |+-- Module: Codec.RPM.Types+-- Copyright: (c) 2016-2017 Red Hat, Inc.+-- License: LGPL+--+-- Maintainer: https://github.com/weldr+-- Stability: stable+-- Portability: portable++module Codec.RPM.Types(RPM(..),+ Lead(..),+ Header(..),+ SectionHeader(..))++ where++import qualified Data.ByteString as BS+import Data.Word(Word8, Word16, Word32)+import Text.PrettyPrint.HughesPJClass(Pretty(..))+import Text.PrettyPrint((<>), ($$), nest, text, vcat)++import Codec.RPM.Tags++-- | The top level RPM record. This contains everything in an RPM file, except for the+-- magic value.+data RPM = RPM {+ -- | The 'Lead', an obsolete record used for identifying RPMs.+ rpmLead :: Lead,+ -- | Special 'Header' entries that can be used to verify the integrity of an RPM. This+ -- is represented as a list because it is technically possible for there to be multiple+ -- signature headers, but in practice there is only ever one. This is the case even if+ -- multiple signatures are present. This situation will be represented by multiple 'Tag's+ -- that can be examined to get each signature. When checking signatures, note that they+ -- only apply to the 'rpmHeaders' and the 'rpmArchive'.+ rpmSignatures :: [Header],+ -- | 'Header' entries that contain all the metadata about an RPM. There could technically+ -- be several entries here too, but in practice there is only ever one. It is likely+ -- that each 'Header' will contain many 'Tag's, as RPMs tend to have a large amount of+ -- metadata.+ rpmHeaders :: [Header],+ -- | The contents of the RPM, stored as a compressed CPIO archive.+ rpmArchive :: BS.ByteString }+ deriving(Eq, Show)++instance Pretty RPM where+ pPrint RPM{..} =+ vcat [ text "RPM:",+ nest 2 (text "rpmLead = " $$ nest 2 (pPrint rpmLead)),+ nest 2 (text "rpmSignatures = " $$ nest 2 (vcat $ map pPrint rpmSignatures)),+ nest 2 (text "rpmHeaders = " $$ nest 2 (vcat $ map pPrint rpmHeaders)),+ nest 2 (text "rpmArchive = ...") ]++-- | Following the magic value that identifies a data stream as an RPM, the Lead is the very+-- first part of the file. Due to its small size and inflexibility, it is largely obsolete+-- and its use is discouraged even inside of the RPM library. It is generally only used as+-- additional help beyond the magic value in verifying something is an RPM. The lead is+-- only exposed here for completeness.+data Lead = Lead {+ -- | The major version number of this RPM, for instance 0x03 for version 3.x.+ rpmMajor :: Word8,+ -- | The minor version number of this RPM, for instance 0x00 for version 3.0.+ rpmMinor :: Word8,+ -- | Is this a binary package (0x0000) or a source package (0x0001)? Other types+ -- may be defined in the future.+ rpmType :: Word16,+ -- | What platform was this package built for? x86 is 0x0001. Many other values+ -- are defined. See /usr/lib/rpm/rpmrc for the possibilities.+ rpmArchNum :: Word16,+ -- | The package name, as a NEVRA. This name is constrained to 66 bytes. Shorter+ -- names are padded with nulls.+ rpmName :: String,+ -- | What operating system was this package built for? Linux is 0x0001. Many other+ -- values are defined. See /usr/lib/rpm/rpmrc for the possibilities.+ rpmOSNum :: Word16,+ -- | What type of signature is used in this RPM? For now, this appears to always+ -- be set to 0x0005.+ rpmSigType :: Word16 }+ deriving(Eq, Show)++instance Pretty Lead where+ pPrint Lead{..} =+ vcat [ text "Lead:",+ nest 2 $ text "rpmMajor: " <> text (show rpmMajor),+ nest 2 $ text "rpmMinor: " <> text (show rpmMinor),+ nest 2 $ text "rpmType: " <> text (show rpmType),+ nest 2 $ text "rpmArchNum: " <> text (show rpmArchNum),+ nest 2 $ text "rpmName: " <> text rpmName,+ nest 2 $ text "rpmOSNum: " <> text (show rpmOSNum),+ nest 2 $ text "rpmSigType: " <> text (show rpmSigType) ]++-- | A Header represents a block of metadata. It is used twice in the RPM - as the+-- representation for signatures and as the representation for regular metadata. Internally,+-- the header is a list of tag descriptors followed by a data store. These descriptors+-- index into the store and explain what type of thing should be found and how many things+-- should be read.+--+-- Here, the hard work of figuring that out is already done and the results provided as a+-- list of 'Tag's. The raw store itself is provided for completeness, in case further+-- processing needs to be done on the RPM. For most users, this will never be needed.+data Header = Header {+ -- | Each header begins with its own 'SectionHeader', describing what type of header+ -- follows and how many entries that header contains.+ headerSectionHeader :: SectionHeader,+ -- | A list of 'Tag' entries and their values. There are many, many types of tags.+ headerTags :: [Tag],+ -- | The raw header store.+ headerStore :: BS.ByteString }+ deriving(Eq, Show)++instance Pretty Header where+ pPrint Header{..} =+ vcat [ text "Header:",+ nest 2 $ text "headerSectionHeader = " $$ nest 2 (pPrint headerSectionHeader),+ nest 2 $ text "headerTags = " $$ nest 2 (vcat $ map pPrint headerTags),+ nest 2 $ text "headerStore = ..." ]++-- | The SectionHeader is useful in parsing an RPM. It allows for figuring out where+-- each section occurs, how large it is, and so forth. It is likely not useful for+-- consumers of this libary. Just like with the top-level 'RPM' record, section headers+-- are preceeded with a magic value that is not exposed here.+data SectionHeader = SectionHeader {+ -- | The version of this header structure, currently only 0x01.+ sectionVersion :: Word8,+ -- | How many 'Tag' entries are stored in this header?+ sectionCount :: Word32,+ -- | What is the size of the data store in this header?+ sectionSize :: Word32 }+ deriving(Eq, Show)++instance Pretty SectionHeader where+ pPrint SectionHeader{..} =+ vcat [ text "SectionHeader:",+ nest 2 $ text "sectionHeader: " <> text (show sectionVersion),+ nest 2 $ text "sectionCount: " <> text (show sectionCount),+ nest 2 $ text "sectionSize: " <> text (show sectionSize) ]
+ Codec/RPM/Version.hs view
@@ -0,0 +1,265 @@+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module: Codec.RPM.Parse+-- Copyright: (c) 2017 Red Hat, Inc.+-- License: LGPL+--+-- Maintainer: https://github.com/weldr+-- Stability: stable+-- Portability: portable+-- +-- Functions and types for working with version numbers, as understood by RPM.++module Codec.RPM.Version(+ -- * Types+ DepOrdering(..),+ DepRequirement(..),+ EVR(..),+ -- * Functions+ parseEVR,+ parseDepRequirement,+ satisfies,+ vercmp)+ where++import Data.Char(digitToInt, isAsciiLower, isAsciiUpper, isDigit, isSpace)+import Data.Maybe(fromMaybe)+import Data.Monoid((<>))+import qualified Data.Ord as Ord+import qualified Data.Text as T+import Data.Word(Word32)+import Text.Parsec++import Prelude hiding(EQ, GT, LT)++-- | The versioning information portion of a package's name - epoch, version, release.+data EVR = EVR {+ -- | The epoch of a package. This is sort of a super version number, used when a package with+ -- an earlier version number must upgrade a package with a later version number. The package+ -- with a larger epoch will always in version comparisons. Most packages do not have an epoch.+ epoch :: Maybe Word32,+ -- | The version number provided by the package's upstream, represented as 'Text'.+ version :: T.Text,+ -- | The release number, represented as 'Text'. The release value is added on by a distribution+ -- and allows them to make multiple releases of the same upstream version, fixing bugs and applying+ -- distribution-specific tweaks.+ release :: T.Text }+ deriving(Show)++-- for Ord and Eq, an epoch of Nothing is the same as an epoch of 0.+-- for Eq, version and release strings need to go through vercmp, since they can be equivalent+-- without being the same String.+instance Eq EVR where+ (==) evr1 evr2 = evr1 `compare` evr2 == Ord.EQ++instance Ord EVR where+ compare evr1 evr2 = fromMaybe 0 (epoch evr1) `compare` fromMaybe 0 (epoch evr2) <>+ version evr1 `vercmp` version evr2 <>+ release evr1 `vercmp` release evr2++-- | Like 'Ordering', but with support for less-than-or-equal and greater-than-or-equal.+data DepOrdering = LT | LTE | EQ | GTE | GT+ deriving(Eq, Show)++-- | RPM supports the concept of dependencies between packages. Collectively, these dependencies+-- are commonly referred to as PRCO - Provides, Requires, Conflicts, and Obsoletes. These+-- dependencies can optionally include version information. These relationships can be examined+-- with various RPM inspection tools or can be found in the spec files that define how a package+-- is built. Examples include:+--+-- @+-- Requires: python-six+-- Requires: python3-blivet >= 1:1.0+-- Obsoletes: booty <= 0.107-1+-- @+--+-- This data type expresses a single dependency relationship. The example dependencies above+-- would be represented like so:+--+-- @+-- DepRequirement "python-six" Nothing+-- DepRequirement "python3-blivet" (Just (GTE, EVR (Just 1) "1.0" ""))+-- DepRequirement "booty" (Just (LTE, EVR Nothing "0.107" "1"))+-- @+--+-- It is not in the scope of this type to know what kind of relationship a 'DepRequirement'+-- describes.+data DepRequirement = DepRequirement T.Text (Maybe (DepOrdering, EVR))+ deriving (Eq, Show)++-- | Compare two version numbers and return an 'Ordering'.+vercmp :: T.Text -> T.Text -> Ordering+vercmp a b = let+ -- strip out all non-version characters+ -- keep in mind the strings may be empty after this+ a' = dropSeparators a+ b' = dropSeparators b++ -- rpm compares strings by digit and non-digit components, so grab the first+ -- component of one type+ fn = if isDigit (T.head a') then isDigit else isAsciiAlpha+ (prefixA, suffixA) = T.span fn a'+ (prefixB, suffixB) = T.span fn b'+ in+ -- Nothing left means the versions are equal+ if | T.null a' && T.null b' -> Ord.EQ+ -- tilde ls less than everything, including an empty string+ | ("~" `T.isPrefixOf` a') && ("~" `T.isPrefixOf` b') -> vercmp (T.tail a') (T.tail b')+ | ("~" `T.isPrefixOf` a') -> Ord.LT+ | ("~" `T.isPrefixOf` b') -> Ord.GT+ -- otherwise, if one of the strings is null, the other is greater+ | (T.null a') -> Ord.LT+ | (T.null b') -> Ord.GT+ -- Now we have two non-null strings, starting with a non-tilde version character+ -- If one prefix is a number and the other is a string, the one that is a number+ -- is greater.+ | isDigit (T.head a') && (not . isDigit) (T.head b') -> Ord.GT+ | (not . isDigit) (T.head a') && isDigit (T.head b') -> Ord.LT+ | isDigit (T.head a') -> (prefixA `compareAsInts` prefixB) <> (suffixA `vercmp` suffixB)+ | otherwise -> (prefixA `compare` prefixB) <> (suffixA `vercmp` suffixB)+ where+ compareAsInts :: T.Text -> T.Text -> Ordering+ -- the version numbers can overflow Int, so strip leading 0's and do a string compare,+ -- longest string wins+ compareAsInts x y =+ let x' = T.dropWhile (== '0') x+ y' = T.dropWhile (== '0') y+ in + if T.length x' > T.length y' then Ord.GT+ else x' `compare` y'++ -- isAlpha returns any unicode alpha, but we just want ASCII characters+ isAsciiAlpha :: Char -> Bool+ isAsciiAlpha x = isAsciiLower x || isAsciiUpper x++ -- RPM only cares about ascii digits, ascii alpha, and ~+ isVersionChar :: Char -> Bool+ isVersionChar x = isDigit x || isAsciiAlpha x || x == '~'++ dropSeparators :: T.Text -> T.Text+ dropSeparators = T.dropWhile (not . isVersionChar)++{-# ANN satisfies ("HLint: ignore Redundant if" :: String) #-}+-- | Determine if a candidate package satisfies the dependency relationship required by some other+-- package.+satisfies :: DepRequirement -- ^ The package in question, represented as a 'DepRequirement'.+ -> DepRequirement -- ^ The requirement.+ -> Bool+satisfies (DepRequirement name1 ver1) (DepRequirement name2 ver2) =+ -- names have to match+ if name1 /= name2 then False+ else satisfiesVersion ver1 ver2+ where+ -- If either half has no version expression, it's a match+ satisfiesVersion Nothing _ = True+ satisfiesVersion _ Nothing = True++ -- There is a special case for matching versions with no release component.+ -- If one side is equal to (or >=, or <=) a version with no release component, it will match any non-empty+ -- release on the other side, regardless of operator.+ -- For example: x >= 1.0 `satisfies` x < 1.0-47.+ -- If *both* sides have no release, the regular rules apply, so x >= 1.0 does not satisfy x < 1.0++ satisfiesVersion (Just (o1, v1)) (Just (o2, v2))+ | T.null (release v1) && (not . T.null) (release v2) && compareEV v1 v2 && isEq o1 = True+ | T.null (release v2) && (not . T.null) (release v1) && compareEV v1 v2 && isEq o2 = True+ | otherwise =+ case compare v1 v2 of+ -- e1 < e2, true if >[=] e1 || <[=] e2+ Ord.LT -> isGt o1 || isLt o2+ -- e1 > e2, true if <[=] e1 || >[=] e2+ Ord.GT -> isLt o1 || isGt o2+ -- e1 == e2, true if both sides are the same direction+ Ord.EQ -> (isLt o1 && isLt o2) || (isEq o1 && isEq o2) || (isGt o1 && isGt o2)++ isEq EQ = True+ isEq GTE = True+ isEq LTE = True+ isEq _ = False++ isLt LT = True+ isLt LTE = True+ isLt _ = False++ isGt GT = True+ isGt GTE = True+ isGt _ = False++ compareEV v1 v2 = fromMaybe 0 (epoch v1) == fromMaybe 0 (epoch v2) && version v1 == version v2++-- parsers for version strings+-- the EVR Parsec is shared by the EVR and DepRequirement parsers+parseEVRParsec :: Parsec T.Text () EVR+parseEVRParsec = do+ e <- optionMaybe $ try parseEpoch+ v <- many1 versionChar+ r <- try parseRelease <|> return ""+ eof++ return EVR{epoch=e, version=T.pack v, release=T.pack r}+ where+ parseEpoch :: Parsec T.Text () Word32+ parseEpoch = do+ e <- many1 digit+ _ <- char ':'++ -- parse the digit string as an Integer until it ends or overflows Word32+ parseInteger 0 e+ where+ maxW32 = toInteger (maxBound :: Word32)++ parseInteger :: Integer -> String -> Parsec T.Text () Word32+ parseInteger acc [] = return $ fromInteger acc+ parseInteger acc (x:xs) = let+ newAcc = (acc * (10 :: Integer)) + toInteger (digitToInt x)+ in+ if newAcc > maxW32 then parserFail ""+ else parseInteger newAcc xs++ parseRelease = do+ _ <- char '-'+ many1 versionChar++ versionChar = digit <|> upper <|> lower <|> oneOf "._+%{}~"++-- | Convert a 'Text' representation into an 'EVR' or a 'ParseError' if something goes wrong.+parseEVR :: T.Text -> Either ParseError EVR+parseEVR = parse parseEVRParsec ""++-- | Convert a 'Text' representation into a 'DepRequirement' or a 'ParseError' if something+-- goes wrong.+parseDepRequirement :: T.Text -> Either ParseError DepRequirement+parseDepRequirement input = parse parseDepRequirement' "" input+ where+ parseDepRequirement' = do+ reqname <- many $ satisfy (not . isSpace)+ spaces+ reqver <- optionMaybe $ try parseDepVersion++ -- If anything went wrong in parsing the version (invalid operator, malformed EVR), treat the entire+ -- string as a name. This way RPMs with bad version strings in Requires, which of course exist, will+ -- match against the full string.+ case reqver of+ Just _ -> return $ DepRequirement (T.pack reqname) reqver+ Nothing -> return $ DepRequirement input Nothing++ -- check lte and gte first, since they overlap lt and gt+ parseOperator :: Parsec T.Text () DepOrdering+ parseOperator = lte <|> gte <|> eq <|> lt <|> gt++ eq = try (string "=") >> return EQ+ lt = try (string "<") >> return LT+ gt = try (string ">") >> return GT+ lte = try (string "<=") >> return LTE+ gte = try (string ">=") >> return GTE++ parseDepVersion :: Parsec T.Text () (DepOrdering, EVR)+ parseDepVersion = do+ oper <- parseOperator+ spaces+ evr <- parseEVRParsec+ eof++ return (oper, evr)
+ LICENSE view
@@ -0,0 +1,502 @@+ GNU LESSER GENERAL PUBLIC LICENSE+ Version 2.1, February 1999++ Copyright (C) 1991, 1999 Free Software Foundation, Inc.+ 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++[This is the first released version of the Lesser GPL. It also counts+ as the successor of the GNU Library Public License, version 2, hence+ the version number 2.1.]++ Preamble++ The licenses for most software are designed to take away your+freedom to share and change it. By contrast, the GNU General Public+Licenses are intended to guarantee your freedom to share and change+free software--to make sure the software is free for all its users.++ This license, the Lesser General Public License, applies to some+specially designated software packages--typically libraries--of the+Free Software Foundation and other authors who decide to use it. You+can use it too, but we suggest you first think carefully about whether+this license or the ordinary General Public License is the better+strategy to use in any particular case, based on the explanations below.++ When we speak of free software, we are referring to freedom of use,+not price. Our General Public Licenses are designed to make sure that+you have the freedom to distribute copies of free software (and charge+for this service if you wish); that you receive source code or can get+it if you want it; that you can change the software and use pieces of+it in new free programs; and that you are informed that you can do+these things.++ To protect your rights, we need to make restrictions that forbid+distributors to deny you these rights or to ask you to surrender these+rights. These restrictions translate to certain responsibilities for+you if you distribute copies of the library or if you modify it.++ For example, if you distribute copies of the library, whether gratis+or for a fee, you must give the recipients all the rights that we gave+you. You must make sure that they, too, receive or can get the source+code. If you link other code with the library, you must provide+complete object files to the recipients, so that they can relink them+with the library after making changes to the library and recompiling+it. And you must show them these terms so they know their rights.++ We protect your rights with a two-step method: (1) we copyright the+library, and (2) we offer you this license, which gives you legal+permission to copy, distribute and/or modify the library.++ To protect each distributor, we want to make it very clear that+there is no warranty for the free library. Also, if the library is+modified by someone else and passed on, the recipients should know+that what they have is not the original version, so that the original+author's reputation will not be affected by problems that might be+introduced by others.++ Finally, software patents pose a constant threat to the existence of+any free program. We wish to make sure that a company cannot+effectively restrict the users of a free program by obtaining a+restrictive license from a patent holder. Therefore, we insist that+any patent license obtained for a version of the library must be+consistent with the full freedom of use specified in this license.++ Most GNU software, including some libraries, is covered by the+ordinary GNU General Public License. This license, the GNU Lesser+General Public License, applies to certain designated libraries, and+is quite different from the ordinary General Public License. We use+this license for certain libraries in order to permit linking those+libraries into non-free programs.++ When a program is linked with a library, whether statically or using+a shared library, the combination of the two is legally speaking a+combined work, a derivative of the original library. The ordinary+General Public License therefore permits such linking only if the+entire combination fits its criteria of freedom. The Lesser General+Public License permits more lax criteria for linking other code with+the library.++ We call this license the "Lesser" General Public License because it+does Less to protect the user's freedom than the ordinary General+Public License. It also provides other free software developers Less+of an advantage over competing non-free programs. These disadvantages+are the reason we use the ordinary General Public License for many+libraries. However, the Lesser license provides advantages in certain+special circumstances.++ For example, on rare occasions, there may be a special need to+encourage the widest possible use of a certain library, so that it becomes+a de-facto standard. To achieve this, non-free programs must be+allowed to use the library. A more frequent case is that a free+library does the same job as widely used non-free libraries. In this+case, there is little to gain by limiting the free library to free+software only, so we use the Lesser General Public License.++ In other cases, permission to use a particular library in non-free+programs enables a greater number of people to use a large body of+free software. For example, permission to use the GNU C Library in+non-free programs enables many more people to use the whole GNU+operating system, as well as its variant, the GNU/Linux operating+system.++ Although the Lesser General Public License is Less protective of the+users' freedom, it does ensure that the user of a program that is+linked with the Library has the freedom and the wherewithal to run+that program using a modified version of the Library.++ The precise terms and conditions for copying, distribution and+modification follow. Pay close attention to the difference between a+"work based on the library" and a "work that uses the library". The+former contains code derived from the library, whereas the latter must+be combined with the library in order to run.++ GNU LESSER GENERAL PUBLIC LICENSE+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION++ 0. This License Agreement applies to any software library or other+program which contains a notice placed by the copyright holder or+other authorized party saying it may be distributed under the terms of+this Lesser General Public License (also called "this License").+Each licensee is addressed as "you".++ A "library" means a collection of software functions and/or data+prepared so as to be conveniently linked with application programs+(which use some of those functions and data) to form executables.++ The "Library", below, refers to any such software library or work+which has been distributed under these terms. A "work based on the+Library" means either the Library or any derivative work under+copyright law: that is to say, a work containing the Library or a+portion of it, either verbatim or with modifications and/or translated+straightforwardly into another language. (Hereinafter, translation is+included without limitation in the term "modification".)++ "Source code" for a work means the preferred form of the work for+making modifications to it. For a library, complete source code means+all the source code for all modules it contains, plus any associated+interface definition files, plus the scripts used to control compilation+and installation of the library.++ Activities other than copying, distribution and modification are not+covered by this License; they are outside its scope. The act of+running a program using the Library is not restricted, and output from+such a program is covered only if its contents constitute a work based+on the Library (independent of the use of the Library in a tool for+writing it). Whether that is true depends on what the Library does+and what the program that uses the Library does.++ 1. You may copy and distribute verbatim copies of the Library's+complete source code as you receive it, in any medium, provided that+you conspicuously and appropriately publish on each copy an+appropriate copyright notice and disclaimer of warranty; keep intact+all the notices that refer to this License and to the absence of any+warranty; and distribute a copy of this License along with the+Library.++ You may charge a fee for the physical act of transferring a copy,+and you may at your option offer warranty protection in exchange for a+fee.++ 2. You may modify your copy or copies of the Library or any portion+of it, thus forming a work based on the Library, and copy and+distribute such modifications or work under the terms of Section 1+above, provided that you also meet all of these conditions:++ a) The modified work must itself be a software library.++ b) You must cause the files modified to carry prominent notices+ stating that you changed the files and the date of any change.++ c) You must cause the whole of the work to be licensed at no+ charge to all third parties under the terms of this License.++ d) If a facility in the modified Library refers to a function or a+ table of data to be supplied by an application program that uses+ the facility, other than as an argument passed when the facility+ is invoked, then you must make a good faith effort to ensure that,+ in the event an application does not supply such function or+ table, the facility still operates, and performs whatever part of+ its purpose remains meaningful.++ (For example, a function in a library to compute square roots has+ a purpose that is entirely well-defined independent of the+ application. Therefore, Subsection 2d requires that any+ application-supplied function or table used by this function must+ be optional: if the application does not supply it, the square+ root function must still compute square roots.)++These requirements apply to the modified work as a whole. If+identifiable sections of that work are not derived from the Library,+and can be reasonably considered independent and separate works in+themselves, then this License, and its terms, do not apply to those+sections when you distribute them as separate works. But when you+distribute the same sections as part of a whole which is a work based+on the Library, the distribution of the whole must be on the terms of+this License, whose permissions for other licensees extend to the+entire whole, and thus to each and every part regardless of who wrote+it.++Thus, it is not the intent of this section to claim rights or contest+your rights to work written entirely by you; rather, the intent is to+exercise the right to control the distribution of derivative or+collective works based on the Library.++In addition, mere aggregation of another work not based on the Library+with the Library (or with a work based on the Library) on a volume of+a storage or distribution medium does not bring the other work under+the scope of this License.++ 3. You may opt to apply the terms of the ordinary GNU General Public+License instead of this License to a given copy of the Library. To do+this, you must alter all the notices that refer to this License, so+that they refer to the ordinary GNU General Public License, version 2,+instead of to this License. (If a newer version than version 2 of the+ordinary GNU General Public License has appeared, then you can specify+that version instead if you wish.) Do not make any other change in+these notices.++ Once this change is made in a given copy, it is irreversible for+that copy, so the ordinary GNU General Public License applies to all+subsequent copies and derivative works made from that copy.++ This option is useful when you wish to copy part of the code of+the Library into a program that is not a library.++ 4. You may copy and distribute the Library (or a portion or+derivative of it, under Section 2) in object code or executable form+under the terms of Sections 1 and 2 above provided that you accompany+it with the complete corresponding machine-readable source code, which+must be distributed under the terms of Sections 1 and 2 above on a+medium customarily used for software interchange.++ If distribution of object code is made by offering access to copy+from a designated place, then offering equivalent access to copy the+source code from the same place satisfies the requirement to+distribute the source code, even though third parties are not+compelled to copy the source along with the object code.++ 5. A program that contains no derivative of any portion of the+Library, but is designed to work with the Library by being compiled or+linked with it, is called a "work that uses the Library". Such a+work, in isolation, is not a derivative work of the Library, and+therefore falls outside the scope of this License.++ However, linking a "work that uses the Library" with the Library+creates an executable that is a derivative of the Library (because it+contains portions of the Library), rather than a "work that uses the+library". The executable is therefore covered by this License.+Section 6 states terms for distribution of such executables.++ When a "work that uses the Library" uses material from a header file+that is part of the Library, the object code for the work may be a+derivative work of the Library even though the source code is not.+Whether this is true is especially significant if the work can be+linked without the Library, or if the work is itself a library. The+threshold for this to be true is not precisely defined by law.++ If such an object file uses only numerical parameters, data+structure layouts and accessors, and small macros and small inline+functions (ten lines or less in length), then the use of the object+file is unrestricted, regardless of whether it is legally a derivative+work. (Executables containing this object code plus portions of the+Library will still fall under Section 6.)++ Otherwise, if the work is a derivative of the Library, you may+distribute the object code for the work under the terms of Section 6.+Any executables containing that work also fall under Section 6,+whether or not they are linked directly with the Library itself.++ 6. As an exception to the Sections above, you may also combine or+link a "work that uses the Library" with the Library to produce a+work containing portions of the Library, and distribute that work+under terms of your choice, provided that the terms permit+modification of the work for the customer's own use and reverse+engineering for debugging such modifications.++ You must give prominent notice with each copy of the work that the+Library is used in it and that the Library and its use are covered by+this License. You must supply a copy of this License. If the work+during execution displays copyright notices, you must include the+copyright notice for the Library among them, as well as a reference+directing the user to the copy of this License. Also, you must do one+of these things:++ a) Accompany the work with the complete corresponding+ machine-readable source code for the Library including whatever+ changes were used in the work (which must be distributed under+ Sections 1 and 2 above); and, if the work is an executable linked+ with the Library, with the complete machine-readable "work that+ uses the Library", as object code and/or source code, so that the+ user can modify the Library and then relink to produce a modified+ executable containing the modified Library. (It is understood+ that the user who changes the contents of definitions files in the+ Library will not necessarily be able to recompile the application+ to use the modified definitions.)++ b) Use a suitable shared library mechanism for linking with the+ Library. A suitable mechanism is one that (1) uses at run time a+ copy of the library already present on the user's computer system,+ rather than copying library functions into the executable, and (2)+ will operate properly with a modified version of the library, if+ the user installs one, as long as the modified version is+ interface-compatible with the version that the work was made with.++ c) Accompany the work with a written offer, valid for at+ least three years, to give the same user the materials+ specified in Subsection 6a, above, for a charge no more+ than the cost of performing this distribution.++ d) If distribution of the work is made by offering access to copy+ from a designated place, offer equivalent access to copy the above+ specified materials from the same place.++ e) Verify that the user has already received a copy of these+ materials or that you have already sent this user a copy.++ For an executable, the required form of the "work that uses the+Library" must include any data and utility programs needed for+reproducing the executable from it. However, as a special exception,+the materials to be distributed need not include anything that is+normally distributed (in either source or binary form) with the major+components (compiler, kernel, and so on) of the operating system on+which the executable runs, unless that component itself accompanies+the executable.++ It may happen that this requirement contradicts the license+restrictions of other proprietary libraries that do not normally+accompany the operating system. Such a contradiction means you cannot+use both them and the Library together in an executable that you+distribute.++ 7. You may place library facilities that are a work based on the+Library side-by-side in a single library together with other library+facilities not covered by this License, and distribute such a combined+library, provided that the separate distribution of the work based on+the Library and of the other library facilities is otherwise+permitted, and provided that you do these two things:++ a) Accompany the combined library with a copy of the same work+ based on the Library, uncombined with any other library+ facilities. This must be distributed under the terms of the+ Sections above.++ b) Give prominent notice with the combined library of the fact+ that part of it is a work based on the Library, and explaining+ where to find the accompanying uncombined form of the same work.++ 8. You may not copy, modify, sublicense, link with, or distribute+the Library except as expressly provided under this License. Any+attempt otherwise to copy, modify, sublicense, link with, or+distribute the Library is void, and will automatically terminate your+rights under this License. However, parties who have received copies,+or rights, from you under this License will not have their licenses+terminated so long as such parties remain in full compliance.++ 9. You are not required to accept this License, since you have not+signed it. However, nothing else grants you permission to modify or+distribute the Library or its derivative works. These actions are+prohibited by law if you do not accept this License. Therefore, by+modifying or distributing the Library (or any work based on the+Library), you indicate your acceptance of this License to do so, and+all its terms and conditions for copying, distributing or modifying+the Library or works based on it.++ 10. Each time you redistribute the Library (or any work based on the+Library), the recipient automatically receives a license from the+original licensor to copy, distribute, link with or modify the Library+subject to these terms and conditions. You may not impose any further+restrictions on the recipients' exercise of the rights granted herein.+You are not responsible for enforcing compliance by third parties with+this License.++ 11. If, as a consequence of a court judgment or allegation of patent+infringement or for any other reason (not limited to patent issues),+conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License. If you cannot+distribute so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you+may not distribute the Library at all. For example, if a patent+license would not permit royalty-free redistribution of the Library by+all those who receive copies directly or indirectly through you, then+the only way you could satisfy both it and this License would be to+refrain entirely from distribution of the Library.++If any portion of this section is held invalid or unenforceable under any+particular circumstance, the balance of the section is intended to apply,+and the section as a whole is intended to apply in other circumstances.++It is not the purpose of this section to induce you to infringe any+patents or other property right claims or to contest validity of any+such claims; this section has the sole purpose of protecting the+integrity of the free software distribution system which is+implemented by public license practices. Many people have made+generous contributions to the wide range of software distributed+through that system in reliance on consistent application of that+system; it is up to the author/donor to decide if he or she is willing+to distribute software through any other system and a licensee cannot+impose that choice.++This section is intended to make thoroughly clear what is believed to+be a consequence of the rest of this License.++ 12. If the distribution and/or use of the Library is restricted in+certain countries either by patents or by copyrighted interfaces, the+original copyright holder who places the Library under this License may add+an explicit geographical distribution limitation excluding those countries,+so that distribution is permitted only in or among countries not thus+excluded. In such case, this License incorporates the limitation as if+written in the body of this License.++ 13. The Free Software Foundation may publish revised and/or new+versions of the Lesser General Public License from time to time.+Such new versions will be similar in spirit to the present version,+but may differ in detail to address new problems or concerns.++Each version is given a distinguishing version number. If the Library+specifies a version number of this License which applies to it and+"any later version", you have the option of following the terms and+conditions either of that version or of any later version published by+the Free Software Foundation. If the Library does not specify a+license version number, you may choose any version ever published by+the Free Software Foundation.++ 14. If you wish to incorporate parts of the Library into other free+programs whose distribution conditions are incompatible with these,+write to the author to ask for permission. For software which is+copyrighted by the Free Software Foundation, write to the Free+Software Foundation; we sometimes make exceptions for this. Our+decision will be guided by the two goals of preserving the free status+of all derivatives of our free software and of promoting the sharing+and reuse of software generally.++ NO WARRANTY++ 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO+WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.+EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR+OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY+KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE+LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME+THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.++ 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN+WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY+AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU+FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR+CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE+LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING+RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A+FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF+SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH+DAMAGES.++ END OF TERMS AND CONDITIONS++ How to Apply These Terms to Your New Libraries++ If you develop a new library, and you want it to be of the greatest+possible use to the public, we recommend making it free software that+everyone can redistribute and change. You can do so by permitting+redistribution under these terms (or, alternatively, under the terms of the+ordinary General Public License).++ To apply these terms, attach the following notices to the library. It is+safest to attach them to the start of each source file to most effectively+convey the exclusion of warranty; and each file should have at least the+"copyright" line and a pointer to where the full notice is found.++ <one line to give the library's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ This library is free software; you can redistribute it and/or+ modify it under the terms of the GNU Lesser General Public+ License as published by the Free Software Foundation; either+ version 2.1 of the License, or (at your option) any later version.++ This library is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU+ Lesser General Public License for more details.++ You should have received a copy of the GNU Lesser General Public+ License along with this library; if not, write to the Free Software+ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA++Also add information on how to contact you by electronic and paper mail.++You should also get your employer (if you work as a programmer) or your+school, if any, to sign a "copyright disclaimer" for the library, if+necessary. Here is a sample; alter the names:++ Yoyodyne, Inc., hereby disclaims all copyright interest in the+ library `Frob' (a library for tweaking knobs) written by James Random Hacker.++ <signature of Ty Coon>, 1 April 1990+ Ty Coon, President of Vice++That's all there is to it!
+ Makefile view
@@ -0,0 +1,13 @@+sandbox:+ [ -d .cabal-sandbox ] || cabal sandbox init++hlint: sandbox+ [ -x .cabal-sandbox/bin/happy ] || cabal install happy+ [ -x .cabal-sandbox/bin/hlint ] || cabal install hlint+ cabal exec hlint .++tests: sandbox+ cabal install --dependencies-only --enable-tests+ cabal configure --enable-tests --enable-coverage+ cabal build+ cabal test
+ README.md view
@@ -0,0 +1,70 @@+[](https://travis-ci.org/weldr/codec-rpm)+[](https://coveralls.io/github/weldr/codec-rpm?branch=master)++Haskell library for working with RPM packages.+++Preparing local development environment for Haskell+===================================================++For development we use the latest upstream versions:++1) Remove the standard `haskell-platform` and `ghc-*` RPMs if you have them installed+2) Download version **8.0.2** of the generic Haskell Platform distribution from+ https://www.haskell.org/platform/linux.html#linux-generic+3) Extract the archive and install Haskell+```+$ tar -xzvf haskell-platform-8.0.2-unknown-posix--minimal-x86_64.tar.gz +$ sudo ./install-haskell-platform.sh+```+4) Add `/usr/local/bin` to your PATH if not already there!+++Building the project locally+============================++`cabal` is used to install and manage Haskell dependencies from upstream.++ $ cabal sandbox init+ $ cabal install++Executing unit tests+====================++ $ cabal sandbox init+ $ cabal install --dependencies-only --enable-tests+ $ cabal test --show-details=always+ Preprocessing library rpm-1...+ Preprocessing test suite 'tests' for rpm-1...+ Running 1 test suites...+ Test suite tests: RUNNING...+ Test suite tests: PASS+ Test suite logged to: dist/test/rpm-1-tests.log+ 1 of 1 test suites (1 of 1 test cases) passed.++Produce code coverage report+============================++ $ cabal sandbox init+ $ cabal install --enable-tests --enable-coverage+ $ cabal test --show-details=always+ $ firefox ./dist/hpc/vanilla/tix/*/hpc_index.html++Testing in Haskell+==================++The recommended way to test this project is to use+[Hspec](https://hspec.github.io/) for annotating unit tests.+For starters you can try adding cases which extend code coverage.++It is also recommended to use property based testing with+QuickCheck (and Hspec) where it makes sense. Property based tools+automatically generates hundreds/thousands of input variants and+execute the function under test with them. This validates that+specific conditions (aka properties of the function) are always met.+This is useful with pure functions. For more information see:++- http://blog.jessitron.com/2013/04/property-based-testing-what-is-it.html+- http://book.realworldhaskell.org/read/testing-and-quality-assurance.html+- https://en.wikibooks.org/wiki/Haskell/Testing+- http://hspec.github.io/quickcheck.html
+ Setup.hs view
@@ -0,0 +1,17 @@+-- Copyright (C) 2016 Red Hat, Inc.+--+-- This library is free software; you can redistribute it and/or+-- modify it under the terms of the GNU Lesser General Public+-- License as published by the Free Software Foundation; either+-- version 2.1 of the License, or (at your option) any later version.+--+-- This library is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU+-- Lesser General Public License for more details.+--+-- You should have received a copy of the GNU Lesser General Public+-- License along with this library; if not, see <http://www.gnu.org/licenses/>.++import Distribution.Simple+main = defaultMain
+ codec-rpm.cabal view
@@ -0,0 +1,70 @@+name: codec-rpm+version: 0.1.0+synopsis: A library for manipulating RPM files+description: This module provides a library for reading RPM files and converting them+ into useful data structures. There is currently no way to operate in+ reverse - that is, for building an RPM file out of a data structure.+homepage: https://github.com/weldr/codec-rpm+category: Distribution+author: Chris Lumens+maintainer: clumens@redhat.com+license: LGPL+license-file: LICENSE+cabal-version: >= 1.10+build-type: Simple++extra-source-files: ChangeLog.md,+ Makefile,+ README.md,+ tests/Codec/RPM/*.hs++extra-doc-files: examples/inspect.hs,+ examples/rpm2json.hs,+ examples/unrpm.hs++source-repository head+ type: git+ location: https://github.com/weldr/codec-rpm++library+ exposed-modules: Codec.RPM.Parse,+ Codec.RPM.Tags,+ Codec.RPM.Types,+ Codec.RPM.Version++ other-modules: Codec.RPM.Internal.Numbers++ build-depends: attoparsec >= 0.12.1.4 && < 0.13,+ attoparsec-binary >= 0.2 && < 0.3,+ base >= 4.7 && < 5.0,+ bytestring >= 0.10 && < 0.11,+ conduit >= 1.2.8 && < 1.3,+ conduit-combinators >= 1.1.0 && < 1.2,+ conduit-extra >= 1.1.16 && < 1.2,+ mtl >= 2.2.1 && < 2.3,+ parsec >= 3.1.11 && < 3.2,+ pretty >= 1.1.2.0,+ resourcet >= 1.1.9 && < 1.2,+ text >= 1.2.2.2 && < 1.3++ default-language: Haskell2010++ ghc-options: -Wall++test-suite tests+ type: exitcode-stdio-1.0+ hs-source-dirs: tests+ main-is: Spec.hs+ + build-depends: HUnit >= 1.6.0.0 && < 1.7,+ hspec >= 2.4.4 && < 2.5,+ hspec-attoparsec >= 0.1.0.2 && < 0.2,+ base >= 4.7 && < 5.0,+ bytestring >= 0.10 && < 0.11,+ attoparsec >= 0.12.1.4 && < 0.13,+ codec-rpm,+ text >= 1.2.2.2 && < 1.3++ default-language: Haskell2010++ ghc-options: -Wall
+ examples/inspect.hs view
@@ -0,0 +1,31 @@+-- Copyright (C) 2016 Red Hat, Inc.+--+-- This library is free software; you can redistribute it and/or+-- modify it under the terms of the GNU Lesser General Public+-- License as published by the Free Software Foundation; either+-- version 2.1 of the License, or (at your option) any later version.+--+-- This library is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU+-- Lesser General Public License for more details.+--+-- You should have received a copy of the GNU Lesser General Public+-- License along with this library; if not, see <http://www.gnu.org/licenses/>.++import Conduit((.|), Consumer, awaitForever, runConduit, stdinC)+import Control.Monad(void)+import Control.Monad.Except(runExceptT)+import Control.Monad.IO.Class(MonadIO, liftIO)+import Text.PrettyPrint(render)+import Text.PrettyPrint.HughesPJClass(Pretty(pPrint))++import Codec.RPM.Parse(parseRPMC)+import Codec.RPM.Types(RPM)++consumer :: MonadIO m => Consumer RPM m ()+consumer = awaitForever (liftIO . putStrLn . render . pPrint)++main :: IO ()+main =+ void $ runExceptT $ runConduit $ stdinC .| parseRPMC .| consumer
+ examples/rpm2json.hs view
@@ -0,0 +1,135 @@+-- Copyright (C) 2016 Red Hat, Inc.+--+-- This library is free software; you can redistribute it and/or+-- modify it under the terms of the GNU Lesser General Public+-- License as published by the Free Software Foundation; either+-- version 2.1 of the License, or (at your option) any later version.+--+-- This library is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU+-- Lesser General Public License for more details.+--+-- You should have received a copy of the GNU Lesser General Public+-- License along with this library; if not, see <http://www.gnu.org/licenses/>.++{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}++import Conduit((.|), Conduit, Consumer, awaitForever, runConduit, stdinC, yield)+import Control.Monad(void)+import Control.Monad.Except(runExceptT)+import Control.Monad.IO.Class(MonadIO, liftIO)+import Data.Aeson(Value(..), toJSON, ToJSON, object, (.=))+import Data.Aeson.TH(deriveToJSON, defaultOptions)+import Data.Aeson.Encode.Pretty(encodePretty)+import qualified Data.ByteString.Lazy.Char8 as C+import Data.Data+import Data.Word++import Codec.RPM.Parse(parseRPMC)+import Codec.RPM.Tags(Tag)+import Codec.RPM.Types(RPM(..), Lead, SectionHeader, Header(..))++-- make the RPM types JSON-able from the bottom up+-- only doing the to-JSON instead of from-JSON, to avoid headaches and+-- because from JSON isn't terribly useful.+--+-- first, the easy ones, using template magic+deriveToJSON defaultOptions ''Lead+deriveToJSON defaultOptions ''SectionHeader++-- Tags, wow. What we want to see depends on what's in it. In general, the content is:+-- - nothing at all.+-- - a string. might be something good, show it!+-- - an int. Probably don't care, but no harm in showing it anyway+-- - a list of strings or ints which could well be three miles long. do not show these, holy crap+-- - a bytestring, skip it+-- JSON-ize as { "name" : "WhateverTag", "value" : "maybe a value" }++-- first, some utility functions+tagName :: Tag -> String+tagName t = showConstr $ toConstr t++-- This takes the first constructor parameter of the tag, which is where the data goes, and+-- converts it to a TypeRep+tagType :: Tag -> TypeRep+tagType = gmapQi 0 typeOf++-- Use a cast to pull the first parameter out of the constructor.+tagValue :: Typeable a => Tag -> Maybe a+tagValue = gmapQi 0 cast++-- There's probably a better way to do this+-- type needs to be explicit on account of OverloadedStrings+stringType :: TypeRep+stringType = typeOf ("" :: String)++stringListType :: TypeRep+stringListType = typeOf ([] :: [String])++word16ListType :: TypeRep+word16ListType = typeOf ([] :: [Word16])++word32Type :: TypeRep+word32Type = typeOf (0 :: Word32)++word32ListType :: TypeRep+word32ListType = typeOf ([] :: [Word32])++word64Type :: TypeRep+word64Type = typeOf (0 :: Word64)++word64ListType :: TypeRep+word64ListType = typeOf ([] :: [Word64])++tagToJSON :: Tag -> Maybe Value+tagToJSON t+ | tt == stringType = applyJSON (tagValue t :: Maybe String)+ | tt == word32Type = applyJSON (tagValue t :: Maybe Word32)+ | tt == word64Type = applyJSON (tagValue t :: Maybe Word64)+ | tt == stringListType = applyJSON (tagValue t :: Maybe [String])+ | tt == word16ListType = applyJSON (tagValue t :: Maybe [Word16])+ | tt == word32ListType = applyJSON (tagValue t :: Maybe [Word32])+ | tt == word64ListType = applyJSON (tagValue t :: Maybe [Word64])+ | otherwise = Nothing+ where tt = tagType t++ -- Do not let type inference get a hold of this one, or it'll infer based+ -- on the first case and barf on the rest+ applyJSON :: (Functor f, ToJSON a) => f a -> f Value+ applyJSON = fmap toJSON++instance ToJSON Tag where+ toJSON t = let namePair = "name" .= tagName t+ value = tagToJSON t++ -- If we have a value, it should be passed to the object below,+ -- otherwise use an empty list so the object just gets "name".+ valueList = case value of+ Just x -> [ "value" .= x ]+ Nothing -> []+ in object (namePair : valueList)++-- for Header, skip the headerStore ByteStream+instance ToJSON Header where+ toJSON hs = object [ "headerSectionHeader" .= toJSON (headerSectionHeader hs),+ "headerTags" .= toJSON (headerTags hs) ]++-- for the top-level RPM type, skip rpmArchive+instance ToJSON RPM where+ toJSON rpm = object [ "rpmLead" .= toJSON (rpmLead rpm),+ "rpmHeaders" .= toJSON (rpmHeaders rpm) ]++-- conduit to encode RPM into a JSON value. Errors are passed through+encodeC :: Monad m => Conduit RPM m Value+encodeC = awaitForever (yield . toJSON)++-- output sink+consumer :: MonadIO m => Consumer Value m ()+consumer = awaitForever (liftIO . C.putStrLn . encodePretty)++main :: IO ()+main =+ void $ runExceptT $ runConduit $ stdinC .| parseRPMC .| encodeC .| consumer
+ examples/unrpm.hs view
@@ -0,0 +1,91 @@+-- Copyright (C) 2016 Red Hat, Inc.+--+-- This library is free software; you can redistribute it and/or+-- modify it under the terms of the GNU Lesser General Public+-- License as published by the Free Software Foundation; either+-- version 2.1 of the License, or (at your option) any later version.+--+-- This library is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU+-- Lesser General Public License for more details.+--+-- You should have received a copy of the GNU Lesser General Public+-- License along with this library; if not, see <http://www.gnu.org/licenses/>.++{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RankNTypes #-}++import Conduit((.|), Conduit, MonadResource, Producer, awaitForever, runConduitRes, sinkFile, sourceLazy, sourceFile, yield)+import Control.Monad(void, when)+import Control.Monad.Except(MonadError, runExceptT)+import Control.Monad.IO.Class(liftIO)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BC+import Data.CPIO(Entry(..), isEntryDirectory, readCPIO)+import qualified Data.Conduit.Combinators as DCC+import Data.Conduit.Lzma(decompress)+import System.Directory(createDirectoryIfMissing)+import System.Environment(getArgs)+import System.Exit(exitFailure)+import System.FilePath((</>), splitFileName)++import Codec.RPM.Parse(parseRPMC)+import Codec.RPM.Types(RPM(..))++-- Grab an RPM from stdin and convert it into a chunked conduit of ByteStrings. This could+-- just as easily come from a stdin (using stdinC) or over the network (see httpSink in+-- the http-conduit package, for instance).+--+-- Important note: stdinC produces a conduit of multiple ByteStrings. A single ByteString+-- is some chunk of the file - I don't know how much, but it feels like maybe 32k. conduit calls+-- this chunked data, and while chunks are more efficient for conduit to work with, they don't do+-- much for us. To examine the RPM header, we need individual bytes. Luckily, the *CE functions+-- out of conduit let us get at individual elements out of the stream of chunks without even+-- having to think about a chunk or asking for more. That all happens for us.+--+-- Long story short, chunks are useful for when we need to just pipe lots of data from one place+-- to another or when we need to tell conduit about types. Elements are useful for when we need+-- to do something to the contents.+getRPM :: MonadResource m => FilePath -> Producer m BS.ByteString+getRPM = sourceFile+++-- If a cpio entry is a directory, just create it. If it's a file, create the directory containing+-- it and then stream the contents onto disk. I'm not worrying with permissions, file mode, timestamps,+-- or any of that stuff here. This is just a demo.+writeCpioEntry :: Entry -> IO ()+writeCpioEntry entry@Entry{..} | isEntryDirectory entry = createDirectoryIfMissing True (BC.unpack cpioFileName)+ | otherwise = do+ let (d, f) = splitFileName (BC.unpack cpioFileName)+ createDirectoryIfMissing True d+ void $ runConduitRes $ sourceLazy cpioFileData .| sinkFile (d </> f)++-- Pull the rpmArchive out of the RPM record+payloadC :: MonadError e m => Conduit RPM m BS.ByteString+payloadC = awaitForever (yield . rpmArchive)++processRPM :: FilePath -> IO ()+processRPM path = do+ -- Hopefully self-explanatory - runErrorT and runResourceT execute and unwrap the monads, giving the+ -- actual result of the whole conduit. That's either an error message nothing, and the files are+ -- written out in the pipeline kind of as a side effect.+ result <- runExceptT $ runConduitRes $+ getRPM path+ .| parseRPMC+ .| payloadC+ .| decompress Nothing+ .| readCPIO+ .| DCC.mapM_ (liftIO . writeCpioEntry)+ either print return result++main :: IO ()+main = do+ -- Read the list of rpms to process from the command line arguments+ argv <- getArgs++ when (length argv < 1) $ do+ putStrLn "Usage: unrpm RPM [RPM ...]"+ exitFailure++ mapM_ processRPM argv
+ tests/Codec/RPM/ParseSpec.hs view
@@ -0,0 +1,213 @@+module Codec.RPM.ParseSpec (spec) where++import Test.Hspec+import Test.Hspec.Attoparsec+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BC+++import Codec.RPM.Parse+import Codec.RPM.Tags+import Codec.RPM.Types++spec :: Spec+spec = describe "Codec.RPM.Parse" $ do+ describe "parseLead" $ do+ it "fails with wrong file signature" $ do+ let stream = BS.pack [+ 0xFF, 0xFF, 0xFF, 0xFF, -- *WRONG* File signature+ 8, -- Major+ 9, -- Minor+ 0, 1, -- Type+ 0, 2, -- ArchNum+ 65, 66, 67, 68, 69, 70, -- name 66 bytes ABCDEF+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,+ 0, 1, -- OS num+ 0, 4, -- Sig type+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0] -- 16 bytes padding+ parseLead `shouldFailOn` stream+ -- NOTE: http://alpmestan.com/posts/2014-06-18-testing-attoparsec-parsers-with-hspec.html+ -- Right now, hspec-attoparsec will only consider leftovers when the parser succeeds.+ -- I’m not really sure whether we should return Fail’s unconsumed input or not.+ --+ -- We can't use `leavesUnconsumed` when the parser fails+ -- so the following assertion is invalid for now!+ -- stream ~?> parseLead `leavesUnconsumed` BS.pack []++ it "fails when name < 66 chars" $ do+ let stream = BS.pack [+ 0xED, 0xAB, 0xEE, 0xDB, -- File signature+ 8, -- Major+ 9, -- Minor+ 0, 1, -- Type+ 0, 1, -- ArchNum+ 65, 66, 67, 68, 69, 70, -- name 26 instead of 66 bytes+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,+ 0, 1, -- OS num+ 0, 4, -- Sig type+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0] -- 16 bytes padding++ parseLead `shouldFailOn` stream++ it "fails when padding < 16 bytes" $ do+ let stream = BS.pack [+ 0xED, 0xAB, 0xEE, 0xDB, -- File signature+ 8, -- Major+ 9, -- Minor+ 0, 1, -- Type+ 0, 1, -- ArchNum+ 65, 66, 67, 68, 69, 70, -- name 66 bytes+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,+ 0, 1, -- OS num+ 0, 4, -- Sig type+ 0, 0, 0, 0, 0, 0] -- 6 instead of 16 bytes padding++ parseLead `shouldFailOn` stream++ it "succeeds with valid data" $ do+ let stream = BS.pack [+ 0xED, 0xAB, 0xEE, 0xDB, -- File signature+ 8, -- Major+ 9, -- Minor+ 0, 1, -- Type+ 0, 2, -- ArchNum+ 65, 66, 67, 68, 69, 70, -- name 66 bytes ABCDEF+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,+ 0, 1, -- OS num+ 0, 4, -- Sig type+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0] -- 16 bytes padding+ let expected = Lead 8 9 1 2 "ABCDEF" 1 4++ -- parsing succeeds+ parseLead `shouldSucceedOn` stream+ -- no unconsumed input+ stream ~?> parseLead `leavesUnconsumed` BS.pack []+ -- result is as expected+ stream ~> parseLead `parseSatisfies` (==expected)++ describe "parseSectionHeader" $ do+ it "fails with invalid section header signature" $ do+ let stream = BS.pack [+ 0xFF, 0xFF, 0xFF, -- *WRONG* section header signature+ 8, -- sectionVersion+ 0, 0, 0, 0, -- 4 reserved bytes+ 255, 255, 255, 255, -- sectionCount 4 bytes+ 0, 0, 255, 255] -- sectionSize 4 bytes++ parseSectionHeader `shouldFailOn` stream++ it "fails when reserved section < 4 bytes" $ do+ let stream = BS.pack [+ 0x8E, 0xAD, 0xE8, -- section header signature+ 8, -- sectionVersion+ 0, 0, -- *2 instead of* 4 reserved bytes+ 255, 255, 255, 255, -- sectionCount 4 bytes+ 0, 0, 255, 255] -- sectionSize 4 bytes++ parseSectionHeader `shouldFailOn` stream++ it "succeeds with valid data" $ do+ let stream = BS.pack [+ 0x8E, 0xAD, 0xE8, -- section header signature+ 8, -- sectionVersion+ 0, 0, 0, 0, -- 4 reserved bytes+ 255, 255, 255, 255, -- sectionCount 4 bytes+ 0, 0, 255, 255] -- sectionSize 4 bytes+ let expected = SectionHeader 8 4294967295 65535++ -- parsing succeeds+ parseSectionHeader `shouldSucceedOn` stream+ -- no unconsumed input+ stream ~?> parseSectionHeader `leavesUnconsumed` BS.pack []+ -- result is as expected+ stream ~> parseSectionHeader `parseSatisfies` (==expected)++ describe "parseOneTag" $ do+ it "returns Nothing when any of the input streams is empty" $ do+ parseOneTag (BS.pack []) (BS.pack []) `shouldBe` Nothing+ parseOneTag (BS.pack [1, 2, 3, 4, 5]) (BS.pack []) `shouldBe` Nothing+ parseOneTag (BS.pack []) (BS.pack [100, 8, 0, 7]) `shouldBe` Nothing++ it "returns valid Tag when both input streams are valid" $ do+ let store = BC.pack "123-test-me"+ let bs = BS.pack [0, 0, 0, 100, -- tag+ 0, 0, 0, 8, -- ty+ 0, 0, 0, 4, -- offset+ 0, 0, 0, 7 -- count+ ]+ parseOneTag store bs `shouldBe` Just (HeaderI18NTable ["test-me"])++ describe "parseSection" $+ it "succeeds with valid data" $ do+ let stream = BS.pack [+ 0x8E, 0xAD, 0xE8, -- section header signature+ 1, -- sectionVersion+ 0, 0, 0, 0, -- 4 reserved bytes+ 0, 0, 0, 7, -- sectionCount 4 bytes+ 0, 0, 0, 0xE4, -- sectionSize 4 bytes++ -- tags defined in this section, sectionCount * 16 bytes+ -- 62 7 212 16 == HeaderSignatures (Null), ty(7) /= 0, returns Nothing+ 0x00, 0x00, 0x00, 0x3e, 0x00, 0x00, 0x00, 0x07, 0x00, 0x00, 0x00, 0xd4, 0x00, 0x00, 0x00, 0x10,+ -- 267 7 0 72 == DSAHeader (binary)+ 0x00, 0x00, 0x01, 0x0b, 0x00, 0x00, 0x00, 0x07, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x48,+ -- 269 6 72 1 == SHA1Header (string)+ 0x00, 0x00, 0x01, 0x0d, 0x00, 0x00, 0x00, 0x06, 0x00, 0x00, 0x00, 0x48, 0x00, 0x00, 0x00, 0x01,+ -- 1000 4 116 1 == Name (string), ty(4) /= 6, returns Nothing+ 0x00, 0x00, 0x03, 0xe8, 0x00, 0x00, 0x00, 0x04, 0x00, 0x00, 0x00, 0x74, 0x00, 0x00, 0x00, 0x01,+ -- 1004 7 120 16 == Summary (i18n string), ty(7) /= 9, returns Nothing+ 0x00, 0x00, 0x03, 0xec, 0x00, 0x00, 0x00, 0x07, 0x00, 0x00, 0x00, 0x78, 0x00, 0x00, 0x00, 0x10,+ -- 1005 7 136 72 == Description (i18n string), ty(7) /= 9, returns Nothing+ 0x00, 0x00, 0x03, 0xed, 0x00, 0x00, 0x00, 0x07, 0x00, 0x00, 0x00, 0x88, 0x00, 0x00, 0x00, 0x48,+ -- 1007 4 208 1 == BuildHost (string), ty(4) /= 6, returns Nothing+ 0x00, 0x00, 0x03, 0xef, 0x00, 0x00, 0x00, 0x04, 0x00, 0x00, 0x00, 0xd0, 0x00, 0x00, 0x00, 0x01,++ -- section payload (228 bytes in this example)+ -- DSAHeader+ 0x88, 0x46, 0x04, 0x00, 0x11, 0x02, 0x00, 0x06, 0x05, 0x02, 0x53, 0x67, 0xab, 0x9d, 0x00, 0x0a,+ 0x09, 0x10, 0x50, 0x8c, 0xe5, 0xe6, 0x66, 0x53, 0x4c, 0x2b, 0x6b, 0x83, 0x00, 0xa0, 0x9e, 0x1c,+ 0x4e, 0x19, 0xd5, 0x78, 0x37, 0x53, 0x61, 0x8a, 0x34, 0x4b, 0x40, 0x91, 0xfb, 0xc1, 0x24, 0xbb,+ 0x1c, 0x62, 0x00, 0x9f, 0x50, 0xe6, 0x5c, 0x34, 0x72, 0xa6, 0x54, 0x70, 0x45, 0xce, 0xe9, 0xec,+ 0x02, 0x6b, 0x98, 0xfa, 0x45, 0x72, 0x8f, 0xca, -- SHA1Header+ 0x66, 0x36, 0x37, 0x35, 0x64, 0x37, 0x39, 0x62,+ 0x66, 0x66, 0x33, 0x34, 0x34, 0x66, 0x36, 0x63, 0x63, 0x63, 0x32, 0x64, 0x34, 0x65, 0x37, 0x31,+ 0x66, 0x66, 0x62, 0x62, 0x38, 0x61, 0x39, 0x63, 0x36, 0x38, 0x39, 0x62, 0x61, 0x64, 0x65, 0x63,+ 0x00, 0x00, 0x00, 0x00, -- Name+ 0x01, 0x2b, 0x00, 0xf6, -- Summary+ 0x00, 0x7c, 0xa1, 0x57, 0x31, 0x3e, 0x1f, 0x20,+ 0x34, 0x4f, 0xf7, 0x1e, 0xc9, 0xbb, 0xd7, 0xdc, -- Description+ 0x88, 0x46, 0x04, 0x00, 0x11, 0x02, 0x00, 0x06,+ 0x05, 0x02, 0x53, 0x67, 0xab, 0x9d, 0x00, 0x0a, 0x09, 0x10, 0x50, 0x8c, 0xe5, 0xe6, 0x66, 0x53,+ 0x4c, 0x2b, 0x6f, 0xdf, 0x00, 0x9d, 0x13, 0x63, 0xe0, 0x2f, 0xed, 0x88, 0x8b, 0x27, 0xad, 0x46,+ 0x23, 0x26, 0xb7, 0xa8, 0xda, 0xb7, 0xea, 0x64, 0x71, 0x88, 0x00, 0xa0, 0x80, 0x31, 0xf5, 0x32,+ 0x25, 0x81, 0xf9, 0xce, 0xe1, 0x63, 0x15, 0x15, 0x9d, 0xe3, 0x74, 0xc1, 0x23, 0xa8, 0xba, 0xaf,+ -- BuildHost+ 0x01, 0x2a, 0xeb, 0x70, 0x00, 0x00, 0x00, 0x3e, 0x00, 0x00, 0x00, 0x07, 0xff, 0xff, 0xff, 0x90,+ 0x00, 0x00, 0x00, 0x00] -- followed by 4 bytes of signature padding before the next section++ -- parsing succeeds+ parseSection `shouldSucceedOn` stream+ -- no unconsumed input+ stream ~?> parseSection `leavesUnconsumed` BS.pack []++ -- verify the result matches expected+ stream ~> parseSection `parseSatisfies` matchExpected+ where+ matchExpected h = do+ let expSH = SectionHeader 1 7 228+ let expT = [+ DSAHeader (BS.pack [+ 0x88, 0x46, 0x04, 0x00, 0x11, 0x02, 0x00, 0x06, 0x05, 0x02, 0x53, 0x67, 0xab, 0x9d, 0x00, 0x0a,+ 0x09, 0x10, 0x50, 0x8c, 0xe5, 0xe6, 0x66, 0x53, 0x4c, 0x2b, 0x6b, 0x83, 0x00, 0xa0, 0x9e, 0x1c,+ 0x4e, 0x19, 0xd5, 0x78, 0x37, 0x53, 0x61, 0x8a, 0x34, 0x4b, 0x40, 0x91, 0xfb, 0xc1, 0x24, 0xbb,+ 0x1c, 0x62, 0x00, 0x9f, 0x50, 0xe6, 0x5c, 0x34, 0x72, 0xa6, 0x54, 0x70, 0x45, 0xce, 0xe9, 0xec,+ 0x02, 0x6b, 0x98, 0xfa, 0x45, 0x72, 0x8f, 0xca]),+ SHA1Header "f675d79bff344f6ccc2d4e71ffbb8a9c689badec"+ ]+ headerSectionHeader h == expSH && headerTags h == expT && BS.length (headerStore h) == 228
+ tests/Codec/RPM/Parse_parseRPMSpec.hs view
@@ -0,0 +1,193 @@+module Codec.RPM.Parse_parseRPMSpec (spec) where++import Test.Hspec+import Test.Hspec.Attoparsec+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BC+++import Codec.RPM.Parse+import Codec.RPM.Tags+import Codec.RPM.Types++stream :: BS.ByteString+stream = BS.pack [+ -- begin RPM lead+ 0xed, 0xab, 0xee, 0xdb, 0x03, 0x00, 0x00, 0x01, 0x00, 0x01, 0x76, 0x6c, 0x63, 0x2d, 0x32, 0x2e,+ 0x31, 0x2e, 0x34, 0x2d, 0x31, 0x34, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x01, 0x00, 0x05,+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,+ -- begin signature section+ 0x8E, 0xAD, 0xE8, -- section header signature+ 1, -- sectionVersion+ 0, 0, 0, 0, -- 4 reserved bytes+ 0, 0, 0, 2, -- sectionCount 4 bytes -- MODIFIED FOR BREVITY+ 0, 0, 0, 0x70, -- sectionSize 4 bytes -- MODIFIED FOR BREVITY++ -- tags defined in this section, sectionCount * 16 bytes, 32 in this example+ -- 267 7 0 72 == DSAHeader (binary)+ 0x00, 0x00, 0x01, 0x0b, 0x00, 0x00, 0x00, 0x07, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x48,+ -- 269 6 72 1 == SHA1Header (string)+ 0x00, 0x00, 0x01, 0x0d, 0x00, 0x00, 0x00, 0x06, 0x00, 0x00, 0x00, 0x48, 0x00, 0x00, 0x00, 0x01,++ -- section payload (112 bytes in this example)+ -- DSAHeader+ 0x88, 0x46, 0x04, 0x00, 0x11, 0x02, 0x00, 0x06, 0x05, 0x02, 0x53, 0x67, 0xab, 0x9d, 0x00, 0x0a,+ 0x09, 0x10, 0x50, 0x8c, 0xe5, 0xe6, 0x66, 0x53, 0x4c, 0x2b, 0x6b, 0x83, 0x00, 0xa0, 0x9e, 0x1c,+ 0x4e, 0x19, 0xd5, 0x78, 0x37, 0x53, 0x61, 0x8a, 0x34, 0x4b, 0x40, 0x91, 0xfb, 0xc1, 0x24, 0xbb,+ 0x1c, 0x62, 0x00, 0x9f, 0x50, 0xe6, 0x5c, 0x34, 0x72, 0xa6, 0x54, 0x70, 0x45, 0xce, 0xe9, 0xec,+ 0x02, 0x6b, 0x98, 0xfa, 0x45, 0x72, 0x8f, 0xca, -- SHA1Header+ 0x66, 0x36, 0x37, 0x35, 0x64, 0x37, 0x39, 0x62,+ 0x66, 0x66, 0x33, 0x34, 0x34, 0x66, 0x36, 0x63, 0x63, 0x63, 0x32, 0x64, 0x34, 0x65, 0x37, 0x31,+ 0x66, 0x66, 0x62, 0x62, 0x38, 0x61, 0x39, 0x63, 0x36, 0x38, 0x39, 0x62, 0x61, 0x64, 0x65, 0x63,+ -- no signature padding here++ -- begin header section+ 0x8e, 0xad, 0xe8, 0x01, 0x00, 0x00, 0x00, 0x00, -- section signature (3b), sectionVersion (1b), reserved (4b)+ 0x00, 0x00, 0x00, 0x03, -- sectionCount (4b) -- MODIFIED FOR BREVITY+ 0x00, 0x00, 0x00, 0x36, -- sectionSize (4b) -- MODIFIED FOR BREVITY++ -- tags defined in this section, sectionCount * 16 bytes (32 bytes in this example)+ -- 1000 6 2 1 == Name (string)+ 0x00, 0x00, 0x03, 0xe8, 0x00, 0x00, 0x00, 0x06, 0x00, 0x00, 0x00, 0x02, 0x00, 0x00, 0x00, 0x01,+ -- 1001 6 6 1 == Version (string)+ 0x00, 0x00, 0x03, 0xe9, 0x00, 0x00, 0x00, 0x06, 0x00, 0x00, 0x00, 0x06, 0x00, 0x00, 0x00, 0x01,+ -- 1004 6 15 1 == Summary (i18n string)+ 0x00, 0x00, 0x03, 0xec, 0x00, 0x00, 0x00, 0x09, 0x00, 0x00, 0x00, 0x0f, 0x00, 0x00, 0x00, 0x01,++ -- section payload (54 bytes in this example)+ 0x43, 0x00, -- Name+ 0x76, 0x6c, 0x63, 0x00, -- Version+ 0x32, 0x2e, 0x31, 0x2e, 0x34, 0x00,+ 0x31, 0x34, 0x00, -- Summary+ 0x41,+ 0x20, 0x66, 0x72, 0x65, 0x65, 0x20, 0x61, 0x6e, 0x64, 0x20, 0x63, 0x72, 0x6f, 0x73, 0x73, 0x2d,+ 0x70, 0x6c, 0x61, 0x74, 0x66, 0x6f, 0x72, 0x6d, 0x20, 0x6d, 0x65, 0x64, 0x69, 0x61, 0x20, 0x70,+ 0x6c, 0x61, 0x79, 0x65, 0x72, 0x00, -- RPM payload -- MODIFIED FOR BREVITY+ 0x54, 0x45, 0x53, 0x54, 0x2D, 0x54, 0x45, 0x53, 0x54, 0x21]++-- NOTE: this is the same as `stream' above so we can reuse the `matchExpected'+-- function. The only difference is an extra tag and padding+paddedStream :: BS.ByteString+paddedStream = BS.pack [+ -- begin RPM lead+ 0xed, 0xab, 0xee, 0xdb, 0x03, 0x00, 0x00, 0x01, 0x00, 0x01, 0x76, 0x6c, 0x63, 0x2d, 0x32, 0x2e,+ 0x31, 0x2e, 0x34, 0x2d, 0x31, 0x34, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x01, 0x00, 0x05,+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,+ -- begin signature section+ 0x8E, 0xAD, 0xE8, -- section header signature+ 1, -- sectionVersion+ 0, 0, 0, 0, -- 4 reserved bytes+ 0, 0, 0, 3, -- sectionCount 4 bytes -- MODIFIED FOR BREVITY+ 0, 0, 0, 0x75, -- sectionSize 4 bytes -- MODIFIED FOR BREVITY++ -- tags defined in this section, sectionCount * 16 bytes, 48 in this example+ -- 267 7 0 72 == DSAHeader (binary)+ 0x00, 0x00, 0x01, 0x0b, 0x00, 0x00, 0x00, 0x07, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x48,+ -- 269 6 72 1 == SHA1Header (string)+ 0x00, 0x00, 0x01, 0x0d, 0x00, 0x00, 0x00, 0x06, 0x00, 0x00, 0x00, 0x48, 0x00, 0x00, 0x00, 0x01,+ -- 1000 4 113 1 == Name (string), ty(4) /= 6, returns Nothing+ 0x00, 0x00, 0x03, 0xe8, 0x00, 0x00, 0x00, 0x04, 0x00, 0x00, 0x00, 0x71, 0x00, 0x00, 0x00, 0x01,++ -- section payload (117 bytes in this example)+ -- DSAHeader+ 0x88, 0x46, 0x04, 0x00, 0x11, 0x02, 0x00, 0x06, 0x05, 0x02, 0x53, 0x67, 0xab, 0x9d, 0x00, 0x0a,+ 0x09, 0x10, 0x50, 0x8c, 0xe5, 0xe6, 0x66, 0x53, 0x4c, 0x2b, 0x6b, 0x83, 0x00, 0xa0, 0x9e, 0x1c,+ 0x4e, 0x19, 0xd5, 0x78, 0x37, 0x53, 0x61, 0x8a, 0x34, 0x4b, 0x40, 0x91, 0xfb, 0xc1, 0x24, 0xbb,+ 0x1c, 0x62, 0x00, 0x9f, 0x50, 0xe6, 0x5c, 0x34, 0x72, 0xa6, 0x54, 0x70, 0x45, 0xce, 0xe9, 0xec,+ 0x02, 0x6b, 0x98, 0xfa, 0x45, 0x72, 0x8f, 0xca, -- SHA1Header+ 0x66, 0x36, 0x37, 0x35, 0x64, 0x37, 0x39, 0x62,+ 0x66, 0x66, 0x33, 0x34, 0x34, 0x66, 0x36, 0x63, 0x63, 0x63, 0x32, 0x64, 0x34, 0x65, 0x37, 0x31,+ 0x66, 0x66, 0x62, 0x62, 0x38, 0x61, 0x39, 0x63, 0x36, 0x38, 0x39, 0x62, 0x61, 0x64, 0x65, 0x63,+ -- NULL, Name NULL+ 0x00, 0x65, 0x65, 0x65, 0x00, -- signature padding+ 0x00, 0x00, 0x00,++ -- begin header section+ 0x8e, 0xad, 0xe8, 0x01, 0x00, 0x00, 0x00, 0x00, -- section signature (3b), sectionVersion (1b), reserved (4b)+ 0x00, 0x00, 0x00, 0x03, -- sectionCount (4b) -- MODIFIED FOR BREVITY+ 0x00, 0x00, 0x00, 0x36, -- sectionSize (4b) -- MODIFIED FOR BREVITY++ -- tags defined in this section, sectionCount * 16 bytes (32 bytes in this example)+ -- 1000 6 2 1 == Name (string)+ 0x00, 0x00, 0x03, 0xe8, 0x00, 0x00, 0x00, 0x06, 0x00, 0x00, 0x00, 0x02, 0x00, 0x00, 0x00, 0x01,+ -- 1001 6 6 1 == Version (string)+ 0x00, 0x00, 0x03, 0xe9, 0x00, 0x00, 0x00, 0x06, 0x00, 0x00, 0x00, 0x06, 0x00, 0x00, 0x00, 0x01,+ -- 1004 6 15 1 == Summary (i18n string)+ 0x00, 0x00, 0x03, 0xec, 0x00, 0x00, 0x00, 0x09, 0x00, 0x00, 0x00, 0x0f, 0x00, 0x00, 0x00, 0x01,++ -- section payload (54 bytes in this example)+ 0x43, 0x00, -- Name+ 0x76, 0x6c, 0x63, 0x00, -- Version+ 0x32, 0x2e, 0x31, 0x2e, 0x34, 0x00,+ 0x31, 0x34, 0x00, -- Summary+ 0x41,+ 0x20, 0x66, 0x72, 0x65, 0x65, 0x20, 0x61, 0x6e, 0x64, 0x20, 0x63, 0x72, 0x6f, 0x73, 0x73, 0x2d,+ 0x70, 0x6c, 0x61, 0x74, 0x66, 0x6f, 0x72, 0x6d, 0x20, 0x6d, 0x65, 0x64, 0x69, 0x61, 0x20, 0x70,+ 0x6c, 0x61, 0x79, 0x65, 0x72, 0x00, -- RPM payload -- MODIFIED FOR BREVITY+ 0x54, 0x45, 0x53, 0x54, 0x2D, 0x54, 0x45, 0x53, 0x54, 0x21]++matchExpected :: RPM -> Bool+matchExpected rpm = do+ let expLead = Lead 3 0 1 1 "vlc-2.1.4-14" 1 5+ let expSigTags = [+ DSAHeader (BS.pack [+ 0x88, 0x46, 0x04, 0x00, 0x11, 0x02, 0x00, 0x06, 0x05, 0x02, 0x53, 0x67, 0xab, 0x9d, 0x00, 0x0a,+ 0x09, 0x10, 0x50, 0x8c, 0xe5, 0xe6, 0x66, 0x53, 0x4c, 0x2b, 0x6b, 0x83, 0x00, 0xa0, 0x9e, 0x1c,+ 0x4e, 0x19, 0xd5, 0x78, 0x37, 0x53, 0x61, 0x8a, 0x34, 0x4b, 0x40, 0x91, 0xfb, 0xc1, 0x24, 0xbb,+ 0x1c, 0x62, 0x00, 0x9f, 0x50, 0xe6, 0x5c, 0x34, 0x72, 0xa6, 0x54, 0x70, 0x45, 0xce, 0xe9, 0xec,+ 0x02, 0x6b, 0x98, 0xfa, 0x45, 0x72, 0x8f, 0xca]),+ SHA1Header "f675d79bff344f6ccc2d4e71ffbb8a9c689badec"+ ]+ let expRpmHeader = SectionHeader 1 3 54+ let expRpmTags = [+ Name "vlc",+ Version "2.1.4",+ Summary (BC.pack "A free and cross-platform media player")+ ]+ let expRpmPayload = BC.pack "TEST-TEST!"++ let actualLead = rpmLead rpm+ let actualSigSection = head (rpmSignatures rpm)+ let actualHdrSection = head (rpmHeaders rpm)+ let actualRpmPayload = rpmArchive rpm++ actualLead == expLead &&+ -- we don't compare the actual section header for the sig section+ -- because count and size varies and that breaks comparissons+ sectionSize (headerSectionHeader actualSigSection) >= 112 &&+ headerTags actualSigSection == expSigTags &&+ BS.length (headerStore actualSigSection) >= 112 &&+ headerSectionHeader actualHdrSection == expRpmHeader &&+ headerTags actualHdrSection == expRpmTags &&+ BS.length (headerStore actualHdrSection) == 54 &&+ actualRpmPayload == expRpmPayload+++spec :: Spec+spec = describe "Codec.RPM.Parse.parseRPM" $ do+ it "succeeds with valid data" $ do+ -- parsing succeeds+ parseRPM `shouldSucceedOn` stream++ -- can't test for unconsumed input b/c takeByteString+ -- will grab all remaining input and put into a single string variable+ -- the leftover is Nothing and hspec-attoparsec doesn't like that when doing+ -- leavesUnconsumed++ -- verify the result matches expected+ stream ~> parseRPM `parseSatisfies` matchExpected++ it "succeeds with valid data with section padding" $ do+ -- parsing succeeds+ parseRPM `shouldSucceedOn` paddedStream++ -- can't test for unconsumed input, see above++ -- verify the result matches expected+ paddedStream ~> parseRPM `parseSatisfies` matchExpected
+ tests/Codec/RPM/Tags_TagSpec.hs view
@@ -0,0 +1,34 @@+module Codec.RPM.Tags_TagSpec (spec) where++import Test.Hspec+import Codec.RPM.Tags(Null(..),+ Tag(..))++spec :: Spec+spec = describe "Codec.RPM.Tags data types" $ do+ describe "Null" $+ it "is equal to itself" $ do+ let null_1 = Null+ null_1 == null_1 `shouldBe` True++-- not implemented+-- it "is different than non-null" $ do+-- let null_1 = Null+-- null_1 /= 1 `shouldBe` True++ describe "Tag" $ do+ it "is equal to itself" $ do+ let tag_1 = Name "anaconda"+ tag_1 == tag_1 `shouldBe` True++ it "tags with two different values are different" $ do+ let tag_1 = Version "20"+ let tag_2 = Version "25"++ tag_1 /= tag_2 `shouldBe` True++ it "two different tags are different" $ do+ let tag_1 = Name "anaconda"+ let tag_2 = Version "25"++ tag_1 /= tag_2 `shouldBe` True
+ tests/Codec/RPM/Tags_findSpec.hs view
@@ -0,0 +1,163 @@+module Codec.RPM.Tags_findSpec (spec) where++import Test.Hspec+import Codec.RPM.Tags(findTag,+ findByteStringTag,+ findStringTag,+ findStringListTag,+ findWord16Tag,+ findWord16ListTag,+ findWord32Tag,+ findWord32ListTag,+ Tag(..))+import qualified Data.ByteString.Char8 as BC+++spec :: Spec+spec = describe "Codec.RPM.Tags.find*" $ do+ describe "findTag" $ do+ it "returns Nothing if name is not in the list of tags" $ do+ let tag_1 = ProvideName ["anaconda"]+ let tags = [tag_1]++ findTag "NonExistingTag" tags `shouldBe` Nothing++ it "returns Nothing if searching inside empty list" $+ findTag "ProvideName" [] `shouldBe` Nothing++ it "returns Maybe Tag if name is in the list of tags" $ do+ let tag_1 = ProvideName ["anaconda"]+ let tag_2 = RequireName ["python"]+ let tag_3 = RequireVersion ["3.5"]+ let tags = [tag_1, tag_2, tag_3]++ findTag "ProvideName" tags `shouldBe` Just tag_1+ findTag "RequireName" tags `shouldBe` Just tag_2+ findTag "RequireVersion" tags `shouldBe` Just tag_3+++ describe "findByteStringTag" $ do+ it "returns Nothing if name is not in the list of tags" $ do+ let tag_1 = ProvideName ["anaconda"]+ let tags = [tag_1]++ findByteStringTag "NonExistingTag" tags `shouldBe` Nothing++ it "returns Nothing if searching inside empty list" $+ findByteStringTag "ProvideName" [] `shouldBe` Nothing++ it "returns Maybe ByteString if name is in the list of tags" $ do+ let tag_1 = Summary (BC.pack "anaconda")+ let tag_2 = Description (BC.pack "The installer")+ let tags = [tag_1, tag_2]++ findByteStringTag "Summary" tags `shouldBe` Just (BC.pack "anaconda")+ findByteStringTag "Description" tags `shouldBe` Just (BC.pack "The installer")+++ describe "findStringTag" $ do+ it "returns Nothing if name is not in the list of tags" $ do+ let tag_1 = ProvideName ["anaconda"]+ let tags = [tag_1]++ findStringTag "NonExistingTag" tags `shouldBe` Nothing++ it "returns Nothing if searching inside empty list" $+ findStringTag "ProvideName" [] `shouldBe` Nothing++ it "returns Maybe String if name is in the list of tags" $ do+ let tag_1 = Name "anaconda"+ let tag_2 = Version "25"+ let tags = [tag_1, tag_2]++ findStringTag "Name" tags `shouldBe` Just "anaconda"+ findStringTag "Version" tags `shouldBe` Just "25"+++ describe "findStringListTag" $ do+ it "returns [] if name is not in the list of tags" $ do+ let tag_1 = ProvideName ["anaconda"]+ let tags = [tag_1]++ findStringListTag "NonExistingTag" tags `shouldBe` []++ it "returns [] if searching inside empty list" $+ findStringListTag "ProvideName" [] `shouldBe` []++ it "returns [String] if name is in the list of tags" $ do+ let tag_1 = ChangeLog ["something", "changed"]+ let tag_2 = Source ["anaconda.tar.gz"]+ let tags = [tag_1, tag_2]++ findStringListTag "ChangeLog" tags `shouldBe` ["something", "changed"]+ findStringListTag "Source" tags `shouldBe` ["anaconda.tar.gz"]+++ describe "findWord16Tag" $ do+ it "returns Nothing if name is not in the list of tags" $ do+ let tag_1 = ProvideName ["anaconda"]+ let tags = [tag_1]++ findWord16Tag "NonExistingTag" tags `shouldBe` Nothing++ it "returns Nothing if searching inside empty list" $+ findWord16Tag "ProvideName" [] `shouldBe` Nothing++ -- "there are no tags holding Word16 values, so no test for those"+++ describe "findWord16ListTag" $ do+ it "returns [] if name is not in the list of tags" $ do+ let tag_1 = ProvideName ["anaconda"]+ let tags = [tag_1]++ findWord16ListTag "NonExistingTag" tags `shouldBe` []++ it "returns [] if searching inside empty list" $+ findWord16ListTag "ProvideName" [] `shouldBe` []++ it "returns [Word16] if name is in the list of tags" $ do+ let tag_1 = FileModes [5]+ let tag_2 = FileRDevs [1]+ let tags = [tag_1, tag_2]++ findWord16ListTag "FileModes" tags `shouldBe` [5]+ findWord16ListTag "FileRDevs" tags `shouldBe` [1]+++ describe "findWord32Tag" $ do+ it "returns Nothing if name is not in the list of tags" $ do+ let tag_1 = ProvideName ["anaconda"]+ let tags = [tag_1]++ findWord32Tag "NonExistingTag" tags `shouldBe` Nothing++ it "returns Nothing if searching inside empty list" $+ findWord32Tag "ProvideName" [] `shouldBe` Nothing++ it "returns Maybe Word32 if name is in the list of tags" $ do+ let tag_1 = InstallColor 5+ let tag_2 = PackageColor 1+ let tags = [tag_1, tag_2]++ findWord32Tag "InstallColor" tags `shouldBe` Just 5+ findWord32Tag "PackageColor" tags `shouldBe` Just 1+++ describe "findWord32ListTag" $ do+ it "returns [] if name is not in the list of tags" $ do+ let tag_1 = ProvideName ["anaconda"]+ let tags = [tag_1]++ findWord32ListTag "NonExistingTag" tags `shouldBe` []++ it "returns [] if searching inside empty list" $+ findWord32ListTag "ProvideName" [] `shouldBe` []++ it "returns [Word32] if name is in the list of tags" $ do+ let tag_1 = FileUIDs [1000]+ let tag_2 = FileGIDs [1001, 1002]+ let tags = [tag_1, tag_2]++ findWord32ListTag "FileUIDs" tags `shouldBe` [1000]+ findWord32ListTag "FileGIDs" tags `shouldBe` [1001, 1002]
+ tests/Codec/RPM/Tags_mkTagSpec.hs view
@@ -0,0 +1,707 @@+module Codec.RPM.Tags_mkTagSpec (spec) where++import Test.Hspec+import Data.Foldable(forM_)+import Codec.RPM.Tags(mkTag, Tag(..), Null(..))+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BC++{-# ANN module "HLint: ignore Reduce duplication" #-}++spec :: Spec+spec = describe "Codec.RPM.Tags.mkTag" $ do+ it "returns Nothing for unsupported `tag' value" $ do+ let store = BS.pack [0]+ let tag = mkTag store 9999 0 0 0+ tag `shouldBe` Nothing++ -- tests for tags which use mkNull+ forM_ [61, 62, 63, 64,+ 256, 258, 260, 263, 264, 265,+ 1038, 1041, 1042, 1083, 1084, 1093,+ 1100, 1101, 1102, 1103, 1104, 1107, 1108, 1109, 1110, 1111,+ 1130, 1171, 1172, 1173, 1193, 1194,+ 5063, 5064, 5065, 5073, 5074, 5075] $ \tagInt -> do+ it ("returns Nothing for `tag' == " ++ show tagInt ++ " and `ty' != 0") $ do+ let store = BS.pack [0]+ let tag = mkTag store tagInt 99 0 0+ tag `shouldBe` Nothing++ it ("returns correct value for `tag' == " ++ show tagInt) $ do+ let store = BS.pack [0]+ let tag = mkTag store tagInt 0 0 0+ tag == Just (HeaderImage Null) || -- 61+ tag == Just (HeaderSignatures Null) || -- 62+ tag == Just (HeaderImmutable Null) || -- 63+ tag == Just (HeaderRegions Null) || -- 64+ tag == Just (SigBase Null) || -- 256+ tag == Just (INTERNAL (OBSOLETE (SigLEMD5_1 Null))) || -- 258+ tag == Just (INTERNAL (OBSOLETE (SigLEMD5_2 Null))) || -- 260+ tag == Just (INTERNAL (OBSOLETE (SigPGP5 Null))) || -- 263+ tag == Just (INTERNAL (OBSOLETE (SigBadSHA1_1 Null))) || -- 264+ tag == Just (INTERNAL (OBSOLETE (SigBadSHA1_2 Null))) || -- 265+ tag == Just (INTERNAL (OBSOLETE (Root Null))) || -- 1038+ tag == Just (INTERNAL (OBSOLETE (Exclude Null))) || -- 1041+ tag == Just (INTERNAL (OBSOLETE (Exclusive Null))) || -- 1042+ tag == Just (INTERNAL (OBSOLETE (BrokenMD5 Null))) || -- 1083+ tag == Just (INTERNAL (PreReq Null)) || -- 1084+ tag == Just (INTERNAL (DocDir Null)) || -- 1093+ tag == Just (INTERNAL (TriggerIn Null)) || -- 1100+ tag == Just (INTERNAL (TriggerUn Null)) || -- 1101+ tag == Just (INTERNAL (TriggerPostUn Null)) || -- 1102+ tag == Just (INTERNAL (AutoReq Null)) || -- 1103+ tag == Just (INTERNAL (AutoProv Null)) || -- 1104+ tag == Just (INTERNAL (OBSOLETE (OldOrigFileNames Null))) || -- 1107+ tag == Just (INTERNAL (BuildPreReq Null)) || -- 1108+ tag == Just (INTERNAL (BuildRequires Null)) || -- 1109+ tag == Just (INTERNAL (BuildConflicts Null)) || -- 1110+ tag == Just (INTERNAL (UNUSED (BuildMacros Null))) || -- 1111+ tag == Just (INTERNAL (OBSOLETE (SHA1RHN Null))) || -- 1130+ tag == Just (INTERNAL (TriggerPreIn Null)) || -- 1171+ tag == Just (INTERNAL (UNIMPLEMENTED (BuildSuggests Null))) || -- 1172+ tag == Just (INTERNAL (UNIMPLEMENTED (BuildEnhances Null))) || -- 1173+ tag == Just (UNIMPLEMENTED (BuildProvides Null)) || -- 1193+ tag == Just (UNIMPLEMENTED (BuildObsoletes Null)) || -- 1194+ tag == Just (INTERNAL (FileTriggerIn Null)) || -- 5063+ tag == Just (INTERNAL (FileTriggerUn Null)) || -- 5064+ tag == Just (INTERNAL (FileTriggerPostUn Null)) || -- 5065+ tag == Just (INTERNAL (TransFileTriggerIn Null)) || -- 5073+ tag == Just (INTERNAL (TransFileTriggerUn Null)) || -- 5074+ tag == Just (INTERNAL (TransFileTriggerPostUn Null)) -- 5075+ `shouldBe` True++ -- tests for tags which use mkChar+ forM_ [1029] $ \tagInt -> do+ it ("returns Nothing for `tag' == " ++ show tagInt ++ " and `ty' != 1") $ do+ let store = BS.pack [0]+ let tag = mkTag store tagInt 99 0 0+ tag `shouldBe` Nothing++ it ("returns correct value for `tag' == " ++ show tagInt) $ do+ let store = BC.pack "5"+ let tag = mkTag store tagInt 1 0 1++ tag == Just (FileStates "5") -- 1029+ `shouldBe` True++ -- tests for tags which use mkWord16+ forM_ [1030, 1033] $ \tagInt -> do+ it ("returns Nothing for `tag' == " ++ show tagInt ++ " and `ty' != 3") $ do+ let store = BS.pack [0]+ let tag = mkTag store tagInt 99 0 0+ tag `shouldBe` Nothing++ it ("returns correct value for `tag' == " ++ show tagInt) $ do+ let store = BS.pack [0,5]+ let tag = mkTag store tagInt 3 0 1+ tag == Just (FileModes [5]) ||+ tag == Just (FileRDevs [5])+ `shouldBe` True++ -- tests for tags which use mkWord32+ forM_ [257,+ 1003, 1006, 1008, 1009,+ 1028, 1031, 1032, 1034, 1037,+ 1045, 1046, 1048, 1051, 1052, 1053,+ 1068, 1069, 1080, 1095, 1096,+ 1105, 1106, 1112, 1114, 1116, 1119,+ 1127, 1128, 1129, 1134, 1136, 1138, 1139,+ 1140, 1141, 1143, 1144, 1145, 1158, 1161, 1162,+ 1174, 1175, 1176, 1177, 1179,+ 1180, 1184, 1185, 1187, 1189,+ 1190, 1191, 1192, 1195,+ 5011, 5017, 5018, 5019,+ 5020, 5021, 5022, 5023, 5024, 5025, 5026, 5027,+ 5032, 5033, 5037, 5045, 5048, 5051, 5054, 5057,+ 5068, 5070, 5072, 5078, 5080, 5082, 5084, 5085,+ 5091] $ \tagInt -> do+ it ("returns Nothing for `tag' == " ++ show tagInt ++ " and `ty' != 4") $ do+ let store = BS.pack [0, 0, 0, 5]+ let tag = mkTag store tagInt 99 0 1+ tag `shouldBe` Nothing++ it ("returns correct value for `tag' == " ++ show tagInt) $ do+ let store = BS.pack [0,0,0,5]+ let tag = mkTag store tagInt 4 0 1++ tag == Just (SigSize 5) || -- 257+ tag == Just (Epoch 5) || -- 1003+ tag == Just (BuildTime 5) || -- 1006+ tag == Just (InstallTime 5) || -- 1008+ tag == Just (Size 5) || -- 1009+ tag == Just (FileSizes [5]) || -- 1028+ tag == Just (INTERNAL (OBSOLETE (FileUIDs [5]))) || -- 1031+ tag == Just (INTERNAL (OBSOLETE (FileGIDs [5]))) || -- 1032+ tag == Just (FileMTimes [5]) || -- 1034+ tag == Just (FileFlags [5]) || -- 1037+ tag == Just (FileVerifyFlags [5]) || -- 1045+ tag == Just (ArchiveSize 5) || -- 1046+ tag == Just (RequireFlags [5]) || -- 1048+ tag == Just (NoSource [5]) || -- 1051+ tag == Just (NoPatch [5]) || -- 1052+ tag == Just (ConflictFlags [5]) || -- 1053+ tag == Just (TriggerFlags [5]) || -- 1068+ tag == Just (TriggerIndex [5]) || -- 1069+ tag == Just (ChangeLogTime [5]) || -- 1080+ tag == Just (FileDevices [5]) || -- 1095+ tag == Just (FileINodes [5]) || -- 1096+ tag == Just (INTERNAL (OBSOLETE (Capability 5))) || -- 1105+ tag == Just (SourcePackage 5) || -- 1106+ tag == Just (ProvideFlags [5]) || -- 1112+ tag == Just (ObsoleteFlags [5]) || -- 1114+ tag == Just (DirIndexes [5]) || -- 1116+ tag == Just (OrigDirIndexes [5]) || -- 1119+ tag == Just (InstallColor 5) || -- 1127+ tag == Just (InstallTID 5) || -- 1128+ tag == Just (RemoveTID 5) || -- 1129+ tag == Just (DEPRECATED (PatchesFlags [5])) || -- 1134+ tag == Just (INTERNAL (OBSOLETE (CacheCTime 5))) || -- 1136+ tag == Just (INTERNAL (OBSOLETE (CachePkgSize 5))) || -- 1138+ tag == Just (INTERNAL (OBSOLETE (CachePkgMTime 5))) || -- 1139+ tag == Just (FileColors [5]) || -- 1140+ tag == Just (FileClass [5]) || -- 1141+ tag == Just (FileDependsX [5]) || -- 1143+ tag == Just (FileDependsN [5]) || -- 1144+ -- note: for tagInt == 1145 the return value of mkTag uses bitwise operations+ -- here we use precalculated values+ tag == Just (DependsDict [(0, 5)]) || -- 1145+ tag == Just (OBSOLETE (OldSuggestsFlags [5])) || -- 1158+ tag == Just (OBSOLETE (OldEnhancesFlags [5])) || -- 1161+ tag == Just (UNIMPLEMENTED (Priority [5])) || -- 1162+ tag == Just (UNIMPLEMENTED (ScriptStates [5])) || -- 1174+ tag == Just (UNIMPLEMENTED (ScriptMetrics [5])) || -- 1175+ tag == Just (UNIMPLEMENTED (BuildCPUClock 5)) || -- 1176+ tag == Just (UNIMPLEMENTED (FileDigestAlgos [5])) || -- 1177+ tag == Just (UNIMPLEMENTED (XMajor 5)) || -- 1179+ tag == Just (UNIMPLEMENTED (XMinor 5)) || -- 1180+ tag == Just (UNIMPLEMENTED (PackageColor 5)) || -- 1184+ tag == Just (UNIMPLEMENTED (PackagePrefColor 5)) || -- 1185+ tag == Just (UNIMPLEMENTED (FileXattrsx [5])) || -- 1187+ tag == Just (UNIMPLEMENTED (ConflictAttrsx [5])) || -- 1189+ tag == Just (UNIMPLEMENTED (ObsoleteAttrsx [5])) || -- 1190+ tag == Just (UNIMPLEMENTED (ProvideAttrsx [5])) || -- 1191+ tag == Just (UNIMPLEMENTED (RequireAttrsx [5])) || -- 1192+ tag == Just (DBInstance 5) || -- 1195+ tag == Just (FileDigestAlgo 5) || -- 5011+ tag == Just (HeaderColor 5) || -- 5017+ tag == Just (Verbose 5) || -- 5018+ tag == Just (EpochNum 5) || -- 5019+ tag == Just (PreInFlags 5) || -- 5020+ tag == Just (PostInFlags 5) || -- 5021+ tag == Just (PreUnFlags 5) || -- 5022+ tag == Just (PostUnFlags 5) || -- 5023+ tag == Just (PreTransFlags 5) || -- 5024+ tag == Just (PostTransFlags 5) || -- 5025+ tag == Just (VerifyScriptFlags 5) || -- 5026+ tag == Just (TriggerScriptFlags [5]) || -- 5027+ tag == Just (PolicyTypesIndexes [5]) || -- 5032+ tag == Just (PolicyFlags [5]) || -- 5033+ tag == Just (OrderFlags [5]) || -- 5037+ tag == Just (FileNLinks [5]) || -- 5045+ tag == Just (RecommendFlags [5]) || -- 5048+ tag == Just (SuggestFlags [5]) || -- 5051+ tag == Just (SupplementFlags [5]) || -- 5054+ tag == Just (EnhanceFlags [5]) || -- 5057+ tag == Just (FileTriggerScriptFlags [5]) || -- 5068+ tag == Just (FileTriggerIndex [5]) || -- 5070+ tag == Just (FileTriggerFlags [5]) || -- 5072+ tag == Just (TransFileTriggerScriptFlags [5]) || -- 5078+ tag == Just (TransFileTriggerIndex [5]) || -- 5080+ tag == Just (TransFileTriggerFlags [5]) || -- 5082+ tag == Just (FileTriggerPriorities [5]) || -- 5084+ tag == Just (TransFileTriggerPriorities [5]) || -- 5085+ tag == Just (FileSignatureLength 5) -- 5091+ `shouldBe` True++ -- tests for tags which use mkWord64+ forM_ [270, 271, 5004, 5008, 5009] $ \tagInt -> do+ it ("returns Nothing for `tag' == " ++ show tagInt ++ " and `ty' != 5") $ do+ let store = BS.pack [0]+ let tag = mkTag store tagInt 99 0 0+ tag `shouldBe` Nothing++ it ("returns correct value for `tag' == " ++ show tagInt) $ do+ let store = BS.pack [0,0,0,0,0,0,0,5]+ let tag = mkTag store tagInt 5 0 1++ tag == Just (LongSigSize 5) || -- 270+ tag == Just (LongArchiveSize 5) || -- 271+ tag == Just (UNIMPLEMENTED (FSSizes [5])) || -- 5004+ tag == Just (LongFileSizes [5]) || -- 5008+ tag == Just (LongSize 5) -- 5009+ `shouldBe` True++ -- tests for tags which use mkString+ forM_ [269,+ 1000, 1001, 1002, 1007, 1010, 1011, 1014, 1015,+ 1020, 1021, 1022, 1023, 1024, 1025, 1026, 1044,+ 1056, 1057, 1058, 1063, 1064, 1079, 1094,+ 1122, 1123, 1124, 1125, 1126, 1131, 1132, 1137,+ 1151, 1152, 1155, 1163, 1170, 1181, 1196,+ 5012, 5013, 5014, 5015, 5016, 5034, 5062, 5083] $ \tagInt -> do+ it ("returns Nothing for `tag' == " ++ show tagInt ++ " and `ty' != 6") $ do+ let store = BS.pack [0]+ let tag = mkTag store tagInt 99 0 0+ tag `shouldBe` Nothing++ it ("returns correct value for `tag' == " ++ show tagInt) $ do+ let store = BC.pack "test-me"+ let tag = mkTag store tagInt 6 0 7++ tag == Just (SHA1Header "test-me") || -- 269+ tag == Just (Name "test-me") || -- 1000+ tag == Just (Version "test-me") || -- 1001+ tag == Just (Release "test-me") || -- 1002+ tag == Just (BuildHost "test-me") || -- 1007+ tag == Just (Distribution "test-me") || -- 1010+ tag == Just (Vendor "test-me") || -- 1011+ tag == Just (License "test-me") || -- 1014+ tag == Just (Packager "test-me") || -- 1015+ tag == Just (URL "test-me") || -- 1020+ tag == Just (OS "test-me") || -- 1021+ tag == Just (Arch "test-me") || -- 1022+ tag == Just (PreIn "test-me") || -- 1023+ tag == Just (PostIn "test-me") || -- 1024+ tag == Just (PreUn "test-me") || -- 1025+ tag == Just (PostUn "test-me") || -- 1026+ tag == Just (SourceRPM "test-me") || -- 1044+ tag == Just (INTERNAL (DEPRECATED (DefaultPrefix "test-me"))) || -- 1056+ tag == Just (INTERNAL (OBSOLETE (BuildRoot "test-me"))) || -- 1057+ tag == Just (INTERNAL (DEPRECATED (InstallPrefix "test-me"))) || -- 1058+ tag == Just (INTERNAL (AutoReqProv "test-me")) || -- 1063+ tag == Just (RPMVersion "test-me") || -- 1064+ tag == Just (VerifyScript "test-me") || -- 1079+ tag == Just (Cookie "test-me") || -- 1094+ tag == Just (OptFlags "test-me") || -- 1122+ tag == Just (DistURL "test-me") || -- 1123+ tag == Just (PayloadFormat "test-me") || -- 1124+ tag == Just (PayloadCompressor "test-me") || -- 1125+ tag == Just (PayloadFlags "test-me") || -- 1126+ tag == Just (INTERNAL (OBSOLETE (RHNPlatform "test-me"))) || -- 1131+ tag == Just (Platform "test-me") || -- 1132+ tag == Just (INTERNAL (OBSOLETE (CachePkgPath "test-me"))) || -- 1137+ tag == Just (PreTrans "test-me") || -- 1151+ tag == Just (PostTrans "test-me") || -- 1152+ tag == Just (DistTag "test-me") || -- 1155+ tag == Just (UNIMPLEMENTED (CVSID "test-me")) || -- 1163+ tag == Just (UNIMPLEMENTED (PackageOrigin "test-me")) || -- 1170+ tag == Just (UNIMPLEMENTED (RepoTag "test-me")) || -- 1181+ tag == Just (NVRA "test-me") || -- 1196+ tag == Just (BugURL "test-me") || -- 5012+ tag == Just (EVR "test-me") || -- 5013+ tag == Just (NVR "test-me") || -- 5014+ tag == Just (NEVR "test-me") || -- 5015+ tag == Just (NEVRA "test-me") || -- 5016+ tag == Just (PolicyVCS "test-me") || -- 5034+ tag == Just (Encoding "test-me") || -- 5062+ tag == Just (INTERNAL (RemovePathPostFixes "test-me")) -- 5083+ `shouldBe` True++ -- tests for tags which use mkBinary+ forM_ [259, 261, 262, 267, 268,+ 1012, 1013, 1043, 1146] $ \tagInt -> do+ it ("returns Nothing for `tag' == " ++ show tagInt ++ " and `ty' != 7") $ do+ let store = BS.pack [0]+ let tag = mkTag store tagInt 99 0 0+ tag `shouldBe` Nothing++ it ("returns correct value for `tag' == " ++ show tagInt) $ do+ let store = BC.pack "test-me"+ let tag = mkTag store tagInt 7 0 7++ tag == Just (SigPGP store) || -- 259+ tag == Just (SigMD5 store) || -- 261+ tag == Just (SigGPG store) || -- 262+ tag == Just (DSAHeader store) || -- 267+ tag == Just (RSAHeader store) || -- 268+ tag == Just (GIF store) || -- 1012+ tag == Just (XPM store) || -- 1013+ tag == Just (Icon store) || -- 1043+ tag == Just (SourcePkgID store) -- 1146+ `shouldBe` True++ -- tests for tags which use mkStringArray+ forM_ [100, 266,+ 1017, 1018, 1019, 1027, 1035, 1036, 1039, 1040,+ 1047, 1049, 1050, 1054, 1055, 1059, 1060, 1061,+ 1062, 1065, 1066, 1067, 1081, 1082, 1085, 1086,+ 1087, 1088, 1089, 1090, 1091, 1092, 1097, 1098,+ 1099, 1113, 1115, 1117, 1118, 1120, 1121, 1133,+ 1135, 1142, 1147, 1148, 1149, 1150, 1153, 1154, 1156,+ 1157, 1159, 1160, 1164, 1165, 1166, 1167, 1167,+ 1168, 1169, 1178, 1182, 1183, 1186, 1188,+ 5000, 5001, 5002, 5003, 5005, 5006, 5007, 5010,+ 5029, 5030, 5031, 5035, 5036, 5038, 5039, 5040,+ 5041, 5042, 5043, 5044, 5046, 5047, 5049, 5050,+ 5052, 5053, 5055, 5056, 5058, 5059, 5060, 5061,+ 5066, 5067, 5069, 5071, 5076, 5077, 5079, 5081,+ 5086, 5087, 5088, 5089, 5090] $ \tagInt -> do+ it ("returns Nothing for `tag' == " ++ show tagInt ++ " and `ty' != 8") $ do+ let store = BS.pack [0]+ let tag = mkTag store tagInt 99 0 0+ tag `shouldBe` Nothing++ it ("returns correct value for `tag' == " ++ show tagInt) $ do+ let store = BC.pack "test-me"+ let tag = mkTag store tagInt 8 0 7++ tag == Just (HeaderI18NTable ["test-me"]) || -- 100+ tag == Just (PubKeys ["test-me"]) || -- 266+ tag == Just (INTERNAL (ChangeLog ["test-me"])) || -- 1017+ tag == Just (Source ["test-me"]) || -- 1018+ tag == Just (Patch ["test-me"]) || -- 1019+ tag == Just (OBSOLETE (OldFileNames ["test-me"])) || -- 1027+ tag == Just (FileMD5s ["test-me"]) || -- 1035+ tag == Just (FileLinkTos ["test-me"]) || -- 1036+ tag == Just (FileUserName ["test-me"]) || -- 1039+ tag == Just (FileGroupName ["test-me"]) || -- 1040+ tag == Just (ProvideName ["test-me"]) || -- 1047+ tag == Just (RequireName ["test-me"]) || -- 1049+ tag == Just (RequireVersion ["test-me"]) || -- 1050+ tag == Just (ConflictName ["test-me"]) || -- 1054+ tag == Just (ConflictVersion ["test-me"]) || -- 1055+ tag == Just (ExcludeArch ["test-me"]) || -- 1059+ tag == Just (ExcludeOS ["test-me"]) || -- 1060+ tag == Just (ExclusiveArch ["test-me"]) || -- 1061+ tag == Just (ExclusiveOS ["test-me"]) || -- 1062+ tag == Just (TriggerScripts ["test-me"]) || -- 1065+ tag == Just (TriggerName ["test-me"]) || -- 1066+ tag == Just (TriggerVersion ["test-me"]) || -- 1067+ tag == Just (ChangeLogName ["test-me"]) || -- 1081+ tag == Just (ChangeLogText ["test-me"]) || -- 1082+ tag == Just (PreInProg ["test-me"]) || -- 1085+ tag == Just (PostInProg ["test-me"]) || -- 1086+ tag == Just (PreUnProg ["test-me"]) || -- 1087+ tag == Just (PostUnProg ["test-me"]) || -- 1088+ tag == Just (BuildArchs ["test-me"]) || -- 1089+ tag == Just (ObsoleteName ["test-me"]) || -- 1090+ tag == Just (VerifyScriptProg ["test-me"]) || -- 1091+ tag == Just (TriggerScriptProg ["test-me"]) || -- 1092+ tag == Just (FileLangs ["test-me"]) || -- 1097+ tag == Just (Prefixes ["test-me"]) || -- 1098+ tag == Just (InstPrefixes ["test-me"]) || -- 1099+ tag == Just (ProvideVersion ["test-me"]) || -- 1113+ tag == Just (ObsoleteVersion ["test-me"]) || -- 1115+ tag == Just (BaseNames ["test-me"]) || -- 1117+ tag == Just (DirNames ["test-me"]) || -- 1118+ tag == Just (OrigBaseNames ["test-me"]) || -- 1120+ tag == Just (OrigDirNames ["test-me"]) || -- 1121+ tag == Just (DEPRECATED (PatchesName ["test-me"])) || -- 1133+ tag == Just (DEPRECATED (PatchesVersion ["test-me"])) || -- 1135+ tag == Just (ClassDict ["test-me"]) || -- 1142+ tag == Just (OBSOLETE (FileContexts ["test-me"])) || -- 1147+ tag == Just (FSContexts ["test-me"]) || -- 1148+ tag == Just (ReContexts ["test-me"]) || -- 1149+ tag == Just (Policies ["test-me"]) || -- 1150+ tag == Just (PreTransProg ["test-me"]) || -- 1153+ tag == Just (PostTransProg ["test-me"]) || -- 1154+ tag == Just (OBSOLETE (OldSuggestsName ["test-me"])) || -- 1156+ tag == Just (OBSOLETE (OldSuggestsVersion ["test-me"])) || -- 1157+ tag == Just (OBSOLETE (OldEnhancesName ["test-me"])) || -- 1159+ tag == Just (OBSOLETE (OldEnhancesVersion ["test-me"])) || -- 1160+ tag == Just (UNIMPLEMENTED (BLinkPkgID ["test-me"])) || -- 1164+ tag == Just (UNIMPLEMENTED (BLinkHdrID ["test-me"])) || -- 1165+ tag == Just (UNIMPLEMENTED (BLinkNEVRA ["test-me"])) || -- 1166+ tag == Just (UNIMPLEMENTED (FLinkPkgID ["test-me"])) || -- 1167+ tag == Just (UNIMPLEMENTED (FLinkHdrID ["test-me"])) || -- 1168+ tag == Just (UNIMPLEMENTED (FLinkNEVRA ["test-me"])) || -- 1169+ tag == Just (UNIMPLEMENTED (Variants["test-me"])) || -- 1178+ tag == Just (UNIMPLEMENTED (Keywords["test-me"])) || -- 1182+ tag == Just (UNIMPLEMENTED (BuildPlatforms["test-me"])) || -- 1183+ tag == Just (UNIMPLEMENTED (XattrsDict["test-me"])) || -- 1186+ tag == Just (UNIMPLEMENTED (DepAttrsDict["test-me"])) || -- 1188+ tag == Just (FileNames ["test-me"]) || -- 5000+ tag == Just (FileProvide ["test-me"]) || -- 5001+ tag == Just (FileRequire ["test-me"]) || -- 5002+ tag == Just (UNIMPLEMENTED (FSNames ["test-me"])) || -- 5003+ tag == Just (TriggerConds ["test-me"]) || -- 5005+ tag == Just (TriggerType ["test-me"]) || -- 5006+ tag == Just (OrigFileNames ["test-me"]) || -- 5007+ tag == Just (FileCaps ["test-me"]) || -- 5010+ tag == Just (UNIMPLEMENTED (Collections ["test-me"])) || -- 5029+ tag == Just (PolicyNames ["test-me"]) || -- 5030+ tag == Just (PolicyTypes ["test-me"]) || -- 5031+ tag == Just (OrderName ["test-me"]) || -- 5035+ tag == Just (OrderVersion ["test-me"]) || -- 5036+ tag == Just (UNIMPLEMENTED (MSSFManifest ["test-me"])) || -- 5038+ tag == Just (UNIMPLEMENTED (MSSFDomain ["test-me"])) || -- 5039+ tag == Just (InstFileNames ["test-me"]) || -- 5040+ tag == Just (RequireNEVRs ["test-me"]) || -- 5041+ tag == Just (ProvideNEVRs ["test-me"]) || -- 5042+ tag == Just (ObsoleteNEVRs ["test-me"]) || -- 5043+ tag == Just (ConflictNEVRs ["test-me"]) || -- 5044+ tag == Just (RecommendName ["test-me"]) || -- 5046+ tag == Just (RecommendVersion ["test-me"]) || -- 5047+ tag == Just (SuggestName ["test-me"]) || -- 5049+ tag == Just (SuggestVersion ["test-me"]) || -- 5050+ tag == Just (SupplementName ["test-me"]) || -- 5052+ tag == Just (SupplementVersion ["test-me"]) || -- 5053+ tag == Just (EnhanceName ["test-me"]) || -- 5055+ tag == Just (EnhanceVersion ["test-me"]) || -- 5056+ tag == Just (RecommendNEVRs ["test-me"]) || -- 5058+ tag == Just (SuggestNEVRs ["test-me"]) || -- 5059+ tag == Just (SupplementNEVRs ["test-me"]) || -- 5060+ tag == Just (EnhanceNEVRs ["test-me"]) || -- 5061+ tag == Just (FileTriggerScripts ["test-me"]) || -- 5066+ tag == Just (FileTriggerScriptProg ["test-me"]) || -- 5067+ tag == Just (FileTriggerName ["test-me"]) || -- 5069+ tag == Just (FileTriggerVersion ["test-me"]) || -- 5071+ tag == Just (TransFileTriggerScripts ["test-me"]) || -- 5076+ tag == Just (TransFileTriggerScriptProg ["test-me"]) || -- 5077+ tag == Just (TransFileTriggerName ["test-me"]) || -- 5079+ tag == Just (TransFileTriggerVersion ["test-me"]) || -- 5081+ tag == Just (FileTriggerConds ["test-me"]) || -- 5086+ tag == Just (FileTriggerType ["test-me"]) || -- 5087+ tag == Just (TransFileTriggerConds ["test-me"]) || -- 5088+ tag == Just (TransFileTriggerType ["test-me"]) || -- 5089+ tag == Just (FileSignatures ["test-me"]) -- 5090+ `shouldBe` True++ -- tests for tags which use mkI18NString+ forM_ [1004, 1005, 1016] $ \tagInt -> do+ it ("returns Nothing for `tag' == " ++ show tagInt ++ " and `ty' != 9") $ do+ let store = BS.pack [0]+ let tag = mkTag store tagInt 99 0 0+ tag `shouldBe` Nothing++ it ("returns correct value for `tag' == " ++ show tagInt) $ do+ let store = BC.pack "test-me"+ let tag = mkTag store tagInt 9 0 7++ tag == Just (Summary store) || -- 1004+ tag == Just (Description store) || -- 1005+ tag == Just (Group store) -- 1016+ `shouldBe` True++ -- tests for tags which use mkString+ forM_ [269,+ 1000, 1001, 1002, 1007, 1010, 1011, 1014, 1015,+ 1020, 1021, 1022, 1023, 1024, 1025, 1026, 1044,+ 1056, 1057, 1058, 1063, 1064, 1079, 1094,+ 1122, 1123, 1124, 1125, 1126, 1131, 1132, 1137,+ 1151, 1152, 1155, 1163, 1170, 1181, 1196,+ 5012, 5013, 5014, 5015, 5016, 5034, 5062, 5083] $ \tagInt -> do+ it ("returns Nothing for `tag' == " ++ show tagInt ++ " and `ty' != 6") $ do+ let store = BS.pack [0]+ let tag = mkTag store tagInt 99 0 0+ tag `shouldBe` Nothing++ it ("returns correct value for `tag' == " ++ show tagInt) $ do+ let store = BC.pack "test-me"+ let tag = mkTag store tagInt 6 0 7++ tag == Just (SHA1Header "test-me") || -- 269+ tag == Just (Name "test-me") || -- 1000+ tag == Just (Version "test-me") || -- 1001+ tag == Just (Release "test-me") || -- 1002+ tag == Just (BuildHost "test-me") || -- 1007+ tag == Just (Distribution "test-me") || -- 1010+ tag == Just (Vendor "test-me") || -- 1011+ tag == Just (License "test-me") || -- 1014+ tag == Just (Packager "test-me") || -- 1015+ tag == Just (URL "test-me") || -- 1020+ tag == Just (OS "test-me") || -- 1021+ tag == Just (Arch "test-me") || -- 1022+ tag == Just (PreIn "test-me") || -- 1023+ tag == Just (PostIn "test-me") || -- 1024+ tag == Just (PreUn "test-me") || -- 1025+ tag == Just (PostUn "test-me") || -- 1026+ tag == Just (SourceRPM "test-me") || -- 1044+ tag == Just (INTERNAL (DEPRECATED (DefaultPrefix "test-me"))) || -- 1056+ tag == Just (INTERNAL (OBSOLETE (BuildRoot "test-me"))) || -- 1057+ tag == Just (INTERNAL (DEPRECATED (InstallPrefix "test-me"))) || -- 1058+ tag == Just (INTERNAL (AutoReqProv "test-me")) || -- 1063+ tag == Just (RPMVersion "test-me") || -- 1064+ tag == Just (VerifyScript "test-me") || -- 1079+ tag == Just (Cookie "test-me") || -- 1094+ tag == Just (OptFlags "test-me") || -- 1122+ tag == Just (DistURL "test-me") || -- 1123+ tag == Just (PayloadFormat "test-me") || -- 1124+ tag == Just (PayloadCompressor "test-me") || -- 1125+ tag == Just (PayloadFlags "test-me") || -- 1126+ tag == Just (INTERNAL (OBSOLETE (RHNPlatform "test-me"))) || -- 1131+ tag == Just (Platform "test-me") || -- 1132+ tag == Just (INTERNAL (OBSOLETE (CachePkgPath "test-me"))) || -- 1137+ tag == Just (PreTrans "test-me") || -- 1151+ tag == Just (PostTrans "test-me") || -- 1152+ tag == Just (DistTag "test-me") || -- 1155+ tag == Just (UNIMPLEMENTED (CVSID "test-me")) || -- 1163+ tag == Just (UNIMPLEMENTED (PackageOrigin "test-me")) || -- 1170+ tag == Just (UNIMPLEMENTED (RepoTag "test-me")) || -- 1181+ tag == Just (NVRA "test-me") || -- 1196+ tag == Just (BugURL "test-me") || -- 5012+ tag == Just (EVR "test-me") || -- 5013+ tag == Just (NVR "test-me") || -- 5014+ tag == Just (NEVR "test-me") || -- 5015+ tag == Just (NEVRA "test-me") || -- 5016+ tag == Just (PolicyVCS "test-me") || -- 5034+ tag == Just (Encoding "test-me") || -- 5062+ tag == Just (INTERNAL (RemovePathPostFixes "test-me")) -- 5083+ `shouldBe` True++ -- tests for tags which use mkStringArray+ forM_ [100, 266,+ 1017, 1018, 1019, 1027, 1035, 1036, 1039, 1040,+ 1047, 1049, 1050, 1054, 1055, 1059, 1060, 1061,+ 1062, 1065, 1066, 1067, 1081, 1082, 1085, 1086,+ 1087, 1088, 1089, 1090, 1091, 1092, 1097, 1098,+ 1099, 1113, 1115, 1117, 1118, 1120, 1121, 1133,+ 1135, 1142, 1147, 1148, 1149, 1150, 1153, 1154, 1156,+ 1157, 1159, 1160, 1164, 1165, 1166, 1167, 1167,+ 1168, 1169, 1178, 1182, 1183, 1186, 1188,+ 5000, 5001, 5002, 5003, 5005, 5006, 5007, 5010,+ 5029, 5030, 5031, 5035, 5036, 5038, 5039, 5040,+ 5041, 5042, 5043, 5044, 5046, 5047, 5049, 5050,+ 5052, 5053, 5055, 5056, 5058, 5059, 5060, 5061,+ 5066, 5067, 5069, 5071, 5076, 5077, 5079, 5081,+ 5086, 5087, 5088, 5089, 5090] $ \tagInt -> do+ it ("returns Nothing for `tag' == " ++ show tagInt ++ " and `ty' != 8") $ do+ let store = BS.pack [0]+ let tag = mkTag store tagInt 99 0 0+ tag `shouldBe` Nothing++ it ("returns correct value for `tag' == " ++ show tagInt) $ do+ let store = BC.pack "test-me"+ let tag = mkTag store tagInt 8 0 7++ tag == Just (HeaderI18NTable ["test-me"]) || -- 100+ tag == Just (PubKeys ["test-me"]) || -- 266+ tag == Just (INTERNAL (ChangeLog ["test-me"])) || -- 1017+ tag == Just (Source ["test-me"]) || -- 1018+ tag == Just (Patch ["test-me"]) || -- 1019+ tag == Just (OBSOLETE (OldFileNames ["test-me"])) || -- 1027+ tag == Just (FileMD5s ["test-me"]) || -- 1035+ tag == Just (FileLinkTos ["test-me"]) || -- 1036+ tag == Just (FileUserName ["test-me"]) || -- 1039+ tag == Just (FileGroupName ["test-me"]) || -- 1040+ tag == Just (ProvideName ["test-me"]) || -- 1047+ tag == Just (RequireName ["test-me"]) || -- 1049+ tag == Just (RequireVersion ["test-me"]) || -- 1050+ tag == Just (ConflictName ["test-me"]) || -- 1054+ tag == Just (ConflictVersion ["test-me"]) || -- 1055+ tag == Just (ExcludeArch ["test-me"]) || -- 1059+ tag == Just (ExcludeOS ["test-me"]) || -- 1060+ tag == Just (ExclusiveArch ["test-me"]) || -- 1061+ tag == Just (ExclusiveOS ["test-me"]) || -- 1062+ tag == Just (TriggerScripts ["test-me"]) || -- 1065+ tag == Just (TriggerName ["test-me"]) || -- 1066+ tag == Just (TriggerVersion ["test-me"]) || -- 1067+ tag == Just (ChangeLogName ["test-me"]) || -- 1081+ tag == Just (ChangeLogText ["test-me"]) || -- 1082+ tag == Just (PreInProg ["test-me"]) || -- 1085+ tag == Just (PostInProg ["test-me"]) || -- 1086+ tag == Just (PreUnProg ["test-me"]) || -- 1087+ tag == Just (PostUnProg ["test-me"]) || -- 1088+ tag == Just (BuildArchs ["test-me"]) || -- 1089+ tag == Just (ObsoleteName ["test-me"]) || -- 1090+ tag == Just (VerifyScriptProg ["test-me"]) || -- 1091+ tag == Just (TriggerScriptProg ["test-me"]) || -- 1092+ tag == Just (FileLangs ["test-me"]) || -- 1097+ tag == Just (Prefixes ["test-me"]) || -- 1098+ tag == Just (InstPrefixes ["test-me"]) || -- 1099+ tag == Just (ProvideVersion ["test-me"]) || -- 1113+ tag == Just (ObsoleteVersion ["test-me"]) || -- 1115+ tag == Just (BaseNames ["test-me"]) || -- 1117+ tag == Just (DirNames ["test-me"]) || -- 1118+ tag == Just (OrigBaseNames ["test-me"]) || -- 1120+ tag == Just (OrigDirNames ["test-me"]) || -- 1121+ tag == Just (DEPRECATED (PatchesName ["test-me"])) || -- 1133+ tag == Just (DEPRECATED (PatchesVersion ["test-me"])) || -- 1135+ tag == Just (ClassDict ["test-me"]) || -- 1142+ tag == Just (OBSOLETE (FileContexts ["test-me"])) || -- 1147+ tag == Just (FSContexts ["test-me"]) || -- 1148+ tag == Just (ReContexts ["test-me"]) || -- 1149+ tag == Just (Policies ["test-me"]) || -- 1150+ tag == Just (PreTransProg ["test-me"]) || -- 1153+ tag == Just (PostTransProg ["test-me"]) || -- 1154+ tag == Just (OBSOLETE (OldSuggestsName ["test-me"])) || -- 1156+ tag == Just (OBSOLETE (OldSuggestsVersion ["test-me"])) || -- 1157+ tag == Just (OBSOLETE (OldEnhancesName ["test-me"])) || -- 1159+ tag == Just (OBSOLETE (OldEnhancesVersion ["test-me"])) || -- 1160+ tag == Just (UNIMPLEMENTED (BLinkPkgID ["test-me"])) || -- 1164+ tag == Just (UNIMPLEMENTED (BLinkHdrID ["test-me"])) || -- 1165+ tag == Just (UNIMPLEMENTED (BLinkNEVRA ["test-me"])) || -- 1166+ tag == Just (UNIMPLEMENTED (FLinkPkgID ["test-me"])) || -- 1167+ tag == Just (UNIMPLEMENTED (FLinkHdrID ["test-me"])) || -- 1168+ tag == Just (UNIMPLEMENTED (FLinkNEVRA ["test-me"])) || -- 1169+ tag == Just (UNIMPLEMENTED (Variants["test-me"])) || -- 1178+ tag == Just (UNIMPLEMENTED (Keywords["test-me"])) || -- 1182+ tag == Just (UNIMPLEMENTED (BuildPlatforms["test-me"])) || -- 1183+ tag == Just (UNIMPLEMENTED (XattrsDict["test-me"])) || -- 1186+ tag == Just (UNIMPLEMENTED (DepAttrsDict["test-me"])) || -- 1188+ tag == Just (FileNames ["test-me"]) || -- 5000+ tag == Just (FileProvide ["test-me"]) || -- 5001+ tag == Just (FileRequire ["test-me"]) || -- 5002+ tag == Just (UNIMPLEMENTED (FSNames ["test-me"])) || -- 5003+ tag == Just (TriggerConds ["test-me"]) || -- 5005+ tag == Just (TriggerType ["test-me"]) || -- 5006+ tag == Just (OrigFileNames ["test-me"]) || -- 5007+ tag == Just (FileCaps ["test-me"]) || -- 5010+ tag == Just (UNIMPLEMENTED (Collections ["test-me"])) || -- 5029+ tag == Just (PolicyNames ["test-me"]) || -- 5030+ tag == Just (PolicyTypes ["test-me"]) || -- 5031+ tag == Just (OrderName ["test-me"]) || -- 5035+ tag == Just (OrderVersion ["test-me"]) || -- 5036+ tag == Just (UNIMPLEMENTED (MSSFManifest ["test-me"])) || -- 5038+ tag == Just (UNIMPLEMENTED (MSSFDomain ["test-me"])) || -- 5039+ tag == Just (InstFileNames ["test-me"]) || -- 5040+ tag == Just (RequireNEVRs ["test-me"]) || -- 5041+ tag == Just (ProvideNEVRs ["test-me"]) || -- 5042+ tag == Just (ObsoleteNEVRs ["test-me"]) || -- 5043+ tag == Just (ConflictNEVRs ["test-me"]) || -- 5044+ tag == Just (RecommendName ["test-me"]) || -- 5046+ tag == Just (RecommendVersion ["test-me"]) || -- 5047+ tag == Just (SuggestName ["test-me"]) || -- 5049+ tag == Just (SuggestVersion ["test-me"]) || -- 5050+ tag == Just (SupplementName ["test-me"]) || -- 5052+ tag == Just (SupplementVersion ["test-me"]) || -- 5053+ tag == Just (EnhanceName ["test-me"]) || -- 5055+ tag == Just (EnhanceVersion ["test-me"]) || -- 5056+ tag == Just (RecommendNEVRs ["test-me"]) || -- 5058+ tag == Just (SuggestNEVRs ["test-me"]) || -- 5059+ tag == Just (SupplementNEVRs ["test-me"]) || -- 5060+ tag == Just (EnhanceNEVRs ["test-me"]) || -- 5061+ tag == Just (FileTriggerScripts ["test-me"]) || -- 5066+ tag == Just (FileTriggerScriptProg ["test-me"]) || -- 5067+ tag == Just (FileTriggerName ["test-me"]) || -- 5069+ tag == Just (FileTriggerVersion ["test-me"]) || -- 5071+ tag == Just (TransFileTriggerScripts ["test-me"]) || -- 5076+ tag == Just (TransFileTriggerScriptProg ["test-me"]) || -- 5077+ tag == Just (TransFileTriggerName ["test-me"]) || -- 5079+ tag == Just (TransFileTriggerVersion ["test-me"]) || -- 5081+ tag == Just (FileTriggerConds ["test-me"]) || -- 5086+ tag == Just (FileTriggerType ["test-me"]) || -- 5087+ tag == Just (TransFileTriggerConds ["test-me"]) || -- 5088+ tag == Just (TransFileTriggerType ["test-me"]) || -- 5089+ tag == Just (FileSignatures ["test-me"]) -- 5090+ `shouldBe` True++ -- tests for tags which use mkI18NString+ forM_ [1004, 1005, 1016] $ \tagInt -> do+ it ("returns Nothing for `tag' == " ++ show tagInt ++ " and `ty' != 9") $ do+ let store = BS.pack [0]+ let tag = mkTag store tagInt 99 0 0+ tag `shouldBe` Nothing++ it ("returns correct value for `tag' == " ++ show tagInt) $ do+ let store = BC.pack "test-me"+ let tag = mkTag store tagInt 9 0 7++ tag == Just (Summary store) || -- 1004+ tag == Just (Description store) || -- 1005+ tag == Just (Group store) -- 1016+ `shouldBe` True++ it "mkTag returns Nothing when store is empty" $ do+ mkTag (BC.pack "") 1029 1 0 1 `shouldBe` Nothing -- mkChar+ mkTag (BC.pack []) 1030 3 0 1 `shouldBe` Nothing -- mkWord16+ mkTag (BS.pack []) 1003 4 0 1 `shouldBe` Nothing -- mkWord32+ mkTag (BS.pack []) 270 5 0 1 `shouldBe` Nothing -- mkWord64+ mkTag (BS.pack []) 259 7 0 1 `shouldBe` Nothing -- mkBinary+ mkTag (BC.pack "") 100 8 0 1 `shouldBe` Nothing -- mkStringArray+ mkTag (BC.pack "") 1000 6 0 7 `shouldBe` Nothing -- mkString+ mkTag (BC.pack "") 1004 9 0 7 `shouldBe` Nothing -- mkI18NString++ it "mkTag -> mkNull returns valid data even when store is empty" $+ -- because mkNull doesn't read from the store+ mkTag (BS.pack []) 61 0 0 1 `shouldBe` Just (HeaderImage Null)
+ tests/Codec/RPM/TypesSpec.hs view
@@ -0,0 +1,16 @@+module Codec.RPM.TypesSpec (spec) where++import Test.Hspec+import Codec.RPM.Types(SectionHeader(..))++spec :: Spec+spec = describe "Codec.RPM.Types" $+ describe "SectionHeader" $ do+ it "is equal to itself" $ do+ let header_1 = SectionHeader 0 1 1+ header_1 == header_1 `shouldBe` True++ it "is not equal to another" $ do+ let header_1 = SectionHeader 0 1 1+ let header_2 = SectionHeader 1 1 1+ header_1 /= header_2 `shouldBe` True
+ tests/Codec/RPM/VersionSpec.hs view
@@ -0,0 +1,366 @@+{-# LANGUAGE OverloadedStrings #-}++module Codec.RPM.VersionSpec (spec) where++import Test.Hspec+import Data.Foldable(forM_)+import qualified Data.Text as T+import Codec.RPM.Version(DepRequirement(..), EVR(..), parseDepRequirement, parseEVR, satisfies, vercmp)+import qualified Codec.RPM.Version as RPM(DepOrdering(..))++spec :: Spec+spec = do+ describe "Codec.RPM.Version.vercmp" $ do+ let vercmpCases = [+ ("1.0", "1.0", EQ),+ ("1.0", "2.0", LT),+ ("2.0", "1.0", GT),++ ("2.0.1", "2.0.1", EQ),+ ("2.0", "2.0.1", LT),+ ("2.0.1", "2.0", GT),++ ("2.0.1a", "2.0.1a", EQ),+ ("2.0.1a", "2.0.1", GT),+ ("2.0.1", "2.0.1a", LT),++ ("5.5p1", "5.5p1", EQ),+ ("5.5p1", "5.5p2", LT),+ ("5.5p2", "5.5p1", GT),++ ("5.5p10", "5.5p10", EQ),+ ("5.5p1", "5.5p10", LT),+ ("5.5p10", "5.5p1", GT),++ ("10xyz", "10.1xyz", LT),+ ("10.1xyz", "10xyz", GT),++ ("xyz10", "xyz10", EQ),+ ("xyz10", "xyz10.1", LT),+ ("xyz10.1", "xyz10", GT),++ ("xyz.4", "xyz.4", EQ),+ ("xyz.4", "8", LT),+ ("8", "xyz.4", GT),+ ("xyz.4", "2", LT),+ ("2", "xyz.4", GT),++ ("5.5p2", "5.6p1", LT),+ ("5.6p1", "5.5p2", GT),++ ("5.6p1", "6.5p1", LT),+ ("6.5p1", "5.6p1", GT),++ ("6.0.rc1", "6.0", GT),+ ("6.0", "6.0.rc1", LT),++ ("10b2", "10a1", GT),+ ("10a2", "10b2", LT),+ ("1.0aa", "1.0aa", EQ),+ ("1.0a", "1.0aa", LT),+ ("1.0aa", "1.0a", GT),++ ("10.0001", "10.0001", EQ),+ ("10.0001", "10.1", EQ),+ ("10.1", "10.0001", EQ),+ ("10.0001", "10.0039", LT),+ ("10.0039", "10.0001", GT),++ ("4.999.9", "5.0", LT),+ ("5.0", "4.999.9", GT),++ ("20101121", "20101121", EQ),+ ("20101121", "20101122", LT),+ ("20101122", "20101121", GT),++ ("2_0", "2_0", EQ),+ ("2.0", "2_0", EQ),+ ("2_0", "2.0", EQ),++ ("a", "a", EQ),+ ("a+", "a+", EQ),+ ("a+", "a_", EQ),+ ("a_", "a+", EQ),+ ("+a", "+a", EQ),+ ("+a", "_a", EQ),+ ("_a", "+a", EQ),+ ("+_", "+_", EQ),+ ("_+", "+_", EQ),+ ("_+", "_+", EQ),+ ("+", "_", EQ),+ ("_", "+", EQ),++ ("1.0~rc1", "1.0~rc1", EQ),+ ("1.0~rc1", "1.0", LT),+ ("1.0", "1.0~rc1", GT),+ ("1.0~rc1", "1.0~rc2", LT),+ ("1.0~rc2", "1.0~rc1", GT),+ ("1.0~rc1~git123", "1.0~rc1~git123", EQ),+ ("1.0~rc1~git123", "1.0~rc1", LT),+ ("1.0~rc1", "1.0~rc1~git123", GT)+ ]++ forM_ vercmpCases $ \(verA, verB, ord) ->+ it (T.unpack verA ++ " " ++ show ord ++ " " ++ T.unpack verB) $+ vercmp verA verB `shouldBe` ord++ describe "Codec.RPM.Version.EVR Ord" $ do+ let ordCases = [+ (EVR{epoch=Nothing, version="1.0", release="1"}, EVR{epoch=Nothing, version="1.0", release="1"}, EQ),+ (EVR{epoch=Just 0, version="1.0", release="1"}, EVR{epoch=Nothing, version="1.0", release="1"}, EQ),+ (EVR{epoch=Just 1, version="1.0", release="1"}, EVR{epoch=Nothing, version="1.0", release="1"}, GT),+ (EVR{epoch=Nothing, version="1.0", release="1"}, EVR{epoch=Nothing, version="1.1", release="1"}, LT),+ (EVR{epoch=Nothing, version="1.0", release="1"}, EVR{epoch=Nothing, version="1.0", release="2"}, LT),++ (EVR{epoch=Just 8, version="3.6.9", release="11.fc100"}, EVR{epoch=Just 3, version="3.6.9", release="11.fc100"}, GT),+ (EVR{epoch=Just 8, version="3.6.9", release="11.fc100"}, EVR{epoch=Just 11, version="3.6.9", release="11.fc100"}, LT),+ (EVR{epoch=Just 8, version="3.6.9", release="11.fc100"}, EVR{epoch=Just 8, version="7.0", release="11.fc100"}, LT),+ (EVR{epoch=Just 8, version="3.6.9", release="11.fc100"}, EVR{epoch=Just 8, version="", release="11.fc100"}, GT),+ (EVR{epoch=Just 8, version="", release="11.fc100"}, EVR{epoch=Just 8, version="", release="11.fc100"}, EQ),++ (EVR{epoch=Nothing, version="1.1", release="1"}, EVR{epoch=Nothing, version="1.01", release="1"}, EQ),+ (EVR{epoch=Nothing, version="1..1", release="1"}, EVR{epoch=Nothing, version="1.1", release="1"}, EQ)+ ]++ forM_ ordCases $ \(verA, verB, ord) ->+ it (show verA ++ " " ++ show ord ++ " " ++ show verB) $+ compare verA verB `shouldBe` ord++ describe "Codec.RPM.Version.satisfies" $ do+ let satisfiesCases = [+ ("no", "match", False),++ ("thing", "thing", True),+ ("thing", "thing >= 1.0-1", True),+ ("thing >= 1.0-1", "thing", True),++ ("thing = 1.0-1", "thing = 1.0-1", True),+ ("thing = 1.0-1", "thing >= 1.0-1", True),+ ("thing = 1.0-1", "thing > 1.0-1", False),+ ("thing = 1.0-1", "thing < 1.0-1", False),+ ("thing = 1.0-1", "thing <= 1.0-1", True),++ ("thing = 1.0", "thing = 1.0-9", True),+ ("thing = 1.0", "thing < 1.0-9", True),+ ("thing = 1.0", "thing <= 1.0-9", True),+ ("thing = 1.0", "thing >= 1.0-9", True),+ ("thing = 1.0", "thing > 1.0-9", True),++ ("thing = 1.0", "thing = 1.0", True),+ ("thing = 1.0", "thing < 1.0", False),+ ("thing = 1.0", "thing > 1.0", False),+ ("thing = 1.0", "thing >= 1.0", True),+ ("thing = 1.0", "thing <= 1.0", True),++ ("thing < 1.0", "thing = 1.0", False),+ ("thing < 1.0", "thing < 1.0", True),+ ("thing < 1.0", "thing > 1.0", False),+ ("thing < 1.0", "thing >= 1.0", False),+ ("thing < 1.0", "thing <= 1.0", True),++ ("thing > 1.0", "thing = 1.0", False),+ ("thing > 1.0", "thing < 1.0", False),+ ("thing > 1.0", "thing > 1.0", True),+ ("thing > 1.0", "thing >= 1.0", True),+ ("thing > 1.0", "thing <= 1.0", False),++ ("thing >= 1.0", "thing = 1.0", True),+ ("thing >= 1.0", "thing < 1.0", False),+ ("thing >= 1.0", "thing > 1.0", True),+ ("thing >= 1.0", "thing >= 1.0", True),+ ("thing >= 1.0", "thing <= 1.0", True),++ ("thing <= 1.0", "thing = 1.0", True),+ ("thing <= 1.0", "thing < 1.0", True),+ ("thing <= 1.0", "thing > 1.0", False),+ ("thing <= 1.0", "thing >= 1.0", True),+ ("thing <= 1.0", "thing <= 1.0", True),++ -- test versions without releases+ ("thing <= 1.0", "thing = 1.0-9", True),+ ("thing <= 1.0", "thing < 1.0-9", True),+ ("thing <= 1.0", "thing <= 1.0-9", True),+ ("thing <= 1.0", "thing >= 1.0-9", True),+ ("thing <= 1.0", "thing > 1.0-9", True),++ ("thing >= 1.0", "thing = 1.0-9", True),+ ("thing >= 1.0", "thing < 1.0-9", True),+ ("thing >= 1.0", "thing <= 1.0-9", True),+ ("thing >= 1.0", "thing >= 1.0-9", True),+ ("thing >= 1.0", "thing > 1.0-9", True),++ -- test versions without releases by swapping the order+ ("thing <= 1.0-8", "thing = 1.0", True),+ ("thing <= 1.0-8", "thing < 1.0", True),+ ("thing <= 1.0-8", "thing <= 1.0", True),+ ("thing <= 1.0-8", "thing >= 1.0", True),+ ("thing <= 1.0-8", "thing > 1.0", True),++ ("thing >= 1.0-8", "thing = 1.0", True),+ ("thing >= 1.0-8", "thing < 1.0", False),+ ("thing >= 1.0-8", "thing <= 1.0", True),+ ("thing >= 1.0-8", "thing >= 1.0", True),+ ("thing >= 1.0-8", "thing > 1.0", True),++ ("thing = 1.0-9", "thing = 1.0-9", True),+ ("thing < 1.0-9", "thing = 1.0-9", False),+ ("thing <= 1.0-9", "thing = 1.0-9", True),+ ("thing > 1.0-9", "thing = 1.0-9", False),+ ("thing >= 1.0-9", "thing = 1.0-9", True),++ ("thing >= 1.0-1", "thing = 1.0-1", True),+ ("thing >= 1.0-1", "thing >= 1.0-1", True),+ ("thing >= 1.0-1", "thing > 1.0-1", True),+ ("thing >= 1.0-1", "thing < 1.0-1", False),+ ("thing >= 1.0-1", "thing <= 1.0-1", True),++ ("thing > 1.0-1", "thing = 1.0-1", False),+ ("thing > 1.0-1", "thing >= 1.0-1", True),+ ("thing > 1.0-1", "thing > 1.0-1", True),+ ("thing > 1.0-1", "thing < 1.0-1", False),+ ("thing > 1.0-1", "thing <= 1.0-1", False),++ ("thing < 1.0-1", "thing = 1.0-1", False),+ ("thing < 1.0-1", "thing >= 1.0-1", False),+ ("thing < 1.0-1", "thing > 1.0-1", False),+ ("thing < 1.0-1", "thing < 1.0-1", True),+ ("thing < 1.0-1", "thing <= 1.0-1", True),++ ("thing <= 1.0-1", "thing = 1.0-1", True),+ ("thing <= 1.0-1", "thing >= 1.0-1", True),+ ("thing <= 1.0-1", "thing > 1.0-1", False),+ ("thing <= 1.0-1", "thing < 1.0-1", True),+ ("thing <= 1.0-1", "thing <= 1.0-1", True),++ ("thing = 9.0", "thing = 1.0-1", False),+ ("thing = 9.0", "thing >= 1.0-1", True),+ ("thing = 9.0", "thing > 1.0-1", True),+ ("thing = 9.0", "thing <= 1.0-1", False),+ ("thing = 9.0", "thing < 1.0-1", False),++ ("thing < 9.0", "thing = 1.0-1", True),+ ("thing < 9.0", "thing >= 1.0-1", True),+ ("thing < 9.0", "thing > 1.0-1", True),+ ("thing < 9.0", "thing <= 1.0-1", True),+ ("thing < 9.0", "thing < 1.0-1", True),++ ("thing <= 9.0", "thing = 1.0-1", True),+ ("thing <= 9.0", "thing >= 1.0-1", True),+ ("thing <= 9.0", "thing > 1.0-1", True),+ ("thing <= 9.0", "thing <= 1.0-1", True),+ ("thing <= 9.0", "thing < 1.0-1", True),++ ("thing > 9.0", "thing = 1.0-1", False),+ ("thing > 9.0", "thing >= 1.0-1", True),+ ("thing > 9.0", "thing > 1.0-1", True),+ ("thing > 9.0", "thing <= 1.0-1", False),+ ("thing > 9.0", "thing < 1.0-1", False),++ ("thing >= 9.0", "thing = 1.0-1", False),+ ("thing >= 9.0", "thing >= 1.0-1", True),+ ("thing >= 9.0", "thing > 1.0-1", True),+ ("thing >= 9.0", "thing <= 1.0-1", False),+ ("thing >= 9.0", "thing < 1.0-1", False),++ ("thing = 1.0", "thing = 9.0-1", False),+ ("thing = 1.0", "thing >= 9.0-1", False),+ ("thing = 1.0", "thing > 9.0-1", False),+ ("thing = 1.0", "thing <= 9.0-1", True),+ ("thing = 1.0", "thing < 9.0-1", True),++ ("thing < 1.0", "thing = 9.0-1", False),+ ("thing < 1.0", "thing >= 9.0-1", False),+ ("thing < 1.0", "thing > 9.0-1", False),+ ("thing < 1.0", "thing <= 9.0-1", True),+ ("thing < 1.0", "thing < 9.0-1", True),++ ("thing <= 1.0", "thing = 9.0-1", False),+ ("thing <= 1.0", "thing >= 9.0-1", False),+ ("thing <= 1.0", "thing > 9.0-1", False),+ ("thing <= 1.0", "thing <= 9.0-1", True),+ ("thing <= 1.0", "thing < 9.0-1", True),++ ("thing >= 1.0", "thing = 9.0-1", True),+ ("thing >= 1.0", "thing >= 9.0-1", True),+ ("thing >= 1.0", "thing > 9.0-1", True),+ ("thing >= 1.0", "thing <= 9.0-1", True),+ ("thing >= 1.0", "thing < 9.0-1", True),++ ("thing > 1.0", "thing = 9.0-1", True),+ ("thing > 1.0", "thing >= 9.0-1", True),+ ("thing > 1.0", "thing > 9.0-1", True),+ ("thing > 1.0", "thing <= 9.0-1", True),+ ("thing > 1.0", "thing < 9.0-1", True)+ ]++ forM_ satisfiesCases $ \(v1, v2, b) ->+ it (T.unpack v1 ++ " " ++ T.unpack v2 ++ ": " ++ show b) $+ case (parseDepRequirement v1, parseDepRequirement v2) of+ (Right verA, Right verB) -> satisfies verA verB `shouldBe` b+ _ -> expectationFailure "Unable to parse versions"++ describe "Codec.RPM.Version.parseEVR" $ do+ let parseEVRCases = [+ ("1.0-11.fc100", Right EVR{epoch=Nothing, version="1.0", release="11.fc100"}),+ ("0:1.0-11.fc100", Right EVR{epoch=Just 0, version="1.0", release="11.fc100"}),+ ("8:1.0-11.fc100", Right EVR{epoch=Just 8, version="1.0", release="11.fc100"}),+ ("1.0", Right EVR{epoch=Nothing, version="1.0", release=""}),+ ("8:1.0", Right EVR{epoch=Just 8, version="1.0", release=""}),++ -- missing epoch+ (":1.0-11.fc100", Left ()),++ -- missing version+ ("0:-11.fc100", Left ()),++ -- missing release+ ("0:1.0-", Left ()),++ -- invalid epochs+ ("-1:1.0-100.fc11", Left ()),+ ("A:1.0-100.fc11", Left ()),+ ("8589934592:1.0-100.fc11", Left ()),++ -- invalid versions+ ("0:1.0:0-100.fc11", Left ()),+ ("0:1.0&0-100.fc11", Left ()),+ ("0:1.0\x01f32e\&0-100.fc11", Left ()),++ -- invalid releases+ ("0:1.0-100.fc:11", Left ()),+ ("0:1.0-100.fc&11", Left ()),+ ("0:1.0-100.fc\x01f32e\&11", Left ())+ ]++ -- For the error cases, we don't actually care about the contents of the error, so just+ -- make sure parseEVR returns a Left. Also, the Either returned by parseEVR is not the+ -- same type as the ones in the test cases (ParseError vs. ()), so unwrap the Right EVR+ -- cases to compare.+ -- Making fake ParseErrors is hard, so the Either returned by parseEVR is not the same type+ -- as the either in the test data (ParseError vs. ()). Unwrap the Right values to compare EVRs,+ -- and for parse errors just check that parseEVR returns a Left.+ forM_ parseEVRCases $ \(str, result) ->+ it (T.unpack str) $ case (result, parseEVR str) of+ (Right evr1, Right evr2) -> evr1 `shouldBe` evr2+ (Left _, Right evr) -> expectationFailure $ "bad string parsed as: " ++ show evr+ (Right _, Left err) -> expectationFailure $ "unable to parse valid EVR: " ++ show err+ _ -> return ()++ describe "Codec.RPM.Version.parseDepRequirement" $ do+ let parseDepRequirementCases = [+ ("libthing", DepRequirement "libthing" Nothing),+ ("libthing >= 1.0", DepRequirement "libthing" $ Just (RPM.GTE, EVR{epoch=Nothing, version="1.0", release=""})),+ ("libthing > 1.0", DepRequirement "libthing" $ Just (RPM.GT, EVR{epoch=Nothing, version="1.0", release=""})),+ ("libthing = 1.0", DepRequirement "libthing" $ Just (RPM.EQ, EVR{epoch=Nothing, version="1.0", release=""})),+ ("libthing < 1.0", DepRequirement "libthing" $ Just (RPM.LT, EVR{epoch=Nothing, version="1.0", release=""})),+ ("libthing <= 1.0", DepRequirement "libthing" $ Just (RPM.LTE, EVR{epoch=Nothing, version="1.0", release=""})),++ -- sometimes an RPM will have an invalid version in a Requires/Provides line.+ -- make sure the whole thing gets parsed as a name+ ("httpd-mmn = 20120211-x86-64", DepRequirement "httpd-mmn = 20120211-x86-64" Nothing)+ ]++ forM_ parseDepRequirementCases $ \(str, result) ->+ it (T.unpack str) $ case parseDepRequirement str of+ Right dr -> dr `shouldBe` result+ Left err -> expectationFailure $ "failed to parse DepRequirement: " ++ show err
+ tests/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}