{- | Integrity-algorithm strength and the admission integrity floors.

Écluse trusts a digest only as far as its algorithm is collision-resistant. Both
contexts -- the /untrusted/ public upstream and the /trusted/ private upstream -- default
to requiring a SHA-256-or-stronger digest, but they are floored __asymmetrically__: the
public floor is a __hard__ SHA-256 boundary (raisable, never lowerable), while the
trusted floor is __operator-loosenable__ below SHA-256 for a legacy private mirror, where
trust in the operator's own vetted source substitutes for cryptographic strength. This
module is the one place that ranks algorithms by strength and decides what clears a
floor, so the worker's tamper gate and the serve layer's two admission gates share a
single notion of "strong enough" rather than each re-encoding the ranking.

== The strength ranking

'integrityStrength' orders algorithms by collision resistance: the broken ones
(MD5, SHA-1) rank below the SHA-256 floor; SHA-256 and the modern long digests rank
at or above it. 'assertedAlg' resolves what a 'Hash' /claims/ -- its tag directly, or
for a Subresource-Integrity string the algorithm named in its @\<alg\>-\<base64\>@
prefix -- so an SRI is ranked and floored by the algorithm it embeds. The 'IntegrityFloor'
class abstracts "the minimum algorithm a floor requires", so 'meetsFloor' and
'classifyArtifacts' rank candidates against either floor through this one ranking.

== The public-integrity floor

A 'MinIntegrity' is the configured minimum algorithm a __public__ (untrusted) version's
digest must meet to be admitted. It is opaque and __hard-floored at SHA-256__: it can be
/raised/ (to SHA-512 or Blake2b, as cryptanalysis ages an algorithm) but never set below
SHA-256, because admitting a public version on a SHA-1 digest would let a collision
substitute its bytes. There is no escape-hatch: 'mkMinIntegrity' \/ 'parseMinIntegrity'
reject a sub-SHA-256 value at construction, so no config or constructor path can lower
this floor.

== The trusted-integrity floor

A 'MinTrustedIntegrity' is the configured minimum algorithm a __trusted__ (private)
version's digest must meet to be served. It also defaults to SHA-256, but is __not
hard-floored__: an operator may loosen it to SHA-1 or MD5 for a legacy private mirror
(see @docs\/architecture\/security.md@ → "Asymmetric integrity trust"). It still rejects
an unknown algorithm name. This loosening is the /only/ way Écluse will serve a sub-SHA-256
digest, and only on the operator's own trusted source -- never on untrusted public bytes.
-}
module Ecluse.Core.Package.Integrity (
    -- * Algorithm strength
    Strength,
    integrityStrength,
    assertedAlg,

    -- * Algorithm names and SRI strings
    renderHashAlg,
    parseHashAlg,
    sriAlgorithm,
    sriPrefix,
    sriBody,

    -- * Integrity floors
    IntegrityFloor (..),
    meetsFloor,

    -- ** The public-integrity floor (hard-floored at SHA-256)
    MinIntegrity,
    defaultMinIntegrity,
    mkMinIntegrity,
    parseMinIntegrity,
    unMinIntegrity,
    renderMinIntegrity,

    -- ** The trusted-integrity floor (loosenable below SHA-256)
    MinTrustedIntegrity,
    defaultMinTrustedIntegrity,
    mkMinTrustedIntegrity,
    parseMinTrustedIntegrity,
    unMinTrustedIntegrity,
    renderMinTrustedIntegrity,

    -- * Version admissibility
    VersionIntegrity (..),
    classifyArtifacts,
) where

import Ecluse.Core.Package (
    Artifact (artHashes),
    Hash,
    HashAlg (Blake2b, MD5, SHA1, SHA256, SHA384, SHA512, SRI),
    hashAlg,
    hashValue,
    parseHashAlg,
    renderHashAlg,
    sriAlgorithm,
    sriBody,
    sriPrefix,
 )

{- | The collision-resistance tier of a hash algorithm, with constructors ordered
__weakest to strongest__ so the derived 'Ord' /is/ the strength ranking: two tiers
compare by collision resistance, and equal-strength algorithms share a tier (so they
compare 'EQ'). This is the one named ranking the worker's tamper gate and the serve
layer's admission floor both consult.
-}
data Strength
    = {- | A bare 'SRI' wrapper asserts no algorithm at all -- below every real
      digest, so an unresolved SRI never wins a strongest-digest comparison.
      -}
      Unasserted
    | -- | MD5: practical collisions; the weakest real algorithm.
      Weakest
    | -- | SHA-1: practical collisions.
      Weak
    | -- A future weak-but-not-broken algorithm would slot a new tier here, between
      -- the broken algorithms and the SHA-256 floor -- an enum needs no renumbering,
      -- unlike the old Int ranking, which reserved a numeric gap for exactly this.

      -- | SHA-256: collision-resistant; the public-integrity floor.
      Floor
    | {- | SHA-384: above the floor but below the top tier. It is SHA-512 truncated, so
      its 192-bit collision resistance sits below SHA-512's 256-bit and above SHA-256's
      128-bit -- a tier of its own.
      -}
      Strong
    | -- | The modern long digests SHA-512 and Blake2b -- equal strength, the top tier.
      Strongest
    deriving stock (Strength -> Strength -> Bool
(Strength -> Strength -> Bool)
-> (Strength -> Strength -> Bool) -> Eq Strength
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Strength -> Strength -> Bool
== :: Strength -> Strength -> Bool
$c/= :: Strength -> Strength -> Bool
/= :: Strength -> Strength -> Bool
Eq, Eq Strength
Eq Strength =>
(Strength -> Strength -> Ordering)
-> (Strength -> Strength -> Bool)
-> (Strength -> Strength -> Bool)
-> (Strength -> Strength -> Bool)
-> (Strength -> Strength -> Bool)
-> (Strength -> Strength -> Strength)
-> (Strength -> Strength -> Strength)
-> Ord Strength
Strength -> Strength -> Bool
Strength -> Strength -> Ordering
Strength -> Strength -> Strength
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Strength -> Strength -> Ordering
compare :: Strength -> Strength -> Ordering
$c< :: Strength -> Strength -> Bool
< :: Strength -> Strength -> Bool
$c<= :: Strength -> Strength -> Bool
<= :: Strength -> Strength -> Bool
$c> :: Strength -> Strength -> Bool
> :: Strength -> Strength -> Bool
$c>= :: Strength -> Strength -> Bool
>= :: Strength -> Strength -> Bool
$cmax :: Strength -> Strength -> Strength
max :: Strength -> Strength -> Strength
$cmin :: Strength -> Strength -> Strength
min :: Strength -> Strength -> Strength
Ord, Int -> Strength -> ShowS
[Strength] -> ShowS
Strength -> String
(Int -> Strength -> ShowS)
-> (Strength -> String) -> ([Strength] -> ShowS) -> Show Strength
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Strength -> ShowS
showsPrec :: Int -> Strength -> ShowS
$cshow :: Strength -> String
show :: Strength -> String
$cshowList :: [Strength] -> ShowS
showList :: [Strength] -> ShowS
Show)

{- | The collision-resistance 'Strength' tier of an algorithm; __a stronger algorithm
ranks higher__ under 'Strength''s 'Ord'.

The broken algorithms rank below the SHA-256 floor (@'integrityStrength' 'SHA256'@):
MD5 and SHA-1 have practical collisions, so a match on one cannot prove the bytes
were not substituted. SHA-256 and the longer digests rank at or above the floor:
SHA-384 above it in a tier of its own, then SHA-512 and Blake2b sharing the top tier
(equal strength). A bare 'SRI' ranks lowest of all -- it is a wrapper, not an algorithm,
so resolve it with 'assertedAlg' before ranking; ranking below every real algorithm, an
unresolved SRI never wins a strongest-digest comparison.

>>> integrityStrength SHA512 > integrityStrength SHA256
True

>>> integrityStrength SHA1 >= integrityStrength SHA256
False
-}
integrityStrength :: HashAlg -> Strength
integrityStrength :: HashAlg -> Strength
integrityStrength = \case
    HashAlg
SRI -> Strength
Unasserted
    HashAlg
MD5 -> Strength
Weakest
    HashAlg
SHA1 -> Strength
Weak
    HashAlg
SHA256 -> Strength
Floor
    HashAlg
SHA384 -> Strength
Strong
    HashAlg
SHA512 -> Strength
Strongest
    HashAlg
Blake2b -> Strength
Strongest

{- | The algorithm a 'Hash' asserts: its tag directly, or -- for an 'SRI' string -- the
algorithm named in its @\<alg\>-\<base64\>@ prefix. The SRI prefixes resolved are
@sha256@, @sha384@ and @sha512@ (every long digest the model represents and a registry
serves); an unrecognised or malformed prefix yields 'Nothing', so it asserts no
algorithm and clears no floor (the fail-closed reading).

>>> import Ecluse.Core.Package (mkHash, HashAlg (SHA1, SRI))
>>> assertedAlg <$> mkHash SRI "sha512-z4PhNX7vuL3xVChQ1m2AB9Yg5AULVxXcg/SpIdNs6c5H0NE8XYXysP+DGNKHfuwvY7kxvUdBeoGlODJ6+SfaPg=="
Right (Just SHA512)

>>> assertedAlg <$> mkHash SHA1 "da39a3ee5e6b4b0d3255bfef95601890afd80709"
Right (Just SHA1)

>>> assertedAlg <$> mkHash SRI "sha384-OLBgp1GsljhM2TJ+sbHjaiH9txEUvgdDTAzHv2P24donTt6/529l+9Ua0vFImLlb"
Right (Just SHA384)
-}
assertedAlg :: Hash -> Maybe HashAlg
assertedAlg :: Hash -> Maybe HashAlg
assertedAlg Hash
h = case Hash -> HashAlg
hashAlg Hash
h of
    HashAlg
SRI -> Text -> Maybe HashAlg
sriAlgorithm (Hash -> Text
hashValue Hash
h)
    HashAlg
alg -> HashAlg -> Maybe HashAlg
forall a. a -> Maybe a
Just HashAlg
alg

{- | The shared interface of an integrity floor: the minimum algorithm it requires. Both
the hard-floored public 'MinIntegrity' and the loosenable trusted 'MinTrustedIntegrity'
are floors, so 'meetsFloor' and 'classifyArtifacts' rank candidates against either through
this one class -- backed by the single 'integrityStrength' ranking the worker's tamper gate
also consults. The class only /reads/ a floor's algorithm; a newtype's construction
invariant (the public hard-floor, the trusted loosenability) lives in its smart
constructors, never here.
-}
class IntegrityFloor floor where
    -- | The minimum algorithm this floor requires.
    floorAlgorithm :: floor -> HashAlg

{- | The configured minimum integrity algorithm a __public__ (untrusted) version's
digest must meet to be admitted. Opaque and __hard-floored at SHA-256__: build it
only through 'mkMinIntegrity' \/ 'parseMinIntegrity', which reject anything weaker, so
a value of this type carries the proof that the floor is itself collision-resistant.
There is deliberately no loosenable variant of /this/ floor: untrusted public bytes are
never admitted on a sub-SHA-256 digest.
-}
newtype MinIntegrity = MinIntegrity HashAlg
    deriving stock (MinIntegrity -> MinIntegrity -> Bool
(MinIntegrity -> MinIntegrity -> Bool)
-> (MinIntegrity -> MinIntegrity -> Bool) -> Eq MinIntegrity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MinIntegrity -> MinIntegrity -> Bool
== :: MinIntegrity -> MinIntegrity -> Bool
$c/= :: MinIntegrity -> MinIntegrity -> Bool
/= :: MinIntegrity -> MinIntegrity -> Bool
Eq, Int -> MinIntegrity -> ShowS
[MinIntegrity] -> ShowS
MinIntegrity -> String
(Int -> MinIntegrity -> ShowS)
-> (MinIntegrity -> String)
-> ([MinIntegrity] -> ShowS)
-> Show MinIntegrity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MinIntegrity -> ShowS
showsPrec :: Int -> MinIntegrity -> ShowS
$cshow :: MinIntegrity -> String
show :: MinIntegrity -> String
$cshowList :: [MinIntegrity] -> ShowS
showList :: [MinIntegrity] -> ShowS
Show)

{- | The default public-integrity floor: SHA-256, which is also the __hard minimum__
the floor may never be set below.
-}
defaultMinIntegrity :: MinIntegrity
defaultMinIntegrity :: MinIntegrity
defaultMinIntegrity = HashAlg -> MinIntegrity
MinIntegrity HashAlg
SHA256

{- | Build a 'MinIntegrity', rejecting any algorithm weaker than SHA-256 (the hard
floor). A weak floor is a configuration error, never a silent clamp: a public version
admitted on a SHA-1 digest could be substituted by a collision, defeating the gate.
-}
mkMinIntegrity :: HashAlg -> Either Text MinIntegrity
mkMinIntegrity :: HashAlg -> Either Text MinIntegrity
mkMinIntegrity HashAlg
alg
    | HashAlg -> Strength
integrityStrength HashAlg
alg Strength -> Strength -> Bool
forall a. Ord a => a -> a -> Bool
>= HashAlg -> Strength
integrityStrength HashAlg
SHA256 = MinIntegrity -> Either Text MinIntegrity
forall a b. b -> Either a b
Right (HashAlg -> MinIntegrity
MinIntegrity HashAlg
alg)
    | Bool
otherwise =
        Text -> Either Text MinIntegrity
forall a b. a -> Either a b
Left
            ( Text
"the minimum public integrity algorithm must be SHA-256 or stronger, not "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HashAlg -> Text
renderHashAlg HashAlg
alg
            )

{- | Parse a 'MinIntegrity' from an algorithm name (e.g. @"sha256"@, @"sha512"@,
@"blake2b"@), case- and separator-insensitive. An unrecognised name and an
algorithm below the SHA-256 floor are distinct errors, so a misconfiguration is
reported precisely.
-}
parseMinIntegrity :: Text -> Either Text MinIntegrity
parseMinIntegrity :: Text -> Either Text MinIntegrity
parseMinIntegrity Text
raw = Text -> Either Text HashAlg
parseHashAlg Text
raw Either Text HashAlg
-> (HashAlg -> Either Text MinIntegrity)
-> Either Text MinIntegrity
forall a b. Either Text a -> (a -> Either Text b) -> Either Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HashAlg -> Either Text MinIntegrity
mkMinIntegrity

-- | The floor algorithm.
unMinIntegrity :: MinIntegrity -> HashAlg
unMinIntegrity :: MinIntegrity -> HashAlg
unMinIntegrity (MinIntegrity HashAlg
alg) = HashAlg
alg

-- | Render a 'MinIntegrity' as its lower-case algorithm name (round-trips 'parseMinIntegrity').
renderMinIntegrity :: MinIntegrity -> Text
renderMinIntegrity :: MinIntegrity -> Text
renderMinIntegrity = HashAlg -> Text
renderHashAlg (HashAlg -> Text)
-> (MinIntegrity -> HashAlg) -> MinIntegrity -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MinIntegrity -> HashAlg
unMinIntegrity

instance IntegrityFloor MinIntegrity where
    floorAlgorithm :: MinIntegrity -> HashAlg
floorAlgorithm = MinIntegrity -> HashAlg
unMinIntegrity

{- | The configured minimum integrity algorithm a __trusted__ (private) version's digest
must meet to be served. Like 'MinIntegrity' it defaults to SHA-256, but unlike it carries
__no hard floor__: an operator may loosen it to SHA-1 or MD5 for a legacy private mirror,
where trust in their own vetted source substitutes for cryptographic strength. Build it
only through 'mkMinTrustedIntegrity' \/ 'parseMinTrustedIntegrity', which still reject an
unknown algorithm name (and the bare 'SRI' wrapper, which names no algorithm). Loosening
this floor is the /only/ path by which Écluse serves a sub-SHA-256 digest, and only on the
operator's own trusted source.
-}
newtype MinTrustedIntegrity = MinTrustedIntegrity HashAlg
    deriving stock (MinTrustedIntegrity -> MinTrustedIntegrity -> Bool
(MinTrustedIntegrity -> MinTrustedIntegrity -> Bool)
-> (MinTrustedIntegrity -> MinTrustedIntegrity -> Bool)
-> Eq MinTrustedIntegrity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MinTrustedIntegrity -> MinTrustedIntegrity -> Bool
== :: MinTrustedIntegrity -> MinTrustedIntegrity -> Bool
$c/= :: MinTrustedIntegrity -> MinTrustedIntegrity -> Bool
/= :: MinTrustedIntegrity -> MinTrustedIntegrity -> Bool
Eq, Int -> MinTrustedIntegrity -> ShowS
[MinTrustedIntegrity] -> ShowS
MinTrustedIntegrity -> String
(Int -> MinTrustedIntegrity -> ShowS)
-> (MinTrustedIntegrity -> String)
-> ([MinTrustedIntegrity] -> ShowS)
-> Show MinTrustedIntegrity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MinTrustedIntegrity -> ShowS
showsPrec :: Int -> MinTrustedIntegrity -> ShowS
$cshow :: MinTrustedIntegrity -> String
show :: MinTrustedIntegrity -> String
$cshowList :: [MinTrustedIntegrity] -> ShowS
showList :: [MinTrustedIntegrity] -> ShowS
Show)

-- | The default trusted-integrity floor: SHA-256, the same secure default as the public floor.
defaultMinTrustedIntegrity :: MinTrustedIntegrity
defaultMinTrustedIntegrity :: MinTrustedIntegrity
defaultMinTrustedIntegrity = HashAlg -> MinTrustedIntegrity
MinTrustedIntegrity HashAlg
SHA256

{- | Build a 'MinTrustedIntegrity'. Any /known/ algorithm is accepted -- including the
broken SHA-1 and MD5, which an operator may deliberately loosen the trusted floor to --
but the bare 'SRI' wrapper, which asserts no algorithm of its own, is rejected (it could
never be a meaningful floor). There is intentionally no SHA-256 hard minimum here: that is
the one behavioural difference from 'mkMinIntegrity'.
-}
mkMinTrustedIntegrity :: HashAlg -> Either Text MinTrustedIntegrity
mkMinTrustedIntegrity :: HashAlg -> Either Text MinTrustedIntegrity
mkMinTrustedIntegrity HashAlg
SRI =
    Text -> Either Text MinTrustedIntegrity
forall a b. a -> Either a b
Left Text
"the minimum trusted integrity algorithm must name a concrete algorithm, not a bare SRI"
mkMinTrustedIntegrity HashAlg
alg = MinTrustedIntegrity -> Either Text MinTrustedIntegrity
forall a b. b -> Either a b
Right (HashAlg -> MinTrustedIntegrity
MinTrustedIntegrity HashAlg
alg)

{- | Parse a 'MinTrustedIntegrity' from an algorithm name (e.g. @"sha256"@, @"sha1"@,
@"md5"@), case- and separator-insensitive. An unrecognised name is rejected; unlike
'parseMinIntegrity', a sub-SHA-256 name is /accepted/ -- the trusted floor is loosenable.
-}
parseMinTrustedIntegrity :: Text -> Either Text MinTrustedIntegrity
parseMinTrustedIntegrity :: Text -> Either Text MinTrustedIntegrity
parseMinTrustedIntegrity Text
raw = Text -> Either Text HashAlg
parseHashAlg Text
raw Either Text HashAlg
-> (HashAlg -> Either Text MinTrustedIntegrity)
-> Either Text MinTrustedIntegrity
forall a b. Either Text a -> (a -> Either Text b) -> Either Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HashAlg -> Either Text MinTrustedIntegrity
mkMinTrustedIntegrity

-- | The trusted floor algorithm.
unMinTrustedIntegrity :: MinTrustedIntegrity -> HashAlg
unMinTrustedIntegrity :: MinTrustedIntegrity -> HashAlg
unMinTrustedIntegrity (MinTrustedIntegrity HashAlg
alg) = HashAlg
alg

-- | Render a 'MinTrustedIntegrity' as its lower-case algorithm name (round-trips 'parseMinTrustedIntegrity').
renderMinTrustedIntegrity :: MinTrustedIntegrity -> Text
renderMinTrustedIntegrity :: MinTrustedIntegrity -> Text
renderMinTrustedIntegrity = HashAlg -> Text
renderHashAlg (HashAlg -> Text)
-> (MinTrustedIntegrity -> HashAlg) -> MinTrustedIntegrity -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MinTrustedIntegrity -> HashAlg
unMinTrustedIntegrity

instance IntegrityFloor MinTrustedIntegrity where
    floorAlgorithm :: MinTrustedIntegrity -> HashAlg
floorAlgorithm = MinTrustedIntegrity -> HashAlg
unMinTrustedIntegrity

{- | Whether an algorithm meets a floor: at least as strong as the floor's configured
minimum, by the shared 'integrityStrength' ranking. The candidate algorithm is a
/resolved/ one (from 'assertedAlg'), never a bare 'SRI'.
-}
meetsFloor :: (IntegrityFloor floor) => floor -> HashAlg -> Bool
meetsFloor :: forall floor. IntegrityFloor floor => floor -> HashAlg -> Bool
meetsFloor floor
flr HashAlg
alg = HashAlg -> Strength
integrityStrength HashAlg
alg Strength -> Strength -> Bool
forall a. Ord a => a -> a -> Bool
>= HashAlg -> Strength
integrityStrength (floor -> HashAlg
forall floor. IntegrityFloor floor => floor -> HashAlg
floorAlgorithm floor
flr)

{- | How a version's artifacts stand against an integrity floor -- the three-way verdict
an admission gate (public or trusted) acts on.
-}
data VersionIntegrity
    = -- | At least one digest asserts an algorithm at or above the floor: admissible.
      MeetsFloor
    | {- | The version carries an integrity digest, but none meets the floor (e.g. a
      legacy SHA-1 shasum only under a SHA-256 floor). Inadmissible -- distinct from
      carrying no digest at all, so the refusal can say which.
      -}
      BelowFloor
    | {- | The version carries no integrity digest of any kind: inadmissible (no floor
      can be met without a digest).
      -}
      NoIntegrity
    deriving stock (VersionIntegrity -> VersionIntegrity -> Bool
(VersionIntegrity -> VersionIntegrity -> Bool)
-> (VersionIntegrity -> VersionIntegrity -> Bool)
-> Eq VersionIntegrity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VersionIntegrity -> VersionIntegrity -> Bool
== :: VersionIntegrity -> VersionIntegrity -> Bool
$c/= :: VersionIntegrity -> VersionIntegrity -> Bool
/= :: VersionIntegrity -> VersionIntegrity -> Bool
Eq, Int -> VersionIntegrity -> ShowS
[VersionIntegrity] -> ShowS
VersionIntegrity -> String
(Int -> VersionIntegrity -> ShowS)
-> (VersionIntegrity -> String)
-> ([VersionIntegrity] -> ShowS)
-> Show VersionIntegrity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VersionIntegrity -> ShowS
showsPrec :: Int -> VersionIntegrity -> ShowS
$cshow :: VersionIntegrity -> String
show :: VersionIntegrity -> String
$cshowList :: [VersionIntegrity] -> ShowS
showList :: [VersionIntegrity] -> ShowS
Show)

{- | Classify a version's artifacts against a floor (public or trusted). A version
'MeetsFloor' iff any of its digests (across all of its artifacts) asserts a floor-clearing
algorithm; failing that, it is 'NoIntegrity' when no artifact carries any digest at all,
else 'BelowFloor'. npm publishes one artifact per version, but the check spans the whole
'NonEmpty' so it holds for a multi-artifact ecosystem too.
-}
classifyArtifacts :: (IntegrityFloor floor) => floor -> NonEmpty Artifact -> VersionIntegrity
classifyArtifacts :: forall floor.
IntegrityFloor floor =>
floor -> NonEmpty Artifact -> VersionIntegrity
classifyArtifacts floor
flr NonEmpty Artifact
arts
    | (Artifact -> Bool) -> NonEmpty Artifact -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Artifact -> Bool
meetsFloorArtifact NonEmpty Artifact
arts = VersionIntegrity
MeetsFloor
    | (Artifact -> Bool) -> NonEmpty Artifact -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([Hash] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Hash] -> Bool) -> (Artifact -> [Hash]) -> Artifact -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Artifact -> [Hash]
artHashes) NonEmpty Artifact
arts = VersionIntegrity
NoIntegrity
    | Bool
otherwise = VersionIntegrity
BelowFloor
  where
    meetsFloorArtifact :: Artifact -> Bool
meetsFloorArtifact Artifact
art = (Hash -> Bool) -> [Hash] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Hash -> Bool
hashMeetsFloor (Artifact -> [Hash]
artHashes Artifact
art)
    hashMeetsFloor :: Hash -> Bool
hashMeetsFloor Hash
h = Bool -> (HashAlg -> Bool) -> Maybe HashAlg -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (floor -> HashAlg -> Bool
forall floor. IntegrityFloor floor => floor -> HashAlg -> Bool
meetsFloor floor
flr) (Hash -> Maybe HashAlg
assertedAlg Hash
h)

-- The algorithm vocabulary (the wire name renderer\/parser and the SRI splitter\/resolver)
-- lives in "Ecluse.Core.Package", the lowest layer, and is re-exported above so this module's
-- callers (and the worker and SQS) keep importing it from here.