module Debian.Repo.Types
( EnvRoot(..)
, EnvPath(..)
, outsidePath
, appendPath
, rootEnvPath
, PackageVersion(..)
, PkgVersion(..)
, Repo(..)
, libraryCompatibilityLevel
, compatibilityFile
, Repository(..)
, LocalRepository(..)
, Layout(..)
, ReleaseName(..)
, parseReleaseName
, ReleaseInfo(..)
, Arch(..)
, archName
, Section(..)
, SubSection(..)
, sectionNameOfSubSection
, sectionName
, sectionName'
, parseSection
, parseSection'
, Release(..)
, releaseName'
, releaseName
, releaseComponents
, releaseArchitectures
, SourceType(..)
, DebSource(..)
, SliceName(..)
, Slice(..)
, SliceList(..)
, NamedSliceList(..)
, PackageIndex(..)
, PackageIndexLocal
, PackageID(..)
, BinaryPackage(..)
, SourcePackage(..)
, SourceFileSpec(..)
, PackageIDLocal
, BinaryPackageLocal
, SourcePackageLocal
, AptCache(..)
, AptBuildCache(..)
, AptImage(..)
) where
import qualified Debian.Control.ByteString as B
import qualified Debian.Relation as B
import Debian.URI
import Debian.Version
import Control.Exception (throw)
import qualified Data.ByteString.Lazy.Char8 as L
import Data.Char
import Data.List
import Data.Maybe
import Network.URI
import System.FilePath ((</>))
import System.Posix.Types
data EnvRoot = EnvRoot { rootPath :: FilePath } deriving (Ord, Eq, Read, Show)
data EnvPath = EnvPath { envRoot :: EnvRoot
, envPath :: FilePath
} deriving (Ord, Eq, Read, Show)
outsidePath :: EnvPath -> FilePath
outsidePath path = rootPath (envRoot path) ++ envPath path
appendPath :: FilePath -> EnvPath -> EnvPath
appendPath suff path = path { envPath = envPath path ++ suff }
rootEnvPath :: FilePath -> EnvPath
rootEnvPath s = EnvPath { envRoot = EnvRoot "", envPath = s }
data Repository
= LocalRepo LocalRepository
| VerifiedRepo URIString [ReleaseInfo]
| UnverifiedRepo URIString
deriving (Read, Show)
instance Ord Repository where
compare a b = compare (repoURI a) (repoURI b)
instance Eq Repository where
a == b = compare a b == EQ
data LocalRepository
= LocalRepository
{ repoRoot :: EnvPath
, repoLayout :: (Maybe Layout)
, repoReleaseInfoLocal :: [ReleaseInfo]
} deriving (Read, Show, Ord, Eq)
data Layout = Flat | Pool deriving (Eq, Ord, Read, Show)
instance Repo Repository where
repoURI (LocalRepo (LocalRepository path _ _)) = fromJust . parseURI $ "file://" ++ envPath path
repoURI (VerifiedRepo uri _) = fromJust (parseURI uri)
repoURI (UnverifiedRepo uri) = fromJust (parseURI uri)
repoReleaseInfo (LocalRepo (LocalRepository _ _ info)) = info
repoReleaseInfo (VerifiedRepo _ info) = info
repoReleaseInfo (UnverifiedRepo _uri) = error "No release info for unverified repository"
instance Repo LocalRepository where
repoURI (LocalRepository path _ _) = fromJust . parseURI $ "file://" ++ envPath path
repoReleaseInfo (LocalRepository _ _ info) = info
class (Ord t, Eq t) => Repo t where
repoURI :: t -> URI
repositoryCompatibilityLevel :: t -> IO (Maybe Int)
repositoryCompatibilityLevel r =
fileFromURI uri' >>= either throw (return . parse . L.unpack)
where
uri' = uri {uriPath = uriPath uri </> compatibilityFile}
uri = repoURI r
parse :: String -> Maybe Int
parse text = case takeWhile isDigit text of
"" -> Nothing
s -> Just . read $ s
repoReleaseInfo :: t -> [ReleaseInfo]
checkCompatibility :: t -> IO ()
checkCompatibility repo =
do level <- repositoryCompatibilityLevel repo
case level of
Nothing -> return ()
Just n | n >= libraryCompatibilityLevel -> return ()
Just n -> error ("Compatibility error: repository level " ++ show n ++
" < library level " ++ show libraryCompatibilityLevel ++ ", please upgrade.")
compatibilityFile :: FilePath
compatibilityFile = "repository-compat"
libraryCompatibilityLevel :: Int
libraryCompatibilityLevel = 2
class (Eq a, Ord a) => PackageVersion a where
pkgName :: a -> B.PkgName
pkgVersion :: a -> DebianVersion
data PkgVersion = PkgVersion { getName :: B.PkgName
, getVersion :: DebianVersion
} deriving (Eq, Ord)
instance PackageVersion PkgVersion where
pkgName = getName
pkgVersion = getVersion
instance Show PkgVersion where
show v = getName v ++ "=" ++ show (getVersion v)
data ReleaseName = ReleaseName { relName :: String } deriving (Eq, Ord, Read, Show)
parseReleaseName :: String -> ReleaseName
parseReleaseName name = ReleaseName {relName = unEscapeString name}
releaseName' :: ReleaseName -> String
releaseName' (ReleaseName {relName = s}) = escapeURIString isAllowedInURI s
data ReleaseInfo = ReleaseInfo { releaseInfoName :: ReleaseName
, releaseInfoAliases :: [ReleaseName]
, releaseInfoArchitectures :: [Arch]
, releaseInfoComponents :: [Section]
} deriving (Eq, Ord, Read, Show)
data Arch = Source | Binary String deriving (Read, Show, Eq, Ord)
archName :: Arch -> String
archName Source = "source"
archName (Binary arch) = arch
newtype Section = Section String deriving (Read, Show, Eq, Ord)
data SubSection = SubSection { section :: Section, subSectionName :: String } deriving (Read, Eq, Ord)
sectionName :: SubSection -> String
sectionName (SubSection (Section "main") y) = y
sectionName (SubSection x y) = sectionName' x ++ "/" ++ y
sectionName' :: Section -> String
sectionName' (Section s) = escapeURIString isAllowedInURI s
sectionNameOfSubSection :: SubSection -> String
sectionNameOfSubSection = sectionName' . section
parseSection section =
case span (/= '/') section of
(x, "") -> SubSection (Section "main") x
("main", y) -> SubSection (Section "main") y
(x, y) -> SubSection (Section x) (tail y)
parseSection' name =
Section (unEscapeString name)
data Release = Release { releaseRepo :: Repository
, releaseInfo :: ReleaseInfo
} deriving (Eq, Ord, Show)
releaseName :: Release -> ReleaseName
releaseName = releaseInfoName . releaseInfo
releaseComponents :: Release -> [Section]
releaseComponents = releaseInfoComponents . releaseInfo
releaseArchitectures :: Release -> [Arch]
releaseArchitectures = releaseInfoArchitectures . releaseInfo
data SourceType
= Deb | DebSrc
deriving (Eq, Ord)
data DebSource
= DebSource
{ sourceType :: SourceType
, sourceUri :: URI
, sourceDist :: Either String (ReleaseName, [Section])
} deriving (Eq, Ord)
instance Show SourceType where
show Deb = "deb"
show DebSrc = "deb-src"
instance Show DebSource where
show (DebSource thetype theuri thedist) =
(show thetype) ++ " "++ uriToString id theuri " " ++
(case thedist of
Left exactPath -> escape exactPath
Right (dist, sections) ->
releaseName' dist ++ " " ++ intercalate " " (map sectionName' sections))
where escape = escapeURIString isAllowedInURI
data SliceName = SliceName { sliceName :: String } deriving (Eq, Ord)
data Slice
= Slice { sliceRepo :: Repository
, sliceSource :: DebSource
} deriving (Eq, Ord)
data SliceList = SliceList {slices :: [Slice]} deriving (Eq, Ord)
data NamedSliceList
= NamedSliceList { sliceList :: SliceList
, sliceListName :: SliceName
} deriving (Eq, Ord)
instance Show Slice where
show = show . sliceSource
instance Show SliceList where
show = concat . map ((++ "\n") . show) . slices
data PackageIndex
= PackageIndex { packageIndexRelease :: Release
, packageIndexComponent :: Section
, packageIndexArch :: Arch
} deriving (Eq, Ord, Show)
type PackageIndexLocal = PackageIndex
instance Show BinaryPackage where
show p = packageName (packageID p) ++ "-" ++ show (packageVersion (packageID p))
data PackageID
= PackageID
{ packageIndex :: PackageIndex
, packageName :: String
, packageVersion :: DebianVersion
} deriving (Eq, Ord, Show)
data BinaryPackage
= BinaryPackage
{ packageID :: PackageID
, packageInfo :: B.Paragraph
, pDepends :: B.Relations
, pPreDepends :: B.Relations
, pConflicts ::B.Relations
, pReplaces :: B.Relations
, pProvides :: B.Relations
}
instance Ord BinaryPackage where
compare a b = compare (packageID a) (packageID b)
instance Eq BinaryPackage where
a == b = (packageID a) == (packageID b)
data SourcePackage
= SourcePackage
{ sourcePackageID :: PackageID
, sourceParagraph :: B.Paragraph
, sourceDirectory :: String
, sourcePackageFiles :: [SourceFileSpec]
}
data SourceFileSpec
= SourceFileSpec
{ sourceFileMD5sum :: String
, sourceFileSize :: FileOffset
, sourceFileName :: FilePath
}
type PackageIDLocal = PackageID
type BinaryPackageLocal = BinaryPackage
type SourcePackageLocal = SourcePackage
class (Ord t, Eq t, Show t) => AptCache t where
globalCacheDir :: t -> FilePath
rootDir :: t -> EnvRoot
aptBaseSliceList :: t -> SliceList
aptArch :: t -> Arch
aptSourcePackages :: t -> [SourcePackage]
aptBinaryPackages :: t -> [BinaryPackage]
aptReleaseName :: t -> ReleaseName
class AptCache t => AptBuildCache t where
aptSliceList :: t -> SliceList
data AptImage =
AptImage { aptGlobalCacheDir :: FilePath
, aptImageRoot :: EnvRoot
, aptImageArch :: Arch
, aptImageSliceList :: SliceList
, aptImageReleaseName :: ReleaseName
, aptImageSourcePackages :: [SourcePackage]
, aptImageBinaryPackages :: [BinaryPackage]
}