{-# LANGUAGE OverloadedStrings #-}
module BDCS.RPM.Files(mkFiles)
where
import Codec.RPM.Tags(Tag, findWord16ListTag, findWord32ListTag, findStringListTag, findTag, tagValue)
import Control.Monad(join)
import Control.Monad.IO.Class(MonadIO)
import Data.ByteArray(convert)
import Data.ContentStore.Digest(ObjectDigest)
import Data.List(zip7)
import Data.Maybe(fromMaybe)
import qualified Data.Text as T
import Data.Word(Word32)
import Database.Esqueleto
import System.FilePath.Posix((</>))
import BDCS.DB
type FileTuple = (T.Text, T.Text, T.Text, Int, Int, Int, Maybe T.Text)
mkFiles :: MonadIO m => [Tag] -> [(T.Text, Maybe ObjectDigest)] -> SqlPersistT m [Files]
mkFiles rpm checksums =
mapM mkOneFile (zipFiles rpm)
where
mkOneFile :: MonadIO m => FileTuple -> SqlPersistT m Files
mkOneFile (path, user, group, mtime, mode, size, target) = do
let cksum = fmap convert (join $ lookup path checksums)
return $ Files path user group mtime cksum mode size target
filePaths :: [Tag] -> [FilePath]
filePaths tags = let
indexes = fromMaybe [] $ findTag "DirIndexes" tags >>= \t -> tagValue t :: Maybe [Word32]
dirnames = findStringListTag "DirNames" tags
basenames = findStringListTag "BaseNames" tags
in
zipWith (</>) (map (\i -> dirnames !! fromIntegral i) indexes) basenames
zipFiles :: [Tag] -> [FileTuple]
zipFiles tags = let
paths = map T.pack $ filePaths tags
users = map T.pack $ findStringListTag "FileUserName" tags
groups = map T.pack $ findStringListTag "FileGroupName" tags
mtimes = fromMaybe [] $ findTag "FileMTimes" tags >>= \t -> (tagValue t :: Maybe [Word32]) >>= Just . map fromIntegral
modes = map fromIntegral $ findWord16ListTag "FileModes" tags
sizes = map fromIntegral $ findWord32ListTag "FileSizes" tags
targets = map (\t -> if t == "" then Nothing else Just $ T.pack t)
(findStringListTag "FileLinkTos" tags)
in
zip7 paths users groups mtimes modes sizes targets