-- SPDX-FileCopyrightText: 2026 Alexandra de Wit
--
-- SPDX-License-Identifier: MIT

{- | Verify artifact bytes before publication into the trusted mirror.
The gate uses current metadata from admission, never digests from the queue.
SRI components at the strongest algorithm are alternatives. A weaker digest
cannot rescue a mismatch, because that would permit substitution through a broken hash.
-}
module Ecluse.Core.Worker.Integrity (
    IntegrityResult (..),
    verifyIntegrity,
) where

import Data.Text qualified as T

import Ecluse.Core.Package (Hash (hashAlg, hashValue), HashAlg (SRI), computeDigest, sriBody, sriPrefix)
import Ecluse.Core.Package.Hash (base64DigestText, hexDigestText)
import Ecluse.Core.Package.Integrity (assertedAlg, authoritativeDigest)

-- | Whether fetched bytes may enter the mirror, with a refusal detail for the operator.
data IntegrityResult
    = -- | The bytes matched the selected digest or one of its SRI alternatives.
      IntegrityVerified
    | -- | The selected digest mismatched or its algorithm cannot be computed.
      IntegrityMismatch Text
    deriving stock (IntegrityResult -> IntegrityResult -> Bool
(IntegrityResult -> IntegrityResult -> Bool)
-> (IntegrityResult -> IntegrityResult -> Bool)
-> Eq IntegrityResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IntegrityResult -> IntegrityResult -> Bool
== :: IntegrityResult -> IntegrityResult -> Bool
$c/= :: IntegrityResult -> IntegrityResult -> Bool
/= :: IntegrityResult -> IntegrityResult -> Bool
Eq, Int -> IntegrityResult -> ShowS
[IntegrityResult] -> ShowS
IntegrityResult -> String
(Int -> IntegrityResult -> ShowS)
-> (IntegrityResult -> String)
-> ([IntegrityResult] -> ShowS)
-> Show IntegrityResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IntegrityResult -> ShowS
showsPrec :: Int -> IntegrityResult -> ShowS
$cshow :: IntegrityResult -> String
show :: IntegrityResult -> String
$cshowList :: [IntegrityResult] -> ShowS
showList :: [IntegrityResult] -> ShowS
Show)

{- | Verify the strongest selected digest, allowing only its same-algorithm SRI alternatives.
A weaker match or an uncomputable selected algorithm never permits publication.
-}
verifyIntegrity :: NonEmpty Hash -> ByteString -> IntegrityResult
verifyIntegrity :: NonEmpty Hash -> ByteString -> IntegrityResult
verifyIntegrity NonEmpty Hash
hashes ByteString
bytes =
    let strongest :: Hash
strongest = NonEmpty Hash -> Hash
authoritativeDigest NonEmpty Hash
hashes
     in case LByteString -> Hash -> NonEmpty Hash -> Maybe Bool
matchesDigest (ByteString -> LByteString
forall l s. LazyStrict l s => s -> l
toLazy ByteString
bytes) Hash
strongest NonEmpty Hash
hashes of
            Maybe Bool
Nothing ->
                Text -> IntegrityResult
IntegrityMismatch
                    ( Text
"the strongest admitted digest ("
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Hash -> Text
describeDigest Hash
strongest
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") is in an algorithm the worker cannot verify"
                    )
            Just Bool
True -> IntegrityResult
IntegrityVerified
            Just Bool
False ->
                Text -> IntegrityResult
IntegrityMismatch (Text
"the " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Hash -> Text
describeDigest Hash
strongest Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" digest did not match the fetched bytes")

matchesDigest :: LByteString -> Hash -> NonEmpty Hash -> Maybe Bool
matchesDigest :: LByteString -> Hash -> NonEmpty Hash -> Maybe Bool
matchesDigest LByteString
lazyBytes Hash
h NonEmpty Hash
hashes = do
    alg <- Hash -> Maybe HashAlg
assertedAlg Hash
h
    digestOf <- computeDigest alg
    let digest = LByteString -> ByteString
digestOf LByteString
lazyBytes
    pure $ case hashAlg h of
        HashAlg
SRI ->
            let encoded :: Text
encoded = ByteString -> Text
base64DigestText ByteString
digest
             in (Hash -> Bool) -> NonEmpty Hash -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Hash
candidate -> Hash -> HashAlg
hashAlg Hash
candidate HashAlg -> HashAlg -> Bool
forall a. Eq a => a -> a -> Bool
== HashAlg
SRI Bool -> Bool -> Bool
&& Hash -> Maybe HashAlg
assertedAlg Hash
candidate Maybe HashAlg -> Maybe HashAlg -> Bool
forall a. Eq a => a -> a -> Bool
== HashAlg -> Maybe HashAlg
forall a. a -> Maybe a
Just HashAlg
alg Bool -> Bool -> Bool
&& Text -> Text
sriBody (Hash -> Text
hashValue Hash
candidate) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
encoded) NonEmpty Hash
hashes
        HashAlg
_ -> ByteString -> Text
hexDigestText ByteString
digest Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Text
T.toLower (Hash -> Text
hashValue Hash
h)

describeDigest :: Hash -> Text
describeDigest :: Hash -> Text
describeDigest Hash
h = case Hash -> HashAlg
hashAlg Hash
h of
    HashAlg
SRI -> Text
"SRI " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
sriPrefix (Hash -> Text
hashValue Hash
h)
    HashAlg
alg -> HashAlg -> Text
forall b a. (Show a, IsString b) => a -> b
show HashAlg
alg