Commit ddb50b31 authored by dterei's avatar dterei
Browse files

Move function from where clause to top level

parent e1a8d3fd
...@@ -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,
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment