cabal-flatpak 0.0 → 0.1
raw patch · 9 files changed
+341/−149 lines, 9 filesdep +cryptohash-sha256dep +tardep +zlibdep ~cabal-plandep ~containers
Dependencies added: cryptohash-sha256, tar, zlib
Dependency ranges changed: cabal-plan, containers
Files
- Changes.md +8/−0
- ReadMe.md +11/−26
- cabal-flatpak.cabal +8/−3
- flatpak.cabal.json +1/−13
- src/Flatpak.hs +11/−5
- src/Generate.hs +25/−50
- src/Main.hs +60/−52
- src/Package.hs +114/−0
- src/Retrieve.hs +103/−0
Changes.md view
@@ -1,5 +1,13 @@ # Change log for the `cabal-flatpak` package +## 0.1++ * No need to specify `main-sources` field anymore.++ * Fix Cabal revisions in the imported packages.+ Manually fetch necessary information from `01-index.tar`+ and downloaded packages.+ ## 0.0 * First experimental version inspired by `stackpak`.
ReadMe.md view
@@ -81,14 +81,13 @@ However, Flatpak does not know the dependency graph and thus simply rebuilds anything after a module that must be rebuilt. -Unfortunately, you cannot simply switch between the two modes-simply by adding or removing the `--cabal-install` option.-The reason is that you must maintain the data for the main package-manually in the `"main-sources"` object-and `Cabal` requires the source tarball unpacked-whereas `cabal-install` needs it packed.-Thus `Cabal` needs `"type": "archive"`-and `cabal-install` needs `"type": "file"`.+Known issue:+If you use the `"main-sources"` list of manually written sources,+then the main tarball needs `"type": "archive"` for `Cabal` mode+and `"type": "file"` for `cabal-install`.+That is you cannot simply switch between both modes only at the command-line.+I suggest to not use `"main-sources"` anyway,+but stick to versions published at Hackage. For some packages you need to build dependencies on external C packages. `cabal-flatpak` cannot generate according build instructions for you.@@ -152,21 +151,7 @@ Unfortunately, `plan.json` does not contain the revision number, it just refers to the currently most recent Cabal file for each Haskell package. This is a fundamental problem since Flatpak builds must be reproducible.--We have currently no solution for that problem.-If someone updates the Cabal file of one of your dependencies,-then the Flatpak build will break with an error due to a SHA256 hash mismatch.-In this case you should find out the original revision-and add that to the Hackage path in the Flatpak manifest.-E.g. if the path to a Cabal file is say-`https://hackage.haskell.org/package/cabal-flatpak-0.0/cabal-flatpak.cabal`-then the path to revision 1 is:-`https://hackage.haskell.org/package/cabal-flatpak-0.0/revision/1.cabal`.--We could try to solve the problem by downloading Cabal file revisions-from Hackage for every imported package-until we find the one with a matching SHA256 hash.-We could try to do this offline and scan Cabal's local package database-using a program like:-https://github.com/haskell-hvr/hackage-index .-None of these ideas is implemented, yet.+We currently solve this problem+by scanning Cabal's local package database+below `.cabal/packages/hackage.haskell.org`.+This has not optimal performance but it is acceptable.
cabal-flatpak.cabal view
@@ -1,5 +1,5 @@ Name: cabal-flatpak-Version: 0.0+Version: 0.1 License: BSD3 License-File: LICENSE Author: Henning Thielemann <haskell@henning-thielemann.de>@@ -25,7 +25,7 @@ flatpak.cabal.json Source-Repository this- Tag: 0.0+ Tag: 0.1 Type: darcs Location: http://hub.darcs.net/thielema/cabal-flatpak/ @@ -36,6 +36,9 @@ Executable cabal-flatpak Build-Depends: cabal-plan >=0.5 && <0.6,+ cryptohash-sha256 >=0.11 && <0.12,+ zlib >=0.5.3 && <0.7,+ tar >=0.5.0.3 && <0.6, http-client-tls >=0.3.5.3 && <0.4, http-client >=0.5.12 && <0.7, http-types >=0.10 && <0.13,@@ -46,7 +49,7 @@ pathtype >=0.8 && <0.9, text >=1.2 && <1.3, bytestring >=0.9 && <0.11,- containers >=0.4.2 && <0.7,+ containers >=0.5 && <0.7, utility-ht >=0.0.12 && <0.1, base >=4.5 && <5 @@ -55,5 +58,7 @@ Main-Is: Main.hs Other-Modules: Generate+ Package+ Retrieve Flatpak Option
flatpak.cabal.json view
@@ -15,17 +15,5 @@ "modules": [] }, - "main-package": "cabal-flatpak",- "main-sources": [- {- "url": "https://hackage.haskell.org/package/cabal-flatpak-0.0/candidate/cabal-flatpak-0.0.tar.gz",- "type": "file",- "sha256": "112e0dee2ffa9e71855ac5350ce26121867434c507c4e660734a885511683f1c"- },- {- "url": "https://hackage.haskell.org/package/cabal-flatpak-0.0/candidate/cabal-flatpak.cabal",- "type": "file",- "sha256": "f4d54935b16f55a406a3844990990347e5ddfdfd147ac647791aebda244d64be"- }- ]+ "main-package": "cabal-flatpak" }
src/Flatpak.hs view
@@ -35,11 +35,14 @@ o .:* field = o .:? (field, []) -infixr 8 .=, .=*+infixr 8 .=, .=?, .=* (.=) :: ToJSON a => String -> (object -> a) -> object -> [Pair] (field .= a) obj = [Text.pack field Json..= a obj] +(.=?) :: (ToJSON a, Eq a) => String -> (object -> a, a) -> object -> [Pair]+(field .=? (a, deflt)) obj = Mn.when (a obj /= deflt) ((field .= a) obj)+ (.=*) :: (ToJSON a) => String -> (object -> [a]) -> object -> [Pair] (field .=* a) obj = Mn.when (not $ null $ a obj) ((field .= a) obj) @@ -101,6 +104,7 @@ Source { typ :: SourceType, url :: String,+ destFilename :: Maybe String, sha256 :: Maybe Plan.Sha256 } deriving (Show) @@ -109,12 +113,14 @@ withObject "Source" $ \o -> pure Source <*> (parseSourceType o =<< o .: "type") <*> o .: "url"+ <*> o .:? ("dest-filename", Nothing) <*> o .: "sha256" instance ToJSON Source where toJSON = object $ (pairsFromSourceType . typ) <> ("url" .= url) <>+ ("dest-filename" .=? (destFilename, Nothing)) <> ("sha256" .= sha256) <> mempty @@ -190,7 +196,7 @@ toJSON m = case m of ModuleEmbed modu -> toJSON modu- ModuleInclude path -> toJSON path+ ModuleInclude includePath -> toJSON includePath data T =@@ -267,7 +273,7 @@ withObject "Cabal" $ \o -> pure Cabal <*> o .: "base" <*> o .: "main-package"- <*> o .: "main-sources"+ <*> o .:* "main-sources" <*> o .:* "package-hooks" <*> o .:* "cabal-configure-options" <*> o .:* "ghc-options"@@ -276,8 +282,8 @@ toJSON = object $ ("base" .= base) <> ("main-package" .= mainPackage) <>- ("main-sources" .= mainSources) <>- ("package-hooks" .= packageHooks) <>+ ("main-sources" .=* mainSources) <>+ ("package-hooks" .=* packageHooks) <> ("cabal-configure-options" .=* cabalConfigureOptions) <> ("ghc-options" .=* ghcOptions) <> mempty
src/Generate.hs view
@@ -1,6 +1,8 @@ module Generate where +import qualified Package import qualified Flatpak+import Retrieve (formatVersion, archGHC, ghcDirUrl, ghcArchive) import Flatpak (ModuleItem(ModuleEmbed)) import qualified Cabal.Plan as Plan@@ -15,40 +17,6 @@ import Text.Printf (printf) -archGHC :: Flatpak.Arch -> String-archGHC arch =- case arch of- Flatpak.I386 -> "i386"- Flatpak.X86_64 -> "x86_64"- Flatpak.ARM -> "armv7"- Flatpak.AArch64 -> "aarch64"--formatVersion :: Plan.Ver -> String-formatVersion = Text.unpack . Plan.dispVer--ghcDirUrl :: Plan.PkgId -> String-ghcDirUrl (Plan.PkgId (Plan.PkgName compName) compVersion) =- printf- "https://downloads.haskell.org/%s/%s/"- (Text.unpack compName)- (formatVersion compVersion)--{- |-ghc-8.4.4-x86_64-deb9 is available but fails due to missing libnuma.so.1--}-ghcNameScheme :: Plan.Ver -> String-ghcNameScheme ghcVer =- if' (ghcVer >= Plan.Ver [8, 6,1]) "%s-%s-deb9-linux.tar.xz" $- if' (ghcVer >= Plan.Ver [7,10,3]) "%s-%s-deb8-linux.tar.xz" $- if' (ghcVer >= Plan.Ver [7, 8,1]) "%s-%s-unknown-linux-deb7.tar.xz" $- "%s-%s-unknown-linux.tar.bz2"--ghcArchive :: Plan.PkgId -> Flatpak.Arch -> String-ghcArchive compiler@(Plan.PkgId _ compVersion) arch =- printf (ghcNameScheme compVersion)- (Text.unpack $ Plan.dispPkgId compiler)- (archGHC arch)- tinfoPath :: Flatpak.Arch -> String tinfoPath arch = case arch of@@ -138,34 +106,40 @@ [Flatpak.Source { Flatpak.typ = Flatpak.archive, Flatpak.url = ghcDirUrl compiler ++ ghcArchive compiler arch,+ Flatpak.destFilename = Nothing, Flatpak.sha256 = Just hash }] } -packageURLs :: Plan.Unit -> (String, String)-packageURLs pkg =+type RevisedUnit = (Plan.Unit, Package.Revision)++packageURLs :: RevisedUnit -> (String, String, String)+packageURLs (pkg, revision) = let pkgId@(Plan.PkgId (Plan.PkgName name) _version) = Plan.uPId pkg pkgName = Text.unpack name pkgNameVer = Text.unpack $ Plan.dispPkgId pkgId in (printf "https://hackage.haskell.org/package/%s/%s.tar.gz" pkgNameVer pkgNameVer,- printf "https://hackage.haskell.org/package/%s/%s.cabal"- pkgNameVer pkgName)+ printf "https://hackage.haskell.org/package/%s/revision/%d.cabal"+ pkgNameVer revision,+ printf "%s.cabal" pkgName) packageSources :: (String, [Flatpak.Source]) -> Flatpak.SourceType ->- Plan.Unit -> [Flatpak.Source]-packageSources (mainPkg, mainSrcs) typ pkg =- let (pkgUrl, cabalUrl) = packageURLs pkg- in if' (matchName mainPkg pkg) mainSrcs $+ RevisedUnit -> [Flatpak.Source]+packageSources (mainPkg, mainSrcs) typ pkgRev@(pkg,_) =+ let (pkgUrl, cabalUrl, cabalPath) = packageURLs pkgRev+ in if' (matchName mainPkg pkg && not (null mainSrcs)) mainSrcs $ Flatpak.Source { Flatpak.typ = typ, Flatpak.url = pkgUrl,+ Flatpak.destFilename = Nothing, Flatpak.sha256 = Plan.uSha256 pkg } : Flatpak.Source { Flatpak.typ = Flatpak.File, Flatpak.url = cabalUrl,+ Flatpak.destFilename = Just cabalPath, Flatpak.sha256 = Plan.uCabalSha256 pkg } : []@@ -181,8 +155,8 @@ -} modul :: (String, [Flatpak.Source]) -> Options -> Map String Flatpak.PackageHook ->- Plan.Unit -> Flatpak.Module-modul main (cabalCfgOptions, ghcOptions) hookMap pkg =+ RevisedUnit -> Flatpak.Module+modul main (cabalCfgOptions, ghcOptions) hookMap pkgRev@(pkg,_) = let (Plan.PkgId (Plan.PkgName name) _version) = Plan.uPId pkg nameStr = Text.unpack name in Flatpak.Module {@@ -204,12 +178,12 @@ Flatpak.postInstall = foldMap Flatpak.postInstallHook $ Map.lookup nameStr hookMap, Flatpak.cleanupModule = [],- Flatpak.sources = packageSources main Flatpak.archive pkg+ Flatpak.sources = packageSources main Flatpak.archive pkgRev } manifest :: Plan.PlanJson ->- [(Flatpak.Arch, Plan.Sha256)] -> [Plan.Unit] -> Flatpak.Cabal -> Flatpak.T+ [(Flatpak.Arch, Plan.Sha256)] -> [RevisedUnit] -> Flatpak.Cabal -> Flatpak.T manifest plan archs units project = let base = Flatpak.base project hookMap =@@ -260,13 +234,14 @@ Flatpak.typ = Flatpak.Archive {Flatpak.stripComponents = 0}, Flatpak.url = url,+ Flatpak.destFilename = Nothing, Flatpak.sha256 = Plan.parseSha256 . Text.pack =<< cabalHash arch }] } allInOneModule :: (String, [Flatpak.Source]) -> Options -> [String] ->- [Plan.Unit] -> Flatpak.Module+ [RevisedUnit] -> Flatpak.Module allInOneModule main (cabalCfgOptions, ghcOptions) postInstall pkgs = let dispPkgId = Text.unpack . Plan.dispPkgId in Flatpak.Module {@@ -276,7 +251,7 @@ Flatpak.builddir = False, Flatpak.configOpts = [], Flatpak.buildCommands =- (flip concatMap pkgs $ \pkg ->+ (flip concatMap pkgs $ \(pkg,_) -> let pkgId@(Plan.PkgId (Plan.PkgName name) _version) = Plan.uPId pkg pkgName = Text.unpack name@@ -294,7 +269,7 @@ ("cabal --config-file=.cabal/config install" : "--offline --prefix=/app" : cabalCfgOptions ++ map ghcOption ghcOptions ++- map (printf "%s.tar.gz" . dispPkgId . Plan.uPId) pkgs) :+ map (printf "%s.tar.gz" . dispPkgId . Plan.uPId . fst) pkgs) : [], Flatpak.postInstall = postInstall, Flatpak.cleanupModule = [],@@ -303,7 +278,7 @@ manifestCabalInstall :: Plan.PlanJson ->- [(Flatpak.Arch, Plan.Sha256)] -> [Plan.Unit] -> Flatpak.Cabal -> Flatpak.T+ [(Flatpak.Arch, Plan.Sha256)] -> [RevisedUnit] -> Flatpak.Cabal -> Flatpak.T manifestCabalInstall plan archs pkgs project = let base = Flatpak.base project in base {
src/Main.hs view
@@ -2,11 +2,15 @@ import qualified Flatpak import qualified Generate+import qualified Package+import qualified Retrieve import qualified Cabal.Plan as Plan+import qualified Crypto.Hash.SHA256 as SHA256 import qualified System.Path.Directory as PathDir import qualified System.Path as Path+import System.Path ((</>)) import qualified Option import qualified Options.Applicative as OP@@ -14,24 +18,19 @@ import qualified Shell.Utility.Verbosity as Verbosity import qualified Shell.Utility.Log as Log -import qualified Network.HTTP.Client as Http-import Network.HTTP.Client.TLS (tlsManagerSettings)-import Network.HTTP.Types.Status (statusCode)- import Control.Monad (when)+import Control.Applicative ((<$>)) import qualified Data.Aeson.Encode.Pretty as JsonPretty import qualified Data.Aeson as Json import qualified Data.ByteString.Lazy.Char8 as BL-import qualified Data.ByteString.Char8 as B-import qualified Data.Text.Encoding as TextEnc import qualified Data.Text as Text import qualified Data.Traversable as Trav import qualified Data.Graph as Graph import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.List.HT as ListHT-import Data.Tuple.HT (mapFst, snd3)+import Data.Tuple.HT (snd3) import Data.Map (Map) import Data.Set (Set) @@ -46,17 +45,7 @@ Graph.graphFromEdges $ Map.elems $ Map.mapWithKey (\k v -> ((), k, Set.toList v)) m -httpsGet :: String -> IO BL.ByteString-httpsGet url = do- response <- do- request <- Http.parseRequest url- manager <- Http.newManager tlsManagerSettings- Http.httpLbs request manager- case statusCode $ Http.responseStatus response of- 200 -> return $ Http.responseBody response- code -> fail $ "HTTPS get failed with status code: " ++ show code - main :: IO () main = do opt <- OP.execParser Option.info@@ -80,16 +69,17 @@ printf ("plan.json is from Cabal-%s, " ++ "but only version %s and higher provide SHA256 hashes for Cabal files.")- (Generate.formatVersion curVersion)- (Generate.formatVersion minVersion)+ (Retrieve.formatVersion curVersion)+ (Retrieve.formatVersion minVersion) let matchExe name comp = case comp of Plan.CompNameExe nameExe -> name == nameExe; _ -> False let mainExe = Text.pack $ Flatpak.command $ Flatpak.base projectJson+ let mainPackage = Flatpak.mainPackage projectJson let units = filter (\unit ->- if Generate.matchName (Flatpak.mainPackage projectJson) unit+ if Generate.matchName mainPackage unit then any (matchExe mainExe) $ Map.keys $ Plan.uComps unit else Map.member Plan.CompNameLib $ Plan.uComps unit) $ filter ((Plan.UnitTypeBuiltin /=) . Plan.uType) $@@ -102,41 +92,59 @@ in maybe (fail $ printf "unsupported architecture: %s" archStr) (return . (:[])) $- ParseArg.enumMaybe Generate.archGHC archStr+ ParseArg.enumMaybe Retrieve.archGHC archStr archs -> return archs - let compiler = Plan.pjCompilerId plan- let sha256Url = Generate.ghcDirUrl compiler ++ "SHA256SUMS"- ghcSha256s <- httpsGet sha256Url- let (ghcSha256Map, ghcSha256Corrupts) =- mapFst Map.fromList $+ archHashes <- do+ let compiler = Plan.pjCompilerId plan+ sha256Map <- Retrieve.ghcHashes compiler+ either fail return $+ Trav.forM archs $ \arch -> do+ sha256 <- Retrieve.ghcHash sha256Map compiler arch+ return (arch, sha256)++ cabalDir <- PathDir.getAppUserDataDirectory "cabal"+ let hackageDir =+ cabalDir </> Path.dir "packages" </> Path.dir "hackage.haskell.org"++ mainVersion <-+ case filter (Generate.matchName mainPackage) units of+ [Plan.Unit{Plan.uPId = Plan.PkgId _pkg ver}] ->+ return $ Retrieve.formatVersion ver+ [] -> fail "main package not found in build plan"+ _ -> fail "main package found multiple times in build plan"+ (revisions, mainCabalHash) <- do+ tar <- Package.readTar $ hackageDir </> Path.file "01-index.tar.gz"+ either fail return $+ Package.scanIndex tar (mainPackage, mainVersion) $+ Package.unitsMapFromList units+ mainTarHash <-+ fmap SHA256.hashlazy $ BL.readFile $ Path.toString $+ hackageDir+ </> Path.dir mainPackage+ </> Path.dir mainVersion+ </> Path.file (printf "%s-%s.tar.gz" mainPackage mainVersion)++ let (revisedUnits, unrevisedUnits) = ListHT.partitionMaybe- (\line ->- case BL.words line of- [hash,archive] -> Just (archive,hash)- _ -> Nothing)- (BL.lines ghcSha256s)- when (not $ null ghcSha256Corrupts) $ fail $ unlines $- (printf "corrupt lines in %s:" sha256Url) :- map BL.unpack ghcSha256Corrupts- archHashes <-- Trav.forM archs $ \arch -> do- let ghcName = Generate.ghcArchive compiler arch- hashStr <-- maybe- (fail $- printf "could not find SHA256 checksum for %s in %s"- ghcName sha256Url) return $- Map.lookup (BL.pack $ "./"++ghcName) ghcSha256Map- sha256 <-- maybe- (fail $ "could not parse SHA256 checksum " ++ BL.unpack hashStr)- return $- Plan.parseSha256 $- TextEnc.decodeLatin1 $ B.concat $ BL.toChunks hashStr- return (arch, sha256)+ (\unit -> (,) unit <$> Map.lookup (Plan.uPId unit) revisions) $+ map+ (\unit ->+ if Generate.matchName mainPackage unit+ then unit{+ Plan.uSha256 = Plan.sha256FromByteString mainTarHash,+ Plan.uCabalSha256 = Plan.sha256FromByteString mainCabalHash+ }+ else unit) $+ units + when (not $ null unrevisedUnits) $ fail $ unlines $+ "units without a SHA256 hash for the Cabal file:" :+ map (Text.unpack . Plan.dispPkgId . Plan.uPId) unrevisedUnits+ BL.writeFile (Path.toString $ Option.output opt) $ JsonPretty.encodePretty $ if Option.cabalInstall opt- then Generate.manifestCabalInstall plan archHashes units projectJson- else Generate.manifest plan archHashes units projectJson+ then Generate.manifestCabalInstall+ plan archHashes revisedUnits projectJson+ else Generate.manifest+ plan archHashes revisedUnits projectJson
+ src/Package.hs view
@@ -0,0 +1,114 @@+module Package (+ Revision,+ readTar,+ unitsMapFromList,+ scanIndex,+ ) where++import qualified Retrieve++import qualified Cabal.Plan as Plan++import qualified Codec.Compression.GZip as GZip+import qualified Codec.Archive.Tar as Tar+import Codec.Archive.Tar.Entry (fromTarPathToPosixPath, entryTarPath)++import qualified Crypto.Hash.SHA256 as SHA256++import qualified System.Path.PartClass as PartClass+import qualified System.Path as Path++import Control.Applicative (liftA2, (<$>))++import qualified Data.Map.Strict as Map+import qualified Data.Text as Text+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString as B+import qualified Data.List as List+import qualified Data.Either.HT as EitherHT+import Data.Map (Map)+import Data.Tuple.HT (mapFst, mapSnd)+++readTar ::+ (PartClass.AbsRel absRel) =>+ Path.File absRel -> IO (Tar.Entries Tar.FormatError)+readTar idxTar = do+ let idxTarStr = Path.toString idxTar+ stream <- BL.readFile idxTarStr+ case Path.takeExtensions idxTar of+ ".tar.gz" -> return $ Tar.read $ GZip.decompress stream+ ".tar" -> return $ Tar.read stream+ _ -> fail $ "unknown extension of " ++ idxTarStr++type SHA256 = B.ByteString+type Revision = Int++unitsMapFromList :: [Plan.Unit] -> Map (String,String) Plan.Unit+unitsMapFromList =+ Map.fromList .+ map+ (\unit ->+ let (Plan.PkgId (Plan.PkgName name) version) = Plan.uPId unit+ in ((Text.unpack name, Retrieve.formatVersion version), unit))++maybeFile :: Tar.EntryContent -> Maybe BL.ByteString+maybeFile entry =+ case entry of+ Tar.NormalFile content _size -> Just content+ _ -> Nothing++type Id a = a -> a++forcePair :: a -> b -> (a,b)+forcePair a b = ((,) $! a) $! b++forceNested :: Id ((Map Plan.PkgId Revision, Map Plan.PkgId Revision), SHA256)+forceNested ((count,found), mainHash) =+ forcePair (forcePair count found) mainHash++updateMaps :: (Ord k) =>+ Map k Plan.Unit -> k ->+ (Map Plan.PkgId Revision, Map Plan.PkgId Revision) -> Maybe SHA256 ->+ (Map Plan.PkgId Revision, Map Plan.PkgId Revision)+updateMaps units pkgNameVer (count,found) maybeHash =+ case Map.lookup pkgNameVer units of+ Nothing -> (count,found)+ Just unit ->+ let pkgId = Plan.uPId unit+ in (Map.insertWith (+) pkgId 1 count,+ if Just True ==+ liftA2 (==) maybeHash+ (Plan.sha256ToByteString <$> Plan.uCabalSha256 unit)+ then Map.insert pkgId (Map.findWithDefault 0 pkgId count) found+ else found)++scanIndex ::+ Tar.Entries Tar.FormatError ->+ (String,String) ->+ Map (String,String) Plan.Unit ->+ Either String (Map Plan.PkgId Revision, SHA256)+scanIndex tar mainPkg units =+ EitherHT.mapRight+ (mapFst $+ \(count,found) ->+ maybe found id $ do+ pkgId <- Plan.uPId <$> Map.lookup mainPkg units+ numRevs <- Map.lookup pkgId count+ return $ Map.insert pkgId (numRevs-1) found) $+ EitherHT.mapLeft (show.fst) $+ Tar.foldlEntries+ (\(maps,mainHash) entry ->+ let path = fromTarPathToPosixPath $ entryTarPath entry+ pkgNameVer =+ mapSnd (takeWhile ('/'/=) . drop 1) $ break ('/'==) path+ maybeHash =+ fmap SHA256.hashlazy $ maybeFile $ Tar.entryContent entry+ in forceNested $+ (if List.isSuffixOf ".cabal" path+ then updateMaps units pkgNameVer maps maybeHash+ else maps,+ case (pkgNameVer == mainPkg, maybeHash) of+ (True, Just hash) -> hash+ _ -> mainHash))+ ((Map.empty, Map.empty), B.empty) tar
+ src/Retrieve.hs view
@@ -0,0 +1,103 @@+module Retrieve where++import qualified Flatpak++import qualified Cabal.Plan as Plan++import qualified Network.HTTP.Client as Http+import Network.HTTP.Client.TLS (tlsManagerSettings)+import Network.HTTP.Types.Status (statusCode)++import Control.Monad (when)++import qualified Data.ByteString.Lazy.Char8 as BL+import qualified Data.ByteString.Char8 as B+import qualified Data.Text.Encoding as TextEnc+import qualified Data.Text as Text+import qualified Data.Map as Map+import qualified Data.List.HT as ListHT+import Data.Map (Map)+import Data.Tuple.HT (mapFst)+import Data.Bool.HT (if')++import Text.Printf (printf)+++formatVersion :: Plan.Ver -> String+formatVersion = Text.unpack . Plan.dispVer++archGHC :: Flatpak.Arch -> String+archGHC arch =+ case arch of+ Flatpak.I386 -> "i386"+ Flatpak.X86_64 -> "x86_64"+ Flatpak.ARM -> "armv7"+ Flatpak.AArch64 -> "aarch64"++ghcDirUrl :: Plan.PkgId -> String+ghcDirUrl (Plan.PkgId (Plan.PkgName compName) compVersion) =+ printf+ "https://downloads.haskell.org/%s/%s/"+ (Text.unpack compName)+ (formatVersion compVersion)++{- |+ghc-8.4.4-x86_64-deb9 is available but fails due to missing libnuma.so.1+-}+ghcNameScheme :: Plan.Ver -> String+ghcNameScheme ghcVer =+ if' (ghcVer >= Plan.Ver [8, 6,1]) "%s-%s-deb9-linux.tar.xz" $+ if' (ghcVer >= Plan.Ver [7,10,3]) "%s-%s-deb8-linux.tar.xz" $+ if' (ghcVer >= Plan.Ver [7, 8,1]) "%s-%s-unknown-linux-deb7.tar.xz" $+ "%s-%s-unknown-linux.tar.bz2"++ghcArchive :: Plan.PkgId -> Flatpak.Arch -> String+ghcArchive compiler@(Plan.PkgId _ compVersion) arch =+ printf (ghcNameScheme compVersion)+ (Text.unpack $ Plan.dispPkgId compiler)+ (archGHC arch)+++httpsGet :: String -> IO BL.ByteString+httpsGet url = do+ response <- do+ request <- Http.parseRequest url+ manager <- Http.newManager tlsManagerSettings+ Http.httpLbs request manager+ case statusCode $ Http.responseStatus response of+ 200 -> return $ Http.responseBody response+ code -> fail $ "HTTPS get failed with status code: " ++ show code++ghcHashes :: Plan.PkgId -> IO (String, Map BL.ByteString BL.ByteString)+ghcHashes compiler = do+ let sha256Url = ghcDirUrl compiler ++ "SHA256SUMS"+ ghcSha256s <- httpsGet sha256Url+ let (ghcSha256Map, ghcSha256Corrupts) =+ mapFst Map.fromList $+ ListHT.partitionMaybe+ (\line ->+ case BL.words line of+ [hash,archive] -> Just (archive,hash)+ _ -> Nothing)+ (BL.lines ghcSha256s)+ when (not $ null ghcSha256Corrupts) $ fail $ unlines $+ (printf "corrupt lines in %s:" sha256Url) :+ map BL.unpack ghcSha256Corrupts+ return (sha256Url,ghcSha256Map)++ghcHash ::+ (String, Map BL.ByteString BL.ByteString) ->+ Plan.PkgId -> Flatpak.Arch -> Either String Plan.Sha256+ghcHash (sha256Url,ghcSha256Map) compiler arch = do+ let ghcName = ghcArchive compiler arch+ let maybeFail msg = maybe (Left msg) Right+ hashStr <-+ maybeFail+ (printf "could not find SHA256 checksum for %s in %s"+ ghcName sha256Url) $+ Map.lookup (BL.pack $ "./"++ghcName) ghcSha256Map+ sha256 <-+ maybeFail ("could not parse SHA256 checksum " ++ BL.unpack hashStr) $+ Plan.parseSha256 $+ TextEnc.decodeLatin1 $ B.concat $ BL.toChunks hashStr+ return sha256