Remove use of unsafe decodeUtf8

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)
 

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

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)

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
 

lib/GHCup/Utils.hs

@@ -83,7 +83,9 @@ 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
+    case
+        version (decUTF8Safe $ B.pack t)
+      of
         Left  e -> fail $ show e
         Right r -> pure r
 
@@ -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
 

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

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