Fix darwin binaries after copying

lib/GHCup.hs

@@ -359,7 +359,8 @@ installUnpackedGHC path inst ver forceInstall
       lift $ logInfo $ "Merging file tree from \"" <> T.pack tmpInstallDest <> "\" to \"" <> T.pack (fromInstallDir inst) <> "\""
       fs <- mergeFileTreeAll (tmpInstallDest </> dropDrive (fromInstallDir inst))
         (fromInstallDir inst)
-        (\f t -> liftIO $ install f t (not forceInstall))
+        (\f t -> liftIO (install f t (not forceInstall)))
+      liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromInstallDir inst)
       case inst of
         IsolateDirResolved _ -> pure ()
         _ -> recordInstalledFiles fs GHC (mkTVer ver)
@@ -659,6 +660,7 @@ installHLSUnpacked :: ( MonadMask m
                       , MonadCatch m
                       , MonadIO m
                       , MonadResource m
+                      , HasPlatformReq env
                       )
                    => FilePath      -- ^ Path to the unpacked hls bindist (where the executable resides)
                    -> InstallDirResolved      -- ^ Path to install to
@@ -666,12 +668,14 @@ installHLSUnpacked :: ( MonadMask m
                    -> Bool
                    -> Excepts '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled] m ()
 installHLSUnpacked path inst ver forceInstall = do
+  PlatformRequest { .. } <- lift getPlatformReq
   lift $ logInfo "Installing HLS"
   tmpInstallDest <- lift withGHCupTmpDir
   lEM $ make ["DESTDIR=" <> tmpInstallDest, "PREFIX=" <> fromInstallDir inst, "install"] (Just path)
   fs <- mergeFileTreeAll (tmpInstallDest </> dropDrive (fromInstallDir inst))
                    (fromInstallDir inst)
-                   (\f t -> liftIO $ install f t (not forceInstall))
+                   (\f t -> liftIO (install f t (not forceInstall)))
+  liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromInstallDir inst)
   case inst of
     IsolateDirResolved _ -> pure ()
     _ -> recordInstalledFiles fs HLS (mkTVer ver)

lib/GHCup/Utils.hs

@@ -1033,6 +1033,8 @@ darwinNotarization Darwin path = exec
 darwinNotarization _ _ = pure $ Right ()
 
 
+
+
 getChangeLog :: GHCupDownloads -> Tool -> Either Version Tag -> Maybe URI
 getChangeLog dls tool (Left v') =
   preview (ix tool % ix v' % viChangeLog % _Just) dls

lib/GHCup/Utils/File/Posix.hs

@@ -1,5 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE DataKinds  #-}
+{-# LANGUAGE MultiWayIf  #-}
 
 {-|
 Module      : GHCup.Utils.File.Posix
@@ -418,41 +420,25 @@ copyFile :: FilePath   -- ^ source file
          -> IO ()
 copyFile from to fail' = do
   bracket
-      (do
+    (openFdHandle from SPI.ReadOnly [FD.oNofollow] Nothing)
-        fd     <- openFd' from SPI.ReadOnly [FD.oNofollow] Nothing
+    (hClose . snd)
-        handle' <- SPI.fdToHandle fd
-        pure (fd, handle')
-      )
-      (\(_, handle') -> hClose handle')
     $ \(fromFd, fH) -> do
-        sourceFileMode <- fileMode
+        sourceFileMode <- fileMode <$> getFdStatus fromFd
-          <$> getFdStatus fromFd
+        let dflags = [ FD.oNofollow
-        let dflags =
+                     , if fail' then FD.oExcl else FD.oTrunc
-              [ FD.oNofollow
+                     ]
-              , case fail' of
+        bracket
-                True    -> FD.oExcl
+          (openFdHandle to SPI.WriteOnly dflags $ Just sourceFileMode)
-                False   -> FD.oTrunc
+          (hClose . snd)
-              ]
-        bracketeer
-            (do
-              fd     <- openFd' to SPI.WriteOnly dflags $ Just sourceFileMode
-              handle' <- SPI.fdToHandle fd
-              pure (fd, handle')
-            )
-            (\(_, handle') -> hClose handle')
-            (\(_, handle') -> do
-              hClose handle'
-              case fail' of
-                   -- if we created the file and copying failed, it's
-                   -- safe to clean up
-                True  -> PF.removeLink to
-                False -> pure ()
-            )
           $ \(_, tH) -> do
               hSetBinaryMode fH True
               hSetBinaryMode tH True
               streamlyCopy (fH, tH)
  where
+  openFdHandle fp omode flags fM = do
+    fd      <- openFd' fp omode flags fM
+    handle' <- SPI.fdToHandle fd
+    pure (fd, handle')
   streamlyCopy (fH, tH) =
     S.fold (FH.writeChunks tH) $ IFH.toChunksWithBufferOf (256 * 1024) fH
 
@@ -563,3 +549,4 @@ install from to fail' = do
   decide fs | PF.isRegularFile fs     = copyFile from to fail'
             | PF.isSymbolicLink fs    = recreateSymlink from to fail'
             | otherwise               = ioError $ mkIOError illegalOperationErrorType "install: not a regular file or symlink" Nothing (Just from)
+

lib/GHCup/Utils/File/Windows.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE DataKinds  #-}
 
 {-|
 Module      : GHCup.Utils.File.Windows

lib/GHCup/Utils/Prelude.hs

@@ -759,21 +759,3 @@ breakOn :: Eq a => [a] -> [a] -> ([a], [a])
 breakOn needle haystack | needle `isPrefixOf` haystack = ([], haystack)
 breakOn _ [] = ([], [])
 breakOn needle (x:xs) = first (x:) $ breakOn needle xs
-
-
--- |Like `bracket`, but allows to have different clean-up
--- actions depending on whether the in-between computation
--- has raised an exception or not.
-bracketeer :: IO a        -- ^ computation to run first
-           -> (a -> IO b) -- ^ computation to run last, when
-                          --   no exception was raised
-           -> (a -> IO b) -- ^ computation to run last,
-                          --   when an exception was raised
-           -> (a -> IO c) -- ^ computation to run in-between
-           -> IO c
-bracketeer before after afterEx thing =
-  mask $ \restore -> do
-    a <- before
-    r <- restore (thing a) `onException` afterEx a
-    _ <- after a
-    return r