Add darwin notarisation

This commit is contained in:
Julian Ospald 2020-04-10 19:27:17 +02:00
parent c106dd3f65
commit 1455c2c175
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
5 changed files with 59 additions and 44 deletions

View File

@ -588,11 +588,14 @@ main = do
@'[ AlreadyInstalled @'[ AlreadyInstalled
, BuildFailed , BuildFailed
, DigestError , DigestError
, DistroNotFound
, DownloadFailed
, GHCupSetError , GHCupSetError
, NoCompatibleArch
, NoCompatiblePlatform
, NoDownload , NoDownload
, PatchFailed , PatchFailed
, UnknownArchive , UnknownArchive
, DownloadFailed
] ]
let runCompileCabal = let runCompileCabal =
@ -600,12 +603,15 @@ main = do
. flip runReaderT settings . flip runReaderT settings
. runResourceT . runResourceT
. runE . runE
@'[ UnknownArchive @'[ BuildFailed
, NoDownload
, DigestError , DigestError
, BuildFailed , DistroNotFound
, PatchFailed
, DownloadFailed , DownloadFailed
, NoCompatibleArch
, NoCompatiblePlatform
, NoDownload
, PatchFailed
, UnknownArchive
] ]
let runUpgrade = let runUpgrade =

View File

@ -96,14 +96,16 @@ installGHCBin bDls ver mpfReq = do
whenM (liftIO $ toolAlreadyInstalled GHC ver) whenM (liftIO $ toolAlreadyInstalled GHC ver)
$ (throwE $ AlreadyInstalled GHC ver) $ (throwE $ AlreadyInstalled GHC ver)
Settings {..} <- lift ask Settings {..} <- lift ask
pfreq@(PlatformRequest {..}) <- maybe (liftE $ platformRequest) pure mpfReq
-- download (or use cached version) -- download (or use cached version)
dlinfo <- liftE $ getDownloadInfo bDls GHC ver mpfReq dlinfo <- lE $ getDownloadInfo GHC ver pfreq bDls
dl <- liftE $ downloadCached dlinfo Nothing dl <- liftE $ downloadCached dlinfo Nothing
-- unpack -- unpack
tmpUnpack <- lift mkGhcupTmpDir tmpUnpack <- lift mkGhcupTmpDir
liftE $ unpackToDir tmpUnpack dl liftE $ unpackToDir tmpUnpack dl
void $ liftIO $ darwinNotarization _rPlatform tmpUnpack
-- prepare paths -- prepare paths
ghcdir <- liftIO $ ghcupGHCDir ver ghcdir <- liftIO $ ghcupGHCDir ver
@ -170,14 +172,16 @@ installCabalBin :: ( MonadMask m
installCabalBin bDls ver mpfReq = do installCabalBin bDls ver mpfReq = do
lift $ $(logDebug) [i|Requested to install cabal version #{ver}|] lift $ $(logDebug) [i|Requested to install cabal version #{ver}|]
Settings {..} <- lift ask Settings {..} <- lift ask
pfreq@(PlatformRequest {..}) <- maybe (liftE $ platformRequest) pure mpfReq
-- download (or use cached version) -- download (or use cached version)
dlinfo <- liftE $ getDownloadInfo bDls Cabal ver mpfReq dlinfo <- lE $ getDownloadInfo Cabal ver pfreq bDls
dl <- liftE $ downloadCached dlinfo Nothing dl <- liftE $ downloadCached dlinfo Nothing
-- unpack -- unpack
tmpUnpack <- lift withGHCupTmpDir tmpUnpack <- lift withGHCupTmpDir
liftE $ unpackToDir tmpUnpack dl liftE $ unpackToDir tmpUnpack dl
void $ liftIO $ darwinNotarization _rPlatform tmpUnpack
-- prepare paths -- prepare paths
bindir <- liftIO ghcupBinDir bindir <- liftIO ghcupBinDir
@ -444,8 +448,11 @@ compileGHC :: ( MonadMask m
'[ AlreadyInstalled '[ AlreadyInstalled
, BuildFailed , BuildFailed
, DigestError , DigestError
, DistroNotFound
, DownloadFailed , DownloadFailed
, GHCupSetError , GHCupSetError
, NoCompatibleArch
, NoCompatiblePlatform
, NoDownload , NoDownload
, PatchFailed , PatchFailed
, UnknownArchive , UnknownArchive
@ -464,6 +471,8 @@ compileGHC dls tver bstrap jobs mbuildConfig patchdir = do
-- unpack -- unpack
tmpUnpack <- lift mkGhcupTmpDir tmpUnpack <- lift mkGhcupTmpDir
liftE $ unpackToDir tmpUnpack dl liftE $ unpackToDir tmpUnpack dl
(PlatformRequest {..}) <- liftE $ platformRequest
void $ liftIO $ darwinNotarization _rPlatform tmpUnpack
bghc <- case bstrap of bghc <- case bstrap of
Right g -> pure $ Right g Right g -> pure $ Right g
@ -579,7 +588,10 @@ compileCabal :: ( MonadReader Settings m
-> Excepts -> Excepts
'[ BuildFailed '[ BuildFailed
, DigestError , DigestError
, DistroNotFound
, DownloadFailed , DownloadFailed
, NoCompatibleArch
, NoCompatiblePlatform
, NoDownload , NoDownload
, PatchFailed , PatchFailed
, UnknownArchive , UnknownArchive
@ -596,6 +608,8 @@ compileCabal dls tver bghc jobs patchdir = do
-- unpack -- unpack
tmpUnpack <- lift mkGhcupTmpDir tmpUnpack <- lift mkGhcupTmpDir
liftE $ unpackToDir tmpUnpack dl liftE $ unpackToDir tmpUnpack dl
(PlatformRequest {..}) <- liftE $ platformRequest
void $ liftIO $ darwinNotarization _rPlatform tmpUnpack
let workdir = maybe id (flip (</>)) (view dlSubdir dlInfo) $ tmpUnpack let workdir = maybe id (flip (</>)) (view dlSubdir dlInfo) $ tmpUnpack
@ -674,7 +688,8 @@ upgradeGHCup :: ( MonadMask m
upgradeGHCup dls mtarget = do upgradeGHCup dls mtarget = do
lift $ $(logInfo) [i|Upgrading GHCup...|] lift $ $(logInfo) [i|Upgrading GHCup...|]
let latestVer = fromJust $ getLatest dls GHCup let latestVer = fromJust $ getLatest dls GHCup
dli <- liftE $ getDownloadInfo dls GHCup latestVer Nothing pfreq <- liftE platformRequest
dli <- lE $ getDownloadInfo GHCup latestVer pfreq dls
tmp <- lift withGHCupTmpDir tmp <- lift withGHCupTmpDir
let fn = [rel|ghcup|] let fn = [rel|ghcup|]
p <- liftE $ download dli tmp (Just fn) p <- liftE $ download dli tmp (Just fn)

View File

@ -16,7 +16,6 @@ import GHCup.Download.IOStreams
import GHCup.Download.Utils import GHCup.Download.Utils
#endif #endif
import GHCup.Errors import GHCup.Errors
import GHCup.Platform
import GHCup.Types import GHCup.Types
import GHCup.Types.JSON ( ) import GHCup.Types.JSON ( )
import GHCup.Types.Optics import GHCup.Types.Optics
@ -204,43 +203,13 @@ getDownloads urlSource = do
setModificationTimeHiRes path mod_time setModificationTimeHiRes path mod_time
getDownloadInfo :: Tool
getDownloadInfo :: (MonadLogger m, MonadCatch m, MonadIO m)
=> GHCupDownloads
-> Tool
-> Version -> Version
-> Maybe PlatformRequest
-> Excepts
'[ DistroNotFound
, NoCompatiblePlatform
, NoCompatibleArch
, NoDownload
]
m
DownloadInfo
getDownloadInfo bDls t v mpfReq = do
(PlatformRequest arch' plat ver) <- case mpfReq of
Just x -> pure x
Nothing -> do
(PlatformResult rp rv) <- liftE getPlatform
ar <- lE getArchitecture
pure $ PlatformRequest ar rp rv
lE $ getDownloadInfo' t v arch' plat ver bDls
getDownloadInfo' :: Tool
-> Version
-- ^ tool version -- ^ tool version
-> Architecture -> PlatformRequest
-- ^ user arch -> GHCupDownloads
-> Platform -> Either NoDownload DownloadInfo
-- ^ user platform getDownloadInfo t v (PlatformRequest a p mv) dls = maybe
-> Maybe Versioning
-- ^ optional version of the platform
-> GHCupDownloads
-> Either NoDownload DownloadInfo
getDownloadInfo' t v a p mv dls = maybe
(Left NoDownload) (Left NoDownload)
Right Right
(with_distro <|> without_distro_ver <|> without_distro) (with_distro <|> without_distro_ver <|> without_distro)

View File

@ -46,6 +46,21 @@ import qualified Data.Text.Encoding as E
-------------------------- --------------------------
-- | Get the full platform request, consisting of architecture, distro, ...
platformRequest :: (MonadLogger m, MonadCatch m, MonadIO m)
=> Excepts
'[ NoCompatiblePlatform
, NoCompatibleArch
, DistroNotFound
]
m
PlatformRequest
platformRequest = do
(PlatformResult rp rv) <- liftE getPlatform
ar <- lE getArchitecture
pure $ PlatformRequest ar rp rv
getArchitecture :: Either NoCompatibleArch Architecture getArchitecture :: Either NoCompatibleArch Architecture
getArchitecture = case arch of getArchitecture = case arch of
"x86_64" -> Right A_64 "x86_64" -> Right A_64

View File

@ -358,3 +358,13 @@ applyPatches pdir ddir = do
Nothing Nothing
) )
!? PatchFailed !? PatchFailed
darwinNotarization :: Platform -> Path Abs -> IO (Either ProcessError ())
darwinNotarization Darwin path = exec
"xattr"
True
["-r", "-d", "com.apple.quarantine", toFilePath path]
Nothing
Nothing
darwinNotarization _ _ = pure $ Right ()