Add darwin notarisation
This commit is contained in:
		
							parent
							
								
									c106dd3f65
								
							
						
					
					
						commit
						1455c2c175
					
				@ -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 =
 | 
				
			||||||
 | 
				
			|||||||
							
								
								
									
										21
									
								
								lib/GHCup.hs
									
									
									
									
									
								
							
							
						
						
									
										21
									
								
								lib/GHCup.hs
									
									
									
									
									
								
							@ -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)
 | 
				
			||||||
 | 
				
			|||||||
@ -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)
 | 
				
			||||||
 | 
				
			|||||||
@ -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
 | 
				
			||||||
 | 
				
			|||||||
@ -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 ()
 | 
				
			||||||
 | 
				
			|||||||
		Loading…
	
		Reference in New Issue
	
	Block a user