{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-}
module Debian.Util.FakeChanges (fakeChanges) where

--import Control.Arrow
import Control.Exception
import Control.Monad hiding (mapM)
import qualified Data.ByteString.Lazy.Char8 as L
import Data.Data (Data, Typeable)
import Data.Digest.Pure.SHA as SHA
import Data.Foldable (concat, all, foldr)
import Data.List as List (intercalate, nub, partition, isSuffixOf)
import Data.Maybe
import Debian.Pretty (prettyShow)
import Data.Traversable
import Debian.Control
import qualified Debian.Deb as Deb
import Debian.Time
import Network.HostName (getHostName)
import Prelude hiding (concat, foldr, all, mapM, sum)
import System.Environment
import System.FilePath
import System.Posix.Files
import Text.Regex.TDFA

data Error
    = NoDebs
    | TooManyDscs [FilePath]
    | TooManyTars [FilePath]
    | TooManyDiffs [FilePath]
    | UnknownFiles [FilePath]
    | MalformedDebFilename [FilePath]
    | VersionMismatch [Maybe String]
    deriving (ReadPrec [Error]
ReadPrec Error
Int -> ReadS Error
ReadS [Error]
(Int -> ReadS Error)
-> ReadS [Error]
-> ReadPrec Error
-> ReadPrec [Error]
-> Read Error
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Error]
$creadListPrec :: ReadPrec [Error]
readPrec :: ReadPrec Error
$creadPrec :: ReadPrec Error
readList :: ReadS [Error]
$creadList :: ReadS [Error]
readsPrec :: Int -> ReadS Error
$creadsPrec :: Int -> ReadS Error
Read, Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> String
$cshow :: Error -> String
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> Error -> ShowS
Show, Error -> Error -> Bool
(Error -> Error -> Bool) -> (Error -> Error -> Bool) -> Eq Error
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c== :: Error -> Error -> Bool
Eq, Typeable, Typeable Error
DataType
Constr
Typeable Error
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Error -> c Error)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Error)
-> (Error -> Constr)
-> (Error -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Error))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Error))
-> ((forall b. Data b => b -> b) -> Error -> Error)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Error -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Error -> r)
-> (forall u. (forall d. Data d => d -> u) -> Error -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Error -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Error -> m Error)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Error -> m Error)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Error -> m Error)
-> Data Error
Error -> DataType
Error -> Constr
(forall b. Data b => b -> b) -> Error -> Error
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Error -> c Error
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Error
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Error -> u
forall u. (forall d. Data d => d -> u) -> Error -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Error -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Error -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Error -> m Error
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Error -> m Error
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Error
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Error -> c Error
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Error)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Error)
$cVersionMismatch :: Constr
$cMalformedDebFilename :: Constr
$cUnknownFiles :: Constr
$cTooManyDiffs :: Constr
$cTooManyTars :: Constr
$cTooManyDscs :: Constr
$cNoDebs :: Constr
$tError :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Error -> m Error
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Error -> m Error
gmapMp :: (forall d. Data d => d -> m d) -> Error -> m Error
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Error -> m Error
gmapM :: (forall d. Data d => d -> m d) -> Error -> m Error
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Error -> m Error
gmapQi :: Int -> (forall d. Data d => d -> u) -> Error -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Error -> u
gmapQ :: (forall d. Data d => d -> u) -> Error -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Error -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Error -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Error -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Error -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Error -> r
gmapT :: (forall b. Data b => b -> b) -> Error -> Error
$cgmapT :: (forall b. Data b => b -> b) -> Error -> Error
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Error)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Error)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Error)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Error)
dataTypeOf :: Error -> DataType
$cdataTypeOf :: Error -> DataType
toConstr :: Error -> Constr
$ctoConstr :: Error -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Error
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Error
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Error -> c Error
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Error -> c Error
$cp1Data :: Typeable Error
Data)

data Files
    = Files { Files -> Maybe (String, Paragraph)
dsc :: Maybe (FilePath, Paragraph)
            , Files -> [(String, Paragraph)]
debs :: [(FilePath, Paragraph)]
            , Files -> Maybe String
tar :: Maybe FilePath
            , Files -> Maybe String
diff :: Maybe FilePath
            }

fakeChanges :: [FilePath] -> IO (FilePath, String)
fakeChanges :: [String] -> IO (String, String)
fakeChanges [String]
fps =
    do Files
files <- [String] -> IO Files
loadFiles [String]
fps
       let version :: String
version      = Files -> String
getVersion Files
files
           source :: String
source       = Files -> String
getSource Files
files
           maintainer :: String
maintainer   = Files -> String
getMaintainer Files
files
           arches :: [String]
arches       = Files -> [String]
getArches Files
files
           binArch :: String
binArch      = Files -> String
getBinArch Files
files
           dist :: String
dist         = String
"unstable"
           urgency :: String
urgency      = String
"low"
           ([String]
invalid, [(String, String, String)]
binaries) = [Either String (String, String, String)]
-> ([String], [(String, String, String)])
forall a b. [Either a b] -> ([a], [b])
unzipEithers ([Either String (String, String, String)]
 -> ([String], [(String, String, String)]))
-> [Either String (String, String, String)]
-> ([String], [(String, String, String)])
forall a b. (a -> b) -> a -> b
$ ((String, Paragraph) -> Either String (String, String, String))
-> [(String, Paragraph)]
-> [Either String (String, String, String)]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Either String (String, String, String)
debNameSplit (String -> Either String (String, String, String))
-> ((String, Paragraph) -> String)
-> (String, Paragraph)
-> Either String (String, String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Paragraph) -> String
forall a b. (a, b) -> a
fst) (Files -> [(String, Paragraph)]
debs Files
files)
       Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> ([String] -> Bool) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> Bool) -> [String] -> Bool
forall a b. (a -> b) -> a -> b
$ [String]
invalid) (String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Some .deb names are invalid: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
invalid)
       String
uploader <- IO String
getUploader
       String
date <- IO String
getCurrentLocalRFC822Time
       [String]
fileLines <- (String -> IO String) -> [String] -> IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO String
mkFileLine [String]
fps
       let changes :: Control' String
changes = [Paragraph] -> Control' String
forall a. [Paragraph' a] -> Control' a
Control ([Paragraph] -> Control' String) -> [Paragraph] -> Control' String
forall a b. (a -> b) -> a -> b
$ Paragraph -> [Paragraph]
forall (m :: * -> *) a. Monad m => a -> m a
return (Paragraph -> [Paragraph])
-> ([Field' String] -> Paragraph) -> [Field' String] -> [Paragraph]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Field' String] -> Paragraph
forall a. [Field' a] -> Paragraph' a
Paragraph ([Field' String] -> [Paragraph]) -> [Field' String] -> [Paragraph]
forall a b. (a -> b) -> a -> b
$ ((String, String) -> Field' String)
-> [(String, String)] -> [Field' String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> Field' String
forall a. (a, a) -> Field' a
Field
               [ (String
"Format",String
" 1.7")
               , (String
"Date", Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: String
date)
               , (String
"Source", Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: String
source)
               , (String
"Binary", Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ((String, String, String) -> String)
-> [(String, String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
n,String
_,String
_) -> String
n) [(String, String, String)]
binaries))
               , (String
"Architecture", Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" " [String]
arches)
               , (String
"Version", Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: String
version)
               , (String
"Distribution", Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: String
dist)
               , (String
"Urgency", Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: String
urgency)
               , (String
"Maintainer", Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: String
maintainer)
               , (String
"Changed-By", Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: String
uploader)
               , (String
"Description", String
"\n Simulated description")
               , (String
"Changes", String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Char
' 'Char -> ShowS
forall a. a -> [a] -> [a]
:) [ String
source String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
version String -> ShowS
forall a. [a] -> [a] -> [a]
++String
") " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
dist String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"; urgency=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
urgency
                                                         , String
"."
                                                         , String
"  * Simulated changes"
                                                         ]
                                             ))
               , (String
"Files", String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines [String]
fileLines)
               ]
       (String, String) -> IO (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return ((String, String) -> IO (String, String))
-> (String, String) -> IO (String, String)
forall a b. (a -> b) -> a -> b
$ ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
source, String
"_", String
version, String
"_", String
binArch, String
".changes"], Control' String -> String
forall a. Pretty a => a -> String
prettyShow Control' String
changes)
--       let (invalid, binaries) = unzipEithers $ map debNameSplit debs
{-
       when (not . null $ invalid) (throwDyn [MalformedDebFilename invalid])
       version <- getVersion dsc debs
       putStrLn version
       source <- getSource dsc debs
       putStrLn source
-}
-- TODO: seems like this could be more aggressive about ensure the
-- versions make sense. Except with packages like libc, the versions
-- don't make sense. Maybe we want a flag that disables version check
-- ?
getVersion :: Files -> String
getVersion :: Files -> String
getVersion Files
files
    | Maybe (String, Paragraph) -> Bool
forall a. Maybe a -> Bool
isNothing (Files -> Maybe (String, Paragraph)
dsc Files
files) =
        let versions :: [Maybe String]
versions = ((String, Paragraph) -> Maybe String)
-> [(String, Paragraph)] -> [Maybe String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Paragraph -> Maybe String
forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue String
"Version" (Paragraph -> Maybe String)
-> ((String, Paragraph) -> Paragraph)
-> (String, Paragraph)
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Paragraph) -> Paragraph
forall a b. (a, b) -> b
snd) (Files -> [(String, Paragraph)]
debs Files
files)
        in
          if ((Maybe String -> Bool) -> [Maybe String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Maybe String -> Bool
forall a. Maybe a -> Bool
isJust [Maybe String]
versions) Bool -> Bool -> Bool
&& ([Maybe String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Maybe String] -> [Maybe String]
forall a. Eq a => [a] -> [a]
nub [Maybe String]
versions) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1)
          then Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust ([Maybe String] -> Maybe String
forall a. [a] -> a
head [Maybe String]
versions)
          else ShowS
forall a. HasCallStack => String -> a
error ([Error] -> String
forall a. Show a => a -> String
show [[Maybe String] -> Error
VersionMismatch ([Maybe String] -> [Maybe String]
forall a. Eq a => [a] -> [a]
nub [Maybe String]
versions)])
    | Bool
otherwise =
        case String -> Paragraph -> Maybe String
forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue String
"Version" ((String, Paragraph) -> Paragraph
forall a b. (a, b) -> b
snd ((String, Paragraph) -> Paragraph)
-> (Maybe (String, Paragraph) -> (String, Paragraph))
-> Maybe (String, Paragraph)
-> Paragraph
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (String, Paragraph) -> (String, Paragraph)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (String, Paragraph) -> Paragraph)
-> Maybe (String, Paragraph) -> Paragraph
forall a b. (a -> b) -> a -> b
$ Files -> Maybe (String, Paragraph)
dsc Files
files) of
          (Just String
v) -> String
v
          Maybe String
Nothing  -> ShowS
forall a. HasCallStack => String -> a
error ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"show (dsc files)" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" does not have a Version field :("


getSource :: Files -> String
getSource :: Files -> String
getSource Files
files =
    let dscSource :: [String]
dscSource =
            case (Files -> Maybe (String, Paragraph)
dsc Files
files) of
              Maybe (String, Paragraph)
Nothing -> []
              (Just (String
fp, Paragraph
p)) ->
                  case String -> Paragraph -> Maybe String
forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue String
"Source" Paragraph
p of
                    (Just String
v) -> [String
v]
                    Maybe String
Nothing -> String -> [String]
forall a. HasCallStack => String -> a
error (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
fp String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" does not have a Source field :("
        debSources :: [String]
debSources = ((String, Paragraph) -> String)
-> [(String, Paragraph)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Paragraph) -> String
forall a. ControlFunctions a => (String, Paragraph' a) -> a
debSource (Files -> [(String, Paragraph)]
debs Files
files)
        srcs :: [String]
srcs = [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String]
dscSource [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
debSources)
    in
      if ([String] -> Bool
forall a. [a] -> Bool
singleton [String]
srcs)
         then ([String] -> String
forall a. [a] -> a
head [String]
srcs)
         else ShowS
forall a. HasCallStack => String -> a
error ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"Could not determine source."
    where
      debSource :: (String, Paragraph' a) -> a
debSource (String
deb,Paragraph' a
p) =
          case (String -> Paragraph' a -> Maybe a
forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue String
"Source" Paragraph' a
p) of
            (Just a
v) -> a
v
            Maybe a
Nothing ->
                case String -> Paragraph' a -> Maybe a
forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue String
"Package" Paragraph' a
p of
                  (Just a
v) -> a
v
                  Maybe a
Nothing -> String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Could not find Source or Package field in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
deb



getMaintainer :: Files -> String
getMaintainer :: Files -> String
getMaintainer Files
files
    | Maybe (String, Paragraph) -> Bool
forall a. Maybe a -> Bool
isJust (Files -> Maybe (String, Paragraph)
dsc Files
files) =
        let (String
fp, Paragraph
p) = Maybe (String, Paragraph) -> (String, Paragraph)
forall a. HasCallStack => Maybe a -> a
fromJust (Files -> Maybe (String, Paragraph)
dsc Files
files)
        in
          case String -> Paragraph -> Maybe String
forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue String
"Maintainer" Paragraph
p of
            Maybe String
Nothing -> ShowS
forall a. HasCallStack => String -> a
error ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
fp String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is missing the Maintainer field."
            (Just String
v) -> String
v
    | Bool
otherwise =
        let maintainers :: [String]
maintainers = [Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe String] -> [String]) -> [Maybe String] -> [String]
forall a b. (a -> b) -> a -> b
$ ((String, Paragraph) -> Maybe String)
-> [(String, Paragraph)] -> [Maybe String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Paragraph -> Maybe String
forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue String
"Maintainer" (Paragraph -> Maybe String)
-> ((String, Paragraph) -> Paragraph)
-> (String, Paragraph)
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Paragraph) -> Paragraph
forall a b. (a, b) -> b
snd) (Files -> [(String, Paragraph)]
debs Files
files)
            maintainer :: [String]
maintainer = [String] -> [String]
forall a. Eq a => [a] -> [a]
nub [String]
maintainers
        in
          if [String] -> Bool
forall a. [a] -> Bool
singleton [String]
maintainer
             then [String] -> String
forall a. [a] -> a
head [String]
maintainer
             else ShowS
forall a. HasCallStack => String -> a
error ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"Could not uniquely determine the maintainer: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
maintainer

getArches :: Files -> [String]
getArches :: Files -> [String]
getArches Files
files =
    let debArchs :: [Maybe String]
debArchs = ((String, Paragraph) -> Maybe String)
-> [(String, Paragraph)] -> [Maybe String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Paragraph -> Maybe String
forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue String
"Architecture" (Paragraph -> Maybe String)
-> ((String, Paragraph) -> Paragraph)
-> (String, Paragraph)
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Paragraph) -> Paragraph
forall a b. (a, b) -> b
snd) (Files -> [(String, Paragraph)]
debs Files
files)
        tarArch :: Maybe String
tarArch  = ShowS -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> ShowS
forall a b. a -> b -> a
const String
"source") (Files -> Maybe String
tar Files
files)
        diffArch :: Maybe String
diffArch = ShowS -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> ShowS
forall a b. a -> b -> a
const String
"source") (Files -> Maybe String
diff Files
files)
    in
      [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes (Maybe String
tarArch Maybe String -> [Maybe String] -> [Maybe String]
forall a. a -> [a] -> [a]
: Maybe String
diffArch Maybe String -> [Maybe String] -> [Maybe String]
forall a. a -> [a] -> [a]
: [Maybe String]
debArchs)


getBinArch :: Files -> String
getBinArch :: Files -> String
getBinArch Files
files =
    let binArch :: [String]
binArch = [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ ((String, Paragraph) -> Maybe String)
-> [(String, Paragraph)] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String -> Paragraph -> Maybe String
forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue String
"Architecture" (Paragraph -> Maybe String)
-> ((String, Paragraph) -> Paragraph)
-> (String, Paragraph)
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Paragraph) -> Paragraph
forall a b. (a, b) -> b
snd) (Files -> [(String, Paragraph)]
debs Files
files)
    in
      if [String] -> Bool
forall a. [a] -> Bool
singleton [String]
binArch
         then [String] -> String
forall a. [a] -> a
head [String]
binArch
         else case ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"all") [String]
binArch) of
                [String
b] -> String
b
                [String]
_ -> ShowS
forall a. HasCallStack => String -> a
error ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"Could not uniquely determine binary architecture: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
binArch

mkFileLine :: FilePath -> IO String
mkFileLine :: String -> IO String
mkFileLine String
fp
    | String
".deb" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
fp =
        do String
sum <- String -> IO ByteString
L.readFile String
fp IO ByteString -> (ByteString -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String)
-> (ByteString -> String) -> ByteString -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest SHA256State -> String
forall a. Show a => a -> String
show (Digest SHA256State -> String)
-> (ByteString -> Digest SHA256State) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Digest SHA256State
sha256
           FileOffset
size <- (FileStatus -> FileOffset) -> IO FileStatus -> IO FileOffset
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM FileStatus -> FileOffset
fileSize (IO FileStatus -> IO FileOffset) -> IO FileStatus -> IO FileOffset
forall a b. (a -> b) -> a -> b
$ String -> IO FileStatus
getFileStatus String
fp
           (Control (Paragraph
p:[Paragraph]
_)) <- String -> IO (Control' String)
forall a. ControlFunctions a => String -> IO (Control' a)
Deb.fields String
fp
           String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
" ", String
sum, String
" ", FileOffset -> String
forall a. Show a => a -> String
show FileOffset
size, String
" ", String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"unknown" (String -> Paragraph -> Maybe String
forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue String
"Section" Paragraph
p), String
" "
                           , String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"optional" (String -> Paragraph -> Maybe String
forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue String
"Priority" Paragraph
p), String
" ", (ShowS
takeBaseName String
fp)
                           ]
    | Bool
otherwise =
        do String
sum <- String -> IO ByteString
L.readFile String
fp IO ByteString -> (ByteString -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String)
-> (ByteString -> String) -> ByteString -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest SHA256State -> String
forall a. Show a => a -> String
show (Digest SHA256State -> String)
-> (ByteString -> Digest SHA256State) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Digest SHA256State
sha256
           FileOffset
size <- (FileStatus -> FileOffset) -> IO FileStatus -> IO FileOffset
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM FileStatus -> FileOffset
fileSize (IO FileStatus -> IO FileOffset) -> IO FileStatus -> IO FileOffset
forall a b. (a -> b) -> a -> b
$ String -> IO FileStatus
getFileStatus String
fp
           String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
" ", String
sum, String
" ", FileOffset -> String
forall a. Show a => a -> String
show FileOffset
size, String
" ", String
"unknown", String
" "
                           , String
"optional",String
" ", (ShowS
takeBaseName String
fp)
                           ]

-- more implementations can be found at:
-- http://www.google.com/codesearch?hl=en&lr=&q=%22%5BEither+a+b%5D+-%3E+%28%5Ba%5D%2C%5Bb%5D%29%22&btnG=Search
unzipEithers :: [Either a b] -> ([a],[b])
unzipEithers :: [Either a b] -> ([a], [b])
unzipEithers = (Either a b -> ([a], [b]) -> ([a], [b]))
-> ([a], [b]) -> [Either a b] -> ([a], [b])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Either a b -> ([a], [b]) -> ([a], [b])
forall a a. Either a a -> ([a], [a]) -> ([a], [a])
unzipEither ([],[])
    where
      unzipEither :: Either a a -> ([a], [a]) -> ([a], [a])
unzipEither (Left a
l) ~([a]
ls, [a]
rs) = (a
la -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ls, [a]
rs)
      unzipEither (Right a
r) ~([a]
ls, [a]
rs) = ([a]
ls, a
ra -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
rs)

-- move to different library
debNameSplit :: String -> Either FilePath (String, String, String)
debNameSplit :: String -> Either String (String, String, String)
debNameSplit String
fp =
    case (ShowS
takeFileName String
fp) String -> String -> [[String]]
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ String
"^(.*)_(.*)_(.*).deb$" of
      [[String
_, String
name, String
version, String
arch]] -> (String, String, String) -> Either String (String, String, String)
forall a b. b -> Either a b
Right (String
name, String
version, String
arch)
      [[String]]
_ -> String -> Either String (String, String, String)
forall a b. a -> Either a b
Left String
fp


loadFiles :: [FilePath] -> IO Files
loadFiles :: [String] -> IO Files
loadFiles [String]
files =
       let ([String]
dscs', [String]
files'') = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf String
".dsc") [String]
files'
           ([String]
debs', [String]
files') = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf String
".deb") [String]
files
           ([String]
tars', [String]
files''') = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf String
".tar.gz") [String]
files''
           ([String]
diffs', [String]
rest) = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf String
".diff.gz") [String]
files'''
           errors :: [Error]
errors = [[Error]] -> [Error]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ if ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
debs'  Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1) then [Error
NoDebs] else []
                           , if ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
dscs'  Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) then [[String] -> Error
TooManyDscs [String]
dscs']   else []
                           , if ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
tars'  Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) then [[String] -> Error
TooManyTars [String]
tars']   else []
                           , if ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
diffs' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) then [[String] -> Error
TooManyDiffs [String]
diffs'] else []
                           , if ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
rest  Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) then [[String] -> Error
UnknownFiles [String]
rest]  else []
                           ]
       in
         do Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> ([Error] -> Bool) -> [Error] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Error] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Error] -> Bool) -> [Error] -> Bool
forall a b. (a -> b) -> a -> b
$ [Error]
errors) (String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [Error] -> String
forall a. Show a => a -> String
show [Error]
errors)
            Maybe (String, Paragraph)
dsc' <- (String -> IO (String, Paragraph))
-> Maybe String -> IO (Maybe (String, Paragraph))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO (String, Paragraph)
loadDsc ([String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe [String]
dscs')
            [(String, Paragraph)]
debs'' <- (String -> IO (String, Paragraph))
-> [String] -> IO [(String, Paragraph)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO (String, Paragraph)
loadDeb [String]
debs'
            Files -> IO Files
forall (m :: * -> *) a. Monad m => a -> m a
return (Files -> IO Files) -> Files -> IO Files
forall a b. (a -> b) -> a -> b
$ Files :: Maybe (String, Paragraph)
-> [(String, Paragraph)] -> Maybe String -> Maybe String -> Files
Files { dsc :: Maybe (String, Paragraph)
dsc = Maybe (String, Paragraph)
dsc', debs :: [(String, Paragraph)]
debs = [(String, Paragraph)]
debs'', tar :: Maybe String
tar = [String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe [String]
tars', diff :: Maybe String
diff = [String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe [String]
diffs' }
         -- if (not . null $ errors) then throwDyn errors else return (debs, listToMaybe dscs, listToMaybe tars, listToMaybe diffs)
    where
      loadDsc :: FilePath -> IO (FilePath, Paragraph)
      loadDsc :: String -> IO (String, Paragraph)
loadDsc String
dsc' =
          do Either ParseError (Control' String)
res <- String -> IO (Either ParseError (Control' String))
forall a.
ControlFunctions a =>
String -> IO (Either ParseError (Control' a))
parseControlFromFile String
dsc'
             case  Either ParseError (Control' String)
res of
               (Left ParseError
e) -> String -> IO (String, Paragraph)
forall a. HasCallStack => String -> a
error (String -> IO (String, Paragraph))
-> String -> IO (String, Paragraph)
forall a b. (a -> b) -> a -> b
$ String
"Error parsing " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
dsc' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ParseError -> String
forall a. Show a => a -> String
show ParseError
e
               (Right (Control [Paragraph
p])) -> (String, Paragraph) -> IO (String, Paragraph)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
dsc', Paragraph
p)
               (Right Control' String
c) -> String -> IO (String, Paragraph)
forall a. HasCallStack => String -> a
error (String -> IO (String, Paragraph))
-> String -> IO (String, Paragraph)
forall a b. (a -> b) -> a -> b
$ String
dsc' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" did not have exactly one paragraph: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Control' String -> String
forall a. Pretty a => a -> String
prettyShow Control' String
c
      loadDeb :: FilePath -> IO (FilePath, Paragraph)
      loadDeb :: String -> IO (String, Paragraph)
loadDeb String
deb =
          do Control' String
res <- String -> IO (Control' String)
forall a. ControlFunctions a => String -> IO (Control' a)
Deb.fields String
deb
             case Control' String
res of
               (Control [Paragraph
p]) -> (String, Paragraph) -> IO (String, Paragraph)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
deb, Paragraph
p)
               Control' String
_ -> String -> IO (String, Paragraph)
forall a. HasCallStack => String -> a
error (String -> IO (String, Paragraph))
-> String -> IO (String, Paragraph)
forall a b. (a -> b) -> a -> b
$ String
deb String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" did not have exactly one paragraph: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Control' String -> String
forall a. Pretty a => a -> String
prettyShow Control' String
res


getUploader :: IO String
getUploader :: IO String
getUploader =
    do String
debFullName <-
           do Either SomeException String
dfn <- IO String -> IO (Either SomeException String)
forall e a. Exception e => IO a -> IO (Either e a)
try (String -> IO String
getEnv String
"DEBFULLNAME")
              case Either SomeException String
dfn of
                (Right String
n) -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
n
                (Left (SomeException
_ :: SomeException)) ->
                    do Either SomeException String
dfn' <-IO String -> IO (Either SomeException String)
forall e a. Exception e => IO a -> IO (Either e a)
try (String -> IO String
getEnv String
"USER")
                       case Either SomeException String
dfn' of
                         (Right String
n) -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
n
                         (Left (SomeException
_ :: SomeException)) -> String -> IO String
forall a. HasCallStack => String -> a
error (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
"Could not determine user name, neither DEBFULLNAME nor USER enviroment variables were set."
       String
emailAddr <-
           do Either SomeException String
eml <- IO String -> IO (Either SomeException String)
forall e a. Exception e => IO a -> IO (Either e a)
try (String -> IO String
getEnv String
"DEBEMAIL")
              case Either SomeException String
eml of
                (Right String
e) -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
e
                (Left (SomeException
_ :: SomeException)) ->
                    do Either SomeException String
eml' <- IO String -> IO (Either SomeException String)
forall e a. Exception e => IO a -> IO (Either e a)
try (String -> IO String
getEnv String
"EMAIL")
                       case Either SomeException String
eml' of
                         (Right String
e) -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
e
                         (Left (SomeException
_ :: SomeException)) -> IO String
getHostName -- FIXME: this is not a FQDN
       String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
debFullName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" <" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
emailAddr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"

-- * Utils

singleton :: [a] -> Bool
singleton :: [a] -> Bool
singleton [a
_] = Bool
True
singleton [a]
_ = Bool
False