content: -- | Parses RegistryImageSource.
  --
  -- This module parses "NAME[:TAG|@DIGEST]" format passed
  -- when using docker pull command.
  --
  --  # Pulling Image from Default Registry
  --
  --  >> docker pull redis
  --  >> docker pull redis:alpine
  --  >> docker pull fossa/haskell-static-alpine
  --  >> docker pull fossa/haskell-static-alpine:latest
  --  >> docker pull fossa/haskell-static-alpine@sha256:a89x...
  --
  --  # Pulling Image from Specific Registry
  --
  --  >> docker pull ghcr.io/fossas/haskell-dev-tools
  --  >> docker pull ghcr.io/fossas/haskell-dev-tools:9.0.2
  --  >> docker pull ghcr.io/fossas/haskell-dev-tools@sha256:a89x...
  --
  --  # Pulling Image from Specific Registry with Credentials
  --
  --  >> docker pull username:password@quay.io/repo/image:tag
  --  >> docker pull https://username:password@quay.io/repo/image:tag
  --
  -- By default,
  --
  --  * Docker hub registry at "index.docker.io" is used, if registry
  --    is not provided in the argument.
  --
  --  * Repository tag of "latest" is used, if repository reference is not
  --    provided.
  --
  -- For more Information Refer to:
  --  https://docs.docker.com/engine/reference/commandline/pull/
  --
  -- - -
  module Container.Docker.SourceParser (
    RegistryImageSource (..),
    RegistryHostScheme (..),
    RepoReference (..),
    RepoTag (..),
    RepoDigest (..),
    parseImageUrl,
    defaultRegistry,
    defaultTag,
    defaultHttpScheme,
    suggestDockerExport,
    showReferenceWithSep,
    toRepoNameWithRegistry,
    toRegistryApiHost,
  ) where
  
  import Control.Monad (unless, void)
  import Data.Functor (($>))
  import Data.Maybe (fromMaybe)
  import Data.String.Conversion (ToString (toString), toText)
  import Data.Text (Text)
  import Data.Text qualified as Text
  import Data.Void (Void)
  import Prettyprinter (Doc, Pretty (pretty), indent, line, vsep)
  import Prettyprinter.Render.Terminal (AnsiStyle)
  import Text.Megaparsec (
    MonadParsec (try),
    Parsec,
    chunk,
    optional,
    some,
    (<|>),
   )
  import Text.Megaparsec.Char (alphaNumChar, char)
  import Text.Megaparsec.Char.Lexer qualified as L
  
  type Parser = Parsec Void Text
  
  defaultRegistry :: Text
  defaultRegistry = "index.docker.io" -- if you change this, update docs on top of module
  
  defaultTag :: RepoReference
  defaultTag = RepoReferenceTag . RepoTag $ "latest"
  
  defaultHttpScheme :: RegistryHostScheme
  defaultHttpScheme = RegistryHTTPS
  
  data RepoReference
    = RepoReferenceTag RepoTag
    | RepoReferenceDigest RepoDigest
    deriving (Eq, Ord)
  
  newtype RepoTag = RepoTag Text deriving (Show, Eq, Ord)
  
  -- TODO: Rename to Digest, as it is more representative
  newtype RepoDigest = RepoDigest Text deriving (Show, Eq, Ord)
  
  instance Show RepoReference where
    show (RepoReferenceTag (RepoTag tag)) = toString tag
    show (RepoReferenceDigest (RepoDigest digest)) = toString digest
  
  data RegistryHostScheme
    = RegistryHTTP
    | RegistryHTTPS
    deriving (Eq, Ord)
  
  instance Show RegistryHostScheme where
    show RegistryHTTP = "http://"
    show RegistryHTTPS = "https://"
  
  data RegistryImageSource = RegistryImageSource
    { registryHost :: Text
    , registryScheme :: RegistryHostScheme
    , registryCred :: Maybe (Text, Text)
    , registryContainerRepository :: Text
    , registryContainerRepositoryReference :: RepoReference
    , platformArchitecture :: Text
    }
    deriving (Show, Eq, Ord)
  
  instance Pretty RegistryImageSource where
    pretty (RegistryImageSource host scheme cred repo ref _) =
      pretty $
        (toText . show $ scheme)
          <> redactedCred
          <> host
          <> "/"
          <> repo
          <> showReferenceWithSep ref
      where
        redactedCred :: Text
        redactedCred = case cred of
          Nothing -> mempty
          _ -> "<REDACTED>:<REDACTED>@"
  
  suggestDockerExport :: RegistryImageSource -> Doc AnsiStyle
  suggestDockerExport (RegistryImageSource host _ _ repo ref _) =
    vsep
      [ "Try using exported container image for analysis instead."
      , line
      , indent 4 $
          vsep
            [ ">> " <> pullCmd
            , ">> " <> saveCmd
            , line
            , fossaAnalyzeCmd
            ]
      ]
    where
      imgIdentifier :: Text
      imgIdentifier = host <> "/" <> repo <> showReferenceWithSep ref
  
      pullCmd :: Doc AnsiStyle
      pullCmd = pretty $ "docker pull " <> imgIdentifier
  
      saveCmd :: Doc AnsiStyle
      saveCmd = pretty $ "docker save " <> imgIdentifier <> " > image-exported.tar"
  
      fossaAnalyzeCmd :: Doc AnsiStyle
      fossaAnalyzeCmd = "fossa container analyze image-exported.tar"
  
  showReferenceWithSep :: RepoReference -> Text
  showReferenceWithSep (RepoReferenceTag (RepoTag tag)) = ":" <> tag
  showReferenceWithSep (RepoReferenceDigest (RepoDigest digest)) = "@" <> digest
  
  -- | Convert a registry host to its API endpoint.
  -- For Docker Hub, we need to use registry-1.docker.io instead of index.docker.io
  -- See: https://docs.docker.com/registry/spec/api/
  toRegistryApiHost :: Text -> Text
  toRegistryApiHost host
    | host == defaultRegistry = "registry-1.docker.io"
    | otherwise = host
  
  -- | Parses to RegistryImageSource.
  --
  -- >> parse parseImageUrl "fossa/db" = https://index.docker.io/fossa/db:latest
  -- >> parse parseImageUrl "fossa/db:alpine" = https://index.docker.io/fossa/db:alpine
  -- >> parse parseImageUrl "quay.io/fossas/cli" = https://quay.io/fossas/cli:latest
  -- >> parse parseImageUrl "quay.io/fossas/cli:9.0.0" = https://quay.io/fossas/cli:9.0.0
  -- >> parse parseImageUrl "user:pass@quay.io/repo/cli:9.0.0" = https://user:pass@quay.io/repo/cli:9.0.0
  -- -
  parseImageUrl :: Text -> Parser RegistryImageSource
  parseImageUrl targetArch = do
    imgSrc <-
      try (parseImageUrl' targetArch)
        <|> parseImageUrlWithDefaultRegistry defaultRegistry targetArch
  
    -- Docker Registry uses library/image for
    -- official images. For instance 'redis' should resolve to 'library/redis:latest'
    if isOfficialImage imgSrc
      then pure $ repoWithPrefix "library/" imgSrc
      else pure imgSrc
    where
      isOfficialImage :: RegistryImageSource -> Bool
      isOfficialImage imgSrc =
        registryHost imgSrc == defaultRegistry
          && not (Text.isInfixOf "/" $ registryContainerRepository imgSrc)
  
      repoWithPrefix :: Text -> RegistryImageSource -> RegistryImageSource
      repoWithPrefix prefix imgSrc =
        imgSrc
          { registryContainerRepository =
              prefix <> registryContainerRepository imgSrc
          }
  
  toRepoNameWithRegistry :: RegistryImageSource -> Text
  toRepoNameWithRegistry imgSrc =
    registryHost imgSrc
      <> "/"
      <> registryContainerRepository imgSrc
  
  parseImageUrlWithDefaultRegistry :: Text -> Text -> Parser RegistryImageSource
  parseImageUrlWithDefaultRegistry defaultHost targetArch = do
    (repo, repoRef) <- parseRepoRef
    pure $
      RegistryImageSource
        { registryHost = defaultHost
        , registryScheme = defaultHttpScheme
        , registryCred = Nothing
        , registryContainerRepository = repo
        , registryContainerRepositoryReference = repoRef
        , platformArchitecture = targetArch
        }
  
  parseImageUrl' :: Text -> Parser RegistryImageSource
  parseImageUrl' targetArch = do
    scheme <- optional parseHostScheme
    cred <- optional . try $ parseAuthCred
    host <- toText <$> some (alphaNumChar <|> char '.' <|> char '-' <|> char '_')
    port :: Maybe Int <- (try . optional $ chunk ":" *> L.decimal)
    void $ optional (chunk "/")
  
    -- Avoid parsing org/repo:tag as valid image source
    -- as "org" is not a valid host url. But allows localhost.
    unless (Text.isInfixOf "." host || host == "localhost") $
      fail "Expected host to have '.' for domain"
  
    (repo, repoRef) <- parseRepoRef
    pure $
      RegistryImageSource
        { registryHost = host <> toText (maybe mempty (\p -> ":" <> show p) port)
        , registryScheme = fromMaybe defaultHttpScheme scheme
        , registryCred = cred
        , registryContainerRepository = repo
        , registryContainerRepositoryReference = repoRef
        , platformArchitecture = targetArch
        }
  
  parseHostScheme :: Parser RegistryHostScheme
  parseHostScheme =
    try (chunk "http://" $> RegistryHTTP)
      <|> (chunk "https://" $> RegistryHTTPS)
  
  -- | Parses Authorization Credentials in URI.
  --
  -- >> parse parseAuthCred "a:b@" = ("a", "b")
  -- -
  parseAuthCred :: Parser (Text, Text)
  parseAuthCred = do
    user <- toText <$> some alphaNumChar
    void (char ':')
    password <- toText <$> (some alphaNumChar)
    void (char '@')
    pure (user, password)
  
  -- | Parses Repository name and reference.
  --
  -- >> parse parseRepoRef "redis" = ("redis", "latest")
  -- >> parse parseRepoRef "redis:alpine" = ("redis", "alpine")
  -- >> parse parseRepoRef "fossas/fossa:4.0.0" = ("fossas/fossa", "4.0.0")
  -- >> parse parseRepoRef "fossas/fossa@4.0.0" = ("fossas/fossa", "4.0.0")
  -- -
  parseRepoRef :: Parser (Text, RepoReference)
  parseRepoRef = try parseRepoRef' <|> parseRepoWithDefaultTag defaultTag
  
  parseRepoRef' :: Parser (Text, RepoReference)
  parseRepoRef' = do
    repo <- parseRepo
    ref <- parseRepoReference
    pure (repo, ref)
  
  parseRepoReference :: Parser RepoReference
  parseRepoReference = try parseRepoTag <|> parseRepoDigest
  
  parseRepoTag :: Parser RepoReference
  parseRepoTag = RepoReferenceTag . RepoTag <$> (chunk ":" *> parseRef)
  
  parseRepoDigest :: Parser RepoReference
  parseRepoDigest = RepoReferenceDigest . RepoDigest <$> (chunk "@" *> parseRef)
  
  parseRepoWithDefaultTag :: RepoReference -> Parser (Text, RepoReference)
  parseRepoWithDefaultTag tag = do
    repo <- parseRepo
    pure (repo, tag)
  
  parseRepo :: Parser Text
  parseRepo =
    toText
      <$> some (alphaNumChar <|> char '.' <|> char '_' <|> char '-' <|> char '/')
  
  parseRef :: Parser Text
  parseRef =
    toText
      <$> some (alphaNumChar <|> char '.' <|> char '_' <|> char '-' <|> char ':')
  