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

{-# LANGUAGE StrictData #-}

module AuraPeerGovernor
  ( PeerId(..)
  , PeerStatus(..)
  , PeerMetrics(..)
  , GovernorTargets(..)
  , GovernorState(..)
  , PeerAction(..)
  , updateGovernor
  ) where

import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import Data.Word (Word32, Word64)

newtype PeerId = PeerId String
  deriving (Eq, Ord, Show)

data PeerStatus = StatusCold | StatusWarm | StatusHot
  deriving (Eq, Show)

-- 피어 평판 수치 (불변 지표)
data PeerMetrics = PeerMetrics
  { metricLatencyMs       :: Word32
  , metricBlocksDelivered :: Word32
  , metricInvalidPackets  :: Word32
  , metricLastActiveSlot  :: Word64
  } deriving (Eq, Show)

-- 거버너 유지 목표치
data GovernorTargets = GovernorTargets
  { targetNumberOfCold :: Int
  , targetNumberOfWarm :: Int
  , targetNumberOfHot  :: Int
  } deriving (Eq, Show)

-- 불변 전역 P2P 위상 상태
data GovernorState = GovernorState
  { targets     :: GovernorTargets
  , knownPeers  :: Map.Map PeerId PeerMetrics
  , coldPeers   :: Set.Set PeerId
  , warmPeers   :: Set.Set PeerId
  , hotPeers    :: Set.Set PeerId
  , blacklisted :: Set.Set PeerId
  } deriving (Eq, Show)

-- 순수 로직이 상위 I/O 실행기에게 요청하는 불변 액션
data PeerAction
  = EstablishTCP PeerId
  | CloseTCP PeerId
  | ActivateHotProtocols PeerId
  | DeactivateToWarm PeerId
  | BanPeer PeerId
  deriving (Eq, Show)

-- 순수 평판 계산: 점수가 높을수록 Hot 유지 가치가 높음
calculateScore :: PeerMetrics -> Int
calculateScore m
  | metricInvalidPackets m > 0 = -999999 -- 악의적 행위 즉시 퇴출
  | otherwise =
      let deliveryBonus = fromIntegral (metricBlocksDelivered m) * 100
          latencyPenalty = fromIntegral (metricLatencyMs m)
      in deliveryBonus - latencyPenalty

-- 상태별 피어를 점수순으로 정렬
rankPeers :: GovernorState -> Set.Set PeerId -> [PeerId]
rankPeers state peerSet =
  let peerList = Set.toList peerSet
      getScore pid = maybe (-1) calculateScore (Map.lookup pid (knownPeers state))
  in foldl insertByScore [] peerList
  where
    insertByScore [] p = [p]
    insertByScore (x:xs) p
      | getScore p >= getScore x = p : x : xs
      | otherwise = x : insertByScore xs p

-- 순수 전이 함수: (현재 상태) -> (새로운 상태, 실행할 I/O 액션들)
updateGovernor :: GovernorState -> (GovernorState, [PeerAction])
updateGovernor state =
  let (state1, actions1) = handleBans state
      (state2, actions2) = adjustHotPeers state1
      (state3, actions3) = adjustWarmPeers state2
  in (state3, actions1 ++ actions2 ++ actions3)

-- 1. 비정상 패킷 전송 피어 즉각 차단
handleBans :: GovernorState -> (GovernorState, [PeerAction])
handleBans st =
  let malPeers = Map.keysSet $ Map.filter (\m -> metricInvalidPackets m > 0) (knownPeers st)
      actions  = map BanPeer (Set.toList malPeers)
      st' = st
        { hotPeers    = hotPeers st `Set.difference` malPeers
        , warmPeers   = warmPeers st `Set.difference` malPeers
        , coldPeers   = coldPeers st `Set.difference` malPeers
        , blacklisted = blacklisted st `Set.union` malPeers
        }
  in (st', actions)

-- 2. Hot 피어 수량 조절 (부족 시 Warm에서 승격, 초과 시 강등)
adjustHotPeers :: GovernorState -> (GovernorState, [PeerAction])
adjustHotPeers st =
  let currentHotCount = Set.size (hotPeers st)
      targetHot       = targetNumberOfHot (targets st)
  in if currentHotCount < targetHot
       then promoteWarmToHot (targetHot - currentHotCount) st
       else (st, [])

promoteWarmToHot :: Int -> GovernorState -> (GovernorState, [PeerAction])
promoteWarmToHot needed st =
  let candidates = take needed (rankPeers st (warmPeers st))
      candSet    = Set.fromList candidates
      actions    = map ActivateHotProtocols candidates
      st' = st
        { warmPeers = warmPeers st `Set.difference` candSet
        , hotPeers  = hotPeers st `Set.union` candSet
        }
  in (st', actions)

-- 3. Warm 피어 수량 조절 (소켓 풀 유지)
adjustWarmPeers :: GovernorState -> (GovernorState, [PeerAction])
adjustWarmPeers st =
  let currentWarmCount = Set.size (warmPeers st)
      targetWarm       = targetNumberOfWarm (targets st)
  in if currentWarmCount < targetWarm
       then promoteColdToWarm (targetWarm - currentWarmCount) st
       else (st, [])

promoteColdToWarm :: Int -> GovernorState -> (GovernorState, [PeerAction])
promoteColdToWarm needed st =
  let candidates = take needed (Set.toList (coldPeers st))
      candSet    = Set.fromList candidates
      actions    = map EstablishTCP candidates
      st' = st
        { coldPeers = coldPeers st `Set.difference` candSet
        , warmPeers = warmPeers st `Set.union` candSet
        }
  in (st', actions)