inter-hub-haskell/Application/Helper/AgentBridge.hs

module Application.Helper.AgentBridge where

-- IHF Phase 11 — Advanced AI Federation (IHUB-WP-0012)
-- Haskell wrapper around scripts/llm_bridge.py (llm-connect subprocess bridge).

import IHP.Prelude
import IHP.ControllerPrelude
import Data.Aeson (object, (.=), encode, decode, Value, FromJSON(..), (.:), (.:?))
import qualified Data.Aeson as A
import qualified Data.ByteString.Lazy as LBS
import System.Process (readProcessWithExitCode)
import System.Exit (ExitCode(..))
import Generated.Types

-- ---------------------------------------------------------------------------
-- Request / response types

data BridgeRequest = BridgeRequest
    { provider     :: !Text
    , model        :: !Text
    , systemPrompt :: !(Maybe Text)
    , prompt       :: !Text
    , maxTokens    :: !Int
    , temperature  :: !Double
    }

data BridgeResponse = BridgeResponse
    { content      :: !Text
    , modelUsed    :: !Text
    , tokensIn     :: !Int
    , tokensOut    :: !Int
    , finishReason :: !Text
    } deriving (Show)

data BridgeError = BridgeError
    { errorMessage :: !Text
    , errorType    :: !Text
    } deriving (Show)

instance FromJSON BridgeResponse where
    parseJSON = A.withObject "BridgeResponse" \o -> BridgeResponse
        <$> o .:  "content"
        <*> o .:  "model"
        <*> o .:  "tokensIn"
        <*> o .:  "tokensOut"
        <*> o .:  "finishReason"

instance FromJSON BridgeError where
    parseJSON = A.withObject "BridgeError" \o -> BridgeError
        <$> o .: "error"
        <*> o .: "errorType"

-- ---------------------------------------------------------------------------
-- Core bridge call

-- | Invoke the llm_bridge.py subprocess with the given request.
callBridge :: BridgeRequest -> IO (Either BridgeError BridgeResponse)
callBridge req = do
    let payload = LBS.toStrict . encode $ object
            [ "provider"     .= req.provider
            , "model"        .= req.model
            , "systemPrompt" .= req.systemPrompt
            , "prompt"       .= req.prompt
            , "maxTokens"    .= req.maxTokens
            , "temperature"  .= req.temperature
            ]
    (exitCode, stdout, stderr) <-
        readProcessWithExitCode "python3" ["scripts/llm_bridge.py"] (cs payload)
    let outBytes = LBS.fromStrict (cs stdout)
    case exitCode of
        ExitSuccess ->
            case decode outBytes of
                Just v  -> pure (Right v)
                Nothing -> pure (Left (BridgeError "Unparseable bridge output" "ParseError"))
        ExitFailure _ ->
            case decode outBytes of
                Just v  -> pure (Left v)
                Nothing -> pure (Left (BridgeError (cs stderr) "BridgeError"))

-- | Call the bridge using an AgentRegistration record.
callAgent :: AgentRegistration -> Text -> IO (Either BridgeError BridgeResponse)
callAgent agent userPrompt =
    callBridge BridgeRequest
        { provider     = agent.provider
        , model        = agent.modelName
        , systemPrompt = agent.systemPrompt
        , prompt       = userPrompt
        , maxTokens    = 2000
        , temperature  = 0.7
        }

-- ---------------------------------------------------------------------------
-- AI governance policy check

-- | Returns True if the agent is allowed to perform the 'propose' action on
-- the given artifact_type in this hub.
-- When no policy exists the default is permissive (True).
checkGovernancePolicy ::
    (?modelContext :: ModelContext) =>
    Id Hub -> Id AgentRegistration -> Text -> IO Bool
checkGovernancePolicy hubId agentId artifactType = do
    mPolicy <- query @AiGovernancePolicy
        |> filterWhere (#hubId, hubId)
        |> filterWhere (#agentRegistrationId, agentId)
        |> filterWhere (#artifactType, artifactType)
        |> filterWhere (#isActive, True)
        |> fetchOneOrNothing
    case mPolicy of
        Nothing -> pure True
        Just p  -> pure ("propose" `elem` jsonArrayTexts p.allowedActions)

-- | Extract Text values from a JSONB array.
jsonArrayTexts :: Value -> [Text]
jsonArrayTexts (A.Array vs) =
    [ t | A.String t <- toList vs ]
jsonArrayTexts _ = []