module GHC.Linker.Windows
   ( ManifestOpts (..)
   , initManifestOpts
   , maybeCreateManifest
   )
where

import GHC.Prelude
import GHC.SysTools
import GHC.Driver.Session
import GHC.Utils.TmpFs
import GHC.Utils.Logger

import System.FilePath
import System.Directory

data ManifestOpts = ManifestOpts
  { ManifestOpts -> Bool
manifestEmbed :: !Bool    -- ^ Should the manifest be embedded in the binary with Windres
  , ManifestOpts -> TempDir
manifestTempdir :: TempDir
  , ManifestOpts -> WindresConfig
manifestWindresConfig :: WindresConfig
  , ManifestOpts -> String
manifestObjectSuf :: String
  }

initManifestOpts :: DynFlags -> ManifestOpts
initManifestOpts :: DynFlags -> ManifestOpts
initManifestOpts DynFlags
dflags = ManifestOpts
  { manifestEmbed :: Bool
manifestEmbed = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_EmbedManifest DynFlags
dflags
  , manifestTempdir :: TempDir
manifestTempdir = DynFlags -> TempDir
tmpDir DynFlags
dflags
  , manifestWindresConfig :: WindresConfig
manifestWindresConfig = DynFlags -> WindresConfig
configureWindres DynFlags
dflags
  , manifestObjectSuf :: String
manifestObjectSuf = DynFlags -> String
objectSuf DynFlags
dflags
  }

maybeCreateManifest
   :: Logger
   -> TmpFs
   -> ManifestOpts
   -> FilePath      -- ^ filename of executable
   -> IO [FilePath] -- ^ extra objects to embed, maybe
maybeCreateManifest :: Logger -> TmpFs -> ManifestOpts -> String -> IO [String]
maybeCreateManifest Logger
logger TmpFs
tmpfs ManifestOpts
opts String
exe_filename = do
   let manifest_filename :: String
manifest_filename = String
exe_filename String -> String -> String
<.> String
"manifest"
       manifest :: String
manifest =
         String
"<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>\n\
         \  <assembly xmlns=\"urn:schemas-microsoft-com:asm.v1\" manifestVersion=\"1.0\">\n\
         \  <assemblyIdentity version=\"1.0.0.0\"\n\
         \     processorArchitecture=\"X86\"\n\
         \     name=\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
dropExtension String
exe_filename String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\"\n\
         \     type=\"win32\"/>\n\n\
         \  <trustInfo xmlns=\"urn:schemas-microsoft-com:asm.v3\">\n\
         \    <security>\n\
         \      <requestedPrivileges>\n\
         \        <requestedExecutionLevel level=\"asInvoker\" uiAccess=\"false\"/>\n\
         \        </requestedPrivileges>\n\
         \       </security>\n\
         \  </trustInfo>\n\
         \</assembly>\n"

   String -> String -> IO ()
writeFile String
manifest_filename String
manifest

   -- Windows will find the manifest file if it is named
   -- foo.exe.manifest. However, for extra robustness, and so that
   -- we can move the binary around, we can embed the manifest in
   -- the binary itself using windres:
   if Bool -> Bool
not (ManifestOpts -> Bool
manifestEmbed ManifestOpts
opts)
      then [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
      else do
         rc_filename <- Logger
-> TmpFs -> TempDir -> TempFileLifetime -> String -> IO String
newTempName Logger
logger TmpFs
tmpfs (ManifestOpts -> TempDir
manifestTempdir ManifestOpts
opts) TempFileLifetime
TFL_CurrentModule String
"rc"
         rc_obj_filename <-
           newTempName logger tmpfs (manifestTempdir opts) TFL_GhcSession (manifestObjectSuf opts)

         writeFile rc_filename $
             "1 24 MOVEABLE PURE \"" ++ manifest_filename ++ "\"\n"
               -- magic numbers :-)

         runWindres logger (manifestWindresConfig opts) $ map GHC.SysTools.Option $
               ["--input="++rc_filename,
                "--output="++rc_obj_filename,
                "--output-format=coff"]
               -- no FileOptions here: windres doesn't like seeing
               -- backslashes, apparently

         removeFile manifest_filename

         return [rc_obj_filename]