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

{- | The integrity-digest vocabulary: hash algorithms and their authority order,
the validated 'Hash' value, digest computation, and the Subresource-Integrity
wire forms.

This is the single home for the algorithm vocabulary: the wire name an algorithm
renders to and parses from, and how a Subresource-Integrity string is split and
resolved. It lives in the package layer's lowest module because 'mkHash' needs it
and the vocabulary's consumers must never disagree on it: everything that names an
algorithm or reads an SRI (the worker's tamper gate, the serve-admission floor, the
queue wire) defers here, so they share one notion of what @"sha512"@ means and what
an SRI asserts rather than each re-encoding it. "Ecluse.Core.Package" re-exports
this whole surface for its callers; import this module directly only where the
package vocabulary itself is not needed.
-}
module Ecluse.Core.Package.Hash (
    -- * Hashes
    Hash,
    hashAlg,
    hashValue,
    mkHash,
    mkSriHashes,
    HashAlg (..),

    -- * Algorithm vocabulary
    renderHashAlg,
    parseHashAlg,
    sriPrefix,
    sriBody,
    sriAlgorithm,

    -- * Digest computation
    computeDigest,
    isComputable,
) where

import Crypto.Hash (Blake2b_512, Digest, MD5, SHA1, SHA256, SHA384, SHA512, digestFromByteString, hashlazy)
import Data.ByteArray (convert)
import Data.ByteArray.Encoding (Base (Base16, Base64), convertFromBase)
import Data.Text qualified as T
import Data.Universe.Class (Universe (..))
import Data.Universe.Generic (universeGeneric)

{- | A hash algorithm an integrity digest is computed with.

The 'Ord' instance is the integrity authority order, not constructor order:
@SRI < MD5 < SHA1 < SHA256 < SHA384 < Blake2b < SHA512@. A bare 'SRI' is a wrapper,
not an algorithm; callers that care about its embedded algorithm should resolve it first.
-}
data HashAlg
    = SHA1
    | SHA256
    | SHA384
    | SHA512
    | MD5
    | Blake2b
    | {- | A single Subresource-Integrity component (npm @dist.integrity@), e.g.
      @"sha512-…"@. Exactly one @\<alg\>-\<base64\>@ component per 'Hash': a wire
      string that joins several with whitespace is split into one 'Hash' per
      component by 'mkSriHashes', so every reader resolves the same algorithm and
      digest body from 'hashValue'.
      -}
      SRI
    deriving stock (HashAlg -> HashAlg -> Bool
(HashAlg -> HashAlg -> Bool)
-> (HashAlg -> HashAlg -> Bool) -> Eq HashAlg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HashAlg -> HashAlg -> Bool
== :: HashAlg -> HashAlg -> Bool
$c/= :: HashAlg -> HashAlg -> Bool
/= :: HashAlg -> HashAlg -> Bool
Eq, (forall x. HashAlg -> Rep HashAlg x)
-> (forall x. Rep HashAlg x -> HashAlg) -> Generic HashAlg
forall x. Rep HashAlg x -> HashAlg
forall x. HashAlg -> Rep HashAlg x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HashAlg -> Rep HashAlg x
from :: forall x. HashAlg -> Rep HashAlg x
$cto :: forall x. Rep HashAlg x -> HashAlg
to :: forall x. Rep HashAlg x -> HashAlg
Generic, Int -> HashAlg -> ShowS
[HashAlg] -> ShowS
HashAlg -> String
(Int -> HashAlg -> ShowS)
-> (HashAlg -> String) -> ([HashAlg] -> ShowS) -> Show HashAlg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HashAlg -> ShowS
showsPrec :: Int -> HashAlg -> ShowS
$cshow :: HashAlg -> String
show :: HashAlg -> String
$cshowList :: [HashAlg] -> ShowS
showList :: [HashAlg] -> ShowS
Show)

-- Enumerate every HashAlg from the type itself, so a new algorithm is covered without a
-- hand-maintained list. Derived from Generic, not a partial Enum/Bounded pair; the
-- cross-module floor-vs-compute invariant test relies on this being exhaustive.
instance Universe HashAlg where universe :: [HashAlg]
universe = [HashAlg]
forall a. (Generic a, GUniverse (Rep a)) => [a]
universeGeneric

instance Ord HashAlg where
    compare :: HashAlg -> HashAlg -> Ordering
compare HashAlg
a HashAlg
b = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (HashAlg -> Int
hashAlgRank HashAlg
a) (HashAlg -> Int
hashAlgRank HashAlg
b)

-- Explicit integrity ordering, weakest to strongest. The gaps are only for
-- readability; order, not arithmetic distance, is the policy.
hashAlgRank :: HashAlg -> Int
hashAlgRank :: HashAlg -> Int
hashAlgRank = \case
    HashAlg
SRI -> Int
0
    HashAlg
MD5 -> Int
10
    HashAlg
SHA1 -> Int
20
    HashAlg
SHA256 -> Int
30
    HashAlg
SHA384 -> Int
40
    HashAlg
Blake2b -> Int
50
    HashAlg
SHA512 -> Int
60

{- | An integrity digest of an artifact. __Opaque__: a 'Hash' is built only through
'mkHash', which validates that the digest is well-formed, so every value of this type
carries the proof that its digest could be a real digest of its algorithm. Read it
back through 'hashAlg' and 'hashValue'.
-}
data Hash = Hash
    { Hash -> HashAlg
hashAlg :: HashAlg
    -- ^ The algorithm the digest was computed with.
    , Hash -> Text
hashValue :: Text
    {- ^ The digest itself, in the algorithm's wire encoding (e.g. hex, or the
    single @sha512-…@ component for 'SRI').
    -}
    }
    deriving stock (Hash -> Hash -> Bool
(Hash -> Hash -> Bool) -> (Hash -> Hash -> Bool) -> Eq Hash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Hash -> Hash -> Bool
== :: Hash -> Hash -> Bool
$c/= :: Hash -> Hash -> Bool
/= :: Hash -> Hash -> Bool
Eq, Int -> Hash -> ShowS
[Hash] -> ShowS
Hash -> String
(Int -> Hash -> ShowS)
-> (Hash -> String) -> ([Hash] -> ShowS) -> Show Hash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Hash -> ShowS
showsPrec :: Int -> Hash -> ShowS
$cshow :: Hash -> String
show :: Hash -> String
$cshowList :: [Hash] -> ShowS
showList :: [Hash] -> ShowS
Show)

{- | Build a 'Hash', validating that the digest is __structurally well-formed__:
cleanly encoded and exactly the byte length its algorithm specifies. This is the only
way to construct a 'Hash', so the type itself is the proof that the digest could be a
real digest of that algorithm -- an empty, truncated, over-long, non-hex, or bad-base64
value is unconstructable and so can never reach an integrity gate as a degenerate
digest (the fail-open this closes is @docs\/architecture\/security.md@ invariant 5).

Well-formedness is __not__ admissibility: a well-formed but weak SHA-1 digest builds
fine; whether it clears the public-integrity floor is the separate decision of
"Ecluse.Core.Package.Integrity". 'mkHash' rejects a malformed digest, never a merely weak one.

A hex-tagged algorithm (everything but 'SRI') takes lower- or upper-case hex of the
algorithm's digest length. An 'SRI' takes __exactly one__ @\<alg\>-\<base64\>@
component, naming a Subresource-Integrity algorithm (@sha256@, @sha384@, @sha512@)
whose base64 body decodes to that algorithm's digest length. A wire string that
joins several components with whitespace is malformed /here/: split it with
'mkSriHashes', which yields one 'Hash' per component, so no reader ever has to
decide which component of a joined string a 'Hash' means.

>>> import Ecluse.Core.Package.Hash (HashAlg (SHA1))
>>> fmap hashAlg (mkHash SHA1 "0a4d55a8d778e5022fab701977c5d840bbc486d0")
Right SHA1

>>> mkHash SHA1 "deadbeef"
Left "malformed sha1 digest"
-}
mkHash :: HashAlg -> Text -> Either Text Hash
mkHash :: HashAlg -> Text -> Either Text Hash
mkHash HashAlg
alg Text
value
    | HashAlg -> Text -> Bool
wellFormed HashAlg
alg Text
value = Hash -> Either Text Hash
forall a b. b -> Either a b
Right (HashAlg -> Text -> Hash
Hash HashAlg
alg Text
value)
    | Bool
otherwise = Text -> Either Text Hash
forall a b. a -> Either a b
Left (Text
"malformed " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HashAlg -> Text
renderHashAlg HashAlg
alg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" digest")

{- | Split a Subresource-Integrity __wire string__ -- one or more
whitespace-separated @\<alg\>-\<base64\>@ components (npm's @dist.integrity@) --
into one 'SRI' 'Hash' per component, each built through the validating 'mkHash'.
The whole string is rejected when it carries no component or /any/ component is
malformed, so a partially-valid value never yields a partial digest set.

This is the one intended path from wire data to 'SRI' hashes. Because each
resulting 'Hash' holds exactly one component, the admission floor, the worker's
tamper gate, and the divergence fingerprint all resolve the same algorithm and
digest body from it -- there is no joined string left for two consumers to read
two different ways.

>>> fmap length (mkSriHashes "sha512-z4PhNX7vuL3xVChQ1m2AB9Yg5AULVxXcg/SpIdNs6c5H0NE8XYXysP+DGNKHfuwvY7kxvUdBeoGlODJ6+SfaPg== sha256-47DEQpj8HBSa+/TImW+5JCeuQeRkm5NMpJWZG3hSuFU=")
Right 2

>>> mkSriHashes "  "
Left "malformed sri digest"
-}
mkSriHashes :: Text -> Either Text (NonEmpty Hash)
mkSriHashes :: Text -> Either Text (NonEmpty Hash)
mkSriHashes Text
wire = case [Text] -> Maybe (NonEmpty Text)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (Text -> [Text]
T.words Text
wire) of
    Maybe (NonEmpty Text)
Nothing -> Text -> Either Text (NonEmpty Hash)
forall a b. a -> Either a b
Left Text
"malformed sri digest"
    Just NonEmpty Text
comps -> (Text -> Either Text Hash)
-> NonEmpty Text -> Either Text (NonEmpty Hash)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonEmpty a -> f (NonEmpty b)
traverse (HashAlg -> Text -> Either Text Hash
mkHash HashAlg
SRI) NonEmpty Text
comps

-- Whether a digest string is a well-formed digest of the given algorithm.
wellFormed :: HashAlg -> Text -> Bool
wellFormed :: HashAlg -> Text -> Bool
wellFormed = \case
    HashAlg
SRI -> Text -> Bool
wellFormedSri
    HashAlg
alg -> HashAlg -> Text -> Bool
wellFormedHex HashAlg
alg

-- A hex digest is well-formed when it decodes as hex (case-insensitively) to exactly
-- the algorithm's digest length -- which 'digestFromByteString' decides by accepting
-- only an input of the right size.
wellFormedHex :: HashAlg -> Text -> Bool
wellFormedHex :: HashAlg -> Text -> Bool
wellFormedHex HashAlg
alg Text
t =
    case Base -> ByteString -> Either String ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> Either String bout
convertFromBase Base
Base16 (Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Text -> Text
T.toLower Text
t) :: ByteString) :: Either String ByteString of
        Left String
_ -> Bool
False
        Right ByteString
bytes -> HashAlg -> ByteString -> Bool
hexDigestOk HashAlg
alg ByteString
bytes

hexDigestOk :: HashAlg -> ByteString -> Bool
hexDigestOk :: HashAlg -> ByteString -> Bool
hexDigestOk HashAlg
alg ByteString
bytes = case HashAlg
alg of
    HashAlg
SHA1 -> Maybe (Digest SHA1) -> Bool
forall a. Maybe a -> Bool
isJust (forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
digestFromByteString @SHA1 ByteString
bytes)
    HashAlg
SHA256 -> Maybe (Digest SHA256) -> Bool
forall a. Maybe a -> Bool
isJust (forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
digestFromByteString @SHA256 ByteString
bytes)
    HashAlg
SHA384 -> Maybe (Digest SHA384) -> Bool
forall a. Maybe a -> Bool
isJust (forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
digestFromByteString @SHA384 ByteString
bytes)
    HashAlg
SHA512 -> Maybe (Digest SHA512) -> Bool
forall a. Maybe a -> Bool
isJust (forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
digestFromByteString @SHA512 ByteString
bytes)
    HashAlg
MD5 -> Maybe (Digest MD5) -> Bool
forall a. Maybe a -> Bool
isJust (forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
digestFromByteString @MD5 ByteString
bytes)
    HashAlg
Blake2b -> Maybe (Digest Blake2b_512) -> Bool
forall a. Maybe a -> Bool
isJust (forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
digestFromByteString @Blake2b_512 ByteString
bytes)
    HashAlg
SRI -> Bool
False

{- | Compute the digest of bytes in a given algorithm, as the raw digest bytes, or
'Nothing' for an algorithm Écluse will not verify against. The computable algorithms are
exactly the collision-resistant ones: 'SHA1', 'SHA256', 'SHA384', 'SHA512', and
Blake2b-512. 'MD5' is deliberately uncomputable here (a match on a broken hash cannot prove
the bytes were not substituted, so the tamper gate never verifies against it), as is the
bare 'SRI' wrapper, which names no algorithm of its own (resolve it with 'sriAlgorithm'
first).

This is the sibling of 'hexDigestOk': both dispatch on the same per-algorithm crypto type,
so they live together and a new 'HashAlg' must be given an arm in each (the 'case' is total,
and the package builds with @-Wincomplete-patterns@ as an error). It is the one place that
defines /which algorithms the worker can verify/; the integrity floor admits by /strength/
("Ecluse.Core.Package.Integrity"), and the invariant that every floor-clearing algorithm is
computable here keeps the worker able to verify whatever the floor admits.
-}
computeDigest :: HashAlg -> Maybe (LByteString -> ByteString)
computeDigest :: HashAlg -> Maybe (LByteString -> ByteString)
computeDigest = \case
    HashAlg
SHA1 -> (LByteString -> ByteString) -> Maybe (LByteString -> ByteString)
forall a. a -> Maybe a
Just (Digest SHA1 -> ByteString
forall a. Digest a -> ByteString
digestBytes (Digest SHA1 -> ByteString)
-> (LByteString -> Digest SHA1) -> LByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HashAlgorithm a => LByteString -> Digest a
hashlazy @SHA1)
    HashAlg
SHA256 -> (LByteString -> ByteString) -> Maybe (LByteString -> ByteString)
forall a. a -> Maybe a
Just (Digest SHA256 -> ByteString
forall a. Digest a -> ByteString
digestBytes (Digest SHA256 -> ByteString)
-> (LByteString -> Digest SHA256) -> LByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HashAlgorithm a => LByteString -> Digest a
hashlazy @SHA256)
    HashAlg
SHA384 -> (LByteString -> ByteString) -> Maybe (LByteString -> ByteString)
forall a. a -> Maybe a
Just (Digest SHA384 -> ByteString
forall a. Digest a -> ByteString
digestBytes (Digest SHA384 -> ByteString)
-> (LByteString -> Digest SHA384) -> LByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HashAlgorithm a => LByteString -> Digest a
hashlazy @SHA384)
    HashAlg
SHA512 -> (LByteString -> ByteString) -> Maybe (LByteString -> ByteString)
forall a. a -> Maybe a
Just (Digest SHA512 -> ByteString
forall a. Digest a -> ByteString
digestBytes (Digest SHA512 -> ByteString)
-> (LByteString -> Digest SHA512) -> LByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HashAlgorithm a => LByteString -> Digest a
hashlazy @SHA512)
    HashAlg
Blake2b -> (LByteString -> ByteString) -> Maybe (LByteString -> ByteString)
forall a. a -> Maybe a
Just (Digest Blake2b_512 -> ByteString
forall a. Digest a -> ByteString
digestBytes (Digest Blake2b_512 -> ByteString)
-> (LByteString -> Digest Blake2b_512) -> LByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HashAlgorithm a => LByteString -> Digest a
hashlazy @Blake2b_512)
    HashAlg
MD5 -> Maybe (LByteString -> ByteString)
forall a. Maybe a
Nothing
    HashAlg
SRI -> Maybe (LByteString -> ByteString)
forall a. Maybe a
Nothing
  where
    digestBytes :: Digest a -> ByteString
    digestBytes :: forall a. Digest a -> ByteString
digestBytes = Digest a -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert

{- | Whether the worker can compute (and so verify a digest in) the given algorithm: the
predicate form of 'computeDigest', taken from the same single definition so the computable
set cannot drift from what 'computeDigest' actually computes.

>>> isComputable SHA256
True

>>> isComputable MD5
False
-}
isComputable :: HashAlg -> Bool
isComputable :: HashAlg -> Bool
isComputable = Maybe (LByteString -> ByteString) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (LByteString -> ByteString) -> Bool)
-> (HashAlg -> Maybe (LByteString -> ByteString))
-> HashAlg
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashAlg -> Maybe (LByteString -> ByteString)
computeDigest

{- An 'SRI' 'Hash' carries exactly one canonical @\<alg\>-\<base64\>@ component: no
surrounding whitespace (the first-dash accessors 'sriPrefix'\/'sriBody' read the
stored value verbatim, so a padded value would corrupt both) and never a
whitespace-joined set (that is the wire shape 'mkSriHashes' splits, one 'Hash' per
component). The single-component invariant is what lets every consumer -- the
admission floor, the worker's tamper gate, the divergence fingerprint -- resolve
the same algorithm and digest body from one 'Hash'.
-}
wellFormedSri :: Text -> Bool
wellFormedSri :: Text -> Bool
wellFormedSri Text
t = case Text -> [Text]
T.words Text
t of
    [Text
comp] -> Text
comp Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
t Bool -> Bool -> Bool
&& Text -> Bool
wellFormedSriComponent Text
comp
    [Text]
_ -> Bool
False

wellFormedSriComponent :: Text -> Bool
wellFormedSriComponent :: Text -> Bool
wellFormedSriComponent Text
comp
    -- An empty body means no @\<alg\>-\<base64\>@ shape (no separator, or nothing after it).
    | Text -> Bool
T.null (Text -> Text
sriBody Text
comp) = Bool
False
    | Bool
otherwise = Text -> Text -> Bool
sriBodyOk (Text -> Text
sriPrefix Text
comp) (Text -> Text
sriBody Text
comp)

-- The SRI algorithms recognised are exactly the Subresource-Integrity set
-- (sha256/sha384/sha512); the base64 body must decode to that algorithm's digest
-- length. Each is a modelled 'HashAlg', so a well-formed component both constructs and
-- resolves to an algorithm the strength tier ranks ('assertedAlg').
sriBodyOk :: Text -> Text -> Bool
sriBodyOk :: Text -> Text -> Bool
sriBodyOk Text
algName Text
body =
    case Base -> ByteString -> Either String ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> Either String bout
convertFromBase Base
Base64 (Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
body :: ByteString) :: Either String ByteString of
        Left String
_ -> Bool
False
        Right ByteString
bytes -> case Text
algName of
            Text
"sha256" -> Maybe (Digest SHA256) -> Bool
forall a. Maybe a -> Bool
isJust (forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
digestFromByteString @SHA256 ByteString
bytes)
            Text
"sha384" -> Maybe (Digest SHA384) -> Bool
forall a. Maybe a -> Bool
isJust (forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
digestFromByteString @SHA384 ByteString
bytes)
            Text
"sha512" -> Maybe (Digest SHA512) -> Bool
forall a. Maybe a -> Bool
isJust (forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
digestFromByteString @SHA512 ByteString
bytes)
            Text
_ -> Bool
False

{- | The lower-case wire name of an algorithm -- the canonical spelling 'parseHashAlg'
reads back. Total and injective, so it doubles as config rendering and error text.

>>> renderHashAlg SHA256
"sha256"
-}
renderHashAlg :: HashAlg -> Text
renderHashAlg :: HashAlg -> Text
renderHashAlg = \case
    HashAlg
MD5 -> Text
"md5"
    HashAlg
SHA1 -> Text
"sha1"
    HashAlg
SHA256 -> Text
"sha256"
    HashAlg
SHA384 -> Text
"sha384"
    HashAlg
SHA512 -> Text
"sha512"
    HashAlg
Blake2b -> Text
"blake2b"
    HashAlg
SRI -> Text
"sri"

{- | Parse an algorithm name, tolerating surrounding whitespace and case, and a
single family-separating @\'-\'@ (so @"SHA-256"@ and @"sha256"@ both parse). It
accepts only the canonical names and their documented single-dash aliases: it does
__not__ strip arbitrary internal dashes, so a typo such as @"s-h-a--2-5-6"@ is
rejected rather than silently read as @sha256@. An unrecognised name is reported as
such, distinct from a recognised-but-too-weak floor. The @sri@ wrapper is not a
config-selectable algorithm and is rejected.

>>> parseHashAlg "SHA-256"
Right SHA256

>>> parseHashAlg "frobnicate"
Left "unknown integrity algorithm: frobnicate"
-}
parseHashAlg :: Text -> Either Text HashAlg
parseHashAlg :: Text -> Either Text HashAlg
parseHashAlg Text
raw = case Text -> Text
T.toLower (Text -> Text
T.strip Text
raw) of
    Text
"md5" -> HashAlg -> Either Text HashAlg
forall a b. b -> Either a b
Right HashAlg
MD5
    Text
"sha1" -> HashAlg -> Either Text HashAlg
forall a b. b -> Either a b
Right HashAlg
SHA1
    Text
"sha-1" -> HashAlg -> Either Text HashAlg
forall a b. b -> Either a b
Right HashAlg
SHA1
    Text
"sha256" -> HashAlg -> Either Text HashAlg
forall a b. b -> Either a b
Right HashAlg
SHA256
    Text
"sha-256" -> HashAlg -> Either Text HashAlg
forall a b. b -> Either a b
Right HashAlg
SHA256
    Text
"sha384" -> HashAlg -> Either Text HashAlg
forall a b. b -> Either a b
Right HashAlg
SHA384
    Text
"sha-384" -> HashAlg -> Either Text HashAlg
forall a b. b -> Either a b
Right HashAlg
SHA384
    Text
"sha512" -> HashAlg -> Either Text HashAlg
forall a b. b -> Either a b
Right HashAlg
SHA512
    Text
"sha-512" -> HashAlg -> Either Text HashAlg
forall a b. b -> Either a b
Right HashAlg
SHA512
    Text
"blake2b" -> HashAlg -> Either Text HashAlg
forall a b. b -> Either a b
Right HashAlg
Blake2b
    Text
_ -> Text -> Either Text HashAlg
forall a b. a -> Either a b
Left (Text
"unknown integrity algorithm: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
raw)

{- | The algorithm-name token of a Subresource-Integrity string -- the @\<alg\>@ before
the first @\'-\'@ in @\<alg\>-\<base64\>@. A string with no @\'-\'@ is all prefix.

>>> sriPrefix "sha512-Zm9vYmFy"
"sha512"
-}
sriPrefix :: Text -> Text
sriPrefix :: Text -> Text
sriPrefix = (Text, Text) -> Text
forall a b. (a, b) -> a
fst ((Text, Text) -> Text) -> (Text -> (Text, Text)) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOn Text
"-"

{- | The base64 digest body of a Subresource-Integrity string -- the @\<base64\>@ after
the first @\'-\'@ in @\<alg\>-\<base64\>@. A string with no @\'-\'@ has an empty body.

>>> sriBody "sha512-Zm9vYmFy"
"Zm9vYmFy"
-}
sriBody :: Text -> Text
sriBody :: Text -> Text
sriBody = Int -> Text -> Text
T.drop Int
1 (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> Text
forall a b. (a, b) -> b
snd ((Text, Text) -> Text) -> (Text -> (Text, Text)) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOn Text
"-"

{- | The 'HashAlg' a Subresource-Integrity string names, read from its @\<alg\>@ prefix.
The prefixes resolved are the Subresource-Integrity set @sha256@, @sha384@ and @sha512@
(every long digest the model represents and a registry serves); an unrecognised or
malformed prefix yields 'Nothing', so the string asserts no algorithm and clears no
floor (the fail-closed reading).

>>> sriAlgorithm "sha512-Zm9vYmFy"
Just SHA512

>>> sriAlgorithm "sha384-Zm9vYmFy"
Just SHA384
-}
sriAlgorithm :: Text -> Maybe HashAlg
sriAlgorithm :: Text -> Maybe HashAlg
sriAlgorithm Text
sri = case Text -> Text
sriPrefix Text
sri of
    Text
"sha256" -> HashAlg -> Maybe HashAlg
forall a. a -> Maybe a
Just HashAlg
SHA256
    Text
"sha384" -> HashAlg -> Maybe HashAlg
forall a. a -> Maybe a
Just HashAlg
SHA384
    Text
"sha512" -> HashAlg -> Maybe HashAlg
forall a. a -> Maybe a
Just HashAlg
SHA512
    Text
_ -> Maybe HashAlg
forall a. Maybe a
Nothing