--
-- 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"
                   ]
    }) #-}