{-| Module : KAR.PolicyEngine Description : محرك السياسة الرئيسي | Main Policy Engine Copyright : (c) Ahmad Ali Parr, 2026 License : Proprietary Maintainer : ahmedparr93@gmail.com Core policy evaluation engine. Evaluates intents against: - Resource constraints (memory, CPU, thermal) - Trust verification (nonce validation) - Priority enforcement - System load balancing التقييم الرئيسي للسياسات في نظام KAR -} module KAR.PolicyEngine ( evaluateIntent , PolicyContext(..) , defaultPolicyContext ) where import KAR.Types.Intent import KAR.Types.Decision import KAR.Types.Resource import KAR.ResourceNegotiator (negotiateResources) import KAR.TrustVerifier (verifyTrustNonce) import Data.Text (Text) import qualified Data.Text as T -- | Policy evaluation context data PolicyContext = PolicyContext { systemResources :: !SystemResources , globalConstraints :: !ResourceConstraints , enforceTrust :: !Bool , allowOvercommit :: !Bool } deriving (Eq, Show) -- | Default policy context (strict enforcement) defaultPolicyContext :: SystemResources -> PolicyContext defaultPolicyContext sys = PolicyContext { systemResources = sys , globalConstraints = ResourceConstraints { maxMemoryBytes = 1024 * 1024 * 1024 -- 1GB per intent , maxCpuShares = 100 -- 100% of one core , maxTempCelsius = 85 -- 85°C thermal limit } , enforceTrust = True , allowOvercommit = False } -- | Main policy evaluation function -- نقطة الدخول الرئيسية لتقييم السياسات evaluateIntent :: PolicyContext -> Intent -> PolicyDecision evaluateIntent ctx intent = -- Step 1: Verify trust nonce (if enforcement enabled) case (enforceTrust ctx, verifyTrustNonce (trustNonce intent) intent) of (True, False) -> PolicyDecision { decisionOutcome = Reject "Trust nonce validation failed" , resourceAlloc = Nothing , recoveryStrategy = GracefulFail , estimatedCostNs = 0 , trustVerified = False , policyReason = "ETRUST_NONCE_FAIL: Cryptographic validation rejected" } _ -> do -- Step 2: Check priority constraints let priorityOk = checkPriorityConstraints ctx intent if not priorityOk then rejectPriority ctx intent else do -- Step 3: Negotiate resources case negotiateResources (systemResources ctx) (globalConstraints ctx) intent of Nothing -> PolicyDecision { decisionOutcome = Reject "Resource negotiation failed" , resourceAlloc = Nothing , recoveryStrategy = RetryWithBackoff 1000 -- Retry in 1s , estimatedCostNs = 0 , trustVerified = True , policyReason = "EKAR_POLICY_REJECT: Insufficient resources" } Just alloc -> let cost = executionCost alloc in PolicyDecision { decisionOutcome = Approve , resourceAlloc = Just alloc , recoveryStrategy = RetryImmediate , estimatedCostNs = cost , trustVerified = True , policyReason = formatApprovalReason intent alloc } -- | Check priority-specific constraints -- التحقق من قيود الأولوية checkPriorityConstraints :: PolicyContext -> Intent -> Bool checkPriorityConstraints ctx intent = case intentPriority intent of Critical -> -- Critical intents always allowed (preemptive) True High -> -- High priority requires <80% CPU load cpuLoad (cpuState (systemResources ctx)) < 0.8 Normal -> -- Normal requires <90% CPU load cpuLoad (cpuState (systemResources ctx)) < 0.9 Background -> -- Background only if <50% CPU load cpuLoad (cpuState (systemResources ctx)) < 0.5 -- | Reject intent due to priority constraints rejectPriority :: PolicyContext -> Intent -> PolicyDecision rejectPriority ctx intent = let reason = T.pack $ "Priority " ++ show (intentPriority intent) ++ " rejected: CPU load " ++ show (cpuLoad (cpuState (systemResources ctx))) in PolicyDecision { decisionOutcome = Defer 500 -- Defer 500ms , resourceAlloc = Nothing , recoveryStrategy = RetryWithBackoff 500 , estimatedCostNs = 0 , trustVerified = True , policyReason = reason } -- | Format approval reason string formatApprovalReason :: Intent -> ResourceAllocation -> Text formatApprovalReason intent alloc = T.pack $ "Approved: " ++ show (intentType intent) ++ " | Memory: " ++ show (allocMemoryBytes alloc `div` 1024) ++ "KB" ++ " | CPU: " ++ show (allocCpuShares alloc) ++ " shares" ++ " | Timeout: " ++ show (allocTimeout alloc) ++ "ms"