hasufell/ghcup-hs
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix header reading wrt #213

Browse Source
This commit is contained in:
Julian Ospald 2021-08-23 23:16:32 +02:00
parent 281f310394
commit 951e676bee
Signed by: hasufell
GPG Key ID: 3786C5262ECB4A3F
1 changed files with 16 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
lib/GHCup/Download.hs
View File

@ -368,7 +368,7 @@ download uri eDigest dest mfn etags
-- this nonsense is necessary, because some older versions of curl would overwrite -- this nonsense is necessary, because some older versions of curl would overwrite
-- the destination file when 304 is returned -- the destination file when 304 is returned
case fmap T.words . listToMaybe . fmap T.strip . T.lines $ headers of case fmap T.words . listToMaybe . fmap T.strip . T.lines . getLastHeader $ headers of
Just (http':sc:_) Just (http':sc:_)
| sc == "304" | sc == "304"
, T.pack "HTTP" `T.isPrefixOf` http' -> $logDebug [i|Status code was 304, not overwriting|] , T.pack "HTTP" `T.isPrefixOf` http' -> $logDebug [i|Status code was 304, not overwriting|]
@ -447,7 +447,7 @@ download uri eDigest dest mfn etags
parseEtags :: (MonadLogger m, MonadIO m, MonadThrow m) => T.Text -> m (Maybe T.Text) parseEtags :: (MonadLogger m, MonadIO m, MonadThrow m) => T.Text -> m (Maybe T.Text)
parseEtags stderr = do parseEtags stderr = do
let mEtag = find (\line -> T.pack "etag:" `T.isPrefixOf` T.toLower line) . fmap T.strip . T.lines $ stderr let mEtag = find (\line -> T.pack "etag:" `T.isPrefixOf` T.toLower line) . fmap T.strip . T.lines . getLastHeader $ stderr
case T.words <$> mEtag of case T.words <$> mEtag of
(Just []) -> do (Just []) -> do
$logDebug "Couldn't parse etags, no input: " $logDebug "Couldn't parse etags, no input: "
@ -585,7 +585,21 @@ getWgetOpts =
Nothing -> pure [] Nothing -> pure []
-- | Get the url base name.
--
-- >>> urlBaseName "/foo/bar/baz"
-- "baz"
urlBaseName :: ByteString -- ^ the url path (without scheme and host) urlBaseName :: ByteString -- ^ the url path (without scheme and host)
-> ByteString -> ByteString
urlBaseName = snd . B.breakEnd (== _slash) . urlDecode False urlBaseName = snd . B.breakEnd (== _slash) . urlDecode False
-- | Curl saves all intermediate connect headers as well, not just the last one, so we make an effort to take the
-- last HTTP block only. Passing '--suppress-connect-headers' would be better, but it isn't supported by all versions,
-- also see:
-- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/213
--
-- >>> getLastHeader "\n\nHTTP/1.0 200 Connection established\n\nHTTP/1.1 304 Not Modified\n"
-- "HTTP/1.1 304 Not Modified\n"
getLastHeader :: T.Text -> T.Text
getLastHeader = T.unlines . lastDef [] . filter (\x -> not (null x)) . splitOn [""] . fmap T.stripEnd . T.lines