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

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

module AuraPlutusExecution
  ( ExUnits(..)
  , ExBudget(..)
  , Term(..)
  , Value(..)
  , EvalError(..)
  , runPlutusScript
  ) where

import Data.Word (Word64)
import qualified Data.Map.Strict as Map

-- 2차원 연산 자원 단위
data ExUnits = ExUnits
  { exCPU :: Word64
  , exMem :: Word64
  } deriving (Eq, Show)

-- 실행 예산 상태
newtype ExBudget = ExBudget { unExBudget :: ExUnits }
  deriving (Eq, Show)

-- UPLC 핵심 람다 항 (Untyped Plutus Core AST)
data Term
  = Var String
  | LamAbs String Term
  | Apply Term Term
  | ConstantInt Integer
  | BuiltinAdd Term Term
  | BuiltinEquals Term Term
  | ErrorTerm
  deriving (Eq, Show)

-- 평가 완료된 런타임 값
data Value
  = VInt Integer
  | VClosure String Term Env
  | VBool Bool
  deriving (Eq, Show)

type Env = Map.Map String Value

-- 평가 지속 컨텍스트 (Kontinuation Stack)
data Kont
  = KDone
  | KApplyL Env Term Kont
  | KApplyR Value Kont
  | KBuiltin1 (Integer -> Value) Kont
  | KBuiltin2 (Integer -> Integer -> Value) Env Term Kont

-- 스크립트 실행 오류
data EvalError
  = ExBudgetExhausted ExUnits
  | VariableNotFound String
  | TypeMismatch String
  | ScriptExplicitError
  deriving (Eq, Show)

-- 순수 상태-에러 모나드
newtype EvalM a = EvalM { runEvalM :: ExBudget -> Either EvalError (a, ExBudget) }

instance Functor EvalM where
  fmap f (EvalM m) = EvalM $ \b -> do
    (a, b') <- m b
    return (f a, b')

instance Applicative EvalM where
  pure a = EvalM $ \b -> Right (a, b)
  (EvalM mf) <*> (EvalM ma) = EvalM $ \b -> do
    (f, b1) <- mf b
    (a, b2) <- ma b1
    return (f a, b2)

instance Monad EvalM where
  (EvalM m) >>= f = EvalM $ \b -> do
    (a, b1) <- m b
    runEvalM (f a) b1

-- 원자적 연산 자원 소비 함수
consumeBudget :: ExUnits -> EvalM ()
consumeBudget (ExUnits cpu mem) = EvalM $ \(ExBudget current) ->
  if exCPU current >= cpu && exMem current >= mem
    then Right ((), ExBudget (ExUnits (exCPU current - cpu) (exMem current - mem)))
    else Left (ExBudgetExhausted current)

-- 기본 연산 스텝 비용 상수
stepCostCPU, stepCostMem :: Word64
stepCostCPU = 1000
stepCostMem = 100

-- CEK 메인 루프: Compute 단계
compute :: Env -> Term -> Kont -> EvalM Value
compute env term k = do
  consumeBudget (ExUnits stepCostCPU stepCostMem)
  case term of
    ConstantInt i -> returnCEK k (VInt i)
    Var x -> case Map.lookup x env of
      Just val -> returnCEK k val
      Nothing  -> EvalM $ \_ -> Left (VariableNotFound x)
    LamAbs x body -> returnCEK k (VClosure x body env)
    Apply f arg -> compute env f (KApplyL env arg k)
    BuiltinAdd t1 t2 -> compute env t1 (KBuiltin2 (\a b -> VInt (a + b)) env t2 k)
    BuiltinEquals t1 t2 -> compute env t1 (KBuiltin2 (\a b -> VBool (a == b)) env t2 k)
    ErrorTerm -> EvalM $ \_ -> Left ScriptExplicitError

-- CEK 메인 루프: Return 단계
returnCEK :: Kont -> Value -> EvalM Value
returnCEK KDone val = pure val
returnCEK (KApplyL env arg k) (VClosure x body cEnv) =
  compute env arg (KApplyR (VClosure x body cEnv) k)
returnCEK (KApplyR (VClosure x body cEnv) k) argVal =
  let extendedEnv = Map.insert x argVal cEnv
  in compute extendedEnv body k
returnCEK (KBuiltin2 op env t2 k) (VInt v1) =
  compute env t2 (KBuiltin1 (op v1) k)
returnCEK (KBuiltin1 op k) (VInt v2) =
  returnCEK k (op v2)
returnCEK _ _ = EvalM $ \_ -> Left (TypeMismatch "비정상적인 Kontinuation 적용")

-- 스크립트 최상위 진입점
runPlutusScript :: Term -> ExUnits -> Either EvalError (Value, ExUnits)
runPlutusScript script initialUnits =
  case runEvalM (compute Map.empty script KDone) (ExBudget initialUnits) of
    Left err -> Left err
    Right (val, ExBudget remaining) -> Right (val, remaining)