diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,3 @@
+## 0.1.0
+
+* Initial release.
diff --git a/Codec/RPM/Internal/Numbers.hs b/Codec/RPM/Internal/Numbers.hs
new file mode 100644
--- /dev/null
+++ b/Codec/RPM/Internal/Numbers.hs
@@ -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 .
+
+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)
diff --git a/Codec/RPM/Parse.hs b/Codec/RPM/Parse.hs
new file mode 100644
--- /dev/null
+++ b/Codec/RPM/Parse.hs
@@ -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)
diff --git a/Codec/RPM/Tags.hs b/Codec/RPM/Tags.hs
new file mode 100644
--- /dev/null
+++ b/Codec/RPM/Tags.hs
@@ -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
diff --git a/Codec/RPM/Types.hs b/Codec/RPM/Types.hs
new file mode 100644
--- /dev/null
+++ b/Codec/RPM/Types.hs
@@ -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) ]
diff --git a/Codec/RPM/Version.hs b/Codec/RPM/Version.hs
new file mode 100644
--- /dev/null
+++ b/Codec/RPM/Version.hs
@@ -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)
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -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.
+
+
+ Copyright (C)
+
+ 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.
+
+ , 1 April 1990
+ Ty Coon, President of Vice
+
+That's all there is to it!
diff --git a/Makefile b/Makefile
new file mode 100644
--- /dev/null
+++ b/Makefile
@@ -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
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -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
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -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 .
+
+import Distribution.Simple
+main = defaultMain
diff --git a/codec-rpm.cabal b/codec-rpm.cabal
new file mode 100644
--- /dev/null
+++ b/codec-rpm.cabal
@@ -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
diff --git a/examples/inspect.hs b/examples/inspect.hs
new file mode 100644
--- /dev/null
+++ b/examples/inspect.hs
@@ -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 .
+
+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
diff --git a/examples/rpm2json.hs b/examples/rpm2json.hs
new file mode 100644
--- /dev/null
+++ b/examples/rpm2json.hs
@@ -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 .
+
+{-# 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
diff --git a/examples/unrpm.hs b/examples/unrpm.hs
new file mode 100644
--- /dev/null
+++ b/examples/unrpm.hs
@@ -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 .
+
+{-# 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
diff --git a/tests/Codec/RPM/ParseSpec.hs b/tests/Codec/RPM/ParseSpec.hs
new file mode 100644
--- /dev/null
+++ b/tests/Codec/RPM/ParseSpec.hs
@@ -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
diff --git a/tests/Codec/RPM/Parse_parseRPMSpec.hs b/tests/Codec/RPM/Parse_parseRPMSpec.hs
new file mode 100644
--- /dev/null
+++ b/tests/Codec/RPM/Parse_parseRPMSpec.hs
@@ -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
diff --git a/tests/Codec/RPM/Tags_TagSpec.hs b/tests/Codec/RPM/Tags_TagSpec.hs
new file mode 100644
--- /dev/null
+++ b/tests/Codec/RPM/Tags_TagSpec.hs
@@ -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
diff --git a/tests/Codec/RPM/Tags_findSpec.hs b/tests/Codec/RPM/Tags_findSpec.hs
new file mode 100644
--- /dev/null
+++ b/tests/Codec/RPM/Tags_findSpec.hs
@@ -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]
diff --git a/tests/Codec/RPM/Tags_mkTagSpec.hs b/tests/Codec/RPM/Tags_mkTagSpec.hs
new file mode 100644
--- /dev/null
+++ b/tests/Codec/RPM/Tags_mkTagSpec.hs
@@ -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)
diff --git a/tests/Codec/RPM/TypesSpec.hs b/tests/Codec/RPM/TypesSpec.hs
new file mode 100644
--- /dev/null
+++ b/tests/Codec/RPM/TypesSpec.hs
@@ -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
diff --git a/tests/Codec/RPM/VersionSpec.hs b/tests/Codec/RPM/VersionSpec.hs
new file mode 100644
--- /dev/null
+++ b/tests/Codec/RPM/VersionSpec.hs
@@ -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
diff --git a/tests/Spec.hs b/tests/Spec.hs
new file mode 100644
--- /dev/null
+++ b/tests/Spec.hs
@@ -0,0 +1,1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}