packages feed

louter-0.1.0.0: app/Main.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

-- | Louter proxy server executable
-- Routes requests between different LLM protocols using raw WAI
module Main where

import Control.Applicative ((<|>))
import Control.Monad (foldM, forM_, unless, when, join)
import Control.Monad.IO.Class (liftIO)
import Data.Aeson (Value(..), Object, encode, eitherDecode, object, (.=))
import qualified Data.Aeson.KeyMap as HM
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Char8 as BS8
import Data.ByteString.Builder (Builder, byteString)
import Data.Conduit ((.|), runConduit, await)
import qualified Data.Conduit.List as CL
import qualified Data.HashMap.Strict as HMS
import qualified Data.HashMap.Lazy as HML
import Data.List (sortBy)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Ord (comparing)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.Vector as V
import qualified Network.HTTP.Client as HTTP
import Network.HTTP.Client (Manager, withResponse, brRead)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import Network.HTTP.Types
import Network.Wai
import Network.Wai.Handler.Warp (run)
import Options.Applicative
import System.IO (hFlush, stdout)
import System.Random (randomIO)
import Data.Word (Word64)
import Text.Printf (printf)
import qualified Data.Yaml as Yaml

import Louter.Client (Client, Backend(..), newClient, chatCompletion, streamChat)
import Louter.Client.OpenAI (llamaServerClient, openAIClientWithUrl)
import Louter.Client.Anthropic (anthropicClientWithUrl)
import Louter.Client.Gemini (geminiClientWithUrl)
import Louter.Types.Request (ChatRequest(..), Message(..), MessageRole(..), ContentPart(..), Tool(..), ToolChoice(..))
import Louter.Types.Streaming (StreamEvent(..))
import Louter.Types.ToolFormat (XMLToolCallState, initialXMLState)
import Louter.Protocol.AnthropicConverter
import Louter.Protocol.AnthropicStreaming
import Louter.Protocol.GeminiConverter
import Louter.Protocol.GeminiStreaming
import Louter.Protocol.GeminiStreamingJsonArray
import Louter.Streaming.XMLStreamProcessor (processXMLStream, finalizeXMLState)
import Louter.Backend.OpenAIToAnthropic
import Louter.Backend.OpenAIToGemini

-- | Server configuration from CLI
data ServerConfig = ServerConfig
  { serverPort :: Int
  , serverConfigFile :: FilePath
  } deriving (Show)

-- | Application state
data AppState = AppState
  { appClients :: Map Text Client  -- backend name -> client
  , appConfig :: Config             -- loaded from TOML
  , appPort :: Int
  , appManager :: Manager           -- HTTP client manager for direct proxying
  }

-- | Backend type enumeration
data BackendType
  = BackendTypeOpenAI    -- OpenAI-compatible (including llama-server)
  | BackendTypeAnthropic -- Anthropic Claude API
  | BackendTypeGemini    -- Google Gemini API
  deriving (Show, Eq)

instance Yaml.FromJSON BackendType where
  parseJSON = Yaml.withText "BackendType" $ \t -> case t of
    "openai" -> pure BackendTypeOpenAI
    "anthropic" -> pure BackendTypeAnthropic
    "gemini" -> pure BackendTypeGemini
    other -> fail $ "Unknown backend type: " <> T.unpack other

-- | Simplified config (will expand later)
data Config = Config
  { configBackends :: Map Text BackendConfig
  } deriving (Show)

instance Yaml.FromJSON Config where
  parseJSON = Yaml.withObject "Config" $ \obj -> do
    backends <- obj Yaml..: "backends"
    pure $ Config backends

data BackendConfig = BackendConfig
  { backendType :: BackendType
  , backendUrl :: Text
  , backendApiKey :: Maybe Text
  , backendRequiresAuth :: Bool
  , backendModelMapping :: Map Text Text  -- frontend model -> backend model
  , backendToolFormat :: Text  -- "json" (default) or "xml" (Qwen3-Coder)
  } deriving (Show)

instance Yaml.FromJSON BackendConfig where
  parseJSON = Yaml.withObject "BackendConfig" $ \obj -> do
    btype <- obj Yaml..: "type"
    url <- obj Yaml..: "url"
    apiKey <- obj Yaml..:? "api_key"
    reqAuth <- obj Yaml..: "requires_auth"
    modelMap <- obj Yaml..:? "model_mapping" Yaml..!= Map.empty
    toolFmt <- obj Yaml..:? "tool_format" Yaml..!= "json"
    pure $ BackendConfig btype url apiKey reqAuth modelMap toolFmt

-- | Load config from YAML file
loadConfig :: FilePath -> IO Config
loadConfig path = do
  result <- Yaml.decodeFileEither path
  case result of
    Left err -> do
      putStrLn $ "Error loading config from " <> path <> ":"
      putStrLn $ "  " <> show err
      putStrLn "Using default config with llama-server (no auth)"
      -- Return default config as fallback
      pure $ Config
        { configBackends = Map.fromList
            [("llama-server", BackendConfig
                { backendType = BackendTypeOpenAI
                , backendUrl = "http://localhost:11211"
                , backendApiKey = Nothing
                , backendRequiresAuth = False
                , backendModelMapping = Map.empty
                , backendToolFormat = "json"
                })]
        }
    Right cfg -> pure cfg

-- | CLI parser
serverConfigParser :: Parser ServerConfig
serverConfigParser = ServerConfig
  <$> option auto
      ( long "port"
     <> short 'p'
     <> metavar "PORT"
     <> value 9000
     <> help "Port to listen on" )
  <*> strOption
      ( long "config"
     <> short 'c'
     <> metavar "FILE"
     <> value "config.toml"
     <> help "Configuration file" )

-- | Main entry point
main :: IO ()
main = do
  ServerConfig{..} <- execParser opts
  putStrLn $ "Louter proxy server starting on port " <> show serverPort
  putStrLn $ "Using config file: " <> serverConfigFile

  -- Load config from TOML file
  config <- loadConfig serverConfigFile

  -- Initialize clients and HTTP manager
  clients <- initClients config
  manager <- HTTP.newManager tlsManagerSettings

  let appState = AppState
        { appClients = clients
        , appConfig = config
        , appPort = serverPort
        , appManager = manager
        }

  putStrLn $ "Initialized " <> show (Map.size clients) <> " backend client(s)"
  putStrLn $ "Server ready on http://localhost:" <> show serverPort
  putStrLn ""

  -- Start server
  run serverPort (application appState)
  where
    opts = info (serverConfigParser <**> helper)
      ( fullDesc
     <> progDesc "Multi-protocol LLM proxy server"
     <> header "louter-server - protocol converter for LLM APIs" )

-- | Initialize backend clients from config
initClients :: Config -> IO (Map Text Client)
initClients Config{..} = do
  let backends = Map.toList configBackends
  clients <- mapM initBackend backends
  return $ Map.fromList clients
  where
    initBackend :: (Text, BackendConfig) -> IO (Text, Client)
    initBackend (name, BackendConfig{..}) = do
      client <- case backendType of
        BackendTypeOpenAI ->
          if backendRequiresAuth
            then case backendApiKey of
              Just key -> openAIClientWithUrl key backendUrl
              Nothing -> error $ "Backend '" <> T.unpack name <> "' requires authentication but no api_key provided"
            else llamaServerClient backendUrl

        BackendTypeAnthropic ->
          case backendApiKey of
            Just key -> anthropicClientWithUrl key backendUrl
            Nothing -> error $ "Backend '" <> T.unpack name <> "' (Anthropic) requires authentication but no api_key provided"

        BackendTypeGemini ->
          case backendApiKey of
            Just key -> geminiClientWithUrl key backendUrl
            Nothing -> error $ "Backend '" <> T.unpack name <> "' (Gemini) requires authentication but no api_key provided"

      return (name, client)

-- | Generate a trace ID for request tracking
generateTraceId :: IO Text
generateTraceId = do
  rnd <- randomIO :: IO Word64
  return $ T.pack $ printf "trace-%016x" rnd

-- | Log event in JSON line format
logEvent :: Text -> Text -> Value -> IO ()
logEvent traceId eventType details = do
  let logLine = object
        [ "trace_id" .= traceId
        , "event" .= eventType
        , "details" .= details
        ]
  BS8.putStrLn (BL.toStrict $ encode logLine)
  hFlush stdout

-- | Main WAI application with manual routing
application :: AppState -> Application
application state req respond = do
  -- Generate trace ID for this request
  traceId <- generateTraceId

  let path = pathInfo req
      method = requestMethod req
      pathStr = T.intercalate "/" path

  -- Log incoming request in JSON line format
  logEvent traceId "request_received" $ object
    [ "method" .= TE.decodeUtf8 method
    , "path" .= pathStr
    , "query" .= TE.decodeUtf8 (rawQueryString req)
    ]

  case (method, path) of
    -- Health check
    ("GET", ["health"]) ->
      healthHandler state req respond

    -- OpenAI API
    ("POST", ["v1", "chat", "completions"]) ->
      openAIChatHandler state req respond

    -- Anthropic API
    ("POST", ["v1", "messages"]) ->
      anthropicMessagesHandler state req respond

    -- Gemini API - list models
    ("GET", ["v1beta", "models"]) ->
      geminiListModelsHandler state req respond

    -- Gemini API - model actions (generate/stream)
    ("POST", "v1beta" : "models" : modelPath) ->
      geminiModelActionHandler traceId state modelPath req respond

    -- Diagnostics
    ("GET", ["api", "diagnostics"]) ->
      diagnosticsHandler state req respond

    -- Default 404
    _ -> do
      logEvent traceId "not_found" $ object
        [ "method" .= TE.decodeUtf8 method
        , "path" .= pathStr
        , "available_endpoints" .=
            [ "/health" :: Text
            , "/v1/chat/completions"
            , "/v1/messages"
            , "/v1beta/models"
            , "/v1beta/models/:model:streamGenerateContent"
            , "/v1beta/models/:model:generateContent"
            ]
        ]
      respond $ responseLBS status404
        [("Content-Type", "application/json")]
        (encode $ object
          [ "error" .= object
              [ "code" .= (404 :: Int)
              , "message" .= ("Requested entity was not found." :: Text)
              , "status" .= ("NOT_FOUND" :: Text)
              ]
          ])

-- | /health endpoint
healthHandler :: AppState -> Application
healthHandler _state _req respond =
  respond $ responseLBS status200
    [("Content-Type", "application/json")]
    (encode $ object
      [ "status" .= ("ok" :: Text)
      , "service" .= ("louter" :: Text)
      ])

-- | /v1/chat/completions - OpenAI endpoint
-- Routes to appropriate backend based on configuration
openAIChatHandler :: AppState -> Application
openAIChatHandler state req respond = do
  -- Read request body
  body <- strictRequestBody req

  case eitherDecode body of
    Left err -> respond $ responseLBS status400
      [("Content-Type", "application/json")]
      (encode $ object ["error" .= ("Invalid request: " <> T.pack err :: Text)])

    Right openAIReq -> do
      -- Get first backend (for now - TODO: support backend selection via model name)
      case Map.toList (configBackends $ appConfig state) of
        [] -> respond $ responseLBS status500
          [("Content-Type", "application/json")]
          (encode $ object ["error" .= ("No backend configured" :: Text)])

        ((backendName, backendCfg):_) -> do
          -- Check if streaming is requested
          let isStreaming = getStreamFlag openAIReq

          -- Route based on backend type
          case backendType backendCfg of
            BackendTypeOpenAI ->
              -- Direct OpenAI-compatible backend (no conversion needed)
              if isStreaming
                then handleOpenAIStreamingToOpenAI state backendCfg openAIReq respond
                else handleOpenAINonStreamingToOpenAI state backendCfg openAIReq respond

            BackendTypeAnthropic ->
              -- OpenAI frontend → Anthropic backend (needs conversion)
              if isStreaming
                then handleOpenAIStreamingToAnthropic state backendCfg openAIReq respond
                else handleOpenAINonStreamingToAnthropic state backendCfg openAIReq respond

            BackendTypeGemini ->
              -- OpenAI frontend → Gemini backend (needs conversion)
              if isStreaming
                then handleOpenAIStreamingToGemini state backendCfg openAIReq respond
                else handleOpenAINonStreamingToGemini state backendCfg openAIReq respond

-- ==============================================================================
-- OpenAI Frontend → OpenAI Backend (Direct, No Conversion)
-- ==============================================================================

-- | OpenAI → OpenAI non-streaming
handleOpenAINonStreamingToOpenAI :: AppState -> BackendConfig -> Value -> (Response -> IO ResponseReceived) -> IO ResponseReceived
handleOpenAINonStreamingToOpenAI state backendCfg openAIReq respond = do
  let url = T.unpack $ backendUrl backendCfg <> "/v1/chat/completions"

  -- Create backend request (pass-through, no conversion)
  req <- HTTP.parseRequest ("POST " <> url)
  let req' = req
        { HTTP.requestBody = HTTP.RequestBodyLBS (encode openAIReq)
        , HTTP.requestHeaders = [("Content-Type", "application/json")]
        }

  -- Make synchronous request
  response <- HTTP.httpLbs req' (appManager state)
  respond $ responseLBS (HTTP.responseStatus response)
    [("Content-Type", "application/json")]
    (HTTP.responseBody response)

-- | OpenAI → OpenAI streaming
handleOpenAIStreamingToOpenAI :: AppState -> BackendConfig -> Value -> (Response -> IO ResponseReceived) -> IO ResponseReceived
handleOpenAIStreamingToOpenAI state backendCfg openAIReq respond = do
  let url = T.unpack $ backendUrl backendCfg <> "/v1/chat/completions"

  req <- HTTP.parseRequest ("POST " <> url)
  let req' = req
        { HTTP.requestBody = HTTP.RequestBodyLBS (encode openAIReq)
        , HTTP.requestHeaders = [("Content-Type", "application/json")]
        }

  -- Check if backend uses XML tool format (Qwen3-Coder)
  let usesXML = backendToolFormat backendCfg == "xml"

  let sseResponse = responseStream status200
        [ ("Content-Type", "text/event-stream")
        , ("Cache-Control", "no-cache")
        , ("Connection", "keep-alive")
        ] $ \write flush -> do
          withResponse req' (appManager state) $ \backendResp -> do
            let body = HTTP.responseBody backendResp
            if usesXML
              then streamWithXMLProcessing write flush body
              else streamPassThrough write flush body

  respond sseResponse
  where
    -- Pass-through streaming (no XML processing)
    streamPassThrough write flush body = do
      let loop = do
            chunk <- brRead body
            if BS.null chunk
              then pure ()
              else do
                write (byteString chunk)
                flush
                loop
      loop

    -- XML processing streaming (buffer and convert tool calls)
    streamWithXMLProcessing write flush body = do
      let loop xmlState = do
            chunk <- brRead body
            if BS.null chunk
              then do
                -- End of stream - finalize XML state
                let finalEvents = finalizeXMLState xmlState
                forM_ finalEvents $ \event -> do
                  write (byteString $ eventToSSE event)
                  flush
              else do
                -- Process chunk through XML parser
                let chunkText = TE.decodeUtf8 chunk
                let (newState, events) = processXMLStream xmlState chunkText
                -- Emit converted events as OpenAI SSE
                forM_ events $ \event -> do
                  write (byteString $ eventToSSE event)
                  flush
                loop newState
      loop initialXMLState

-- ==============================================================================
-- OpenAI Frontend → Anthropic Backend (Requires Conversion)
-- ==============================================================================

-- | OpenAI → Anthropic non-streaming
handleOpenAINonStreamingToAnthropic :: AppState -> BackendConfig -> Value -> (Response -> IO ResponseReceived) -> IO ResponseReceived
handleOpenAINonStreamingToAnthropic state backendCfg openAIReq respond = do
  -- Convert OpenAI request to Anthropic format (reverse of anthropicToOpenAI)
  case openAIToAnthropic openAIReq of
    Left err -> respond $ responseLBS status400
      [("Content-Type", "application/json")]
      (encode $ object ["error" .= err])

    Right anthropicReq -> do
      let url = T.unpack $ backendUrl backendCfg <> "/v1/messages"

      req <- HTTP.parseRequest ("POST " <> url)
      let req' = req
            { HTTP.requestBody = HTTP.RequestBodyLBS (encode anthropicReq)
            , HTTP.requestHeaders = [("Content-Type", "application/json")]
            }

      response <- HTTP.httpLbs req' (appManager state)

      -- Convert Anthropic response back to OpenAI format
      case eitherDecode (HTTP.responseBody response) of
        Left err -> respond $ responseLBS status500
          [("Content-Type", "application/json")]
          (encode $ object ["error" .= ("Failed to parse Anthropic response: " <> T.pack err :: Text)])

        Right anthropicResp -> do
          let openAIResp = anthropicToOpenAIResponse anthropicResp
          respond $ responseLBS status200
            [("Content-Type", "application/json")]
            (encode openAIResp)

-- | OpenAI → Anthropic streaming
handleOpenAIStreamingToAnthropic :: AppState -> BackendConfig -> Value -> (Response -> IO ResponseReceived) -> IO ResponseReceived
handleOpenAIStreamingToAnthropic state backendCfg openAIReq respond = do
  case openAIToAnthropic openAIReq of
    Left err -> respond $ responseLBS status400
      [("Content-Type", "application/json")]
      (encode $ object ["error" .= err])

    Right anthropicReq -> do
      let url = T.unpack $ backendUrl backendCfg <> "/v1/messages"

      req <- HTTP.parseRequest ("POST " <> url)
      let req' = req
            { HTTP.requestBody = HTTP.RequestBodyLBS (encode anthropicReq)
            , HTTP.requestHeaders = [("Content-Type", "application/json")]
            }

      -- Stream and convert Anthropic SSE → OpenAI SSE
      let sseResponse = responseStream status200
            [ ("Content-Type", "text/event-stream")
            , ("Cache-Control", "no-cache")
            , ("Connection", "keep-alive")
            ] $ \write flush -> do
              withResponse req' (appManager state) $ \backendResp -> do
                let body = HTTP.responseBody backendResp
                -- TODO: Convert Anthropic SSE events to OpenAI SSE format
                -- For now, pass through (will need proper conversion)
                convertAnthropicToOpenAIStream write flush body

      respond sseResponse

-- ==============================================================================
-- OpenAI Frontend → Gemini Backend (Requires Conversion)
-- ==============================================================================

-- | OpenAI → Gemini non-streaming
handleOpenAINonStreamingToGemini :: AppState -> BackendConfig -> Value -> (Response -> IO ResponseReceived) -> IO ResponseReceived
handleOpenAINonStreamingToGemini state backendCfg openAIReq respond = do
  -- Convert OpenAI request to Gemini format (reverse of geminiToOpenAI)
  case openAIToGemini openAIReq of
    Left err -> respond $ responseLBS status400
      [("Content-Type", "application/json")]
      (encode $ object ["error" .= err])

    Right (modelName, geminiReq) -> do
      let url = T.unpack $ backendUrl backendCfg <> "/v1beta/models/" <> modelName <> ":generateContent"

      req <- HTTP.parseRequest ("POST " <> url)
      let req' = req
            { HTTP.requestBody = HTTP.RequestBodyLBS (encode geminiReq)
            , HTTP.requestHeaders = [("Content-Type", "application/json")]
            }

      response <- HTTP.httpLbs req' (appManager state)

      -- Convert Gemini response back to OpenAI format
      case eitherDecode (HTTP.responseBody response) of
        Left err -> respond $ responseLBS status500
          [("Content-Type", "application/json")]
          (encode $ object ["error" .= ("Failed to parse Gemini response: " <> T.pack err :: Text)])

        Right geminiResp -> do
          let openAIResp = geminiToOpenAIResponse geminiResp
          respond $ responseLBS status200
            [("Content-Type", "application/json")]
            (encode openAIResp)

-- | OpenAI → Gemini streaming
handleOpenAIStreamingToGemini :: AppState -> BackendConfig -> Value -> (Response -> IO ResponseReceived) -> IO ResponseReceived
handleOpenAIStreamingToGemini state backendCfg openAIReq respond = do
  case openAIToGemini openAIReq of
    Left err -> respond $ responseLBS status400
      [("Content-Type", "application/json")]
      (encode $ object ["error" .= err])

    Right (modelName, geminiReq) -> do
      let url = T.unpack $ backendUrl backendCfg <> "/v1beta/models/" <> modelName <> ":streamGenerateContent"

      req <- HTTP.parseRequest ("POST " <> url)
      let req' = req
            { HTTP.requestBody = HTTP.RequestBodyLBS (encode geminiReq)
            , HTTP.requestHeaders = [("Content-Type", "application/json")]
            }

      -- Stream and convert Gemini SSE → OpenAI SSE
      let sseResponse = responseStream status200
            [ ("Content-Type", "text/event-stream")
            , ("Cache-Control", "no-cache")
            , ("Connection", "keep-alive")
            ] $ \write flush -> do
              withResponse req' (appManager state) $ \backendResp -> do
                let body = HTTP.responseBody backendResp
                -- TODO: Convert Gemini SSE events to OpenAI SSE format
                -- For now, pass through (will need proper conversion)
                convertGeminiToOpenAIStream write flush body

      respond sseResponse

-- | Convert StreamEvent to SSE format
eventToSSE :: StreamEvent -> BS.ByteString
eventToSSE event = case event of
  StreamContent txt ->
    "data: " <> BL.toStrict (encode $ object
      [ "choices" .= [object
          [ "delta" .= object ["content" .= txt]
          , "index" .= (0 :: Int)
          ]]
      ]) <> "\n\n"

  StreamReasoning txt ->
    "data: " <> BL.toStrict (encode $ object
      [ "choices" .= [object
          [ "delta" .= object ["reasoning" .= txt]
          , "index" .= (0 :: Int)
          ]]
      ]) <> "\n\n"

  StreamToolCall toolCall ->
    "data: " <> BL.toStrict (encode $ object
      [ "choices" .= [object
          [ "delta" .= object ["tool_calls" .= [toolCall]]
          , "index" .= (0 :: Int)
          ]]
      ]) <> "\n\n"

  StreamFinish reason ->
    "data: " <> BL.toStrict (encode $ object
      [ "choices" .= [object
          [ "finish_reason" .= reason
          , "index" .= (0 :: Int)
          ]]
      ]) <> "\n\n"

  StreamError err ->
    "data: " <> BL.toStrict (encode $ object ["error" .= err]) <> "\n\n"

-- | Extract stream flag from OpenAI request
getStreamFlag :: Value -> Bool
getStreamFlag (Object obj) = case HM.lookup "stream" obj of
  Just (Bool b) -> b
  _ -> False
getStreamFlag _ = False

-- | Parse OpenAI request to ChatRequest
parseOpenAIRequest :: Value -> Either Text ChatRequest
parseOpenAIRequest (Object obj) = do
  -- Extract model
  model <- case HM.lookup "model" obj of
    Just (String m) -> Right m
    _ -> Left "Missing or invalid 'model' field"

  -- Extract messages
  messages <- case HM.lookup "messages" obj of
    Just (Array msgs) -> parseMessages (V.toList msgs)
    _ -> Left "Missing or invalid 'messages' field"

  -- Extract optional fields
  let temperature = case HM.lookup "temperature" obj of
        Just (Number n) -> Just (realToFrac n)
        _ -> Nothing

  let maxTokens = case HM.lookup "max_tokens" obj of
        Just (Number n) -> Just (floor n)
        _ -> Nothing

  let stream = case HM.lookup "stream" obj of
        Just (Bool b) -> b
        _ -> False

  -- Extract tools (if any)
  tools <- case HM.lookup "tools" obj of
    Just (Array ts) -> parseTools (V.toList ts)
    _ -> Right []

  Right ChatRequest
    { reqModel = model
    , reqMessages = messages
    , reqTools = tools
    , reqToolChoice = ToolChoiceAuto
    , reqTemperature = temperature
    , reqMaxTokens = maxTokens
    , reqStream = stream
    }
parseOpenAIRequest _ = Left "Request must be a JSON object"

-- | Parse messages array
parseMessages :: [Value] -> Either Text [Message]
parseMessages = mapM parseMessage
  where
    parseMessage :: Value -> Either Text Message
    parseMessage (Object obj) = do
      role <- case HM.lookup "role" obj of
        Just (String "system") -> Right RoleSystem
        Just (String "user") -> Right RoleUser
        Just (String "assistant") -> Right RoleAssistant
        Just (String "tool") -> Right RoleTool
        _ -> Left "Invalid or missing 'role' field"

      content <- case HM.lookup "content" obj of
        Just (String c) -> Right [TextPart c]
        _ -> Left "Invalid or missing 'content' field"

      Right Message { msgRole = role, msgContent = content }
    parseMessage _ = Left "Message must be a JSON object"

-- | Parse tools array
parseTools :: [Value] -> Either Text [Tool]
parseTools = mapM parseTool
  where
    parseTool :: Value -> Either Text Tool
    parseTool (Object obj) = do
      -- OpenAI tools format: { "type": "function", "function": { ... } }
      function <- case HM.lookup "function" obj of
        Just (Object fn) -> Right fn
        _ -> Left "Missing or invalid 'function' field"

      name <- case HM.lookup "name" function of
        Just (String n) -> Right n
        _ -> Left "Missing or invalid function 'name'"

      let description = case HM.lookup "description" function of
            Just (String d) -> Just d
            _ -> Nothing

      parameters <- case HM.lookup "parameters" function of
        Just params -> Right params
        _ -> Left "Missing 'parameters' field"

      Right Tool
        { toolName = name
        , toolDescription = description
        , toolParameters = parameters
        }
    parseTool _ = Left "Tool must be a JSON object"

-- | /v1/messages - Anthropic endpoint
anthropicMessagesHandler :: AppState -> Application
anthropicMessagesHandler state req respond = do
  -- Read request body
  body <- strictRequestBody req

  case eitherDecode body of
    Left err -> respond $ responseLBS status400
      [("Content-Type", "application/json")]
      (encode $ object ["error" .= ("Invalid Anthropic request: " <> T.pack err :: Text)])

    Right anthropicReq -> do
      -- Get first backend (for now - TODO: support backend selection via model name)
      case Map.toList (configBackends $ appConfig state) of
        [] -> respond $ responseLBS status500
          [("Content-Type", "application/json")]
          (encode $ object ["error" .= ("No backend configured" :: Text)])

        ((backendName, backendCfg):_) -> do
          -- Check if streaming
          let isStreaming = getAnthropicStreamFlag anthropicReq

          if isStreaming
            then handleAnthropicStreaming state backendCfg anthropicReq respond
            else handleAnthropicNonStreaming state backendCfg anthropicReq respond

-- | Get Anthropic stream flag
getAnthropicStreamFlag :: Value -> Bool
getAnthropicStreamFlag (Object obj) = case HM.lookup "stream" obj of
  Just (Bool b) -> b
  _ -> False
getAnthropicStreamFlag _ = False

-- | Handle Anthropic streaming request
handleAnthropicStreaming :: AppState -> BackendConfig -> Value -> (Response -> IO ResponseReceived) -> IO ResponseReceived
handleAnthropicStreaming state backendCfg anthropicReq respond = do
  -- Convert Anthropic request to OpenAI format
  case anthropicToOpenAI anthropicReq of
    Left err -> respond $ responseLBS status400
      [("Content-Type", "application/json")]
      (encode $ object ["error" .= err])

    Right openAIReq -> do
      -- Make request to backend
      let backendUrlStr = T.unpack (backendUrl backendCfg) <> "/v1/chat/completions"

      req <- HTTP.parseRequest ("POST " <> backendUrlStr)
      let req' = req
            { HTTP.requestBody = HTTP.RequestBodyLBS (encode openAIReq)
            , HTTP.requestHeaders = [("Content-Type", "application/json")]
            }

      -- Stream response and convert OpenAI SSE → Anthropic SSE
      let sseResponse = responseStream status200
            [ ("Content-Type", "text/event-stream")
            , ("Cache-Control", "no-cache")
            , ("Connection", "keep-alive")
            ] $ \write flush -> do
              withResponse req' (appManager state) $ \backendResp -> do
                let body = HTTP.responseBody backendResp
                -- Convert OpenAI chunks to Anthropic events
                convertOpenAIToAnthropic write flush body

      respond sseResponse

-- | Handle Anthropic non-streaming request
handleAnthropicNonStreaming :: AppState -> BackendConfig -> Value -> (Response -> IO ResponseReceived) -> IO ResponseReceived
handleAnthropicNonStreaming state backendCfg anthropicReq respond = do
  case anthropicToOpenAI anthropicReq of
    Left err -> respond $ responseLBS status400
      [("Content-Type", "application/json")]
      (encode $ object ["error" .= err])

    Right openAIReq -> do
      let backendUrlStr = T.unpack (backendUrl backendCfg) <> "/v1/chat/completions"

      req <- HTTP.parseRequest ("POST " <> backendUrlStr)
      let req' = req
            { HTTP.requestBody = HTTP.RequestBodyLBS (encode openAIReq)
            , HTTP.requestHeaders = [("Content-Type", "application/json")]
            }

      response <- HTTP.httpLbs req' (appManager state)

      -- Convert OpenAI response to Anthropic format
      case eitherDecode (HTTP.responseBody response) of
        Left err -> respond $ responseLBS status500
          [("Content-Type", "application/json")]
          (encode $ object ["error" .= ("Failed to parse backend response: " <> T.pack err :: Text)])

        Right openAIResp -> do
          let anthropicResp = openAIResponseToAnthropic openAIResp
          respond $ responseLBS status200
            [("Content-Type", "application/json")]
            (encode anthropicResp)

-- Anthropic conversion functions and streaming now imported from library modules

-- ==============================================================================
-- Gemini API Handlers
-- ==============================================================================

-- | Handle Gemini streaming request
-- Supports two formats based on ?alt= parameter:
-- - alt=sse (default): Server-Sent Events format
-- - alt=json: JSON array format
handleGeminiStreaming :: Text -> AppState -> BackendConfig -> Text -> Value -> Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived
handleGeminiStreaming traceId state backendCfg modelName geminiReq req respond = do
  -- Detect streaming format from query parameter
  let queryParams = queryString req
      altParam = lookup "alt" queryParams
      streamFormat :: BS.ByteString
      streamFormat = case altParam of
        Just (Just "json") -> "json"
        Just (Just "sse") -> "sse"
        _ -> "sse"  -- Default to SSE for backward compatibility

  logEvent traceId "stream_format_detected" $ object
    [ "format" .= TE.decodeUtf8 streamFormat
    , "alt_param" .= (TE.decodeUtf8 <$> join altParam :: Maybe Text)
    ]

  case geminiToOpenAI modelName True geminiReq of
    Left err -> do
      logEvent traceId "gemini_to_openai_error" $ object
        [ "error" .= err
        , "model" .= modelName
        ]
      respond $ responseLBS status400
        [("Content-Type", "application/json")]
        (encode $ object ["error" .= err])

    Right openAIReq -> do
      -- Create backend HTTP request
      let backendUrlStr = T.unpack (backendUrl backendCfg) <> "/v1/chat/completions"

      -- Log converted OpenAI request
      logEvent traceId "openai_request" $ object
        [ "backend_url" .= backendUrlStr
        , "request" .= openAIReq
        , "streaming" .= True
        , "format" .= TE.decodeUtf8 streamFormat
        ]

      backendReq <- HTTP.parseRequest ("POST " <> backendUrlStr)
      let backendReq' = backendReq
            { HTTP.requestBody = HTTP.RequestBodyLBS (encode openAIReq)
            , HTTP.requestHeaders = [("Content-Type", "application/json")]
            }

      -- Choose response format based on alt= parameter
      case streamFormat of
        "json" -> handleJsonArrayStreaming traceId backendReq' state respond
        _ -> handleSSEStreaming traceId backendReq' state respond

-- | Handle SSE format streaming (default)
handleSSEStreaming :: Text -> HTTP.Request -> AppState -> (Response -> IO ResponseReceived) -> IO ResponseReceived
handleSSEStreaming traceId backendReq state respond = do
  let streamResponse = responseStream status200
        [ ("Content-Type", "text/event-stream; charset=utf-8")
        , ("Cache-Control", "no-cache")
        , ("Connection", "keep-alive")
        ] $ \write flush -> do
          withResponse backendReq (appManager state) $ \backendResp -> do
            let body = HTTP.responseBody backendResp
                statusCode = HTTP.responseStatus backendResp

            -- Log backend response status
            logEvent traceId "backend_response" $ object
              [ "status" .= show statusCode
              , "streaming" .= True
              , "format" .= ("sse" :: Text)
              ]

            -- Convert OpenAI SSE to Gemini SSE
            convertOpenAIToGeminiStream write flush body

  logEvent traceId "streaming_started" $ object
    [ "status" .= ("ok" :: Text)
    , "format" .= ("sse" :: Text)
    ]
  respond streamResponse

-- | Handle JSON array format streaming (alt=json)
-- Streams an incremental JSON array: [{"candidates":[...]},{"candidates":[...]},...]
handleJsonArrayStreaming :: Text -> HTTP.Request -> AppState -> (Response -> IO ResponseReceived) -> IO ResponseReceived
handleJsonArrayStreaming traceId backendReq state respond = do
  let streamResponse = responseStream status200
        [ ("Content-Type", "application/json; charset=utf-8")
        , ("Cache-Control", "no-cache")
        ] $ \write flush -> do
          withResponse backendReq (appManager state) $ \backendResp -> do
            let body = HTTP.responseBody backendResp
                statusCode = HTTP.responseStatus backendResp

            -- Log backend response status
            logEvent traceId "backend_response" $ object
              [ "status" .= show statusCode
              , "streaming" .= True
              , "format" .= ("json" :: Text)
              ]

            -- Convert OpenAI SSE to Gemini JSON array (incremental)
            convertOpenAIToGeminiJsonArray write flush body

  logEvent traceId "streaming_started" $ object
    [ "status" .= ("ok" :: Text)
    , "format" .= ("json" :: Text)
    ]
  respond streamResponse

-- | Handle Gemini non-streaming request
handleGeminiNonStreaming :: Text -> AppState -> BackendConfig -> Text -> Value -> (Response -> IO ResponseReceived) -> IO ResponseReceived
handleGeminiNonStreaming traceId state backendCfg modelName geminiReq respond = do
  case geminiToOpenAI modelName False geminiReq of
    Left err -> do
      logEvent traceId "gemini_to_openai_error" $ object
        [ "error" .= err
        , "model" .= modelName
        ]
      respond $ responseLBS status400
        [("Content-Type", "application/json")]
        (encode $ object ["error" .= err])

    Right openAIReq -> do
      -- Create backend HTTP request
      let backendUrlStr = T.unpack (backendUrl backendCfg) <> "/v1/chat/completions"

      -- Log converted OpenAI request
      logEvent traceId "openai_request" $ object
        [ "backend_url" .= backendUrlStr
        , "request" .= openAIReq
        , "streaming" .= False
        ]

      req <- HTTP.parseRequest ("POST " <> backendUrlStr)
      let req' = req
            { HTTP.requestBody = HTTP.RequestBodyLBS (encode openAIReq)
            , HTTP.requestHeaders = [("Content-Type", "application/json")]
            }

      -- Make synchronous request
      httpResp <- HTTP.httpLbs req' (appManager state)
      let responseBody' = HTTP.responseBody httpResp
          statusCode = HTTP.responseStatus httpResp

      -- Log backend response status
      logEvent traceId "backend_response" $ object
        [ "status" .= show statusCode
        , "body_length" .= BL.length responseBody'
        ]

      -- Convert OpenAI response to Gemini format
      case eitherDecode responseBody' of
        Left err -> do
          logEvent traceId "backend_parse_error" $ object
            [ "error" .= T.pack err
            , "body_preview" .= T.take 200 (TE.decodeUtf8 (BL.toStrict responseBody'))
            ]
          respond $ responseLBS status500
            [("Content-Type", "application/json")]
            (encode $ object ["error" .= ("Failed to parse backend response: " <> T.pack err :: Text)])

        Right openAIResp -> do
          logEvent traceId "response_success" $ object
            [ "status" .= ("ok" :: Text)
            ]
          respond $ responseLBS status200
            [("Content-Type", "application/json")]
            (encode $ openAIResponseToGemini openAIResp)

-- | Handle Gemini countTokens request
handleCountTokens :: Text -> AppState -> BackendConfig -> Text -> Value -> (Response -> IO ResponseReceived) -> IO ResponseReceived
handleCountTokens traceId state backendCfg modelName geminiReq respond = do
  -- Log countTokens request
  logEvent traceId "count_tokens_request" $ object
    [ "model" .= modelName
    , "request" .= geminiReq
    ]

  case geminiToOpenAI modelName False geminiReq of
    Left err -> do
      logEvent traceId "gemini_to_openai_error" $ object ["error" .= err]
      respond $ responseLBS status400
        [("Content-Type", "application/json")]
        (encode $ object ["error" .= err])

    Right openAIReq -> do
      -- Estimate tokens from the OpenAI request
      let totalTokens = estimateTokensFromRequest openAIReq

      -- Log token count result
      logEvent traceId "count_tokens_result" $ object
        [ "model" .= modelName
        , "total_tokens" .= totalTokens
        ]

      -- Return Gemini countTokens response format
      respond $ responseLBS status200
        [("Content-Type", "application/json")]
        (encode $ object ["totalTokens" .= totalTokens])

-- | Estimate tokens from an OpenAI request
-- Simple heuristic: ~4 characters per token
estimateTokensFromRequest :: Value -> Int
estimateTokensFromRequest (Object obj) =
  let messagesTokens = case HM.lookup "messages" obj of
        Just (Array msgs) -> sum $ map estimateTokensFromMessage (V.toList msgs)
        _ -> 0
      toolsTokens = case HM.lookup "tools" obj of
        Just (Array tools) -> sum $ map estimateTokensFromValue (V.toList tools)
        _ -> 0
  in max 1 (messagesTokens + toolsTokens)
estimateTokensFromRequest _ = 1

-- | Estimate tokens from a single message
estimateTokensFromMessage :: Value -> Int
estimateTokensFromMessage (Object msg) =
  case HM.lookup "content" msg of
    Just (String txt) -> estimateTokensFromText txt
    Just val -> estimateTokensFromValue val
    Nothing -> 0
estimateTokensFromMessage _ = 0

-- | Estimate tokens from text
estimateTokensFromText :: Text -> Int
estimateTokensFromText txt = max 1 ((T.length txt + 3) `div` 4)

-- | Estimate tokens from any JSON value
estimateTokensFromValue :: Value -> Int
estimateTokensFromValue (String txt) = estimateTokensFromText txt
estimateTokensFromValue (Array arr) = sum $ map estimateTokensFromValue (V.toList arr)
estimateTokensFromValue (Object obj) = sum $ map estimateTokensFromValue (HM.elems obj)
estimateTokensFromValue _ = 1

-- Gemini conversion functions and streaming now imported from library modules

-- | /v1beta/models - Gemini list models
geminiListModelsHandler :: AppState -> Application
geminiListModelsHandler _state _req respond =
  respond $ responseLBS status501
    [("Content-Type", "application/json")]
    (encode $ object ["error" .= ("Gemini list models not yet implemented" :: Text)])

-- | /v1beta/models/:model:action - Gemini model actions
geminiModelActionHandler :: Text -> AppState -> [Text] -> Application
geminiModelActionHandler traceId state modelPath req respond = do
  -- Parse model and action from path
  -- Path format: ["model-name:streamGenerateContent"] or ["model-name:generateContent"]
  case modelPath of
    [] -> do
      logEvent traceId "error" $ object ["message" .= ("Missing model path" :: Text)]
      respond $ responseLBS status400
        [("Content-Type", "application/json")]
        (encode $ object ["error" .= ("Missing model path" :: Text)])

    (fullPath:_) -> do
      -- Split on ':' to get model and action
      let parts = T.splitOn ":" fullPath
      case parts of
        [modelName, action] -> do
          -- Read request body
          body <- strictRequestBody req

          -- Log incoming Gemini request
          case eitherDecode body of
            Left err -> do
              logEvent traceId "request_parse_error" $ object
                [ "error" .= T.pack err
                , "body_size" .= BL.length body
                ]
              respond $ responseLBS status400
                [("Content-Type", "application/json")]
                (encode $ object ["error" .= ("Invalid Gemini request: " <> T.pack err :: Text)])

            Right geminiReq -> do
              -- Get first backend (for now - TODO: support backend selection via model name)
              case Map.toList (configBackends $ appConfig state) of
                [] -> do
                  logEvent traceId "error" $ object ["message" .= ("No backend configured" :: Text)]
                  respond $ responseLBS status500
                    [("Content-Type", "application/json")]
                    (encode $ object ["error" .= ("No backend configured" :: Text)])

                ((backendName, backendCfg):_) -> do
                  -- Log parsed Gemini request
                  logEvent traceId "gemini_request_parsed" $ object
                    [ "model" .= modelName
                    , "action" .= action
                    , "request" .= geminiReq
                    ]

                  case action of
                    "streamGenerateContent" -> handleGeminiStreaming traceId state backendCfg modelName geminiReq req respond
                    "generateContent" -> handleGeminiNonStreaming traceId state backendCfg modelName geminiReq respond
                    "countTokens" -> handleCountTokens traceId state backendCfg modelName geminiReq respond
                _ -> do
                  logEvent traceId "error" $ object
                    [ "message" .= ("Unsupported action" :: Text)
                    , "action" .= action
                    ]
                  respond $ responseLBS status400
                    [("Content-Type", "application/json")]
                    (encode $ object ["error" .= ("Unsupported action: " <> action :: Text)])

        _ -> do
          logEvent traceId "error" $ object
            [ "message" .= ("Invalid model path format" :: Text)
            , "path" .= fullPath
            ]
          respond $ responseLBS status400
            [("Content-Type", "application/json")]
            (encode $ object ["error" .= ("Invalid model path format" :: Text)])

-- | /api/diagnostics endpoint
diagnosticsHandler :: AppState -> Application
diagnosticsHandler state _req respond =
  respond $ responseLBS status200
    [("Content-Type", "application/json")]
    (encode $ object
      [ "status" .= ("ok" :: Text)
      , "backends" .= Map.keys (appClients state)
      , "port" .= appPort state
      ])