module Data.Acid.Archive
( Entry
, Entries(..)
, putEntries
, packEntries
, readEntries
, entriesToList
, entriesToListNoFail
) where
import Data.Acid.CRC
import qualified Data.ByteString.Lazy as Lazy
import qualified Data.ByteString as Strict
import qualified Data.Serialize.Get as Serialize
import Data.Serialize.Get hiding (Result(..))
import Data.Serialize.Builder
import Data.Monoid
type Entry = Lazy.ByteString
data Entries = Done | Next Entry Entries | Fail String
deriving (Show)
entriesToList :: Entries -> [Entry]
entriesToList Done = []
entriesToList (Next entry next) = entry : entriesToList next
entriesToList (Fail msg) = error msg
entriesToListNoFail :: Entries -> [Entry]
entriesToListNoFail Done = []
entriesToListNoFail (Next entry next) = entry : entriesToListNoFail next
entriesToListNoFail Fail{} = []
putEntry :: Entry -> Builder
putEntry content
= putWord64le contentLength `mappend`
putWord16le contentHash `mappend`
fromLazyByteString content
where contentLength = fromIntegral $ Lazy.length content
contentHash = crc16 content
putEntries :: [Entry] -> Builder
putEntries = mconcat . map putEntry
packEntries :: [Entry] -> Lazy.ByteString
packEntries = toLazyByteString . putEntries
readEntries :: Lazy.ByteString -> Entries
readEntries bs
= worker (Lazy.toChunks bs)
where worker [] = Done
worker (x:xs)
= check (runGetPartial readEntry x) xs
check result more
= case result of
Serialize.Done entry rest
| Strict.null rest -> Next entry (worker more)
| otherwise -> Next entry (worker (rest:more))
Serialize.Fail msg -> Fail msg
Serialize.Partial cont -> case more of
[] -> check (cont Strict.empty) []
(x:xs) -> check (cont x) xs
readEntry :: Get Entry
readEntry
= do contentLength <- getWord64le
contentChecksum <-getWord16le
content <- getLazyByteString (fromIntegral contentLength)
if crc16 content /= contentChecksum
then fail "Invalid hash"
else return content