diff --git a/lib/GHCup/Download.hs b/lib/GHCup/Download.hs index 3792e2a..f0a7425 100644 --- a/lib/GHCup/Download.hs +++ b/lib/GHCup/Download.hs @@ -368,7 +368,7 @@ download uri eDigest dest mfn etags -- this nonsense is necessary, because some older versions of curl would overwrite -- 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:_) | sc == "304" , 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 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 (Just []) -> do $logDebug "Couldn't parse etags, no input: " @@ -585,7 +585,21 @@ getWgetOpts = Nothing -> pure [] +-- | Get the url base name. +-- +-- >>> urlBaseName "/foo/bar/baz" +-- "baz" urlBaseName :: ByteString -- ^ the url path (without scheme and host) -> ByteString 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 diff --git a/lib/GHCup/Utils/Prelude.hs b/lib/GHCup/Utils/Prelude.hs index f9e5632..f68e9c9 100644 --- a/lib/GHCup/Utils/Prelude.hs +++ b/lib/GHCup/Utils/Prelude.hs @@ -68,6 +68,14 @@ import qualified System.Win32.File as Win32 #endif +-- $setup +-- >>> import Data.ByteString.Internal (c2w, w2c) +-- >>> import Test.QuickCheck +-- >>> import Data.Word8 +-- >>> import Data.Word8 +-- >>> import qualified Data.Text as T +-- >>> instance Arbitrary T.Text where arbitrary = T.pack <$> arbitrary + fS :: IsString a => String -> a fS = fromString @@ -489,7 +497,14 @@ recover action = #endif --- Gathering monoidal values +-- | Gathering monoidal values +-- +-- >>> traverseFold (pure . (:["0"])) ["1","2"] +-- ["1","0","2","0"] +-- >>> traverseFold Just ["1","2","3","4","5"] +-- Just "12345" +-- +-- prop> \t -> traverseFold Just t === Just (mconcat t) traverseFold :: (Foldable t, Applicative m, Monoid b) => (a -> m b) -> t a -> m b traverseFold f = foldl (\mb a -> (<>) <$> mb <*> f a) (pure mempty) @@ -499,6 +514,16 @@ forFold = \t -> (`traverseFold` t) -- | Strip @\\r@ and @\\n@ from 'ByteString's +-- +-- >>> stripNewline "foo\n\n\n" +-- "foo" +-- >>> stripNewline "foo\r" +-- "foo" +-- >>> stripNewline "foo" +-- "foo" +-- +-- prop> \t -> stripNewline (t <> "\n") === stripNewline t +-- prop> \t -> not (any (isNewLine . c2w) t) ==> stripNewline t == t stripNewline :: String -> String stripNewline s | null s = [] @@ -507,6 +532,16 @@ stripNewline s -- | Strip @\\r@ and @\\n@ from 'ByteString's +-- +-- >>> stripNewline' "foo\n\n\n" +-- "foo" +-- >>> stripNewline' "foo\r" +-- "foo" +-- >>> stripNewline' "foo" +-- "foo" +-- +-- prop> \t -> stripNewline' (t <> "\n") === stripNewline' t +-- prop> \t -> not (T.any (isNewLine . c2w) t) ==> stripNewline' t == t stripNewline' :: T.Text -> T.Text stripNewline' s | T.null s = mempty @@ -514,6 +549,14 @@ stripNewline' s | otherwise = T.singleton (T.head s) <> stripNewline' (T.tail s) +-- | Is the word8 a newline? +-- +-- >>> isNewLine (c2w '\n') +-- True +-- >>> isNewLine (c2w '\r') +-- True +-- +-- prop> \w -> w /= _lf && w /= _cr ==> not (isNewLine w) isNewLine :: Word8 -> Bool isNewLine w | w == _lf = True @@ -523,8 +566,10 @@ isNewLine w -- | Split on a PVP suffix. -- --- >>> splitOnPVP "-" "ghc-iserv-dyn-9.3.20210706" == ("ghc-iserv-dyn", "9.3.20210706") --- >>> splitOnPVP "-" "ghc-iserv-dyn" == ("ghc-iserv-dyn", "") +-- >>> splitOnPVP "-" "ghc-iserv-dyn-9.3.20210706" +-- ("ghc-iserv-dyn","9.3.20210706") +-- >>> splitOnPVP "-" "ghc-iserv-dyn" +-- ("ghc-iserv-dyn","") splitOnPVP :: String -> String -> (String, String) splitOnPVP c s = case Split.splitOn c s of [] -> def