Aura Hard Fork Combinator: 무중단 온체인 프로토콜 진화와 타입 레벨 다중 에라(Era) 합성 엔진

{-# LANGUAGE StrictData #-}

module AuraTxMempool
  ( MempoolCapacity(..)
  , MempoolState(..)
  , MempoolError(..)
  , emptyMempool
  , insertTx
  , removeTxs
  , reapBlockBatch
  ) where

import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import Data.Word (Word32, Word64)
import CardanoStateMachine (TxId, TxIn, Tx(..), UTxOSet, validateTx)
import CardanoCoin (Coin, unCoin)

-- 멤풀 용량 한도 파라미터
data MempoolCapacity = MempoolCapacity
  { maxTxCount   :: Word32
  , maxSizeBytes :: Word64
  } deriving (Eq, Show)

-- 불변 멤풀 상태
data MempoolState = MempoolState
  { poolCapacity :: MempoolCapacity
  , poolTxCount  :: Word32
  , poolBytes    :: Word64
  , poolTxs      :: Map.Map TxId (Tx, Word64) -- TxId -> (트랜잭션, 도착 시퀀스)
  , poolSpentIns :: Set.Set TxIn              -- 현재 멤풀이 점유 중인 입력 UTxO 집합
  , nextSequence :: Word64                    -- 공정 선입선출 카운터
  } deriving (Eq, Show)

-- 멤풀 유입 거부 사유
data MempoolError
  = MempoolFull
  | InputAlreadyClaimed TxIn
  | LedgerValidationFailed String
  deriving (Eq, Show)

emptyMempool :: MempoolCapacity -> MempoolState
emptyMempool cap = MempoolState
  { poolCapacity = cap
  , poolTxCount  = 0
  , poolBytes    = 0
  , poolTxs      = Map.empty
  , poolSpentIns = Set.empty
  , nextSequence = 0
  }

-- 순수 트랜잭션 유입 함수: (현재 멤풀, 현재 원장, 신규 TxId, 트랜잭션, 바이트크기) -> Either 에러 신규멤풀
insertTx :: MempoolState 
         -> UTxOSet 
         -> TxId 
         -> Tx 
         -> Word64 
         -> Either MempoolError MempoolState
insertTx pool utxo txId tx txSize = do
  -- 1. 용량 한도 체크
  if poolTxCount pool + 1 > maxTxCount (poolCapacity pool) ||
     poolBytes pool + txSize > maxSizeBytes (poolCapacity pool)
    then Left MempoolFull
    else Right ()

  -- 2. 멤풀 내 기존 트랜잭션과의 UTxO 충돌(이중지불) 검사
  let ins = Set.fromList (txInputs tx)
      conflicts = Set.intersection ins (poolSpentIns pool)
  if not (Set.null conflicts)
    then Left (InputAlreadyClaimed (Set.findMin conflicts))
    else Right ()

  -- 3. 베이스 원장 유효성 검증
  case validateTx utxo tx of
    Left err -> Left (LedgerValidationFailed (show err))
    Right () -> do
      let pool' = pool
            { poolTxCount  = poolTxCount pool + 1
            , poolBytes    = poolBytes pool + txSize
            , poolTxs      = Map.insert txId (tx, nextSequence pool) (poolTxs pool)
            , poolSpentIns = Set.union (poolSpentIns pool) ins
            , nextSequence = nextSequence pool + 1
            }
      Right pool'

-- 최대 블록 바이트 한도 내에서 가장 오래 대기한 트랜잭션들을 순수 추출
reapBlockBatch :: MempoolState -> Word64 -> ([Tx], MempoolState)
reapBlockBatch pool maxBlockBytes =
  let -- 도착 시퀀스 기준 오름차순 정렬
      sortedEntries = foldl insertSorted [] (Map.toList (poolTxs pool))
      (packedTxs, packedIds, totalBytes) = packFIFO sortedEntries maxBlockBytes ([], [], 0)
      pool' = removeTxs pool (Set.fromList packedIds)
  in (packedTxs, pool')
  where
    insertSorted [] item = [item]
    insertSorted (x:xs) item@(_, (_, s2)) =
      let (_, (_, s1)) = x
      in if s2 <= s1 then item : x : xs else x : insertSorted xs item

    packFIFO [] _ acc = acc
    packFIFO ((tId, (tx, _)):rest) limit (txsAcc, idAcc, bytesAcc) =
      let estimatedSize = 500 -- 트랜잭션 평균 표준 크기 바이트
      in if bytesAcc + estimatedSize <= limit
           then packFIFO rest limit (tx : txsAcc, tId : idAcc, bytesAcc + estimatedSize)
           else (txsAcc, idAcc, bytesAcc)

-- 블록에 패킹되거나 확정된 트랜잭션들을 멤풀에서 순수 제거
removeTxs :: MempoolState -> Set.Set TxId -> MempoolState
removeTxs pool txIds =
  let remainingTxs = Map.filterWithKey (\k _ -> not (Set.member k txIds)) (poolTxs pool)
      freedIns = foldl (\acc (tx, _) -> Set.union acc (Set.fromList (txInputs tx))) Set.empty 
                       (Map.filterWithKey (\k _ -> Set.member k txIds) (poolTxs pool))
  in pool
       { poolTxCount  = fromIntegral (Map.size remainingTxs)
       , poolTxs      = remainingTxs
       , poolSpentIns = Set.difference (poolSpentIns pool) freedIns
       }