{-# 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]
(Int -> ReadS Compression)
-> ReadS [Compression]
-> ReadPrec Compression
-> ReadPrec [Compression]
-> Read 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 -> String
(Int -> Compression -> ShowS)
-> (Compression -> String)
-> ([Compression] -> ShowS)
-> Show Compression
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Compression] -> ShowS
$cshowList :: [Compression] -> ShowS
show :: Compression -> String
$cshow :: Compression -> String
showsPrec :: Int -> Compression -> ShowS
$cshowsPrec :: Int -> Compression -> ShowS
Show, Compression -> Compression -> Bool
(Compression -> Compression -> Bool)
-> (Compression -> Compression -> Bool) -> Eq Compression
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
Eq Compression
-> (Compression -> Compression -> Ordering)
-> (Compression -> Compression -> Bool)
-> (Compression -> Compression -> Bool)
-> (Compression -> Compression -> Bool)
-> (Compression -> Compression -> Bool)
-> (Compression -> Compression -> Compression)
-> (Compression -> Compression -> Compression)
-> Ord 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
$cp1Ord :: Eq Compression
Ord, Int -> Compression
Compression -> Int
Compression -> [Compression]
Compression -> Compression
Compression -> Compression -> [Compression]
Compression -> Compression -> Compression -> [Compression]
(Compression -> Compression)
-> (Compression -> Compression)
-> (Int -> Compression)
-> (Compression -> Int)
-> (Compression -> [Compression])
-> (Compression -> Compression -> [Compression])
-> (Compression -> Compression -> [Compression])
-> (Compression -> Compression -> Compression -> [Compression])
-> Enum 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
Compression -> Compression -> Bounded Compression
forall a. a -> a -> Bounded a
maxBound :: Compression
$cmaxBound :: Compression
minBound :: Compression
$cminBound :: Compression
Bounded)

data CheckSums
    = CheckSums { CheckSums -> Maybe String
md5sum :: Maybe String
                , CheckSums -> Maybe String
sha1   :: Maybe String
                , CheckSums -> Maybe String
sha256 :: Maybe String
                }
      deriving (ReadPrec [CheckSums]
ReadPrec CheckSums
Int -> ReadS CheckSums
ReadS [CheckSums]
(Int -> ReadS CheckSums)
-> ReadS [CheckSums]
-> ReadPrec CheckSums
-> ReadPrec [CheckSums]
-> Read 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 -> String
(Int -> CheckSums -> ShowS)
-> (CheckSums -> String)
-> ([CheckSums] -> ShowS)
-> Show CheckSums
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CheckSums] -> ShowS
$cshowList :: [CheckSums] -> ShowS
show :: CheckSums -> String
$cshow :: CheckSums -> String
showsPrec :: Int -> CheckSums -> ShowS
$cshowsPrec :: Int -> CheckSums -> ShowS
Show, CheckSums -> CheckSums -> Bool
(CheckSums -> CheckSums -> Bool)
-> (CheckSums -> CheckSums -> Bool) -> Eq CheckSums
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
-> String
-> String
-> [DebSource]
-> IO [Maybe (String, Compression)]
update Fetcher
fetcher String
basePath String
arch [DebSource]
sourcesList =
    ((URI, String) -> IO (Maybe (String, Compression)))
-> [(URI, String)] -> IO [Maybe (String, Compression)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((URI -> String -> IO (Maybe (String, Compression)))
-> (URI, String) -> IO (Maybe (String, Compression))
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((URI -> String -> IO (Maybe (String, Compression)))
 -> (URI, String) -> IO (Maybe (String, Compression)))
-> (URI -> String -> IO (Maybe (String, Compression)))
-> (URI, String)
-> IO (Maybe (String, Compression))
forall a b. (a -> b) -> a -> b
$ Fetcher -> URI -> String -> IO (Maybe (String, Compression))
fetchIndex Fetcher
fetcher) (((URI, String, DebSource) -> (URI, String))
-> [(URI, String, DebSource)] -> [(URI, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\(URI
uri, String
fp, DebSource
_) -> (URI
uri, (String
basePath String -> ShowS
</> String
fp))) ((DebSource -> [(URI, String, DebSource)])
-> [DebSource] -> [(URI, String, DebSource)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> DebSource -> [(URI, String, DebSource)]
indexURIs String
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 -> String -> IO (Maybe (String, Compression))
fetchIndex Fetcher
fetcher URI
uri String
localPath =
    do let localPath' :: String
localPath' = String
localPath String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".bz2"
       --lm <- getLastModified localPath'
       Bool
res <- Fetcher
fetcher (URI
uri { uriPath :: String
uriPath = (URI -> String
uriPath URI
uri) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".bz2" }) String
localPath' Maybe UTCTime
forall a. Maybe a
Nothing
       if Bool
res
          then Maybe (String, Compression) -> IO (Maybe (String, Compression))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (String, Compression) -> IO (Maybe (String, Compression)))
-> Maybe (String, Compression) -> IO (Maybe (String, Compression))
forall a b. (a -> b) -> a -> b
$ (String, Compression) -> Maybe (String, Compression)
forall a. a -> Maybe a
Just (String
localPath', Compression
BZ2)
          else do let localPath' :: String
localPath' = String
localPath String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".gz"
                  Maybe UTCTime
lm <- String -> IO (Maybe UTCTime)
getLastModified String
localPath'
                  Bool
res <- Fetcher
fetcher (URI
uri { uriPath :: String
uriPath = (URI -> String
uriPath URI
uri) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".gz" }) String
localPath' Maybe UTCTime
lm
                  if Bool
res
                     then Maybe (String, Compression) -> IO (Maybe (String, Compression))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (String, Compression) -> IO (Maybe (String, Compression)))
-> Maybe (String, Compression) -> IO (Maybe (String, Compression))
forall a b. (a -> b) -> a -> b
$ (String, Compression) -> Maybe (String, Compression)
forall a. a -> Maybe a
Just (String
localPath', Compression
GZ)
                     else do Maybe UTCTime
lm <- String -> IO (Maybe UTCTime)
getLastModified String
localPath
                             Bool
res <- Fetcher
fetcher (URI
uri { uriPath :: String
uriPath = (URI -> String
uriPath URI
uri) }) String
localPath Maybe UTCTime
lm
                             if Bool
res
                                then Maybe (String, Compression) -> IO (Maybe (String, Compression))
forall (m :: * -> *) a. Monad m => a -> m a
return ((String, Compression) -> Maybe (String, Compression)
forall a. a -> Maybe a
Just (String
localPath, Compression
Uncompressed))
                                else Maybe (String, Compression) -> IO (Maybe (String, Compression))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (String, Compression)
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 :: String -> DebSource -> [(URI, String, DebSource)]
indexURIs String
arch DebSource
debSource =
    (Section -> (URI, String, DebSource))
-> [Section] -> [(URI, String, DebSource)]
forall a b. (a -> b) -> [a] -> [b]
map (\ Section
section -> let (URI
uri, String
fp) = SourceType
-> String -> VendorURI -> Codename -> Section -> (URI, String)
calcPath (Getting SourceType DebSource SourceType -> DebSource -> SourceType
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting SourceType DebSource SourceType
Lens' DebSource SourceType
sourceType DebSource
debSource) String
arch VendorURI
baseURI Codename
release Section
section
                      in (URI
uri,String
fp, DebSource
debSource { _sourceDist :: Either String (Codename, [Section])
_sourceDist = ((Codename, [Section]) -> Either String (Codename, [Section])
forall a b. b -> Either a b
Right (Codename
release, [Section
section])) }) ) [Section]
sections
    where
      baseURI :: VendorURI
baseURI = Getting VendorURI DebSource VendorURI -> DebSource -> VendorURI
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting VendorURI DebSource VendorURI
Lens' DebSource VendorURI
sourceUri DebSource
debSource
      (Codename
release, [Section]
sections) =
          (String -> (Codename, [Section]))
-> ((Codename, [Section]) -> (Codename, [Section]))
-> Either String (Codename, [Section])
-> (Codename, [Section])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> String -> (Codename, [Section])
forall a. HasCallStack => String -> a
error (String -> String -> (Codename, [Section]))
-> String -> String -> (Codename, [Section])
forall a b. (a -> b) -> a -> b
$ String
"indexURIs: support not implemented for exact path: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Doc -> String
render (DebSource -> Doc
forall a. Pretty a => a -> Doc
pretty DebSource
debSource)) (Codename, [Section]) -> (Codename, [Section])
forall a. a -> a
id (Getting
  (Either String (Codename, [Section]))
  DebSource
  (Either String (Codename, [Section]))
-> DebSource -> Either String (Codename, [Section])
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Either String (Codename, [Section]))
  DebSource
  (Either String (Codename, [Section]))
Lens' DebSource (Either String (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
-> String -> VendorURI -> Codename -> Section -> (URI, String)
calcPath SourceType
srcType String
arch VendorURI
baseURI Codename
release Section
section =
          let indexPath :: String
indexPath = case SourceType
srcType of
                      SourceType
DebSrc -> String
"source/Sources"
                      SourceType
Deb -> String
"binary-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
arch String -> ShowS
</> String
"Packages"
              uri' :: URI
uri' = ASetter URI URI String String -> ShowS -> URI -> URI
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter URI URI String String
Lens' URI String
uriPathLens (\String
path -> String
path String -> ShowS
</> String
"dists" String -> ShowS
</> Codename -> String
codename Codename
release String -> ShowS
</> Section -> String
sectionName' Section
section String -> ShowS
</> String
indexPath) (Getting URI VendorURI URI -> VendorURI -> URI
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting URI VendorURI URI
Iso' VendorURI URI
vendorURI VendorURI
baseURI)
              path :: String
path = Getting String URI String -> URI -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String URI String
Lens' URI String
uriPathLens URI
uri'
          in (URI
uri', ShowS
addPrefix (ShowS
escapePath String
path))
          where
            addPrefix :: ShowS
addPrefix String
s = String -> Maybe String -> Maybe String -> Maybe String -> ShowS
forall a a.
(Eq a, IsString a) =>
a -> Maybe String -> Maybe a -> Maybe String -> ShowS
prefix String
scheme Maybe String
user' Maybe String
pass' Maybe String
reg String
port String -> ShowS
forall a. [a] -> [a] -> [a]
++ {- "_" ++ -} String
s
            prefix :: a -> Maybe String -> Maybe a -> Maybe String -> ShowS
prefix a
"http:" (Just String
user) Maybe a
Nothing (Just String
host) String
port = String
user String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
host String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
port
            prefix a
"http:" Maybe String
_ Maybe a
_ (Just String
host) String
port = String
host String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
port
            prefix a
"ftp:" Maybe String
_ Maybe a
_ (Just String
host) String
_ = String
host
            prefix a
"file:" Maybe String
Nothing Maybe a
Nothing Maybe String
Nothing String
"" = String
""
            prefix a
"ssh:" (Just String
user) Maybe a
Nothing (Just String
host) String
port = String
user String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
host String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
port
            prefix a
"ssh:" Maybe String
_ Maybe a
_ (Just String
host) String
port = String
host String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
port
            prefix a
_ Maybe String
_ Maybe a
_ Maybe String
_ String
_ = ShowS
forall a. HasCallStack => String -> a
error (String
"calcPath: unsupported uri: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Getting String VendorURI String -> VendorURI -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((URI -> Const String URI) -> VendorURI -> Const String VendorURI
Iso' VendorURI URI
vendorURI ((URI -> Const String URI) -> VendorURI -> Const String VendorURI)
-> Getting String URI String -> Getting String VendorURI String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (URI -> String) -> Getting String URI String
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to URI -> String
uriToString') VendorURI
baseURI)
            user' :: Maybe String
user' = String -> Maybe String
maybeOfString String
user
            pass' :: Maybe String
pass' = String -> Maybe String
maybeOfString String
pass
            (String
user, String
pass) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') String
userpass
            userpass :: String
userpass = String -> (URIAuth -> String) -> Maybe URIAuth -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" URIAuth -> String
uriUserInfo Maybe URIAuth
auth
            reg :: Maybe String
reg = String -> Maybe String
maybeOfString (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> (URIAuth -> String) -> Maybe URIAuth -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" URIAuth -> String
uriRegName Maybe URIAuth
auth
            port :: String
port = String -> (URIAuth -> String) -> Maybe URIAuth -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" URIAuth -> String
uriPort Maybe URIAuth
auth
            scheme :: String
scheme = Getting String VendorURI String -> VendorURI -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((URI -> Const String URI) -> VendorURI -> Const String VendorURI
Iso' VendorURI URI
vendorURI ((URI -> Const String URI) -> VendorURI -> Const String VendorURI)
-> Getting String URI String -> Getting String VendorURI String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (URI -> String) -> Getting String URI String
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to URI -> String
uriScheme) VendorURI
baseURI
            auth :: Maybe URIAuth
auth = Getting (Maybe URIAuth) VendorURI (Maybe URIAuth)
-> VendorURI -> Maybe URIAuth
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((URI -> Const (Maybe URIAuth) URI)
-> VendorURI -> Const (Maybe URIAuth) VendorURI
Iso' VendorURI URI
vendorURI ((URI -> Const (Maybe URIAuth) URI)
 -> VendorURI -> Const (Maybe URIAuth) VendorURI)
-> ((Maybe URIAuth -> Const (Maybe URIAuth) (Maybe URIAuth))
    -> URI -> Const (Maybe URIAuth) URI)
-> Getting (Maybe URIAuth) VendorURI (Maybe URIAuth)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (URI -> Maybe URIAuth)
-> (Maybe URIAuth -> Const (Maybe URIAuth) (Maybe URIAuth))
-> URI
-> Const (Maybe URIAuth) URI
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 String
s = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"_" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> [String]
forall a. Eq a => (a -> Bool) -> [a] -> [[a]]
wordsBy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') String
s

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

            wordsBy :: Eq a => (a -> Bool) -> [a] -> [[a]]
            wordsBy :: (a -> Bool) -> [a] -> [[a]]
wordsBy a -> Bool
p [a]
s =
                case ((a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break a -> Bool
p [a]
s) of
                  ([a]
s, []) -> [[a]
s]
                  ([a]
h, [a]
t) -> [a]
h [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: (a -> Bool) -> [a] -> [[a]]
forall a. Eq a => (a -> Bool) -> [a] -> [[a]]
wordsBy a -> Bool
p (Int -> [a] -> [a]
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
-> String -> ByteString -> Either ParseError (Control' Text)
controlFromIndex Compression
GZ String
path ByteString
s = (ParseError -> Either ParseError (Control' Text))
-> (Control -> Either ParseError (Control' Text))
-> Either ParseError Control
-> Either ParseError (Control' Text)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseError -> Either ParseError (Control' Text)
forall a b. a -> Either a b
Left (Control' Text -> Either ParseError (Control' Text)
forall a b. b -> Either a b
Right (Control' Text -> Either ParseError (Control' Text))
-> (Control -> Control' Text)
-> Control
-> Either ParseError (Control' Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Control -> Control' Text
decodeControl) (Either ParseError Control -> Either ParseError (Control' Text))
-> (ByteString -> Either ParseError Control)
-> ByteString
-> Either ParseError (Control' Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString -> Either ParseError Control
forall a.
ControlFunctions a =>
String -> a -> Either ParseError (Control' a)
parseControl String
path (ByteString -> Either ParseError Control)
-> (ByteString -> ByteString)
-> ByteString
-> Either ParseError Control
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
L.toChunks (ByteString -> [ByteString])
-> (ByteString -> ByteString) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
GZip.decompress (ByteString -> Either ParseError (Control' Text))
-> ByteString -> Either ParseError (Control' Text)
forall a b. (a -> b) -> a -> b
$ ByteString
s
controlFromIndex Compression
BZ2 String
path ByteString
s = (ParseError -> Either ParseError (Control' Text))
-> (Control -> Either ParseError (Control' Text))
-> Either ParseError Control
-> Either ParseError (Control' Text)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseError -> Either ParseError (Control' Text)
forall a b. a -> Either a b
Left (Control' Text -> Either ParseError (Control' Text)
forall a b. b -> Either a b
Right (Control' Text -> Either ParseError (Control' Text))
-> (Control -> Control' Text)
-> Control
-> Either ParseError (Control' Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Control -> Control' Text
decodeControl) (Either ParseError Control -> Either ParseError (Control' Text))
-> (ByteString -> Either ParseError Control)
-> ByteString
-> Either ParseError (Control' Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString -> Either ParseError Control
forall a.
ControlFunctions a =>
String -> a -> Either ParseError (Control' a)
parseControl String
path (ByteString -> Either ParseError Control)
-> (ByteString -> ByteString)
-> ByteString
-> Either ParseError Control
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
L.toChunks (ByteString -> [ByteString])
-> (ByteString -> ByteString) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BZip.decompress (ByteString -> Either ParseError (Control' Text))
-> ByteString -> Either ParseError (Control' Text)
forall a b. (a -> b) -> a -> b
$ ByteString
s
controlFromIndex Compression
Uncompressed String
path ByteString
s = (ParseError -> Either ParseError (Control' Text))
-> (Control -> Either ParseError (Control' Text))
-> Either ParseError Control
-> Either ParseError (Control' Text)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseError -> Either ParseError (Control' Text)
forall a b. a -> Either a b
Left (Control' Text -> Either ParseError (Control' Text)
forall a b. b -> Either a b
Right (Control' Text -> Either ParseError (Control' Text))
-> (Control -> Control' Text)
-> Control
-> Either ParseError (Control' Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Control -> Control' Text
decodeControl) (Either ParseError Control -> Either ParseError (Control' Text))
-> (ByteString -> Either ParseError Control)
-> ByteString
-> Either ParseError (Control' Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString -> Either ParseError Control
forall a.
ControlFunctions a =>
String -> a -> Either ParseError (Control' a)
parseControl String
path (ByteString -> Either ParseError Control)
-> (ByteString -> ByteString)
-> ByteString
-> Either ParseError Control
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
L.toChunks (ByteString -> Either ParseError (Control' Text))
-> ByteString -> Either ParseError (Control' Text)
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 -> String -> IO (Either ParseError (Control' Text))
controlFromIndex' Compression
compression String
path = String -> IO ByteString
L.readFile String
path IO ByteString
-> (ByteString -> IO (Either ParseError (Control' Text)))
-> IO (Either ParseError (Control' Text))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either ParseError (Control' Text)
-> IO (Either ParseError (Control' Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ParseError (Control' Text)
 -> IO (Either ParseError (Control' Text)))
-> (ByteString -> Either ParseError (Control' Text))
-> ByteString
-> IO (Either ParseError (Control' Text))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compression
-> String -> ByteString -> Either ParseError (Control' Text)
controlFromIndex Compression
compression String
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] -> [(String, [(FileTuple, Compression)])]
groupIndexes [FileTuple]
indexFiles =
    Map String [(FileTuple, Compression)]
-> [(String, [(FileTuple, Compression)])]
forall k a. Map k a -> [(k, a)]
M.toList (Map String [(FileTuple, Compression)]
 -> [(String, [(FileTuple, Compression)])])
-> Map String [(FileTuple, Compression)]
-> [(String, [(FileTuple, Compression)])]
forall a b. (a -> b) -> a -> b
$ ([(FileTuple, Compression)]
 -> [(FileTuple, Compression)] -> [(FileTuple, Compression)])
-> [(String, [(FileTuple, Compression)])]
-> Map String [(FileTuple, Compression)]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith [(FileTuple, Compression)]
-> [(FileTuple, Compression)] -> [(FileTuple, Compression)]
forall a.
[(a, Compression)] -> [(a, Compression)] -> [(a, Compression)]
combine ([(String, [(FileTuple, Compression)])]
 -> Map String [(FileTuple, Compression)])
-> [(String, [(FileTuple, Compression)])]
-> Map String [(FileTuple, Compression)]
forall a b. (a -> b) -> a -> b
$ (FileTuple -> (String, [(FileTuple, Compression)]))
-> [FileTuple] -> [(String, [(FileTuple, Compression)])]
forall a b. (a -> b) -> [a] -> [b]
map FileTuple -> (String, [(FileTuple, Compression)])
forall a b.
(a, b, String) -> (String, [((a, b, String), Compression)])
makeKV [FileTuple]
indexFiles
    where
      makeKV :: (a, b, String) -> (String, [((a, b, String), Compression)])
makeKV fileTuple :: (a, b, String)
fileTuple@(a
_,b
_,String
fp) =
          let (String
name, Compression
compressionMethod) = String -> (String, Compression)
uncompressedName String
fp
          in
            (String
name, [((a, b, String)
fileTuple, Compression
compressionMethod)])
      combine :: [(a, Compression)] -> [(a, Compression)] -> [(a, Compression)]
combine = (\[(a, Compression)]
x [(a, Compression)]
y -> ((a, Compression) -> (a, Compression) -> Ordering)
-> [(a, Compression)] -> [(a, Compression)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Compression -> Compression -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Compression -> Compression -> Ordering)
-> ((a, Compression) -> Compression)
-> (a, Compression)
-> (a, Compression)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (a, Compression) -> Compression
forall a b. (a, b) -> b
snd) ([(a, Compression)]
x [(a, Compression)] -> [(a, Compression)] -> [(a, Compression)]
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 :: String
-> (String, [(FileTuple, Compression)])
-> IO (String, [(FileTuple, Compression)])
filterExists String
distDir (String
fp, [(FileTuple, Compression)]
alternatives) =
          do [(FileTuple, Compression)]
e <- ((FileTuple, Compression) -> IO Bool)
-> [(FileTuple, Compression)] -> IO [(FileTuple, Compression)]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ( \((CheckSums
_,Size
_,String
fp),Compression
_) -> String -> IO Bool
fileExist (String
distDir String -> ShowS
</> String
fp)) [(FileTuple, Compression)]
alternatives
             -- when (null e) (error $ "None of these files exist: " ++ show alternatives)
             (String, [(FileTuple, Compression)])
-> IO (String, [(FileTuple, Compression)])
forall (m :: * -> *) a. Monad m => a -> m a
return (String
fp, [(FileTuple, Compression)]
e)

findIndexes :: FilePath -> String -> [FileTuple] -> IO [(FileTuple, Compression)]
findIndexes :: String -> String -> [FileTuple] -> IO [(FileTuple, Compression)]
findIndexes String
distDir String
iType [FileTuple]
controlFiles =
    let indexes :: [(String, [(FileTuple, Compression)])]
indexes = [FileTuple] -> [(String, [(FileTuple, Compression)])]
groupIndexes [FileTuple]
controlFiles
    in
      do [(String, [(FileTuple, Compression)])]
indexes' <- ((String, [(FileTuple, Compression)])
 -> IO (String, [(FileTuple, Compression)]))
-> [(String, [(FileTuple, Compression)])]
-> IO [(String, [(FileTuple, Compression)])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String
-> (String, [(FileTuple, Compression)])
-> IO (String, [(FileTuple, Compression)])
filterExists String
distDir) (((String, [(FileTuple, Compression)]) -> Bool)
-> [(String, [(FileTuple, Compression)])]
-> [(String, [(FileTuple, Compression)])]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> (String, [(FileTuple, Compression)]) -> Bool
forall a b. Eq a => [a] -> ([a], b) -> Bool
isType String
iType) [(String, [(FileTuple, Compression)])]
indexes)
         [(FileTuple, Compression)] -> IO [(FileTuple, Compression)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(FileTuple, Compression)] -> IO [(FileTuple, Compression)])
-> [(FileTuple, Compression)] -> IO [(FileTuple, Compression)]
forall a b. (a -> b) -> a -> b
$ ((String, [(FileTuple, Compression)]) -> (FileTuple, Compression))
-> [(String, [(FileTuple, Compression)])]
-> [(FileTuple, Compression)]
forall a b. (a -> b) -> [a] -> [b]
map ([(FileTuple, Compression)] -> (FileTuple, Compression)
forall a. [a] -> a
head ([(FileTuple, Compression)] -> (FileTuple, Compression))
-> ((String, [(FileTuple, Compression)])
    -> [(FileTuple, Compression)])
-> (String, [(FileTuple, Compression)])
-> (FileTuple, Compression)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, [(FileTuple, Compression)]) -> [(FileTuple, Compression)]
forall a b. (a, b) -> b
snd) (((String, [(FileTuple, Compression)]) -> Bool)
-> [(String, [(FileTuple, Compression)])]
-> [(String, [(FileTuple, Compression)])]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((String, [(FileTuple, Compression)]) -> Bool)
-> (String, [(FileTuple, Compression)])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(FileTuple, Compression)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null ([(FileTuple, Compression)] -> Bool)
-> ((String, [(FileTuple, Compression)])
    -> [(FileTuple, Compression)])
-> (String, [(FileTuple, Compression)])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, [(FileTuple, Compression)]) -> [(FileTuple, Compression)]
forall a b. (a, b) -> b
snd) [(String, [(FileTuple, Compression)])]
indexes')
    where
      isType :: [a] -> ([a], b) -> Bool
isType [a]
iType ([a]
fp, b
_) = [a]
iType [a] -> [a] -> Bool
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 :: String -> (String, Compression)
uncompressedName String
fp
          | String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf String
".gz"  String
fp = (ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
3) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
fp, Compression
GZ)
          | String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf String
".bz2" String
fp = (ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
4) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
fp, Compression
BZ2)
          | Bool
otherwise            = (String
fp, Compression
Uncompressed)

indexesInRelease :: (FilePath -> Bool)
                 -> Control' Text -- ^ A release file
                 -> [(CheckSums, Integer, FilePath)] -- ^
indexesInRelease :: (String -> Bool) -> Control' Text -> [FileTuple]
indexesInRelease String -> 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
    (String -> [FileTuple])
-> ([FileTuple] -> [FileTuple])
-> Either String [FileTuple]
-> [FileTuple]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> [FileTuple]
forall a. HasCallStack => String -> a
error ((FileTuple -> Bool) -> [FileTuple] -> [FileTuple]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(CheckSums
_,Size
_,String
fp) -> String -> Bool
filterp String
fp)) (Either String [FileTuple] -> [FileTuple])
-> Either String [FileTuple] -> [FileTuple]
forall a b. (a -> b) -> a -> b
$
           [Either String [FileTuple]] -> Either String [FileTuple]
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [(String -> Either String [FileTuple])
-> ([(Text, Text, Text)] -> Either String [FileTuple])
-> Either String [(Text, Text, Text)]
-> Either String [FileTuple]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Either String [FileTuple]
forall a b. a -> Either a b
Left ((String -> CheckSums)
-> [(Text, Text, Text)] -> Either String [FileTuple]
makeTuples String -> CheckSums
makeSHA256) (Either String [(Text, Text, Text)]
-> (Text -> Either String [(Text, Text, Text)])
-> Maybe Text
-> Either String [(Text, Text, Text)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String [(Text, Text, Text)]
forall a b. a -> Either a b
Left String
"No SHA256 Field") Text -> Either String [(Text, Text, Text)]
makeTriples (Maybe Text -> Either String [(Text, Text, Text)])
-> Maybe Text -> Either String [(Text, Text, Text)]
forall a b. (a -> b) -> a -> b
$ String -> Paragraph' Text -> Maybe Text
forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue String
"SHA256" Paragraph' Text
p),
                 (String -> Either String [FileTuple])
-> ([(Text, Text, Text)] -> Either String [FileTuple])
-> Either String [(Text, Text, Text)]
-> Either String [FileTuple]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Either String [FileTuple]
forall a b. a -> Either a b
Left ((String -> CheckSums)
-> [(Text, Text, Text)] -> Either String [FileTuple]
makeTuples String -> CheckSums
makeSHA1) (Either String [(Text, Text, Text)]
-> (Text -> Either String [(Text, Text, Text)])
-> Maybe Text
-> Either String [(Text, Text, Text)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String [(Text, Text, Text)]
forall a b. a -> Either a b
Left String
"No SHA1 Field") Text -> Either String [(Text, Text, Text)]
makeTriples (Maybe Text -> Either String [(Text, Text, Text)])
-> Maybe Text -> Either String [(Text, Text, Text)]
forall a b. (a -> b) -> a -> b
$ String -> Paragraph' Text -> Maybe Text
forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue String
"SHA1" Paragraph' Text
p),
                 (String -> Either String [FileTuple])
-> ([(Text, Text, Text)] -> Either String [FileTuple])
-> Either String [(Text, Text, Text)]
-> Either String [FileTuple]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Either String [FileTuple]
forall a b. a -> Either a b
Left ((String -> CheckSums)
-> [(Text, Text, Text)] -> Either String [FileTuple]
makeTuples String -> CheckSums
makeMD5) (Either String [(Text, Text, Text)]
-> (Text -> Either String [(Text, Text, Text)])
-> Maybe Text
-> Either String [(Text, Text, Text)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String [(Text, Text, Text)]
forall a b. a -> Either a b
Left String
"No MD5Sum Field") Text -> Either String [(Text, Text, Text)]
makeTriples (Maybe Text -> Either String [(Text, Text, Text)])
-> Maybe Text -> Either String [(Text, Text, Text)]
forall a b. (a -> b) -> a -> b
$ [Maybe Text] -> Maybe Text
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [String -> Paragraph' Text -> Maybe Text
forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue String
"MD5Sum" Paragraph' Text
p,
                                                                                                      String -> Paragraph' Text -> Maybe Text
forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue String
"Md5Sum" Paragraph' Text
p,
                                                                                                      String -> Paragraph' Text -> Maybe Text
forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue String
"MD5sum" Paragraph' Text
p])]
    where
      makeSHA256 :: String -> CheckSums
makeSHA256 String
s = CheckSums :: Maybe String -> Maybe String -> Maybe String -> CheckSums
CheckSums {md5sum :: Maybe String
md5sum = Maybe String
forall a. Maybe a
Nothing, sha1 :: Maybe String
sha1 = Maybe String
forall a. Maybe a
Nothing, sha256 :: Maybe String
sha256 = String -> Maybe String
forall a. a -> Maybe a
Just String
s}
      makeSHA1 :: String -> CheckSums
makeSHA1 String
s = CheckSums :: Maybe String -> Maybe String -> Maybe String -> CheckSums
CheckSums {md5sum :: Maybe String
md5sum = Maybe String
forall a. Maybe a
Nothing, sha1 :: Maybe String
sha1 = String -> Maybe String
forall a. a -> Maybe a
Just String
s, sha256 :: Maybe String
sha256 = Maybe String
forall a. Maybe a
Nothing}
      makeMD5 :: String -> CheckSums
makeMD5 String
s = CheckSums :: Maybe String -> Maybe String -> Maybe String -> CheckSums
CheckSums {md5sum :: Maybe String
md5sum = String -> Maybe String
forall a. a -> Maybe a
Just String
s, sha1 :: Maybe String
sha1 = Maybe String
forall a. Maybe a
Nothing, sha256 :: Maybe String
sha256 = Maybe String
forall a. Maybe a
Nothing}

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

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

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

      makeTriple :: Text -> Either String (Text, Text, Text)
      makeTriple :: Text -> Either String (Text, Text, Text)
makeTriple Text
t = case Text -> [Text]
Text.words Text
t of
                       [Text
a, Text
b, Text
c] -> (Text, Text, Text) -> Either String (Text, Text, Text)
forall a b. b -> Either a b
Right (Text
a, Text
b, Text
c)
                       [Text]
_ -> String -> Either String (Text, Text, Text)
forall a b. a -> Either a b
Left (String
"Invalid checksum line: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
t)
indexesInRelease String -> Bool
_ Control' Text
x = String -> [FileTuple]
forall a. HasCallStack => String -> a
error (String -> [FileTuple]) -> String -> [FileTuple]
forall a b. (a -> b) -> a -> b
$ String
"Invalid release file: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
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 :: String -> String -> IO (Maybe FileTuple)
tupleFromFilePath String
basePath String
fp =
          do Bool
e <- String -> IO Bool
fileExist (String
basePath String -> ShowS
</> String
fp)
             if Bool -> Bool
not Bool
e
              then Maybe FileTuple -> IO (Maybe FileTuple)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FileTuple
forall a. Maybe a
Nothing
              else do Size
size <- String -> IO FileStatus
getFileStatus (String
basePath String -> ShowS
</> String
fp) IO FileStatus -> (FileStatus -> IO Size) -> IO Size
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Size -> IO Size
forall (m :: * -> *) a. Monad m => a -> m a
return (Size -> IO Size) -> (FileStatus -> Size) -> FileStatus -> IO Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileOffset -> Size
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FileOffset -> Size)
-> (FileStatus -> FileOffset) -> FileStatus -> Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> FileOffset
fileSize
                      String
md5 <- String -> IO ByteString
L.readFile (String
basePath String -> ShowS
</> 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
. MD5Digest -> String
forall a. Show a => a -> String
show (MD5Digest -> String)
-> (ByteString -> MD5Digest) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> MD5Digest
MD5.md5
                      String
sha1 <- String -> IO ByteString
L.readFile (String
basePath String -> ShowS
</> 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 SHA1State -> String
forall a. Show a => a -> String
show (Digest SHA1State -> String)
-> (ByteString -> Digest SHA1State) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Digest SHA1State
SHA.sha1
                      String
sha256 <- String -> IO ByteString
L.readFile (String
basePath String -> ShowS
</> 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
SHA.sha256
                      Maybe FileTuple -> IO (Maybe FileTuple)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FileTuple -> IO (Maybe FileTuple))
-> Maybe FileTuple -> IO (Maybe FileTuple)
forall a b. (a -> b) -> a -> b
$ FileTuple -> Maybe FileTuple
forall a. a -> Maybe a
Just (CheckSums :: Maybe String -> Maybe String -> Maybe String -> CheckSums
CheckSums { md5sum :: Maybe String
md5sum = String -> Maybe String
forall a. a -> Maybe a
Just String
md5, sha1 :: Maybe String
sha1 = String -> Maybe String
forall a. a -> Maybe a
Just String
sha1, sha256 :: Maybe String
sha256 = String -> Maybe String
forall a. a -> Maybe a
Just String
sha256 }, Size
size, String
fp)

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