From 9d9e415a09453f1d9b6f870b8b12029794ecd153 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Fri, 17 Apr 2020 09:30:45 +0200 Subject: [PATCH] Remove use of unsafe decodeUtf8 --- lib/GHCup/Download.hs | 12 ++++++------ lib/GHCup/Download/IOStreams.hs | 3 +-- lib/GHCup/Platform.hs | 11 +++++------ lib/GHCup/Types/JSON.hs | 4 ++-- lib/GHCup/Utils.hs | 18 +++++++++++------- lib/GHCup/Utils/File.hs | 4 +--- lib/GHCup/Utils/Prelude.hs | 19 ++++++++++++++----- 7 files changed, 40 insertions(+), 31 deletions(-) diff --git a/lib/GHCup/Download.hs b/lib/GHCup/Download.hs index 438e004..c72d5d9 100644 --- a/lib/GHCup/Download.hs +++ b/lib/GHCup/Download.hs @@ -192,7 +192,7 @@ getDownloads urlSource = do True defaultTimeLocale "%a, %d %b %Y %H:%M:%S %Z" - (T.unpack . E.decodeUtf8 $ h) + (T.unpack . decUTF8Safe $ h) #endif @@ -256,7 +256,7 @@ download dli dest mfn liftIO $ copyFile fromFile destFile Strict pure destFile dl = do - let uri' = E.decodeUtf8 (serializeURIRef' (view dlUri dli)) + let uri' = decUTF8Safe (serializeURIRef' (view dlUri dli)) lift $ $(logInfo) [i|downloading: #{uri'}|] -- destination dir must exist @@ -371,17 +371,17 @@ downloadBS uri' #endif -checkDigest :: (MonadIO m, MonadLogger m, MonadReader Settings m) +checkDigest :: (MonadIO m, MonadThrow m, MonadLogger m, MonadReader Settings m) => DownloadInfo -> Path Abs -> Excepts '[DigestError] m () checkDigest dli file = do verify <- lift ask <&> (not . noVerify) when verify $ do - let p' = toFilePath file + p' <- toFilePath <$> basename file lift $ $(logInfo) [i|verifying digest of: #{p'}|] c <- liftIO $ readFile file - let cDigest = E.decodeUtf8 . B16.encode . SHA256.hashlazy $ c - eDigest = view dlHash dli + cDigest <- throwEither . E.decodeUtf8' . B16.encode . SHA256.hashlazy $ c + let eDigest = view dlHash dli when ((cDigest /= eDigest) && verify) $ throwE (DigestError cDigest eDigest) diff --git a/lib/GHCup/Download/IOStreams.hs b/lib/GHCup/Download/IOStreams.hs index 2dbf696..272bb0e 100644 --- a/lib/GHCup/Download/IOStreams.hs +++ b/lib/GHCup/Download/IOStreams.hs @@ -47,7 +47,6 @@ import URI.ByteString import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as L import qualified Data.Map.Strict as M -import qualified Data.Text.Encoding as E import qualified System.IO.Streams as Streams @@ -146,7 +145,7 @@ downloadInternal = go (5 :: Int) downloadStream r i' = do let size = case getHeader r "Content-Length" of - Just x' -> case decimal $ E.decodeUtf8 x' of + Just x' -> case decimal $ decUTF8Safe x' of Left _ -> 0 Right (r', _) -> r' Nothing -> 0 diff --git a/lib/GHCup/Platform.hs b/lib/GHCup/Platform.hs index 33514f0..3521717 100644 --- a/lib/GHCup/Platform.hs +++ b/lib/GHCup/Platform.hs @@ -39,7 +39,6 @@ import System.Info import Text.Regex.Posix import qualified Data.Text as T -import qualified Data.Text.Encoding as E -------------------------- --[ Platform detection ]-- @@ -84,13 +83,13 @@ getPlatform = do ( either (const Nothing) Just . versioning . getMajorVersion - . E.decodeUtf8 + . decUTF8Safe ) <$> getDarwinVersion pure $ PlatformResult { _platform = Darwin, _distroVersion = ver } "freebsd" -> do ver <- - (either (const Nothing) Just . versioning . E.decodeUtf8) + (either (const Nothing) Just . versioning . decUTF8Safe) <$> getFreeBSDVersion pure $ PlatformResult { _platform = FreeBSD, _distroVersion = ver } what -> throwE $ NoCompatiblePlatform what @@ -159,7 +158,7 @@ getLinuxDistro = do (Just _) <- findExecutable lsb_release_cmd name <- fmap _stdOut $ executeOut lsb_release_cmd ["-si"] Nothing ver <- fmap _stdOut $ executeOut lsb_release_cmd ["-sr"] Nothing - pure (E.decodeUtf8 name, Just $ E.decodeUtf8 ver) + pure (decUTF8Safe name, Just $ decUTF8Safe ver) try_lsb_release :: IO (Text, Maybe Text) try_lsb_release = do @@ -169,7 +168,7 @@ getLinuxDistro = do try_redhat_release :: IO (Text, Maybe Text) try_redhat_release = do - t <- fmap lBS2sT $ readFile redhat_release + t <- fmap decUTF8Safe' $ readFile redhat_release let nameRegex n = makeRegexOpts compIgnoreCase execBlank @@ -192,4 +191,4 @@ getLinuxDistro = do try_debian_version :: IO (Text, Maybe Text) try_debian_version = do ver <- readFile debian_version - pure (T.pack "debian", Just $ lBS2sT ver) + pure (T.pack "debian", Just . decUTF8Safe' $ ver) diff --git a/lib/GHCup/Types/JSON.hs b/lib/GHCup/Types/JSON.hs index aa17289..d0fe183 100644 --- a/lib/GHCup/Types/JSON.hs +++ b/lib/GHCup/Types/JSON.hs @@ -44,7 +44,7 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Requir instance ToJSON URI where - toJSON = toJSON . decodeUtf8 . serializeURIRef' + toJSON = toJSON . decUTF8Safe . serializeURIRef' instance FromJSON URI where parseJSON = withText "URL" $ \t -> @@ -151,7 +151,7 @@ instance FromJSONKey Tool where instance ToJSON (Path Rel) where toJSON p = case and . fmap isAscii . BS.unpack $ fp of - True -> toJSON . E.decodeUtf8 $ fp + True -> toJSON . decUTF8Safe $ fp False -> String "/not/a/valid/path" where fp = toFilePath p diff --git a/lib/GHCup/Utils.hs b/lib/GHCup/Utils.hs index 0c0beea..394dd47 100644 --- a/lib/GHCup/Utils.hs +++ b/lib/GHCup/Utils.hs @@ -83,9 +83,11 @@ ghcLinkVersion = either (throwM . ParseError) pure . parseOnly parser where parser = string "../ghc/" *> verParser <* string "/bin/ghc" verParser = many1' (notWord8 _slash) >>= \t -> - case version $ E.decodeUtf8 $ B.pack t of - Left e -> fail $ show e - Right r -> pure r + case + version (decUTF8Safe $ B.pack t) + of + Left e -> fail $ show e + Right r -> pure r -- e.g. ghc-8.6.5 @@ -179,7 +181,7 @@ cabalSet = do cabalbin <- ( [rel|cabal|]) <$> liftIO ghcupBinDir mc <- liftIO $ executeOut cabalbin ["--numeric-version"] Nothing let reportedVer = fst . B.spanEnd (== _lf) . _stdOut $ mc - case version (E.decodeUtf8 reportedVer) of + case version $ decUTF8Safe reportedVer of Left e -> throwM e Right r -> pure r @@ -206,7 +208,8 @@ getGHCForMajor :: (MonadIO m, MonadThrow m) getGHCForMajor major' minor' = do p <- liftIO $ ghcupGHCBaseDir ghcs <- liftIO $ getDirsFiles' p - semvers <- forM ghcs $ throwEither . semver . E.decodeUtf8 . toFilePath + semvers <- forM ghcs $ \ghc -> + throwEither . semver =<< (throwEither . E.decodeUtf8' . toFilePath $ ghc) mapM (throwEither . version) . fmap prettySemVer . lastMay @@ -232,8 +235,9 @@ unpackToDir :: (MonadLogger m, MonadIO m, MonadThrow m) -> Path Abs -- ^ archive path -> Excepts '[UnknownArchive] m () unpackToDir dest av = do - let fp = E.decodeUtf8 (toFilePath av) - lift $ $(logInfo) [i|Unpacking: #{fp}|] + fp <- (decUTF8Safe . toFilePath) <$> basename av + let dfp = decUTF8Safe . toFilePath $ dest + lift $ $(logInfo) [i|Unpacking: #{fp} to #{dfp}|] fn <- toFilePath <$> basename av let untar = Tar.unpack (toFilePath dest) . Tar.read diff --git a/lib/GHCup/Utils/File.hs b/lib/GHCup/Utils/File.hs index d212b50..802f3f8 100644 --- a/lib/GHCup/Utils/File.hs +++ b/lib/GHCup/Utils/File.hs @@ -43,8 +43,6 @@ import System.Posix.Types import qualified Control.Exception as EX import qualified Data.Text as T -import qualified Data.Text.Encoding as E -import qualified Data.Text.Encoding.Error as E import qualified System.Posix.Process.ByteString as SPPB import Streamly.External.Posix.DirStream @@ -208,7 +206,7 @@ execLogged exe spath args lfile chdir env = do . T.pack . color Blue . T.unpack - . E.decodeUtf8With E.lenientDecode + . decUTF8Safe . trim w . (\b -> "[ " <> toFilePath lfile <> " ] " <> b) $ bs diff --git a/lib/GHCup/Utils/Prelude.hs b/lib/GHCup/Utils/Prelude.hs index 7003bf1..0d698d1 100644 --- a/lib/GHCup/Utils/Prelude.hs +++ b/lib/GHCup/Utils/Prelude.hs @@ -29,6 +29,7 @@ import qualified Data.ByteString.Lazy as L import qualified Data.Strict.Maybe as S import qualified Data.Text as T import qualified Data.Text.Encoding as E +import qualified Data.Text.Encoding.Error as E import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as B import qualified Data.Text.Lazy.Builder.Int as B @@ -87,10 +88,6 @@ whileM_ ~action = void . whileM action guardM :: (Monad m, Alternative m) => m Bool -> m () guardM ~f = guard =<< f -lBS2sT :: L.ByteString -> Text -lBS2sT = TL.toStrict . TLE.decodeUtf8 - - handleIO' :: (MonadIO m, MonadCatch m) => IOErrorType @@ -243,4 +240,16 @@ addToCurrentEnv adds = do pvpToVersion :: PVP -> Version -pvpToVersion = either (\_ -> error "Couldn't convert PVP to Version") id . version . prettyPVP +pvpToVersion = + either (\_ -> error "Couldn't convert PVP to Version") id + . version + . prettyPVP + + +-- | Safe 'decodeUtf8With'. Replaces an invalid input byte with +-- the Unicode replacement character U+FFFD. +decUTF8Safe :: ByteString -> Text +decUTF8Safe = E.decodeUtf8With E.lenientDecode + +decUTF8Safe' :: L.ByteString -> Text +decUTF8Safe' = TL.toStrict . TLE.decodeUtf8With E.lenientDecode