Remove use of unsafe decodeUtf8
This commit is contained in:
parent
6c1ae585b7
commit
9d9e415a09
@ -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)
|
||||
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user