Skip to content
Snippets Groups Projects
Commit 4a2127ce authored by David Terei's avatar David Terei Committed by Ian Lynagh
Browse files

Move function from where clause to top level

parent c5b92fbf
No related merge requests found
...@@ -911,20 +911,18 @@ hscCheckSafeImports tcg_env = do ...@@ -911,20 +911,18 @@ hscCheckSafeImports tcg_env = do
text "Rule \"" <> ftext n <> text "\" ignored" $+$ text "Rule \"" <> ftext n <> text "\" ignored" $+$
text "User defined rules are disabled under Safe Haskell" text "User defined rules are disabled under Safe Haskell"
-- | Validate that safe imported modules are actually safe. -- | Validate that safe imported modules are actually safe. For modules in the
-- For modules in the HomePackage (the package the module we -- HomePackage (the package the module we are compiling in resides) this just
-- are compiling in resides) this just involves checking its -- involves checking its trust type is 'Safe' or 'Trustworthy'. For modules
-- trust type is 'Safe' or 'Trustworthy'. For modules that -- that reside in another package we also must check that the external pacakge
-- reside in another package we also must check that the -- is trusted. See the Note [Safe Haskell Trust Check] above for more
-- external pacakge is trusted. See the Note [Safe Haskell -- information.
-- Trust Check] above for more information.
-- --
-- The code for this is quite tricky as the whole algorithm -- The code for this is quite tricky as the whole algorithm is done in a few
-- is done in a few distinct phases in different parts of the -- distinct phases in different parts of the code base. See
-- code base. See RnNames.rnImportDecl for where package trust -- RnNames.rnImportDecl for where package trust dependencies for a module are
-- dependencies for a module are collected and unioned. -- collected and unioned. Specifically see the Note [RnNames . Tracking Trust
-- Specifically see the Note [RnNames . Tracking Trust Transitively] -- Transitively] and the Note [RnNames . Trust Own Package].
-- and the Note [RnNames . Trust Own Package].
checkSafeImports :: DynFlags -> TcGblEnv -> Hsc TcGblEnv checkSafeImports :: DynFlags -> TcGblEnv -> Hsc TcGblEnv
checkSafeImports dflags tcg_env checkSafeImports dflags tcg_env
= do = do
...@@ -941,7 +939,7 @@ checkSafeImports dflags tcg_env ...@@ -941,7 +939,7 @@ checkSafeImports dflags tcg_env
clearWarnings clearWarnings
logWarnings oldErrs logWarnings oldErrs
-- See the Note [ Safe Haskell Inference] -- See the Note [Safe Haskell Inference]
case (not $ isEmptyBag errs) of case (not $ isEmptyBag errs) of
-- We have errors! -- We have errors!
...@@ -953,7 +951,7 @@ checkSafeImports dflags tcg_env ...@@ -953,7 +951,7 @@ checkSafeImports dflags tcg_env
-- All good matey! -- All good matey!
False -> do False -> do
when (packageTrustOn dflags) $ checkPkgTrust pkg_reqs when (packageTrustOn dflags) $ checkPkgTrust dflags pkg_reqs
-- add in trusted package requirements for this module -- add in trusted package requirements for this module
let new_trust = emptyImportAvails { imp_trust_pkgs = catMaybes pkgs } let new_trust = emptyImportAvails { imp_trust_pkgs = catMaybes pkgs }
return tcg_env { tcg_imports = imp_info `plusImportAvails` new_trust } return tcg_env { tcg_imports = imp_info `plusImportAvails` new_trust }
...@@ -986,22 +984,6 @@ checkSafeImports dflags tcg_env ...@@ -986,22 +984,6 @@ checkSafeImports dflags tcg_env
checkSafe (_, _, False) = return Nothing checkSafe (_, _, False) = return Nothing
checkSafe (m, l, True ) = hscCheckSafe' dflags m l checkSafe (m, l, True ) = hscCheckSafe' dflags m l
-- Here we check the transitive package trust requirements are OK still.
checkPkgTrust :: [PackageId] -> Hsc ()
checkPkgTrust pkgs =
case errors of
[] -> return ()
_ -> (liftIO . throwIO . mkSrcErr . listToBag) errors
where
errors = catMaybes $ map go pkgs
go pkg
| trusted $ getPackageDetails (pkgState dflags) pkg
= Nothing
| otherwise
= Just $ mkPlainErrMsg noSrcSpan
$ text "The package (" <> ppr pkg <> text ") is required"
<> text " to be trusted but it isn't!"
-- | Check that a module is safe to import. -- | Check that a module is safe to import.
-- --
-- We return a package id if the safe import is OK and a Nothing otherwise -- We return a package id if the safe import is OK and a Nothing otherwise
...@@ -1055,11 +1037,10 @@ hscCheckSafe' dflags m l = do ...@@ -1055,11 +1037,10 @@ hscCheckSafe' dflags m l = do
<+> text "can't be safely imported!" <+> text "can't be safely imported!"
<+> text "The module itself isn't safe." <+> text "The module itself isn't safe."
-- | Check the package a module resides in is trusted. -- | Check the package a module resides in is trusted. Safe compiled
-- Safe compiled modules are trusted without requiring -- modules are trusted without requiring that their package is trusted. For
-- that their package is trusted. For trustworthy modules, -- trustworthy modules, modules in the home package are trusted but
-- modules in the home package are trusted but otherwise -- otherwise we check the package trust flag.
-- we check the package trust flag.
packageTrusted :: SafeHaskellMode -> Bool -> Module -> Bool packageTrusted :: SafeHaskellMode -> Bool -> Module -> Bool
packageTrusted _ _ _ packageTrusted _ _ _
| not (packageTrustOn dflags) = True | not (packageTrustOn dflags) = True
...@@ -1084,6 +1065,22 @@ hscCheckSafe' dflags m l = do ...@@ -1084,6 +1065,22 @@ hscCheckSafe' dflags m l = do
| thisPackage dflags == modulePackageId m = True | thisPackage dflags == modulePackageId m = True
| otherwise = False | otherwise = False
-- | Check the list of packages are trusted.
checkPkgTrust :: DynFlags -> [PackageId] -> Hsc ()
checkPkgTrust dflags pkgs =
case errors of
[] -> return ()
_ -> (liftIO . throwIO . mkSrcErr . listToBag) errors
where
errors = catMaybes $ map go pkgs
go pkg
| trusted $ getPackageDetails (pkgState dflags) pkg
= Nothing
| otherwise
= Just $ mkPlainErrMsg noSrcSpan
$ text "The package (" <> ppr pkg <> text ") is required"
<> text " to be trusted but it isn't!"
-- | Set module to unsafe and wipe trust information. -- | Set module to unsafe and wipe trust information.
-- --
-- Make sure to call this method to set a module to infered unsafe, -- Make sure to call this method to set a module to infered unsafe,
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment