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

{-# LANGUAGE StrictData #-}
{-# LANGUAGE GADTs #-}

module CardanoKES
  ( Period(..)
  , KESPublicKey(..)
  , KESSecretKey(..)
  , KESSignature(..)
  , evolveKES
  , signKES
  , verifyKES
  ) where

import Data.Word (Word32, Word8)
import CardanoBlake2b (Blake2b256, blake2b256, hashToBytes)

-- 불변 주기 (0부터 2^d - 1까지 단조 증가)
newtype Period = Period Word32
  deriving (Eq, Ord, Show)

-- 마스터 공개키 (32바이트 다이제스트)
newtype KESPublicKey = KESPublicKey Blake2b256
  deriving (Eq, Show)

-- 기저 서명 프리미티브 (Ed25519 스텁)
newtype RawSecret = RawSecret [Word8] deriving (Eq, Show)
newtype RawPublic = RawPublic [Word8] deriving (Eq, Show)
newtype RawSig    = RawSig [Word8]    deriving (Eq, Show)

-- 깊이 d를 재귀적으로 표현하는 합성 KES 비밀키
data KESSecretKey where
  -- 단말 노드: 깊이 0 (단 1회용 기본 키)
  ZeroSK :: Period -> RawSecret -> KESSecretKey
  -- 분기 노드: 좌측 트리 활성 상태 (우측 시드 보관)
  LeftSK  :: Period -> KESSecretKey -> [Word8] -> KESPublicKey -> KESSecretKey
  -- 분기 노드: 좌측 소각 후 우측 트리 활성 상태
  RightSK :: Period -> KESPublicKey -> KESSecretKey -> KESSecretKey

-- 서명 구조체: 단말 서명 + 공존 서브트리 공개키 + 머클 경로 증명
data KESSignature
  = SigLeaf RawSig
  | SigLeft  KESSignature KESPublicKey
  | SigRight KESPublicKey KESSignature
  deriving (Eq, Show)

-- 순수 함수형 키 진화: SK_t -> Maybe SK_{t+1} (수명 초과 시 Nothing)
evolveKES :: KESSecretKey -> Maybe KESSecretKey
evolveKES (ZeroSK _ _) = Nothing -- 단말 키는 자체 진화 불가 (상위 합성자가 제어)

evolveKES (LeftSK (Period p) leftSK rightSeed rightPK) =
  case evolveKES leftSK of
    Just nextLeftSK ->
      Just (LeftSK (Period (p + 1)) nextLeftSK rightSeed rightPK)
    Nothing ->
      let activatedRightSK = deriveSubTree (Period (p + 1)) rightSeed
      in Just (RightSK (Period (p + 1)) (derivePublic leftSK) activatedRightSK)

evolveKES (RightSK (Period p) leftPK rightSK) =
  case evolveKES rightSK of
    Just nextRightSK ->
      Just (RightSK (Period (p + 1)) leftPK nextRightSK)
    Nothing -> Nothing

deriveSubTree :: Period -> [Word8] -> KESSecretKey
deriveSubTree p seed =
  let subSecret = hashToBytes (blake2b256 seed)
  in ZeroSK p (RawSecret subSecret)

derivePublic :: KESSecretKey -> KESPublicKey
derivePublic (ZeroSK _ (RawSecret s)) =
  KESPublicKey (blake2b256 s)
derivePublic (LeftSK _ _ _ pk) = pk
derivePublic (RightSK _ pk _)  = pk

-- 현재 주기에 구속된 결정론적 블록 서명
signKES :: KESSecretKey -> [Word8] -> Maybe KESSignature
signKES (ZeroSK _ (RawSecret sk)) msg =
  Just (SigLeaf (RawSig (hashToBytes (blake2b256 (sk ++ msg)))))

signKES (LeftSK _ leftSK _ rightPK) msg = do
  sig <- signKES leftSK msg
  Just (SigLeft sig rightPK)

signKES (RightSK _ leftPK rightSK) msg = do
  sig <- signKES rightSK msg
  Just (SigRight leftPK sig)

-- 순수 함수형 공개 검증기: verifyKES(PK, Period, Message, Signature)
verifyKES :: KESPublicKey -> Period -> [Word8] -> KESSignature -> Bool
verifyKES (KESPublicKey expectedRoot) (Period p) msg sig =
  case verifyStep p msg sig of
    Just computedRoot -> computedRoot == expectedRoot
    Nothing           -> False
  where
    verifyStep _ m (SigLeaf (RawSig s)) =
      Just (blake2b256 (s ++ m))
    verifyStep period m (SigLeft subSig rPK) = do
      subHash <- verifyStep period m subSig
      Just (combineKESHash (KESPublicKey subHash) rPK)
    verifyStep period m (SigRight lPK subSig) = do
      subHash <- verifyStep period m subSig
      Just (combineKESHash lPK (KESPublicKey subHash))

combineKESHash :: KESPublicKey -> KESPublicKey -> Blake2b256
combineKESHash (KESPublicKey (Blake2b256 h1)) (KESPublicKey (Blake2b256 h2)) =
  blake2b256 (show h1 ++ show h2)