Remove use of unsafe decodeUtf8

This commit is contained in:
Julian Ospald 2020-04-17 09:30:45 +02:00
parent 6c1ae585b7
commit 9d9e415a09
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
7 changed files with 40 additions and 31 deletions

View File

@ -192,7 +192,7 @@ getDownloads urlSource = do
True True
defaultTimeLocale defaultTimeLocale
"%a, %d %b %Y %H:%M:%S %Z" "%a, %d %b %Y %H:%M:%S %Z"
(T.unpack . E.decodeUtf8 $ h) (T.unpack . decUTF8Safe $ h)
#endif #endif
@ -256,7 +256,7 @@ download dli dest mfn
liftIO $ copyFile fromFile destFile Strict liftIO $ copyFile fromFile destFile Strict
pure destFile pure destFile
dl = do dl = do
let uri' = E.decodeUtf8 (serializeURIRef' (view dlUri dli)) let uri' = decUTF8Safe (serializeURIRef' (view dlUri dli))
lift $ $(logInfo) [i|downloading: #{uri'}|] lift $ $(logInfo) [i|downloading: #{uri'}|]
-- destination dir must exist -- destination dir must exist
@ -371,17 +371,17 @@ downloadBS uri'
#endif #endif
checkDigest :: (MonadIO m, MonadLogger m, MonadReader Settings m) checkDigest :: (MonadIO m, MonadThrow m, MonadLogger m, MonadReader Settings m)
=> DownloadInfo => DownloadInfo
-> Path Abs -> Path Abs
-> Excepts '[DigestError] m () -> Excepts '[DigestError] m ()
checkDigest dli file = do checkDigest dli file = do
verify <- lift ask <&> (not . noVerify) verify <- lift ask <&> (not . noVerify)
when verify $ do when verify $ do
let p' = toFilePath file p' <- toFilePath <$> basename file
lift $ $(logInfo) [i|verifying digest of: #{p'}|] lift $ $(logInfo) [i|verifying digest of: #{p'}|]
c <- liftIO $ readFile file c <- liftIO $ readFile file
let cDigest = E.decodeUtf8 . B16.encode . SHA256.hashlazy $ c cDigest <- throwEither . E.decodeUtf8' . B16.encode . SHA256.hashlazy $ c
eDigest = view dlHash dli let eDigest = view dlHash dli
when ((cDigest /= eDigest) && verify) $ throwE (DigestError cDigest eDigest) when ((cDigest /= eDigest) && verify) $ throwE (DigestError cDigest eDigest)

View File

@ -47,7 +47,6 @@ import URI.ByteString
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import qualified Data.Text.Encoding as E
import qualified System.IO.Streams as Streams import qualified System.IO.Streams as Streams
@ -146,7 +145,7 @@ downloadInternal = go (5 :: Int)
downloadStream r i' = do downloadStream r i' = do
let size = case getHeader r "Content-Length" of 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 Left _ -> 0
Right (r', _) -> r' Right (r', _) -> r'
Nothing -> 0 Nothing -> 0

View File

@ -39,7 +39,6 @@ import System.Info
import Text.Regex.Posix import Text.Regex.Posix
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as E
-------------------------- --------------------------
--[ Platform detection ]-- --[ Platform detection ]--
@ -84,13 +83,13 @@ getPlatform = do
( either (const Nothing) Just ( either (const Nothing) Just
. versioning . versioning
. getMajorVersion . getMajorVersion
. E.decodeUtf8 . decUTF8Safe
) )
<$> getDarwinVersion <$> getDarwinVersion
pure $ PlatformResult { _platform = Darwin, _distroVersion = ver } pure $ PlatformResult { _platform = Darwin, _distroVersion = ver }
"freebsd" -> do "freebsd" -> do
ver <- ver <-
(either (const Nothing) Just . versioning . E.decodeUtf8) (either (const Nothing) Just . versioning . decUTF8Safe)
<$> getFreeBSDVersion <$> getFreeBSDVersion
pure $ PlatformResult { _platform = FreeBSD, _distroVersion = ver } pure $ PlatformResult { _platform = FreeBSD, _distroVersion = ver }
what -> throwE $ NoCompatiblePlatform what what -> throwE $ NoCompatiblePlatform what
@ -159,7 +158,7 @@ getLinuxDistro = do
(Just _) <- findExecutable lsb_release_cmd (Just _) <- findExecutable lsb_release_cmd
name <- fmap _stdOut $ executeOut lsb_release_cmd ["-si"] Nothing name <- fmap _stdOut $ executeOut lsb_release_cmd ["-si"] Nothing
ver <- fmap _stdOut $ executeOut lsb_release_cmd ["-sr"] 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 :: IO (Text, Maybe Text)
try_lsb_release = do try_lsb_release = do
@ -169,7 +168,7 @@ getLinuxDistro = do
try_redhat_release :: IO (Text, Maybe Text) try_redhat_release :: IO (Text, Maybe Text)
try_redhat_release = do try_redhat_release = do
t <- fmap lBS2sT $ readFile redhat_release t <- fmap decUTF8Safe' $ readFile redhat_release
let nameRegex n = let nameRegex n =
makeRegexOpts compIgnoreCase makeRegexOpts compIgnoreCase
execBlank execBlank
@ -192,4 +191,4 @@ getLinuxDistro = do
try_debian_version :: IO (Text, Maybe Text) try_debian_version :: IO (Text, Maybe Text)
try_debian_version = do try_debian_version = do
ver <- readFile debian_version ver <- readFile debian_version
pure (T.pack "debian", Just $ lBS2sT ver) pure (T.pack "debian", Just . decUTF8Safe' $ ver)

View File

@ -44,7 +44,7 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Requir
instance ToJSON URI where instance ToJSON URI where
toJSON = toJSON . decodeUtf8 . serializeURIRef' toJSON = toJSON . decUTF8Safe . serializeURIRef'
instance FromJSON URI where instance FromJSON URI where
parseJSON = withText "URL" $ \t -> parseJSON = withText "URL" $ \t ->
@ -151,7 +151,7 @@ instance FromJSONKey Tool where
instance ToJSON (Path Rel) where instance ToJSON (Path Rel) where
toJSON p = case and . fmap isAscii . BS.unpack $ fp of 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" False -> String "/not/a/valid/path"
where fp = toFilePath p where fp = toFilePath p

View File

@ -83,9 +83,11 @@ ghcLinkVersion = either (throwM . ParseError) pure . parseOnly parser
where where
parser = string "../ghc/" *> verParser <* string "/bin/ghc" parser = string "../ghc/" *> verParser <* string "/bin/ghc"
verParser = many1' (notWord8 _slash) >>= \t -> verParser = many1' (notWord8 _slash) >>= \t ->
case version $ E.decodeUtf8 $ B.pack t of case
Left e -> fail $ show e version (decUTF8Safe $ B.pack t)
Right r -> pure r of
Left e -> fail $ show e
Right r -> pure r
-- e.g. ghc-8.6.5 -- e.g. ghc-8.6.5
@ -179,7 +181,7 @@ cabalSet = do
cabalbin <- (</> [rel|cabal|]) <$> liftIO ghcupBinDir cabalbin <- (</> [rel|cabal|]) <$> liftIO ghcupBinDir
mc <- liftIO $ executeOut cabalbin ["--numeric-version"] Nothing mc <- liftIO $ executeOut cabalbin ["--numeric-version"] Nothing
let reportedVer = fst . B.spanEnd (== _lf) . _stdOut $ mc let reportedVer = fst . B.spanEnd (== _lf) . _stdOut $ mc
case version (E.decodeUtf8 reportedVer) of case version $ decUTF8Safe reportedVer of
Left e -> throwM e Left e -> throwM e
Right r -> pure r Right r -> pure r
@ -206,7 +208,8 @@ getGHCForMajor :: (MonadIO m, MonadThrow m)
getGHCForMajor major' minor' = do getGHCForMajor major' minor' = do
p <- liftIO $ ghcupGHCBaseDir p <- liftIO $ ghcupGHCBaseDir
ghcs <- liftIO $ getDirsFiles' p 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) mapM (throwEither . version)
. fmap prettySemVer . fmap prettySemVer
. lastMay . lastMay
@ -232,8 +235,9 @@ unpackToDir :: (MonadLogger m, MonadIO m, MonadThrow m)
-> Path Abs -- ^ archive path -> Path Abs -- ^ archive path
-> Excepts '[UnknownArchive] m () -> Excepts '[UnknownArchive] m ()
unpackToDir dest av = do unpackToDir dest av = do
let fp = E.decodeUtf8 (toFilePath av) fp <- (decUTF8Safe . toFilePath) <$> basename av
lift $ $(logInfo) [i|Unpacking: #{fp}|] let dfp = decUTF8Safe . toFilePath $ dest
lift $ $(logInfo) [i|Unpacking: #{fp} to #{dfp}|]
fn <- toFilePath <$> basename av fn <- toFilePath <$> basename av
let untar = Tar.unpack (toFilePath dest) . Tar.read let untar = Tar.unpack (toFilePath dest) . Tar.read

View File

@ -43,8 +43,6 @@ import System.Posix.Types
import qualified Control.Exception as EX import qualified Control.Exception as EX
import qualified Data.Text as T 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 import qualified System.Posix.Process.ByteString
as SPPB as SPPB
import Streamly.External.Posix.DirStream import Streamly.External.Posix.DirStream
@ -208,7 +206,7 @@ execLogged exe spath args lfile chdir env = do
. T.pack . T.pack
. color Blue . color Blue
. T.unpack . T.unpack
. E.decodeUtf8With E.lenientDecode . decUTF8Safe
. trim w . trim w
. (\b -> "[ " <> toFilePath lfile <> " ] " <> b) . (\b -> "[ " <> toFilePath lfile <> " ] " <> b)
$ bs $ bs

View File

@ -29,6 +29,7 @@ import qualified Data.ByteString.Lazy as L
import qualified Data.Strict.Maybe as S import qualified Data.Strict.Maybe as S
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as E 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 as TL
import qualified Data.Text.Lazy.Builder as B import qualified Data.Text.Lazy.Builder as B
import qualified Data.Text.Lazy.Builder.Int 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 :: (Monad m, Alternative m) => m Bool -> m ()
guardM ~f = guard =<< f guardM ~f = guard =<< f
lBS2sT :: L.ByteString -> Text
lBS2sT = TL.toStrict . TLE.decodeUtf8
handleIO' :: (MonadIO m, MonadCatch m) handleIO' :: (MonadIO m, MonadCatch m)
=> IOErrorType => IOErrorType
@ -243,4 +240,16 @@ addToCurrentEnv adds = do
pvpToVersion :: PVP -> Version 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