mfmts-1.2.0.0: cid/MultiFormats/CID/Component/Hash.hs
-- | Module : MultiFormats.CID.Component.Hash
-- Description : Implements extraction and verification of multihash CID data
-- Copyright : Zoey McBride (c) 2026
-- License : AGPL-3.0-or-later
-- Maintainer : zoeymcbride@mailbox.org
-- Stability : experimental
module MultiFormats.CID.Component.Hash (Hash (Hash)) where
import Control.DeepSeq (force, NFData (..))
import Data.ByteString.Builder (Builder)
import Data.XCodec.BinaryTranscoder (BinaryTranscoder)
import Data.XCodec.BinaryTranscoder qualified as BXC
import MultiFormats.CID.Component.Codec qualified as CID
import MultiFormats.CID.Errors
import MultiFormats.CID.Extractor (Extractor (extractor))
import MultiFormats.MultiHash (MultiHash, resolveHashCodec)
import MultiFormats.VarInt (VarInt)
import Data.Bifunctor (first)
data Hash = Hash
{ -- | Stores the MultiCodec for the hash function used.
cidHashCodec :: MultiHash,
-- | Stores the length in bytes of the hash builder.
cidHashLength :: VarInt,
-- | Stores the hash function's output.
cidHashDigest :: Builder
}
-- | Evaluates the Hash into normal form without executing the hash builder.
instance NFData Hash where
rnf (Hash codec len _) = rnf codec `seq` rnf len
-- | Extracts the MultiHash codec and hash digest via a varint size following
-- the MultiHash codec.
instance (BinaryTranscoder t) => Extractor Hash t where
extractor bytes = do
-- Get the CodecCode from the first varint
(CID.Codec codec, onsize) <- extractor bytes
-- Get the digest size from the first varint, make CID.Error if on Left
(usize :: VarInt, ondigest) <- extractor onsize
-- When codec is a valid hash and the given size is available in the bytes,
-- take #size elements from bytes and construct the Hash
case resolveHashCodec codec of
Nothing -> Left (InvalidHash $ UnknownHashCodec codec)
Just hash
| isize < BXC.totalOctets ondigest -> Left (InvalidHash IncorrectLength)
| otherwise -> Right $ extractHashDigest hash usize ondigest
where
-- Gets the varint size as generic integral type
isize = fromIntegral usize
-- Extracts the hash data from the bytes
extractHashDigest !multihash !size rest =
let (hashdata, final) = BXC.splitOffset isize rest
hashbuilder = BXC.unpackSerial hashdata
in first force (Hash multihash size hashbuilder, final)