packages feed

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)