FormatSpec.hs

module Database.TransferDB.DumpDB.FormatSpec (spec) where

import Test.Hspec
import Test.QuickCheck

import Database.TransferDB.DumpDB.Format

import Data.Store               (Store(size, peek, poke),
                                 Size(ConstSize, VarSize),
                                 PeekException,
                                 encode,
                                 decode)

import Data.Time.Clock          (UTCTime(UTCTime), secondsToDiffTime)
import Data.Time.Calendar       (Day(ModifiedJulianDay))
import Data.Word                (Word8, Word16, Word32)
import Data.Int                 (Int16, Int64)
import Foreign.C.Types          (CShort(CShort), CLong(CLong))

import Foreign.Marshal          (allocaBytes)
import Foreign.Storable         (Storable (pokeElemOff))

import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString as B

import System.Endian    (getSystemEndianness, Endianness(BigEndian))

import SQL.CLI (SQLINTEGER)

spec :: Spec
spec = do
  describe "Version" $ do
    it "has constant size of 1 byte" $ do
      (size::Size Version) `shouldBe` ConstSize 1
    context "when using value V1" $ do
      it "encodes to a bytestring of length 1 byte" $ do
        (B.length $ encode V1) `shouldBe` 1
      it "encodes to a bytestring that has a single octet with value 1" $ do
        encode V1 `shouldBe` B.pack [1]
      describe "decode" $ do
        it "decodes the encoded value to the same value" $ do
          (decode $ encode V1) `shouldBe` Right V1

  describe "HeaderV1" $ do
    it "has the size given by the size of its components" $ property $
      \ header -> let maxChunkSizeS = sizeOf (size :: Size SQLINTEGER)    (hv1_MaxChunkSize header)
                      timestampS    = sizeOf (size :: Size UTCTime)       (hv1_Timestamp header)
                      descriptionS  = sizeOf (size :: Size C.ByteString)  (hv1_Description header)
                  in case (size::Size HeaderV1) of
                       ConstSize _ -> False
                       VarSize f   -> f header == maxChunkSizeS + timestampS + descriptionS
    it "encodes to a bytestring with the length equal to the size returned by sizeOf" $ property $
      \ header -> (B.length $ encode (header::HeaderV1)) == sizeOf (size :: Size HeaderV1) header
    describe "decode" $ do
      it "decodes an encoded value to the same value" $ property $
        \ header -> (decode $ encode (header::HeaderV1)) == Right header

  describe "SchemaV1" $ do
    it "encodes to a bytestring with the length equal to the size returned by sizeOf" $ property $
      \ sch -> (B.length $ encode (sch::SchemaV1)) == sizeOf (size :: Size SchemaV1) sch
    describe "decode" $ do
      it "decodes an encoded value to the same value" $ property $
        \ sch -> (decode $ encode (sch::SchemaV1)) == Right sch

  describe "FieldInfoV1" $ do
    it "encodes to a bytestring with the length equal to the size returned by sizeOf" $ property $
      \ fld -> (B.length $ encode (fld::FieldInfoV1)) == sizeOf (size :: Size FieldInfoV1) fld
    describe "decode" $ do
      it "decodes an encoded value to the same value" $ property $
        \ fld -> (decode $ encode (fld::FieldInfoV1)) == Right fld

  describe "RecordIndicator" $ do
    it "has constant size of 1 byte" $ do
      (size::Size RecordIndicator) `shouldBe` ConstSize 1
    context "when using value RI" $ do
      it "encodes to a bytstring of length 1" $ do
        (B.length $ encode RI) `shouldBe` 1
      it "encodes to a bytestring containing a single byte with value 255" $ do
        encode RI `shouldBe` B.pack [255]
      describe "decode" $ do
        it "decodes the encoded value back to the original value" $ do
          (decode $ encode RI) `shouldBe` Right RI 
    context "when using value EOT" $ do
      it "encodes to a bytstring of length 1" $ do
        (B.length $ encode EOT) `shouldBe` 1
      it "encodes to a bytestring containing a single byte with value 0" $ do
        encode EOT `shouldBe` B.pack [0]
      describe "decode" $ do
        it "decodes the encoded value back to the original value" $ do
          (decode $ encode EOT) `shouldBe` Right EOT

  describe "sizeOf" $ do
    it "should be 1 for any Word8" $ property $
      \ int -> sizeOf (size :: Size Word8) int == 1

  describe "writeVersion" $ do
    it "shouldBe the bytes '11' for V1" $ do
      writeVersion V1 `shouldBe` B.pack [1,1]

  describe "writeHeader" $ do
    it "should write the length of the header as first 2 bytes" $ property $
      \ h -> let h' = writeHeader h
             in
               ((decode (B.take 2 h')) :: Either PeekException Word16) == (Right $ fromIntegral $ sizeOf (size :: Size HeaderV1) h)
    it "should encode the header after the length" $ property $
      \ h -> let h' = writeHeader h
             in
               decode (B.drop 2 h') == Right h
    it "should create a ByteString with the length 2 + the length encoded as the first 2 bytes" $ property $
      \ h -> let h' = writeHeader h
             in
               (Right $ fromIntegral $ (B.length h') - 2) == ((decode (B.take 2 h')) :: Either PeekException Word16)
  describe "writeSchema" $ do
    it "should write the length of the encoded schema as the first 4 bytes" $ property $
      \ s -> let s' = writeSchema s
             in
               ((decode (B.take 4 s')) :: Either PeekException Word32) == (Right $ fromIntegral $ sizeOf (size :: Size SchemaV1) s)
    it "should encode the header after the length" $ property $
      \ s -> let s' = writeSchema s
             in
               decode (B.drop 4 s') == Right s
    it "should create a ByteString with the lengh 4 + the length encoded as the first 4 bytes" $ property $
      \ s -> let s' = writeSchema s
             in
               (Right $ fromIntegral $ (B.length s') - 4) == ((decode (B.take 4 s')) :: Either PeekException Word32)
  describe "writeRI" $ do
    it "should return a bytestring with a sigle byte with value 255" $ do
      writeRI `shouldBe` B.pack [255]
  describe "writeEOT" $ do
    it "should return a bytestring with a single byte with value 255" $ do
      writeEOT `shouldBe` B.pack [0]
  describe "writeNullIndicator" $ do
    it "should write a Null value into a bytestring with only one byte whose value is 0" $ do
      writeNullIndicator Null `shouldBe` B.pack [0]
    it "should write a NotNull indicator into a bytestring with only one byte whose value is 255" $ do
      writeNullIndicator NotNull `shouldBe` B.pack [255]
  describe "writeChunk" $ do
    context "when using 1 byte chunk size field" $ do
      let lenlen = 1
      it "should encode bytes [1, 2, 3, 4] to a bytestring containing bytes [4, 1, 2, 3, 4]" $ do
        allocaBytes 4
          (\ ptr -> do
              pokeElemOff ptr 0 (1::Word8)
              pokeElemOff ptr 1 (2::Word8)
              pokeElemOff ptr 2 (3::Word8)
              pokeElemOff ptr 3 (4::Word8)

              return $ writeChunk lenlen 4 ptr
          ) `shouldReturn` B.pack [4, 1, 2, 3, 4]
    context "when using 2 byte chunk size field" $ do
      let lenlen   = 2
          expected = if getSystemEndianness == BigEndian then [0, 4, 1, 2, 3, 4] else [4, 0, 1, 2, 3, 4]
      it ("should encode bytes [1, 2, 3, 4] to a bytestring containing bytes " ++ (show expected)) $ do
        allocaBytes 4
          (\ ptr -> do
              pokeElemOff ptr 0 (1::Word8)
              pokeElemOff ptr 1 (2::Word8)
              pokeElemOff ptr 2 (3::Word8)
              pokeElemOff ptr 3 (4::Word8)

              return $ writeChunk lenlen 4 ptr
          ) `shouldReturn` B.pack expected
    context "when using 4 byte chunk size field" $ do
      let lenlen = 4
          expected = if getSystemEndianness == BigEndian then [0, 0, 0, 4, 1, 2, 3, 4] else [4, 0, 0, 0, 1, 2, 3, 4]
      it ("should encode bytes [1, 2, 3, 4] to a bytestring containing bytes " ++ (show expected)) $ do
        allocaBytes 4
          (\ ptr -> do
              pokeElemOff ptr 0 (1::Word8)
              pokeElemOff ptr 1 (2::Word8)
              pokeElemOff ptr 2 (3::Word8)
              pokeElemOff ptr 3 (4::Word8)

              return $ writeChunk lenlen 4 ptr
          ) `shouldReturn` B.pack expected
      
  describe "writePlainBuf" $ do
    it "should encode a buffer containing bytes 1, 2, 3 and 4 into a bytestring containing bytes [1,2,3,4]" $ do
      allocaBytes 4
          (\ ptr -> do
              pokeElemOff ptr 0 (1::Word8)
              pokeElemOff ptr 1 (2::Word8)
              pokeElemOff ptr 2 (3::Word8)
              pokeElemOff ptr 3 (4::Word8)
              
              return $ writePlainBuf ptr 4
          ) `shouldReturn` B.pack [1, 2, 3, 4]
                       
        
instance Arbitrary HeaderV1 where
  arbitrary = HeaderV1 <$> arbitrary <*> arbitrary <*> arbitrary

instance Arbitrary SchemaV1 where
  arbitrary = SchemaV1 <$> arbitrary <*> arbitrary <*> (listOf arbitrary)

instance Arbitrary FieldInfoV1 where
  arbitrary = FieldInfoV1 <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary

instance Arbitrary UTCTime where
  arbitrary = do
    day     <- arbitrary
    seconds <- choose (0, 86400)
    return $ UTCTime (ModifiedJulianDay day) (secondsToDiffTime seconds)

instance Arbitrary C.ByteString where
  arbitrary = listOf arbitrary >>= return.C.pack