{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleContexts, OverloadedStrings, ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-orphans #-}
module Debian.Apt.Index
    ( update
    , Fetcher
    , CheckSums(..)
    , Compression(..)
    , FileTuple
    , Size
    , controlFromIndex
    , controlFromIndex'
    , findContentsFiles
    , findIndexes
    , indexesInRelease
    , tupleFromFilePath
    ) where

import qualified Codec.Compression.GZip as GZip
import qualified Codec.Compression.BZip as BZip
import Control.Lens (over, to, view)
import Control.Monad
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as L
import qualified Data.Digest.Pure.MD5 as MD5
import qualified Data.Digest.Pure.SHA as SHA
import Data.Either (partitionEithers)
import Data.Function
import Data.List as List (null, intercalate, sortBy, isSuffixOf, isPrefixOf)
import qualified Data.Map as M
import Data.Monoid ((<>))
import Data.Text as Text (Text, unpack, concat, lines, words)
import Data.Time
import Debian.Apt.Methods
import Debian.Codename (Codename, codename)
import Debian.Control (formatControl)
import Debian.Control.ByteString
--import Debian.Control.Common
import Debian.Control.Text (decodeControl)
import Debian.Release
import Debian.Sources
import Debian.URI (uriPathLens, uriToString')
import Debian.VendorURI (VendorURI, vendorURI)
import Network.URI
import System.Directory
import System.FilePath ((</>))
import System.Posix.Files
import System.FilePath (takeBaseName)
--import qualified System.Unix.Misc as Misc
import Text.ParserCombinators.Parsec.Error
import Text.PrettyPrint (render)
import Distribution.Pretty (pretty)
import Text.Read (readMaybe)
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative (pure, (<$>), (<*>))
#endif

-- |Package indexes on the server are uncompressed or compressed with
-- gzip or bzip2. We do not know what will exist on the server until we
-- actually look. This type is used to mark the compression status of
-- what was actually found.
data Compression
    = BZ2 | GZ | Uncompressed
      deriving (ReadPrec [Compression]
ReadPrec Compression
Int -> ReadS Compression
ReadS [Compression]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Compression]
$creadListPrec :: ReadPrec [Compression]
readPrec :: ReadPrec Compression
$creadPrec :: ReadPrec Compression
readList :: ReadS [Compression]
$creadList :: ReadS [Compression]
readsPrec :: Int -> ReadS Compression
$creadsPrec :: Int -> ReadS Compression
Read, Int -> Compression -> ShowS
[Compression] -> ShowS
Compression -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Compression] -> ShowS
$cshowList :: [Compression] -> ShowS
show :: Compression -> [Char]
$cshow :: Compression -> [Char]
showsPrec :: Int -> Compression -> ShowS
$cshowsPrec :: Int -> Compression -> ShowS
Show, Compression -> Compression -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Compression -> Compression -> Bool
$c/= :: Compression -> Compression -> Bool
== :: Compression -> Compression -> Bool
$c== :: Compression -> Compression -> Bool
Eq, Eq Compression
Compression -> Compression -> Bool
Compression -> Compression -> Ordering
Compression -> Compression -> Compression
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Compression -> Compression -> Compression
$cmin :: Compression -> Compression -> Compression
max :: Compression -> Compression -> Compression
$cmax :: Compression -> Compression -> Compression
>= :: Compression -> Compression -> Bool
$c>= :: Compression -> Compression -> Bool
> :: Compression -> Compression -> Bool
$c> :: Compression -> Compression -> Bool
<= :: Compression -> Compression -> Bool
$c<= :: Compression -> Compression -> Bool
< :: Compression -> Compression -> Bool
$c< :: Compression -> Compression -> Bool
compare :: Compression -> Compression -> Ordering
$ccompare :: Compression -> Compression -> Ordering
Ord, Int -> Compression
Compression -> Int
Compression -> [Compression]
Compression -> Compression
Compression -> Compression -> [Compression]
Compression -> Compression -> Compression -> [Compression]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Compression -> Compression -> Compression -> [Compression]
$cenumFromThenTo :: Compression -> Compression -> Compression -> [Compression]
enumFromTo :: Compression -> Compression -> [Compression]
$cenumFromTo :: Compression -> Compression -> [Compression]
enumFromThen :: Compression -> Compression -> [Compression]
$cenumFromThen :: Compression -> Compression -> [Compression]
enumFrom :: Compression -> [Compression]
$cenumFrom :: Compression -> [Compression]
fromEnum :: Compression -> Int
$cfromEnum :: Compression -> Int
toEnum :: Int -> Compression
$ctoEnum :: Int -> Compression
pred :: Compression -> Compression
$cpred :: Compression -> Compression
succ :: Compression -> Compression
$csucc :: Compression -> Compression
Enum, Compression
forall a. a -> a -> Bounded a
maxBound :: Compression
$cmaxBound :: Compression
minBound :: Compression
$cminBound :: Compression
Bounded)

data CheckSums
    = CheckSums { CheckSums -> Maybe [Char]
md5sum :: Maybe String
                , CheckSums -> Maybe [Char]
sha1   :: Maybe String
                , CheckSums -> Maybe [Char]
sha256 :: Maybe String
                }
      deriving (ReadPrec [CheckSums]
ReadPrec CheckSums
Int -> ReadS CheckSums
ReadS [CheckSums]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CheckSums]
$creadListPrec :: ReadPrec [CheckSums]
readPrec :: ReadPrec CheckSums
$creadPrec :: ReadPrec CheckSums
readList :: ReadS [CheckSums]
$creadList :: ReadS [CheckSums]
readsPrec :: Int -> ReadS CheckSums
$creadsPrec :: Int -> ReadS CheckSums
Read, Int -> CheckSums -> ShowS
[CheckSums] -> ShowS
CheckSums -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [CheckSums] -> ShowS
$cshowList :: [CheckSums] -> ShowS
show :: CheckSums -> [Char]
$cshow :: CheckSums -> [Char]
showsPrec :: Int -> CheckSums -> ShowS
$cshowsPrec :: Int -> CheckSums -> ShowS
Show, CheckSums -> CheckSums -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CheckSums -> CheckSums -> Bool
$c/= :: CheckSums -> CheckSums -> Bool
== :: CheckSums -> CheckSums -> Bool
$c== :: CheckSums -> CheckSums -> Bool
Eq)

-- |function-type for a function that downloads a file
-- The timestamp is optional. If the local file is as new or newer
-- than the remote copy, the download may be skipped.
--
-- A good choice might be a partially parameterized call to
-- 'Debian.Apt.Methods.fetch'
type Fetcher =
    URI ->              -- remote URI
    FilePath ->         -- local file name
    Maybe UTCTime ->    -- optional time stamp for local file
    IO Bool             -- True on success, False on failure

-- |update - similar to apt-get update

-- downloads the index files associated with a sources.list. The
-- downloaded index files will have the same basenames that apt-get uses
-- in \/var\/lib\/apt\/lists. You can almost use this function instead of
-- calling apt-get update. However there are a few key differences:
--  1. apt-get update also updates the binary cache files
--  2. apt-get update uses the partial directory and lock file in\ /var\/lib\/apt\/lists
--  3. apt-get update downloads the Release and Release.gpg files
update :: Fetcher -- ^ function that will do actually downloading
       -> FilePath -- ^ download indexes to the directory (must already exist)
       -> String -- ^ binary architecture
       -> [DebSource] -- ^ sources.list
       -> IO [Maybe (FilePath, Compression)] -- ^ (basename of index file, compression status)
update :: Fetcher
-> [Char]
-> [Char]
-> [DebSource]
-> IO [Maybe ([Char], Compression)]
update Fetcher
fetcher [Char]
basePath [Char]
arch [DebSource]
sourcesList =
    forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. (a -> b) -> a -> b
$ Fetcher -> URI -> [Char] -> IO (Maybe ([Char], Compression))
fetchIndex Fetcher
fetcher) (forall a b. (a -> b) -> [a] -> [b]
map (\(URI
uri, [Char]
fp, DebSource
_) -> (URI
uri, ([Char]
basePath [Char] -> ShowS
</> [Char]
fp))) (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Char] -> DebSource -> [(URI, [Char], DebSource)]
indexURIs [Char]
arch) [DebSource]
sourcesList))

-- | download possibly compressed files
-- NOTE: index uri must not include the .bz2 or .gz extension
fetchIndex :: Fetcher -- ^ function that will do the actual fetch
           -> URI -- ^ remote URI of package index, without .bz2 or .gz extension
           -> FilePath -- ^ name to save downloaded file as, without .bz2 or .gz extension
           -> IO (Maybe (FilePath, Compression)) -- ^ (downloaded file name + extension, compression status)
fetchIndex :: Fetcher -> URI -> [Char] -> IO (Maybe ([Char], Compression))
fetchIndex Fetcher
fetcher URI
uri [Char]
localPath =
    do let localPath' :: [Char]
localPath' = [Char]
localPath forall a. [a] -> [a] -> [a]
++ [Char]
".bz2"
       --lm <- getLastModified localPath'
       Bool
res <- Fetcher
fetcher (URI
uri { uriPath :: [Char]
uriPath = (URI -> [Char]
uriPath URI
uri) forall a. [a] -> [a] -> [a]
++ [Char]
".bz2" }) [Char]
localPath' forall a. Maybe a
Nothing
       if Bool
res
          then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ([Char]
localPath', Compression
BZ2)
          else do let localPath' :: [Char]
localPath' = [Char]
localPath forall a. [a] -> [a] -> [a]
++ [Char]
".gz"
                  Maybe UTCTime
lm <- [Char] -> IO (Maybe UTCTime)
getLastModified [Char]
localPath'
                  Bool
res <- Fetcher
fetcher (URI
uri { uriPath :: [Char]
uriPath = (URI -> [Char]
uriPath URI
uri) forall a. [a] -> [a] -> [a]
++ [Char]
".gz" }) [Char]
localPath' Maybe UTCTime
lm
                  if Bool
res
                     then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ([Char]
localPath', Compression
GZ)
                     else do Maybe UTCTime
lm <- [Char] -> IO (Maybe UTCTime)
getLastModified [Char]
localPath
                             Bool
res <- Fetcher
fetcher (URI
uri { uriPath :: [Char]
uriPath = (URI -> [Char]
uriPath URI
uri) }) [Char]
localPath Maybe UTCTime
lm
                             if Bool
res
                                then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just ([Char]
localPath, Compression
Uncompressed))
                                else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

-- |examine a DebSource line, and calculate for each section:
--  - the URI to the uncompressed index file
--  - the basename that apt-get would name the downloaded index
-- FIXME: ExactPath dist will fail with error at runtime :(
indexURIs :: String -- ^ which binary architecture
          -> DebSource -- ^ line from sources.list
          -> [(URI, FilePath, DebSource)] -- ^ (remote uri, local name, deb source for just this section)
indexURIs :: [Char] -> DebSource -> [(URI, [Char], DebSource)]
indexURIs [Char]
arch DebSource
debSource =
    forall a b. (a -> b) -> [a] -> [b]
map (\ Section
section -> let (URI
uri, [Char]
fp) = SourceType
-> [Char] -> VendorURI -> Codename -> Section -> (URI, [Char])
calcPath (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' DebSource SourceType
sourceType DebSource
debSource) [Char]
arch VendorURI
baseURI Codename
release Section
section
                      in (URI
uri,[Char]
fp, DebSource
debSource { _sourceDist :: Either [Char] (Codename, [Section])
_sourceDist = (forall a b. b -> Either a b
Right (Codename
release, [Section
section])) }) ) [Section]
sections
    where
      baseURI :: VendorURI
baseURI = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' DebSource VendorURI
sourceUri DebSource
debSource
      (Codename
release, [Section]
sections) =
          forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"indexURIs: support not implemented for exact path: " forall a. [a] -> [a] -> [a]
++ Doc -> [Char]
render (forall a. Pretty a => a -> Doc
pretty DebSource
debSource)) forall a. a -> a
id (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' DebSource (Either [Char] (Codename, [Section]))
sourceDist DebSource
debSource)

-- |return a tuple for the section
--  - the URI to the uncompressed index file
--  - the basename that apt-get uses for the downloaded index
-- FIXME: support for Release and Release.gpg
calcPath :: SourceType -- ^ do we want Packages or Sources
         -> String  -- ^ The binary architecture to use for Packages
         -> VendorURI -- ^ base URI as it appears in sources.list
         -> Codename -- ^ the release (e.g., unstable, testing, stable, sid, etc)
         -> Section -- ^ the section (main, contrib, non-free, etc)
         -> (URI, [Char]) -- ^ (uri to index file, basename for the downloaded file)
calcPath :: SourceType
-> [Char] -> VendorURI -> Codename -> Section -> (URI, [Char])
calcPath SourceType
srcType [Char]
arch VendorURI
baseURI Codename
release Section
section =
          let indexPath :: [Char]
indexPath = case SourceType
srcType of
                      SourceType
DebSrc -> [Char]
"source/Sources"
                      SourceType
Deb -> [Char]
"binary-" forall a. [a] -> [a] -> [a]
++ [Char]
arch [Char] -> ShowS
</> [Char]
"Packages"
              uri' :: URI
uri' = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' URI [Char]
uriPathLens (\[Char]
path -> [Char]
path [Char] -> ShowS
</> [Char]
"dists" [Char] -> ShowS
</> Codename -> [Char]
codename Codename
release [Char] -> ShowS
</> Section -> [Char]
sectionName' Section
section [Char] -> ShowS
</> [Char]
indexPath) (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Iso' VendorURI URI
vendorURI VendorURI
baseURI)
              path :: [Char]
path = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' URI [Char]
uriPathLens URI
uri'
          in (URI
uri', ShowS
addPrefix (ShowS
escapePath [Char]
path))
          where
            addPrefix :: ShowS
addPrefix [Char]
s = forall {a} {a}.
(Eq a, IsString a) =>
a -> Maybe [Char] -> Maybe a -> Maybe [Char] -> ShowS
prefix [Char]
scheme Maybe [Char]
user' Maybe [Char]
pass' Maybe [Char]
reg [Char]
port forall a. [a] -> [a] -> [a]
++ {- "_" ++ -} [Char]
s
            prefix :: a -> Maybe [Char] -> Maybe a -> Maybe [Char] -> ShowS
prefix a
"http:" (Just [Char]
user) Maybe a
Nothing (Just [Char]
host) [Char]
port = [Char]
user forall a. [a] -> [a] -> [a]
++ [Char]
host forall a. [a] -> [a] -> [a]
++ [Char]
port
            prefix a
"http:" Maybe [Char]
_ Maybe a
_ (Just [Char]
host) [Char]
port = [Char]
host forall a. [a] -> [a] -> [a]
++ [Char]
port
            prefix a
"ftp:" Maybe [Char]
_ Maybe a
_ (Just [Char]
host) [Char]
_ = [Char]
host
            prefix a
"file:" Maybe [Char]
Nothing Maybe a
Nothing Maybe [Char]
Nothing [Char]
"" = [Char]
""
            prefix a
"ssh:" (Just [Char]
user) Maybe a
Nothing (Just [Char]
host) [Char]
port = [Char]
user forall a. [a] -> [a] -> [a]
++ [Char]
host forall a. [a] -> [a] -> [a]
++ [Char]
port
            prefix a
"ssh:" Maybe [Char]
_ Maybe a
_ (Just [Char]
host) [Char]
port = [Char]
host forall a. [a] -> [a] -> [a]
++ [Char]
port
            prefix a
_ Maybe [Char]
_ Maybe a
_ Maybe [Char]
_ [Char]
_ = forall a. HasCallStack => [Char] -> a
error ([Char]
"calcPath: unsupported uri: " forall a. [a] -> [a] -> [a]
++ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Iso' VendorURI URI
vendorURI forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to URI -> [Char]
uriToString') VendorURI
baseURI)
            user' :: Maybe [Char]
user' = [Char] -> Maybe [Char]
maybeOfString [Char]
user
            pass' :: Maybe [Char]
pass' = [Char] -> Maybe [Char]
maybeOfString [Char]
pass
            ([Char]
user, [Char]
pass) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
':') [Char]
userpass
            userpass :: [Char]
userpass = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" URIAuth -> [Char]
uriUserInfo Maybe URIAuth
auth
            reg :: Maybe [Char]
reg = [Char] -> Maybe [Char]
maybeOfString forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" URIAuth -> [Char]
uriRegName Maybe URIAuth
auth
            port :: [Char]
port = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" URIAuth -> [Char]
uriPort Maybe URIAuth
auth
            scheme :: [Char]
scheme = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Iso' VendorURI URI
vendorURI forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to URI -> [Char]
uriScheme) VendorURI
baseURI
            auth :: Maybe URIAuth
auth = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Iso' VendorURI URI
vendorURI forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to URI -> Maybe URIAuth
uriAuthority) VendorURI
baseURI
            --path = uriPath baseURI

            escapePath :: String -> String
            escapePath :: ShowS
escapePath [Char]
s = forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"_" forall a b. (a -> b) -> a -> b
$ forall a. Eq a => (a -> Bool) -> [a] -> [[a]]
wordsBy (forall a. Eq a => a -> a -> Bool
== Char
'/') [Char]
s

            maybeOfString :: String -> Maybe String
            maybeOfString :: [Char] -> Maybe [Char]
maybeOfString [Char]
"" = forall a. Maybe a
Nothing
            maybeOfString [Char]
s = forall a. a -> Maybe a
Just [Char]
s

            wordsBy :: Eq a => (a -> Bool) -> [a] -> [[a]]
            wordsBy :: forall a. Eq a => (a -> Bool) -> [a] -> [[a]]
wordsBy a -> Bool
p [a]
s =
                case (forall a. (a -> Bool) -> [a] -> ([a], [a])
break a -> Bool
p [a]
s) of
                  ([a]
s, []) -> [[a]
s]
                  ([a]
h, [a]
t) -> [a]
h forall a. a -> [a] -> [a]
: forall a. Eq a => (a -> Bool) -> [a] -> [[a]]
wordsBy a -> Bool
p (forall a. Int -> [a] -> [a]
drop Int
1 [a]
t)

-- |Parse a possibly compressed index file.
controlFromIndex :: Compression -> FilePath -> L.ByteString -> Either ParseError (Control' Text)
controlFromIndex :: Compression
-> [Char] -> ByteString -> Either ParseError (Control' Text)
controlFromIndex Compression
GZ [Char]
path ByteString
s = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Control -> Control' Text
decodeControl) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ControlFunctions a =>
[Char] -> a -> Either ParseError (Control' a)
parseControl [Char]
path forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
B.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
L.toChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
GZip.decompress forall a b. (a -> b) -> a -> b
$ ByteString
s
controlFromIndex Compression
BZ2 [Char]
path ByteString
s = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Control -> Control' Text
decodeControl) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ControlFunctions a =>
[Char] -> a -> Either ParseError (Control' a)
parseControl [Char]
path forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
B.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
L.toChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BZip.decompress forall a b. (a -> b) -> a -> b
$ ByteString
s
controlFromIndex Compression
Uncompressed [Char]
path ByteString
s = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Control -> Control' Text
decodeControl) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ControlFunctions a =>
[Char] -> a -> Either ParseError (Control' a)
parseControl [Char]
path forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
B.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
L.toChunks forall a b. (a -> b) -> a -> b
$ ByteString
s

-- |parse an index possibly compressed file
controlFromIndex' :: Compression -> FilePath -> IO (Either ParseError (Control' Text))
controlFromIndex' :: Compression -> [Char] -> IO (Either ParseError (Control' Text))
controlFromIndex' Compression
compression [Char]
path = [Char] -> IO ByteString
L.readFile [Char]
path forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compression
-> [Char] -> ByteString -> Either ParseError (Control' Text)
controlFromIndex Compression
compression [Char]
path

type Size = Integer
type FileTuple = (CheckSums, Size, FilePath)

-- |A release file contains a list of indexes (Packages\/Sources). Each
-- Package or Source index may appear multiple times because it may be
-- compressed several different ways. This function will return an
-- assoc list where the key is the name of the uncompressed package
-- index name and the value is the list of (file, compression) which
-- decompress to the key.
groupIndexes :: [FileTuple] -> [(FilePath, [(FileTuple, Compression)])]
groupIndexes :: [FileTuple] -> [([Char], [(FileTuple, Compression)])]
groupIndexes [FileTuple]
indexFiles =
    forall k a. Map k a -> [(k, a)]
M.toList forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith forall {a}.
[(a, Compression)] -> [(a, Compression)] -> [(a, Compression)]
combine forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a} {b}.
(a, b, [Char]) -> ([Char], [((a, b, [Char]), Compression)])
makeKV [FileTuple]
indexFiles
    where
      makeKV :: (a, b, [Char]) -> ([Char], [((a, b, [Char]), Compression)])
makeKV fileTuple :: (a, b, [Char])
fileTuple@(a
_,b
_,[Char]
fp) =
          let ([Char]
name, Compression
compressionMethod) = [Char] -> ([Char], Compression)
uncompressedName [Char]
fp
          in
            ([Char]
name, [((a, b, [Char])
fileTuple, Compression
compressionMethod)])
      combine :: [(a, Compression)] -> [(a, Compression)] -> [(a, Compression)]
combine = (\[(a, Compression)]
x [(a, Compression)]
y -> forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> b
snd) ([(a, Compression)]
x forall a. [a] -> [a] -> [a]
++ [(a, Compression)]
y))
{-
      with t@(_,_,fp) m =
          let (un, compression) =
          in
            M.insertWith
-}

{-
groupIndexes' :: String ->[FileTuple] -> [(FilePath, [(FileTuple, Compression)])]
groupIndexes' iType indexFiles =
    M.toList (foldr (insertType iType) M.empty indexFiles)
    where
      insertType iType t@(_,_,fp) m =
          case uncompressedName' iType fp of
            Nothing -> m
            (Just (un, compression)) ->
                M.insertWith (\x y -> sortBy (compare `on` snd) (x ++ y)) un [(t, compression)] m
-}

-- |The release file contains the checksums for the uncompressed
-- package indexes, even if the uncompressed package indexes are not
-- stored on the server. This function returns the list of files that
-- actually exist.
filterExists :: FilePath -> (FilePath, [(FileTuple, Compression)]) -> IO (FilePath, [(FileTuple, Compression)])
filterExists :: [Char]
-> ([Char], [(FileTuple, Compression)])
-> IO ([Char], [(FileTuple, Compression)])
filterExists [Char]
distDir ([Char]
fp, [(FileTuple, Compression)]
alternatives) =
          do [(FileTuple, Compression)]
e <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ( \((CheckSums
_,Size
_,[Char]
fp),Compression
_) -> [Char] -> IO Bool
fileExist ([Char]
distDir [Char] -> ShowS
</> [Char]
fp)) [(FileTuple, Compression)]
alternatives
             -- when (null e) (error $ "None of these files exist: " ++ show alternatives)
             forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
fp, [(FileTuple, Compression)]
e)

findIndexes :: FilePath -> String -> [FileTuple] -> IO [(FileTuple, Compression)]
findIndexes :: [Char] -> [Char] -> [FileTuple] -> IO [(FileTuple, Compression)]
findIndexes [Char]
distDir [Char]
iType [FileTuple]
controlFiles =
    let indexes :: [([Char], [(FileTuple, Compression)])]
indexes = [FileTuple] -> [([Char], [(FileTuple, Compression)])]
groupIndexes [FileTuple]
controlFiles
    in
      do [([Char], [(FileTuple, Compression)])]
indexes' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Char]
-> ([Char], [(FileTuple, Compression)])
-> IO ([Char], [(FileTuple, Compression)])
filterExists [Char]
distDir) (forall a. (a -> Bool) -> [a] -> [a]
filter (forall {a} {b}. Eq a => [a] -> ([a], b) -> Bool
isType [Char]
iType) [([Char], [(FileTuple, Compression)])]
indexes)
         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [([Char], [(FileTuple, Compression)])]
indexes')
    where
      isType :: [a] -> ([a], b) -> Bool
isType [a]
iType ([a]
fp, b
_) = [a]
iType forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [a]
fp

{-
findIndexes' :: FilePath -> String -> [FileTuple] -> IO [(FileTuple, Compression)]
findIndexes' distDir iType controlFiles =
    let m = groupIndexes' iType controlFiles
    in
      do m' <- mapM (filterExists distDir) m
         return $ map (head . snd) (filter (not . null . snd) m')
-}

      -- insertType :: String -> (CheckSums, Integer, FilePath) -> M.Map FilePath ((CheckSums, Integer, FilePath), Compression) -> M.Map FilePath ((CheckSums, Integer, FilePath), Compression)

{-
uncompressedName' :: String -> FilePath -> Maybe (FilePath, Compression)
uncompressedName' iType fp
          | isSuffixOf iType fp = Just (fp, Uncompressed)
          | isSuffixOf (iType ++".gz") fp = Just (reverse . (drop 3) . reverse $ fp, GZ)
          | isSuffixOf (iType ++".bz2") fp = Just (reverse . (drop 4) . reverse $ fp, BZ2)
          | otherwise = Nothing
-}

uncompressedName :: FilePath -> (FilePath, Compression)
uncompressedName :: [Char] -> ([Char], Compression)
uncompressedName [Char]
fp
          | forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf [Char]
".gz"  [Char]
fp = (forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Int -> [a] -> [a]
drop Int
3) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ [Char]
fp, Compression
GZ)
          | forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf [Char]
".bz2" [Char]
fp = (forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Int -> [a] -> [a]
drop Int
4) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ [Char]
fp, Compression
BZ2)
          | Bool
otherwise            = ([Char]
fp, Compression
Uncompressed)

indexesInRelease :: (FilePath -> Bool)
                 -> Control' Text -- ^ A release file
                 -> [(CheckSums, Integer, FilePath)] -- ^
indexesInRelease :: ([Char] -> Bool) -> Control' Text -> [FileTuple]
indexesInRelease [Char] -> Bool
filterp (Control [Paragraph' Text
p]) =
    -- In a release file we should find one or more of the fields
    -- "SHA256", "SHA1", or "MD5Sum", each containing a list of triples
    case ([[Char]], [[FileTuple]])
attempts of
      ([[Char]]
_, [FileTuple]
fps:[[FileTuple]]
_) -> forall a. (a -> Bool) -> [a] -> [a]
filter (\(CheckSums
_,Size
_,[Char]
fp) -> [Char] -> Bool
filterp [Char]
fp) [FileTuple]
fps
      ([[Char]]
errs,  [[FileTuple]]
_) -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"No indexes in release: " forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " [[Char]]
errs
    where
      attempts :: ([[Char]], [[FileTuple]])
attempts = forall a b. [Either a b] -> ([a], [b])
partitionEithers
        [ ([Char] -> CheckSums) -> [Char] -> Either [Char] [FileTuple]
attempt [Char] -> CheckSums
makeSHA256 [Char]
"SHA256"
        , ([Char] -> CheckSums) -> [Char] -> Either [Char] [FileTuple]
attempt [Char] -> CheckSums
makeSHA1 [Char]
"SHA1"
        , ([Char] -> CheckSums) -> [Char] -> Either [Char] [FileTuple]
attempt [Char] -> CheckSums
makeMD5 [Char]
"MD5Sum" ]

      attempt :: ([Char] -> CheckSums) -> [Char] -> Either [Char] [FileTuple]
attempt [Char] -> CheckSums
mksum [Char]
fn = ([Char] -> CheckSums)
-> [(Text, Text, Text)] -> Either [Char] [FileTuple]
makeTuples [Char] -> CheckSums
mksum forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Either [Char] [(Text, Text, Text)]
makeTriples forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"No " forall a. Semigroup a => a -> a -> a
<> [Char]
fn forall a. Semigroup a => a -> a -> a
<> [Char]
" Field") forall a b. b -> Either a b
Right (forall a. ControlFunctions a => [Char] -> Paragraph' a -> Maybe a
fieldValue [Char]
fn Paragraph' Text
p)

      makeSHA256 :: [Char] -> CheckSums
makeSHA256 [Char]
s = CheckSums {md5sum :: Maybe [Char]
md5sum = forall a. Maybe a
Nothing, sha1 :: Maybe [Char]
sha1 = forall a. Maybe a
Nothing, sha256 :: Maybe [Char]
sha256 = forall a. a -> Maybe a
Just [Char]
s}
      makeSHA1 :: [Char] -> CheckSums
makeSHA1 [Char]
s = CheckSums {md5sum :: Maybe [Char]
md5sum = forall a. Maybe a
Nothing, sha1 :: Maybe [Char]
sha1 = forall a. a -> Maybe a
Just [Char]
s, sha256 :: Maybe [Char]
sha256 = forall a. Maybe a
Nothing}
      makeMD5 :: [Char] -> CheckSums
makeMD5 [Char]
s = CheckSums {md5sum :: Maybe [Char]
md5sum = forall a. a -> Maybe a
Just [Char]
s, sha1 :: Maybe [Char]
sha1 = forall a. Maybe a
Nothing, sha256 :: Maybe [Char]
sha256 = forall a. Maybe a
Nothing}

      makeTuples :: (String -> CheckSums) -> [(Text, Text, Text)] -> Either String [(CheckSums, Integer, FilePath)]
      makeTuples :: ([Char] -> CheckSums)
-> [(Text, Text, Text)] -> Either [Char] [FileTuple]
makeTuples [Char] -> CheckSums
mk [(Text, Text, Text)]
triples =
          case forall a b. [Either a b] -> ([a], [b])
partitionEithers (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Char] -> CheckSums)
-> (Text, Text, Text) -> Either [Char] FileTuple
makeTuple [Char] -> CheckSums
mk) [(Text, Text, Text)]
triples) of
            ([], [FileTuple]
tuples) -> forall a b. b -> Either a b
Right [FileTuple]
tuples
            ([Char]
s : [[Char]]
_, [FileTuple]
_) -> forall a b. a -> Either a b
Left [Char]
s

      makeTuple :: (String -> CheckSums) -> (Text, Text, Text) -> Either String (CheckSums, Integer, FilePath)
      makeTuple :: ([Char] -> CheckSums)
-> (Text, Text, Text) -> Either [Char] FileTuple
makeTuple [Char] -> CheckSums
mk (Text
sum, Text
size, Text
fp) =
          (,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> CheckSums
mk (Text -> [Char]
Text.unpack Text
sum))
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left ([Char]
"Invalid size field: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Text
size)) forall a b. b -> Either a b
Right (forall a. Read a => [Char] -> Maybe a
readMaybe (Text -> [Char]
Text.unpack Text
size))
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> [Char]
Text.unpack Text
fp)

      makeTriples :: Text -> Either String [(Text, Text, Text)]
      makeTriples :: Text -> Either [Char] [(Text, Text, Text)]
makeTriples Text
t = case forall a b. [Either a b] -> ([a], [b])
partitionEithers (forall a b. (a -> b) -> [a] -> [b]
map Text -> Either [Char] (Text, Text, Text)
makeTriple (Text -> [Text]
Text.lines Text
t)) of
                        ([], [(Text, Text, Text)]
xs) -> forall a b. b -> Either a b
Right [(Text, Text, Text)]
xs
                        ([Char]
s : [[Char]]
_, [(Text, Text, Text)]
_) -> forall a b. a -> Either a b
Left [Char]
s

      makeTriple :: Text -> Either String (Text, Text, Text)
      makeTriple :: Text -> Either [Char] (Text, Text, Text)
makeTriple Text
t = case Text -> [Text]
Text.words Text
t of
                       [Text
a, Text
b, Text
c] -> forall a b. b -> Either a b
Right (Text
a, Text
b, Text
c)
                       [Text]
_ -> forall a b. a -> Either a b
Left ([Char]
"Invalid checksum line: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Text
t)
indexesInRelease [Char] -> Bool
_ Control' Text
x = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid release file: " forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
Text.unpack ([Text] -> Text
Text.concat (Control' Text -> [Text]
formatControl Control' Text
x))

-- |make a FileTuple for a file found on the local disk
-- returns 'Nothing' if the file does not exist.
tupleFromFilePath :: FilePath -> FilePath -> IO (Maybe FileTuple)
tupleFromFilePath :: [Char] -> [Char] -> IO (Maybe FileTuple)
tupleFromFilePath [Char]
basePath [Char]
fp =
          do Bool
e <- [Char] -> IO Bool
fileExist ([Char]
basePath [Char] -> ShowS
</> [Char]
fp)
             if Bool -> Bool
not Bool
e
              then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
              else do Size
size <- [Char] -> IO FileStatus
getFileStatus ([Char]
basePath [Char] -> ShowS
</> [Char]
fp) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> FileOffset
fileSize
                      [Char]
md5 <- [Char] -> IO ByteString
L.readFile ([Char]
basePath [Char] -> ShowS
</> [Char]
fp) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> MD5Digest
MD5.md5
                      [Char]
sha1 <- [Char] -> IO ByteString
L.readFile ([Char]
basePath [Char] -> ShowS
</> [Char]
fp) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Digest SHA1State
SHA.sha1
                      [Char]
sha256 <- [Char] -> IO ByteString
L.readFile ([Char]
basePath [Char] -> ShowS
</> [Char]
fp) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Digest SHA256State
SHA.sha256
                      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (CheckSums { md5sum :: Maybe [Char]
md5sum = forall a. a -> Maybe a
Just [Char]
md5, sha1 :: Maybe [Char]
sha1 = forall a. a -> Maybe a
Just [Char]
sha1, sha256 :: Maybe [Char]
sha256 = forall a. a -> Maybe a
Just [Char]
sha256 }, Size
size, [Char]
fp)

-- |find the Contents-* files. These are not listed in the Release file
findContentsFiles :: (FilePath -> Bool) -> FilePath -> IO [FilePath]
findContentsFiles :: ([Char] -> Bool) -> [Char] -> IO [[Char]]
findContentsFiles [Char] -> Bool
filterP [Char]
distDir =
          do [[Char]]
files <- [Char] -> IO [[Char]]
getDirectoryContents [Char]
distDir
             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter [Char] -> Bool
filterP forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [Char]
"Contents-" forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
takeBaseName) [[Char]]
files