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