marlborg-worm / hardware /clash /WormChainInterface.hs

push from SNAPKITTYWEST/marlborg-worm

75619b0 verified about 2 months ago

2.95 kB

--
-- Copyright (c) 2026 BEL ESPRIT D ACCORD TRUST HOLDINGS INC
-- All rights reserved.

{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

module MarlborgWorm.Hardware.WormChainInterface
  ( wormChainInterface
  , topEntity
  ) where

import Clash.Prelude

type BlockSize = 512    -- 64 bytes = 512 bits
type HashSize = 256     -- SHA3-256 = 256 bits
type ChainDepth = 100   -- Maximum chain length

data WormChainState = WormChainState
  { chainLength :: Unsigned 8
  , lastHash    :: BitVector HashSize
  , chainValid  :: Bool
  } deriving (Show, Eq, Generic, NFDataX)

initialChainState :: WormChainState
initialChainState = WormChainState
  { chainLength = 0
  , lastHash    = 0
  , chainValid  = True
  }

-- | Simplified hash function for hardware (XOR-fold)
-- In production: replace with SHA3-256 hardware core
simpleHash :: BitVector HashSize -> BitVector BlockSize -> BitVector HashSize
simpleHash prevHash payload =
  let upper = truncateB payload :: BitVector HashSize
      lower = truncateB (payload `shiftR` 256) :: BitVector HashSize
  in prevHash `xor` upper `xor` lower

chainStep :: WormChainState
          -> (Bit, BitVector BlockSize)
          -> (WormChainState, (Bool, BitVector HashSize))
chainStep st (appendValid, newPayload) =
  if appendValid == high && chainLength st < fromIntegral (natVal (Proxy @ChainDepth))
    then let newHash = simpleHash (lastHash st) newPayload
             newState = WormChainState
               { chainLength = chainLength st + 1
               , lastHash    = newHash
               , chainValid  = True
               }
         in (newState, (True, newHash))
    else (st, (chainValid st, lastHash st))

-- | WORM chain interface
wormChainInterface
  :: Clock System
  -> Reset System
  -> Enable System
  -> Signal System Bit
  -> Signal System (BitVector BlockSize)
  -> Signal System (Bool, BitVector HashSize)
wormChainInterface clk rst en appendValid newPayload =
  mealy clk rst en chainStep initialChainState
    (bundle (appendValid, newPayload))

topEntity
  :: Clock System
  -> Reset System
  -> Enable System
  -> Signal System Bit
  -> Signal System (BitVector BlockSize)
  -> Signal System (Bool, BitVector HashSize)
topEntity = wormChainInterface
{-# ANN topEntity
  (Synthesize
    { t_name   = "WormChainInterface"
    , t_inputs = [ PortName "clk"
                 , PortName "rst"
                 , PortName "en"
                 , PortName "appendValid"
                 , PortName "newPayload"
                 ]
    , t_output = PortProduct ""
                   [ PortName "chainValid"
                   , PortName "currentHash"
                   ]
    }) #-}

	--
	-- Copyright (c) 2026 BEL ESPRIT D ACCORD TRUST HOLDINGS INC
	-- All rights reserved.

	{-# LANGUAGE BinaryLiterals #-}
	{-# LANGUAGE DataKinds #-}
	{-# LANGUAGE KindSignatures #-}
	{-# LANGUAGE NumericUnderscores #-}
	{-# LANGUAGE ScopedTypeVariables #-}
	{-# LANGUAGE TypeApplications #-}
	{-# LANGUAGE TypeFamilies #-}
	{-# LANGUAGE TypeOperators #-}

	module MarlborgWorm.Hardware.WormChainInterface
	( wormChainInterface
	, topEntity
	) where

	import Clash.Prelude

	type BlockSize = 512 -- 64 bytes = 512 bits
	type HashSize = 256 -- SHA3-256 = 256 bits
	type ChainDepth = 100 -- Maximum chain length

	data WormChainState = WormChainState
	{ chainLength :: Unsigned 8
	, lastHash :: BitVector HashSize
	, chainValid :: Bool
	} deriving (Show, Eq, Generic, NFDataX)

	initialChainState :: WormChainState
	initialChainState = WormChainState
	{ chainLength = 0
	, lastHash = 0
	, chainValid = True
	}

	-- \| Simplified hash function for hardware (XOR-fold)
	-- In production: replace with SHA3-256 hardware core
	simpleHash :: BitVector HashSize -> BitVector BlockSize -> BitVector HashSize
	simpleHash prevHash payload =
	let upper = truncateB payload :: BitVector HashSize
	lower = truncateB (payload `shiftR` 256) :: BitVector HashSize
	in prevHash `xor` upper `xor` lower

	chainStep :: WormChainState
	-> (Bit, BitVector BlockSize)
	-> (WormChainState, (Bool, BitVector HashSize))
	chainStep st (appendValid, newPayload) =
	if appendValid == high && chainLength st < fromIntegral (natVal (Proxy @ChainDepth))
	then let newHash = simpleHash (lastHash st) newPayload
	newState = WormChainState
	{ chainLength = chainLength st + 1
	, lastHash = newHash
	, chainValid = True
	}
	in (newState, (True, newHash))
	else (st, (chainValid st, lastHash st))

	-- \| WORM chain interface
	wormChainInterface
	:: Clock System
	-> Reset System
	-> Enable System
	-> Signal System Bit
	-> Signal System (BitVector BlockSize)
	-> Signal System (Bool, BitVector HashSize)
	wormChainInterface clk rst en appendValid newPayload =
	mealy clk rst en chainStep initialChainState
	(bundle (appendValid, newPayload))

	topEntity
	:: Clock System
	-> Reset System
	-> Enable System
	-> Signal System Bit
	-> Signal System (BitVector BlockSize)
	-> Signal System (Bool, BitVector HashSize)
	topEntity = wormChainInterface
	{-# ANN topEntity
	(Synthesize
	{ t_name = "WormChainInterface"
	, t_inputs = [ PortName "clk"
	, PortName "rst"
	, PortName "en"
	, PortName "appendValid"
	, PortName "newPayload"
	]
	, t_output = PortProduct ""
	[ PortName "chainValid"
	, PortName "currentHash"
	]
	}) #-}