packages feed

ipldm-1.0.0.0: dagcbor/IPLD/DagCBOR/Encoder/Ints.hs

-- | Module      : IPLD.DagCBOR.Encoder.Ints
--   Description : Implements encoder for DAG-CBOR integer data
--   Copyright   : Zoey McBride (c) 2026
--   License     : AGPL-3.0-or-later
--   Maintainer  : zoeymcbride@mailbox.org
--   Stability   : experimental
module IPLD.DagCBOR.Encoder.Ints
  ( -- * CBOR encoder for IPLD Integer kind
    encodeIntKind,

    -- * Generates an argument with an attached CBOR value
    encodeIntArgument,

    -- * CBOR integer constants
    majorIntPositive,
    majorIntNegative,
    majorIntSign,
    paramInt8,
    paramInt16,
    paramInt32,
    paramInt64,
  )
where

import Data.ByteString.Builder (Builder)
import Data.ByteString.Builder qualified as BSB
import Data.Word (Word16, Word32, Word64, Word8)
import IPLD.DagCBOR.Encoder.Arguments
import IPLD.DagCBOR.Encoder.Errors

-- | Major id for positive integer values in CBOR.
majorIntPositive :: MajorArg
majorIntPositive = 0

-- | Major id for negative integer values in CBOR.
majorIntNegative :: MajorArg
majorIntNegative = 1

-- | Provides the `MajorArg` associated with a number's sign (+: 0/-: 1).
{-# INLINE majorIntSign #-}
majorIntSign :: (Integral a, Integral b) => a -> b
majorIntSign value = fromIntegral $ fromEnum (value < 0)

-- | Parameter value for 1-byte CBOR integer encodings.
paramInt8 :: ParamArg
paramInt8 = 24

-- | Parameter value for 2-byte CBOR integer encodings.
paramInt16 :: ParamArg
paramInt16 = 25

-- | Parameter value for 4-byte CBOR integer encodings.
paramInt32 :: ParamArg
paramInt32 = 26

-- | Parameter value for 8-byte CBOR integer encodings.
paramInt64 :: ParamArg
paramInt64 = 27

-- | Encodes a CBOR argument with an integer value attached with for the
-- provided major type.
{-# INLINE encodeIntArgument #-}
encodeIntArgument :: forall a. (Integral a) => MajorArg -> a -> Okay Builder
encodeIntArgument major value
  -- Encode 5-bit values
  | 0 <= normal && normal <= max5 = Right $ encode5bit major value
  -- Encode 8-bit values
  | max5 < normal && normal <= max8 = Right $ encode8bit major value
  -- Encode 16-bit values
  | max8 < normal && normal <= max16 = Right $ encode16bit major value
  -- Encode 32-bit values
  | max16 < normal && normal <= max32 = Right $ encode32bit major value
  -- Encode 64-bit values
  | max32 < normal && normal <= max64 = Right $ encode64bit major value
  -- Otherwise, the Integer is too large for CBOR
  | otherwise = Left OverflowIntKind
  where
    -- Normalizes the value for positive/negative encodings
    normal = normalize value :: a
    -- Upper bounds for supported bitwidths
    max64 = fromIntegral (maxBound :: Word64)
    max32 = fromIntegral (maxBound :: Word32)
    max16 = fromIntegral (maxBound :: Word16)
    max8 = fromIntegral (maxBound :: Word8)
    max5 = 23 -- values > 23 are parameter reserved

-- | Encodes `Integral` values to a CBOR bytestring builder.
{-# INLINE encodeIntKind #-}
encodeIntKind :: forall a. (Integral a) => a -> Okay Builder
encodeIntKind value = encodeIntArgument (majorIntSign value) value

-- | Normalizes the value in `a` and fits the bits to type `b`.
{-# INLINE normalize #-}
normalize :: (Integral a, Integral b) => a -> b
normalize v = fromIntegral $ abs v - majorIntSign v

-- | Encodes a 5-bit CBOR value into argument parmeter data.
{-# INLINE encode5bit #-}
encode5bit :: (Integral a) => MajorArg -> a -> Builder
encode5bit major value = encodeArgument major (normalize value)

-- | Encodes a 8-bit CBOR value.
{-# INLINE encode8bit #-}
encode8bit :: (Integral a) => MajorArg -> a -> Builder
encode8bit major value =
  encodeArgument major paramInt8 <> BSB.word8 normal
  where
    normal = normalize value

-- | Encodes a 16-bit CBOR value.
{-# INLINE encode16bit #-}
encode16bit :: (Integral a) => MajorArg -> a -> Builder
encode16bit major value =
  encodeArgument major paramInt16 <> BSB.word16BE normal
  where
    normal = normalize value

-- | Encodes a 32-bit CBOR value.
{-# INLINE encode32bit #-}
encode32bit :: (Integral a) => MajorArg -> a -> Builder
encode32bit major value =
  encodeArgument major paramInt32 <> BSB.word32BE normal
  where
    normal = normalize value

-- | Encodes a 64-bit CBOR value.
{-# INLINE encode64bit #-}
encode64bit :: (Integral a) => MajorArg -> a -> Builder
encode64bit major value =
  encodeArgument major paramInt64 <> BSB.word64BE normal
  where
    normal = normalize value