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