Changes.hs

-- | A .changes file is a file generated by dpkg-buildpackage
-- describing the result of a package build.  Not to be confused
-- with a debian/changelog file.  After it is uploaded it goes into
-- the @installed/@ subdirectory of the repository.
{-# LANGUAGE PackageImports, OverloadedStrings #-}
{-# OPTIONS -fno-warn-name-shadowing -fno-warn-missing-signatures #-}
module Debian.Repo.Changes
    ( findChangesFiles
    , saveChangesFile
{-
    , parseChangesFilename
    , parseChangesFile
-}
    , changeKey
    , changePath
    , changeName
    ) where

import Data.List (isSuffixOf)
import Data.Maybe (catMaybes)
import Data.Monoid ((<>), mconcat)
import Data.Text (pack, Text, unpack)
import Debian.Arch (Arch, parseArch, prettyArch)
import Debian.Changes (ChangedFileSpec(..), ChangesFile(..), changesFileName, parseChanges)
import qualified Debian.Control.Text as S (Control'(Control), ControlFunctions(parseControlFromFile), fieldValue, modifyField, Paragraph'(..))
import Debian.Pretty (ppDisplay)
import Debian.Release (parseReleaseName, parseSection)
import Debian.Repo.Prelude (replaceFile)
import Debian.URI ()
import Debian.Version (DebianVersion, parseDebianVersion, prettyDebianVersion)
import System.Directory (getDirectoryContents)
import Text.Regex (matchRegex, matchRegexAll, mkRegex)

findChangesFiles :: FilePath -> IO [ChangesFile]
findChangesFiles dir =
    getDirectoryContents dir >>=
    return . filter (isSuffixOf ".changes") >>=
    mapM (loadChangesFile dir) >>= return . catMaybes

loadChangesFile :: FilePath -> String -> IO (Maybe ChangesFile)
loadChangesFile dir file =
    do
      case parseChangesFilename file of
        Just (name, ver, arch) ->
            do
              result <- parseChangesFile dir file
              case result of
                Right (S.Control changes) ->
                    -- The .changes file should be a single paragraph,
                    -- but there have been instances where extra newlines
                    -- are inserted.  To be forgiving we will concat all
                    -- the paragraphs into one (rather than erroring out
                    -- or discarding all but the first paragraph.)
                    let changes' = mergeParagraphs changes in
                    case (S.fieldValue "Files" changes' :: Maybe Text,
                          S.fieldValue "Checksums-Sha1" changes' :: Maybe Text,
                          S.fieldValue "Checksums-Sha256" changes' :: Maybe Text,
                          maybe Nothing parseChanges (S.fieldValue "Changes" changes'),
                          S.fieldValue "Distribution" changes') of
                      (Just text, sha1text, sha256text, Just entry, Just release) ->
                          do return . Just $ Changes { changeDir = dir
                                                     , changePackage = name
                                                     , changeVersion = ver
                                                     , changeRelease = parseReleaseName (unpack release)
                                                     , changeArch = arch
                                                     , changeInfo = changes'
                                                     , changeEntry = entry
                                                     , changeFiles = changedFileSpecs text sha1text sha256text }
                      _ -> return Nothing	-- Missing 'Files', 'Checksums-Sha1', 'Checksums-Sha256', 'Changes', or 'Distribution' field in .changes
                Left _error -> return Nothing
        Nothing -> return Nothing		-- Couldn't parse changes filename

mergeParagraphs :: [S.Paragraph' Text] -> S.Paragraph' Text
mergeParagraphs paragraphs =
    S.Paragraph . concat . map fieldsOf $ paragraphs
    where fieldsOf (S.Paragraph fields) = fields

saveChangesFile :: ChangesFile -> IO ()
saveChangesFile changes =
    replaceFile path (ppDisplay (updateFiles (changeFiles changes) (changeInfo changes)))
    where
      path = changeDir changes ++ "/" ++ changesFileName changes
      updateFiles files info =
          S.modifyField "Checksums-Sha1" (const (showSHA1List files)).
          S.modifyField "Checksums-Sha256" (const (showSHA256List files)) .
          S.modifyField "Files" (const (showFileList files)) $ info

-- | They primary key for .changes files is the triple containing the
-- package name, version, and architecture.  There is a 1-1 correspondence
-- between a key value and the name of the .changes file.
changeKey :: ChangesFile -> (String, DebianVersion, Arch)
changeKey changes = (changePackage changes, changeVersion changes, changeArch changes)

changeName :: ChangesFile -> FilePath
changeName changes =
    changePackage changes <> "_" <>
    show (prettyDebianVersion (changeVersion changes)) <> "_" <>
    show (prettyArch (changeArch changes)) <> ".changes"

changePath :: ChangesFile -> FilePath
changePath changes = changeDir changes ++ "/" ++ changeName changes

-- | I suspect it would be more correct to read the contents of the file and
-- use that to construct the info we are inferring here from the filename.
parseChangesFilename :: String -> Maybe (String, DebianVersion, Arch)
parseChangesFilename name =
    case matchRegex (mkRegex "^(.*/)?([^_]*)_(.*)_([^.]*)\\.changes$") name of
      Just [_, name, version, arch] -> Just (name, parseDebianVersion version, parseArch arch)
      _ -> error ("Invalid .changes file name: " ++ name)

-- parseChangesFile :: FilePath -> String -> IO (Either ParseError S.Control)
parseChangesFile dir file = S.parseControlFromFile (dir ++ "/" ++ file)

changedFileSpecs :: Text -> Maybe Text -> Maybe Text -> [ChangedFileSpec]
changedFileSpecs text sha1text sha256text =
    map changedFileSpec fileInfo
    where
      changedFileSpec (md5sum, size, section, priority, filename) =
                ChangedFileSpec { changedFileMD5sum = md5sum
                                , changedFileSHA1sum = maybe "" fst (lookup filename sha1sums)
                                , changedFileSHA256sum = maybe "" fst (lookup filename sha256sums)
                                , changedFileSize = read size
                                , changedFileSection = parseSection section
                                , changedFilePriority = priority
                                , changedFileName = filename }
      fileInfo = parseFileList (unpack text)
      sha1sums = maybe [] (parseChecksums . unpack) sha1text
      sha256sums = maybe [] (parseChecksums . unpack) sha256text

parseFileList :: String -> [(String, String, String, String, String)]
parseFileList text =
    case matchRegexAll re text of
      Just (_, _, remaining, [md5sum, size, section, priority, filename]) ->
          (md5sum, size, section, priority, filename) : parseFileList remaining
      _ -> []
    where
      re = mkRegex ("^[ \t\n]*" ++ g ++w++ g ++w++ g ++w++ g ++w++ g ++ "[ \t\n]*")
      g = "(" ++ t ++ ")"
      t = "[^ \t\n]+"
      w = "[ \t]+"

parseChecksums :: String -> [(String, (String, String))]
parseChecksums text =
    case matchRegexAll re text of
      Just (_, _, remaining, [checksum, size, name]) -> (name, (checksum, size)) : parseChecksums remaining
      _ -> []
    where
      re = mkRegex ("^[ \t\n]*" ++ g ++w++ g ++w++ g ++ "[ \t\n]*")
      g = "(" ++ t ++ ")"
      t = "[^ \t\n]+"
      w = "[ \t]+"

showFileList :: [ChangedFileSpec] -> Text
showFileList files = pack $ concat (map (("\n " <>) . ppDisplay) files)

showSHA1List :: [ChangedFileSpec] -> Text
showSHA1List files = mconcat (map (("\n " <>) . showSHA1) files)
    where showSHA1 x = pack $ changedFileSHA1sum x ++ " " ++ show (changedFileSize x) ++ " " ++ changedFileName x

showSHA256List :: [ChangedFileSpec] -> Text
showSHA256List files = mconcat (map (("\n " <>) . showSHA256) files)
    where showSHA256 x = pack $ changedFileSHA256sum x ++ " " ++ show (changedFileSize x) ++ " " ++ changedFileName x