[No Ticket] Stricter redirects when interacting with registry v2 api

Changelog.md

@@ -1,5 +1,8 @@
 # FOSSA CLI Changelog
 
+## Unreleased
+- container scanning: Fixes a network error defect, when interacting with container registry redirects. ([#1308](https://github.com/fossas/fossa-cli/pull/1308/))
+
 ## v3.8.20
 - container scanning: Fixes registry network calls, to ensure `fossa-cli` uses `Accept` header on `HEAD` network calls. ([#1309](https://github.com/fossas/fossa-cli/pull/1309))
 

integration-test/Analysis/ContainerScanningSpec.hs

@@ -0,0 +1,116 @@
+{-# LANGUAGE DataKinds #-}
+
+module Analysis.ContainerScanningSpec (spec) where
+
+import Container.Docker.OciManifest (OciManifestConfig (..), OciManifestV2 (..))
+import Container.Docker.SourceParser (
+  RegistryImageSource,
+  RepoDigest (..),
+  parseImageUrl,
+ )
+import Control.Algebra (Has)
+import Control.Carrier.ContainerRegistryApi (runContainerRegistryApi)
+import Control.Carrier.ContainerRegistryApi.Common (RegistryCtx)
+import Control.Carrier.Diagnostics (
+  DiagnosticsC,
+  fromEitherShow,
+  runDiagnostics,
+ )
+import Control.Carrier.Finally (FinallyC, runFinally)
+import Control.Carrier.Lift (Lift)
+import Control.Carrier.Reader (ReaderC, runReader)
+import Control.Carrier.Simple (SimpleC)
+import Control.Carrier.Stack (StackC, runStack)
+import Control.Carrier.StickyLogger (
+  IgnoreStickyLoggerC,
+  ignoreStickyLogger,
+ )
+import Control.Effect.ContainerRegistryApi (
+  ContainerRegistryApi,
+  ContainerRegistryApiF,
+  getImageManifest,
+ )
+import Control.Effect.Diagnostics (Diagnostics)
+import Control.Effect.Lift (sendIO)
+import Data.String.Conversion (toText)
+import Data.Text (Text)
+import Data.Void (Void)
+import Diag.Result (Result (..), renderFailure)
+import Discovery.Filters (AllFilters)
+import Effect.Exec (ExecIOC, runExecIO)
+import Effect.Logger (IgnoreLoggerC, ignoreLogger)
+import Effect.ReadFS (ReadFSIOC, runReadFSIO)
+import System.Environment (lookupEnv)
+import Test.Hspec (Spec, describe, it, shouldBe)
+import Text.Megaparsec (ParseErrorBundle, parse)
+import Type.Operator (type ($))
+
+spec :: Spec
+spec = testPrivateRepos
+
+-- Integeration tests to catch, if registry api implementation changes
+-- abruptly.
+testPrivateRepos :: Spec
+testPrivateRepos =
+  describe "private registries" $ do
+    it "dockerhub" $ do
+      -- Refer to 1Password for creds or Github Action Env Keys
+      img <- withAuth "FOSSA_DOCKERHUB_WWW_STYLE_USER_PASS" dockerHubImage
+      res <- runEff $ getImageConfig "amd64" img
+      case res of
+        Failure ws eg -> fail (show (renderFailure ws eg "An issue occurred"))
+        Success _ res' -> res' `shouldBe` dockerHubImageConfigDigest
+
+dockerHubImage :: Text
+dockerHubImage = "index.docker.io/fossabot/container-test-fixture:0"
+
+dockerHubImageConfigDigest :: RepoDigest
+dockerHubImageConfigDigest = RepoDigest "sha256:792d29ec0ccee20718b0233b1ca0c633a57009bbb4d99c247b0ec1e3f562b19b"
+
+--
+
+type EffectStack m =
+  FinallyC
+    $ SimpleC ContainerRegistryApiF
+    $ ReaderC RegistryCtx
+    $ ReaderC AllFilters
+    $ ExecIOC
+    $ ReadFSIOC
+    $ DiagnosticsC
+    $ IgnoreLoggerC
+    $ IgnoreStickyLoggerC
+    $ StackC IO
+
+runEff :: EffectStack IO a -> IO (Result a)
+runEff =
+  runStack
+    . ignoreStickyLogger
+    . ignoreLogger
+    . runDiagnostics
+    . runReadFSIO
+    . runExecIO
+    . runReader mempty
+    . runContainerRegistryApi
+    . runFinally
+
+decodeStrict :: Text -> Text -> Either (ParseErrorBundle Text Void) RegistryImageSource
+decodeStrict arch = parse (parseImageUrl arch) mempty
+
+getImageConfig ::
+  ( Has (Lift IO) sig m
+  , Has Diagnostics sig m
+  , Has ContainerRegistryApi sig m
+  ) =>
+  Text ->
+  Text ->
+  m RepoDigest
+getImageConfig arch img =
+  configDigest . ociConfig
+    <$> (getImageManifest =<< fromEitherShow (decodeStrict arch img))
+
+withAuth :: Has (Lift IO) sig m => String -> Text -> m Text
+withAuth authEnvKey target = do
+  auth <- sendIO $ lookupEnv authEnvKey
+  case auth of
+    Nothing -> pure target
+    Just auth' -> pure $ (toText auth') <> "@" <> target

spectrometer.cabal

@@ -669,6 +669,7 @@ test-suite integration-tests
     Analysis.CarthageSpec
     Analysis.ClojureSpec
     Analysis.CocoapodsSpec
+    Analysis.ContainerScanningSpec
     Analysis.ElixirSpec
     Analysis.ErlangSpec
     Analysis.FixtureExpectationUtils

src/Container/Docker/SourceParser.hs

@@ -246,7 +246,7 @@ parseAuthCred :: Parser (Text, Text)
 parseAuthCred = do
   user <- toText <$> some alphaNumChar
   void (char ':')
-  password <- toText <$> (some alphaNumChar)
+  password <- toText <$> some (alphaNumChar <|> char '_' <|> char '-')
   void (char '@')
   pure (user, password)
 

src/Control/Carrier/ContainerRegistryApi/Authorization.hs

@@ -33,20 +33,20 @@ import Data.Aeson (FromJSON (parseJSON), decode', eitherDecode, withObject, (.:)
 import Data.ByteString.Lazy qualified as ByteStringLazy
 import Data.Map (Map)
 import Data.Map qualified as Map
-import Data.String.Conversion (ConvertUtf8 (decodeUtf8), encodeUtf8, toString, toText)
-import Data.Text (Text, isInfixOf)
+import Data.String.Conversion (encodeUtf8, toString, toText)
+import Data.Text (Text)
 import Data.Text qualified as Text
 import Data.Void (Void)
 import Effect.Logger (Logger)
 import Network.HTTP.Client (
   Manager,
-  Request (host, method, shouldStripHeaderOnRedirect),
+  Request (method, shouldStripHeaderOnRedirect),
   Response (responseBody, responseHeaders, responseStatus),
   applyBasicAuth,
   applyBearerAuth,
   parseRequest,
  )
-import Network.HTTP.Types (methodGet, statusCode)
+import Network.HTTP.Types (statusCode)
 import Network.HTTP.Types.Header (
   hAuthorization,
   hWWWAuthenticate,
@@ -99,16 +99,7 @@ applyAuthToken (Just (BearerAuthToken token)) r =
 -- If we don't strip auth headers, on redirect, depending on how
 -- blobs/manifest are retrieved cloud vendor may throw 'Bad Request' error.
 stripAuthHeaderOnRedirect :: Request -> Request
-stripAuthHeaderOnRedirect r =
-  if ((isAwsECR || isAzure) && method r == methodGet)
-    then r{shouldStripHeaderOnRedirect = (== hAuthorization)}
-    else r
-  where
-    isAwsECR :: Bool
-    isAwsECR = "amazonaws.com" `isInfixOf` decodeUtf8 (host r)
-
-    isAzure :: Bool
-    isAzure = "azurecr.io" `isInfixOf` decodeUtf8 (host r)
+stripAuthHeaderOnRedirect r = r{shouldStripHeaderOnRedirect = (== hAuthorization)}
 
 -- | Generates Auth Token For Request.
 --

test/Container/Docker/SourceParserSpec.hs

@@ -127,6 +127,16 @@ spec = do
                               fixtureArch
                           )
 
+      "https://user:[email protected]/fossas/haskell-dev-tools:9.0.2"
+        `shouldParseInto` ( RegistryImageSource
+                              "ghcr.io"
+                              defaultHttpScheme
+                              (Just ("user", "pass-pass_pass"))
+                              "fossas/haskell-dev-tools"
+                              (mkTagRef "9.0.2")
+                              fixtureArch
+                          )
+
 fixtureArch :: Text
 fixtureArch = "amd64"