Initial commit

.gitea/workflows/pr-review.yml

@@ -0,0 +1,37 @@
+name: Claude PR Bot
+
+on:
+  issue_comment:
+    types: [created]
+  pull_request:
+    types: [opened, synchronize, ready_for_review, reopened]
+  pull_request_review:
+    types: [submitted]
+  pull_request_review_comment:
+    types: [created]
+
+jobs:
+  claude-bot:
+    runs-on: native
+    if: >-
+      (github.event_name == 'pull_request') ||
+      (github.event_name == 'pull_request_review') ||
+      (github.event_name == 'pull_request_review_comment') ||
+      (github.event_name == 'issue_comment' && github.event.issue.pull_request)
+    steps:
+      - uses: actions/checkout@v4
+
+      - name: Install Claude Code CLI
+        run: curl -fsSL https://claude.ai/install.sh | bash
+
+      - name: Download os-ai-pr-bot
+        run: |
+          curl -fsSL -o /usr/local/bin/os-ai-pr-bot \
+            "${GITHUB_SERVER_URL}/api/v1/repos/${GITHUB_REPOSITORY}/releases/latest/assets/os-ai-pr-bot" \
+            -H "Authorization: token ${GITHUB_TOKEN}"
+          chmod +x /usr/local/bin/os-ai-pr-bot
+
+      - name: Run Claude Bot
+        env:
+          ANTHROPIC_API_KEY: ${{ secrets.ANTHROPIC_API_KEY }}
+        run: os-ai-pr-bot

.gitignore

@@ -0,0 +1 @@
+dist-newstyle

app/Main.hs

@@ -0,0 +1,15 @@
+module Main (main) where
+
+import System.Exit (exitFailure)
+import System.IO (hPutStrLn, stderr)
+
+import Bot.Config (loadConfig, Config (..))
+import Bot.Event (parseEvent)
+import Bot.Review (handleEvent)
+
+main :: IO ()
+main = do
+  config <- loadConfig
+  parseEvent (cfgEventName config) (cfgEventPath config) >>= \case
+    Left err    -> hPutStrLn stderr ("Event parse error: " <> err) >> exitFailure
+    Right event -> handleEvent config event

os-ai-pr-bot.cabal

@@ -0,0 +1,38 @@
+cabal-version: 3.0
+name:          os-ai-pr-bot
+version:       0.1.0.0
+synopsis:      Gitea Actions PR review bot using Claude Code
+license:       MIT
+
+executable os-ai-pr-bot
+  default-language: GHC2021
+  hs-source-dirs:   app, src
+  main-is:          Main.hs
+  other-modules:
+    Bot.Config
+    Bot.Event
+    Bot.Trigger
+    Bot.Gitea
+    Bot.Claude
+    Bot.Prompt
+    Bot.Review
+
+  build-depends:
+    , aeson            >=2.0
+    , base             >=4.16   && <5
+    , bytestring       >=0.11
+    , directory        >=1.3
+    , filepath         >=1.4
+    , http-client      >=0.7
+    , http-client-tls  >=0.3
+    , http-types       >=0.12
+    , process          >=1.6
+    , text             >=2.0
+    , time             >=1.12
+    , regex-tdfa       >=1.3
+
+  default-extensions:
+    LambdaCase
+    OverloadedStrings
+
+  ghc-options: -Wall -O2

src/Bot/Claude.hs

@@ -0,0 +1,142 @@
+module Bot.Claude
+  ( ReviewOutput (..)
+  , ClaudeComment (..)
+  , invokeClaudeReview
+  , invokeClaudeReply
+  ) where
+
+import Data.Aeson
+import Data.Aeson.Types (Parser, parseMaybe)
+import Data.ByteString.Lazy qualified as BL
+import Data.Text (Text)
+import Data.Text qualified as T
+import Data.Text.Encoding qualified as TE
+import Data.Text.IO qualified as TIO
+import System.Directory (getTemporaryDirectory, removeFile)
+import System.Exit (ExitCode (..))
+import System.FilePath ((</>))
+import System.Process (readProcessWithExitCode)
+
+data ReviewOutput = ReviewOutput
+  { roSummary  :: Text
+  , roComments :: [ClaudeComment]
+  }
+
+data ClaudeComment = ClaudeComment
+  { ccPath    :: Text
+  , ccLine    :: Int
+  , ccComment :: Text
+  }
+
+instance FromJSON ReviewOutput where
+  parseJSON = withObject "ReviewOutput" $ \o -> do
+    summary  <- o .: "summary"
+    comments <- o .:? "comments" .!= []
+    pure ReviewOutput { roSummary = summary, roComments = comments }
+
+instance FromJSON ClaudeComment where
+  parseJSON = withObject "ClaudeComment" $ \o -> do
+    path    <- o .: "path"
+    line    <- o .: "line"
+    comment <- o .: "comment"
+    pure ClaudeComment { ccPath = path, ccLine = line, ccComment = comment }
+
+reviewJsonSchema :: String
+reviewJsonSchema = unlines
+  [ "{"
+  , "  \"type\": \"object\","
+  , "  \"required\": [\"summary\", \"comments\"],"
+  , "  \"properties\": {"
+  , "    \"summary\": { \"type\": \"string\" },"
+  , "    \"comments\": {"
+  , "      \"type\": \"array\","
+  , "      \"items\": {"
+  , "        \"type\": \"object\","
+  , "        \"required\": [\"path\", \"line\", \"comment\"],"
+  , "        \"properties\": {"
+  , "          \"path\": { \"type\": \"string\" },"
+  , "          \"line\": { \"type\": \"integer\" },"
+  , "          \"comment\": { \"type\": \"string\" }"
+  , "        },"
+  , "        \"additionalProperties\": false"
+  , "      }"
+  , "    }"
+  , "  },"
+  , "  \"additionalProperties\": false"
+  , "}"
+  ]
+
+invokeClaudeReview :: Text -> IO (Either String ReviewOutput)
+invokeClaudeReview prompt = do
+  tmpDir <- getTemporaryDirectory
+  let promptFile = tmpDir </> "claude-review-prompt.txt"
+      schemaFile = tmpDir </> "claude-review-schema.json"
+  TIO.writeFile promptFile prompt
+  writeFile schemaFile reviewJsonSchema
+  (exitCode, stdout, stderr_) <- readProcessWithExitCode "claude"
+    [ "-p"
+    , "--output-format", "json"
+    , "--max-turns", "1"
+    , "--prompt-file", promptFile
+    , "--json-schema", schemaFile
+    ] ""
+  removeFile promptFile
+  removeFile schemaFile
+  case exitCode of
+    ExitSuccess -> pure $ parseClaudeJsonOutput stdout
+    ExitFailure code ->
+      pure $ Left $ "claude exited with code " <> show code <> ": " <> stderr_
+
+invokeClaudeReply :: Text -> IO (Either String Text)
+invokeClaudeReply prompt = do
+  tmpDir <- getTemporaryDirectory
+  let promptFile = tmpDir </> "claude-reply-prompt.txt"
+  TIO.writeFile promptFile prompt
+  (exitCode, stdout, stderr_) <- readProcessWithExitCode "claude"
+    [ "-p"
+    , "--output-format", "json"
+    , "--max-turns", "1"
+    , "--prompt-file", promptFile
+    ] ""
+  removeFile promptFile
+  case exitCode of
+    ExitSuccess -> pure $ parseClaudeTextOutput stdout
+    ExitFailure code ->
+      pure $ Left $ "claude exited with code " <> show code <> ": " <> stderr_
+
+-- Parse Claude's JSON envelope: { "result": <structured output> }
+parseClaudeJsonOutput :: String -> Either String ReviewOutput
+parseClaudeJsonOutput raw =
+  case eitherDecode (strToLBS raw) of
+    Right val ->
+      case parseMaybe extractResult val of
+        Just (String resultText) ->
+          -- result is a JSON string that needs to be parsed again
+          eitherDecode (BL.fromStrict $ TE.encodeUtf8 resultText)
+        Just resultVal ->
+          -- result is already a JSON object
+          case fromJSON resultVal of
+            Success v -> Right v
+            Error e   -> Left $ "Failed to parse result object: " <> e
+        Nothing -> Left "Missing 'result' field in Claude output"
+    Left err -> Left $ "Failed to parse Claude JSON: " <> err
+  where
+    extractResult :: Value -> Parser Value
+    extractResult = withObject "envelope" (.: "result")
+
+-- Parse Claude's JSON envelope for freeform text: { "result": "..." }
+parseClaudeTextOutput :: String -> Either String Text
+parseClaudeTextOutput raw =
+  case eitherDecode (strToLBS raw) of
+    Right val ->
+      case parseMaybe extractResult val of
+        Just (String resultText) -> Right resultText
+        Just _  -> Left "Expected string 'result' in Claude output"
+        Nothing -> Left "Missing 'result' field in Claude output"
+    Left err -> Left $ "Failed to parse Claude JSON: " <> err
+  where
+    extractResult :: Value -> Parser Value
+    extractResult = withObject "envelope" (.: "result")
+
+strToLBS :: String -> BL.ByteString
+strToLBS = BL.fromStrict . TE.encodeUtf8 . T.pack

src/Bot/Config.hs

@@ -0,0 +1,65 @@
+module Bot.Config
+  ( Config (..)
+  , loadConfig
+  ) where
+
+import Data.Text (Text)
+import Data.Text qualified as T
+import System.Environment (lookupEnv)
+import System.Exit (exitFailure)
+import System.IO (hPutStrLn, stderr)
+
+data Config = Config
+  { cfgGiteaUrl      :: Text
+  , cfgGiteaToken    :: Text
+  , cfgRepoOwner     :: Text
+  , cfgRepoName      :: Text
+  , cfgEventName     :: Text
+  , cfgEventPath     :: FilePath
+  , cfgRunId         :: Text
+  , cfgBotUser       :: Text      -- filled in later by Gitea.getCurrentUser
+  , cfgTriggerPhrase :: Text
+  }
+
+loadConfig :: IO Config
+loadConfig = do
+  giteaUrl   <- requireEnv "GITHUB_SERVER_URL"
+  token      <- requireEnv "GITHUB_TOKEN"
+  repository <- requireEnv "GITHUB_REPOSITORY"
+  eventName  <- requireEnv "GITHUB_EVENT_NAME"
+  eventPath  <- requireEnv "GITHUB_EVENT_PATH"
+  runId      <- lookupEnvText "GITHUB_RUN_ID" ""
+  trigger    <- lookupEnvText "INPUT_TRIGGER_PHRASE" "@claude"
+
+  let repoText = T.pack repository
+  (owner, name) <- case T.splitOn "/" repoText of
+    [o, n] -> pure (o, n)
+    _      -> do
+      hPutStrLn stderr $ "Invalid GITHUB_REPOSITORY format: " <> repository
+      exitFailure
+
+  pure Config
+    { cfgGiteaUrl      = T.pack giteaUrl
+    , cfgGiteaToken    = T.pack token
+    , cfgRepoOwner     = owner
+    , cfgRepoName      = name
+    , cfgEventName     = T.pack eventName
+    , cfgEventPath     = eventPath
+    , cfgRunId         = runId
+    , cfgBotUser       = ""  -- set after getCurrentUser
+    , cfgTriggerPhrase = trigger
+    }
+
+requireEnv :: String -> IO String
+requireEnv name = do
+  val <- lookupEnv name
+  case val of
+    Just v  -> pure v
+    Nothing -> do
+      hPutStrLn stderr $ "Missing required environment variable: " <> name
+      exitFailure
+
+lookupEnvText :: String -> Text -> IO Text
+lookupEnvText name def = do
+  val <- lookupEnv name
+  pure $ maybe def T.pack val

src/Bot/Event.hs

@@ -0,0 +1,147 @@
+module Bot.Event
+  ( Event (..)
+  , PullRequestEvent (..)
+  , IssueCommentEvent (..)
+  , PRReviewEvent (..)
+  , PRReviewCommentEvent (..)
+  , parseEvent
+  ) where
+
+import Data.Aeson
+import Data.Aeson.Types (Parser)
+import Data.ByteString.Lazy qualified as BL
+import Data.Text (Text)
+import Data.Text qualified as T
+
+data Event
+  = EvPullRequest PullRequestEvent
+  | EvIssueComment IssueCommentEvent
+  | EvPRReview PRReviewEvent
+  | EvPRReviewComment PRReviewCommentEvent
+
+data PullRequestEvent = PullRequestEvent
+  { preAction :: Text
+  , preNumber :: Int
+  , preTitle  :: Text
+  , preBody   :: Maybe Text
+  , preDraft  :: Bool
+  , preSender :: Text
+  , preHead   :: Text
+  , preBase   :: Text
+  }
+
+data IssueCommentEvent = IssueCommentEvent
+  { iceAction      :: Text
+  , iceIsPull      :: Bool
+  , iceNumber      :: Int
+  , iceCommentBody :: Text
+  , iceSender      :: Text
+  }
+
+data PRReviewEvent = PRReviewEvent
+  { prreAction     :: Text
+  , prreNumber     :: Int
+  , prreTitle      :: Text
+  , prreReviewBody :: Text
+  , prreSender     :: Text
+  }
+
+data PRReviewCommentEvent = PRReviewCommentEvent
+  { prrceAction      :: Text
+  , prrceNumber      :: Int
+  , prrceTitle       :: Text
+  , prrceCommentBody :: Text
+  , prrceSender      :: Text
+  }
+
+instance FromJSON PullRequestEvent where
+  parseJSON = withObject "PullRequestEvent" $ \o -> do
+    action <- o .: "action"
+    pr     <- o .: "pull_request"
+    number <- pr .: "number"
+    title  <- pr .: "title"
+    body   <- pr .:? "body"
+    draft  <- pr .:? "draft" .!= False
+    head_  <- pr .: "head" >>= (.: "label")
+    base   <- pr .: "base" >>= (.: "label")
+    sender <- parseSender o
+    pure PullRequestEvent
+      { preAction = action
+      , preNumber = number
+      , preTitle  = title
+      , preBody   = body
+      , preDraft  = draft
+      , preSender = sender
+      , preHead   = head_
+      , preBase   = base
+      }
+
+instance FromJSON IssueCommentEvent where
+  parseJSON = withObject "IssueCommentEvent" $ \o -> do
+    action  <- o .: "action"
+    issue   <- o .: "issue"
+    number  <- issue .: "number"
+    isPull  <- do
+      pr <- issue .:? "pull_request" :: Parser (Maybe Value)
+      pure $ case pr of
+        Just (Object _) -> True
+        _               -> False
+    comment <- o .: "comment"
+    body    <- comment .: "body"
+    sender  <- parseSender o
+    pure IssueCommentEvent
+      { iceAction      = action
+      , iceIsPull      = isPull
+      , iceNumber      = number
+      , iceCommentBody = body
+      , iceSender      = sender
+      }
+
+instance FromJSON PRReviewEvent where
+  parseJSON = withObject "PRReviewEvent" $ \o -> do
+    action <- o .: "action"
+    pr     <- o .: "pull_request"
+    number <- pr .: "number"
+    title  <- pr .: "title"
+    review <- o .: "review"
+    body   <- review .:? "body" .!= ""
+    sender <- parseSender o
+    pure PRReviewEvent
+      { prreAction     = action
+      , prreNumber     = number
+      , prreTitle      = title
+      , prreReviewBody = body
+      , prreSender     = sender
+      }
+
+instance FromJSON PRReviewCommentEvent where
+  parseJSON = withObject "PRReviewCommentEvent" $ \o -> do
+    action  <- o .: "action"
+    pr      <- o .: "pull_request"
+    number  <- pr .: "number"
+    title   <- pr .: "title"
+    comment <- o .: "comment"
+    body    <- comment .: "body"
+    sender  <- parseSender o
+    pure PRReviewCommentEvent
+      { prrceAction      = action
+      , prrceNumber      = number
+      , prrceTitle       = title
+      , prrceCommentBody = body
+      , prrceSender      = sender
+      }
+
+parseSender :: Object -> Parser Text
+parseSender o = do
+  sender <- o .: "sender"
+  sender .: "login"
+
+parseEvent :: Text -> FilePath -> IO (Either String Event)
+parseEvent eventName path = do
+  bytes <- BL.readFile path
+  pure $ case eventName of
+    _ | eventName == "pull_request"                -> EvPullRequest      <$> eitherDecode bytes
+      | eventName == "issue_comment"               -> EvIssueComment     <$> eitherDecode bytes
+      | eventName == "pull_request_review"         -> EvPRReview         <$> eitherDecode bytes
+      | eventName == "pull_request_review_comment" -> EvPRReviewComment  <$> eitherDecode bytes
+      | otherwise                                  -> Left $ "Unsupported event type: " <> T.unpack eventName

src/Bot/Gitea.hs

@@ -0,0 +1,262 @@
+module Bot.Gitea
+  ( GiteaClient
+  , newGiteaClient
+  , getCurrentUser
+  , getPrInfo
+  , getPrDiff
+  , getIssueComments
+  , getPrReviews
+  , createComment
+  , updateComment
+  , postReview
+  , PrInfo (..)
+  , GiteaComment (..)
+  , GiteaReview (..)
+  , InlineComment (..)
+  ) where
+
+import Data.Aeson
+import Data.Aeson.Types (parseMaybe)
+import Data.ByteString.Char8 qualified as BS
+import Data.ByteString.Lazy qualified as BL
+import Data.Text (Text)
+import Data.Text qualified as T
+import Data.Text.Encoding qualified as TE
+import Data.Time (UTCTime)
+import Network.HTTP.Client
+import Network.HTTP.Client.TLS (tlsManagerSettings)
+import Network.HTTP.Types.Status (statusCode)
+
+import Bot.Config (Config (..))
+
+data GiteaClient = GiteaClient
+  { gcManager :: Manager
+  , gcBaseUrl :: Text   -- e.g. "https://gitea.example.com/api/v1"
+  , gcToken   :: Text
+  , gcOwner   :: Text
+  , gcRepo    :: Text
+  }
+
+newGiteaClient :: Config -> IO GiteaClient
+newGiteaClient cfg = do
+  mgr <- newManager tlsManagerSettings
+  pure GiteaClient
+    { gcManager = mgr
+    , gcBaseUrl = cfgGiteaUrl cfg <> "/api/v1"
+    , gcToken   = cfgGiteaToken cfg
+    , gcOwner   = cfgRepoOwner cfg
+    , gcRepo    = cfgRepoName cfg
+    }
+
+-- Helpers
+
+repoPath :: GiteaClient -> Text
+repoPath gc = "/repos/" <> gcOwner gc <> "/" <> gcRepo gc
+
+apiGet :: FromJSON a => GiteaClient -> Text -> IO a
+apiGet gc path = do
+  let url = T.unpack (gcBaseUrl gc <> path)
+  req <- parseRequest url
+  let req' = req
+        { requestHeaders =
+            [ ("Authorization", "token " <> TE.encodeUtf8 (gcToken gc))
+            , ("Accept", "application/json")
+            ]
+        }
+  resp <- httpLbs req' (gcManager gc)
+  case eitherDecode (responseBody resp) of
+    Right v  -> pure v
+    Left err -> fail $ "API GET " <> url <> " decode error: " <> err
+
+apiGetText :: GiteaClient -> Text -> IO Text
+apiGetText gc path = do
+  let url = T.unpack (gcBaseUrl gc <> path)
+  req <- parseRequest url
+  let req' = req
+        { requestHeaders =
+            [ ("Authorization", "token " <> TE.encodeUtf8 (gcToken gc))
+            , ("Accept", "text/plain")
+            ]
+        }
+  resp <- httpLbs req' (gcManager gc)
+  pure $ TE.decodeUtf8 $ BL.toStrict $ responseBody resp
+
+apiPost :: FromJSON a => GiteaClient -> Text -> Value -> IO a
+apiPost gc path body = do
+  let url = T.unpack (gcBaseUrl gc <> path)
+  initReq <- parseRequest url
+  let req = initReq
+        { method = "POST"
+        , requestHeaders =
+            [ ("Authorization", "token " <> TE.encodeUtf8 (gcToken gc))
+            , ("Accept", "application/json")
+            , ("Content-Type", "application/json")
+            ]
+        , requestBody = RequestBodyLBS (encode body)
+        }
+  resp <- httpLbs req (gcManager gc)
+  case eitherDecode (responseBody resp) of
+    Right v  -> pure v
+    Left err -> fail $ "API POST " <> url <> " decode error: " <> err
+      <> "\nStatus: " <> show (statusCode $ responseStatus resp)
+      <> "\nBody: " <> show (BL.toStrict $ responseBody resp)
+
+apiPatch :: GiteaClient -> Text -> Value -> IO ()
+apiPatch gc path body = do
+  let url = T.unpack (gcBaseUrl gc <> path)
+  initReq <- parseRequest url
+  let req = initReq
+        { method = "PATCH"
+        , requestHeaders =
+            [ ("Authorization", "token " <> TE.encodeUtf8 (gcToken gc))
+            , ("Accept", "application/json")
+            , ("Content-Type", "application/json")
+            ]
+        , requestBody = RequestBodyLBS (encode body)
+        }
+  resp <- httpLbs req (gcManager gc)
+  let sc = statusCode (responseStatus resp)
+  if sc >= 200 && sc < 300
+    then pure ()
+    else fail $ "API PATCH " <> url <> " failed with status " <> show sc
+      <> ": " <> BS.unpack (BL.toStrict $ responseBody resp)
+
+apiPostRaw :: GiteaClient -> Text -> Value -> IO (Int, BL.ByteString)
+apiPostRaw gc path body = do
+  let url = T.unpack (gcBaseUrl gc <> path)
+  initReq <- parseRequest url
+  let req = initReq
+        { method = "POST"
+        , requestHeaders =
+            [ ("Authorization", "token " <> TE.encodeUtf8 (gcToken gc))
+            , ("Accept", "application/json")
+            , ("Content-Type", "application/json")
+            ]
+        , requestBody = RequestBodyLBS (encode body)
+        }
+  resp <- httpLbs req (gcManager gc)
+  pure (statusCode $ responseStatus resp, responseBody resp)
+
+-- API operations
+
+getCurrentUser :: GiteaClient -> IO Text
+getCurrentUser gc = do
+  v <- apiGet gc "/user" :: IO Value
+  case parseMaybe parseLogin v of
+    Just login -> pure login
+    Nothing    -> fail "GET /user: missing login field"
+  where
+    parseLogin = withObject "User" $ \o -> o .: "login"
+
+data PrInfo = PrInfo
+  { piTitle :: Text
+  , piBody  :: Maybe Text
+  , piUser  :: Text
+  , piHead  :: Text
+  , piBase  :: Text
+  }
+
+instance FromJSON PrInfo where
+  parseJSON = withObject "PrInfo" $ \o -> do
+    title <- o .: "title"
+    body  <- o .:? "body"
+    user  <- o .: "user" >>= (.: "login")
+    head_ <- o .: "head" >>= (.: "label")
+    base  <- o .: "base" >>= (.: "label")
+    pure PrInfo
+      { piTitle = title
+      , piBody  = body
+      , piUser  = user
+      , piHead  = head_
+      , piBase  = base
+      }
+
+getPrInfo :: GiteaClient -> Int -> IO PrInfo
+getPrInfo gc n =
+  apiGet gc (repoPath gc <> "/pulls/" <> T.pack (show n))
+
+getPrDiff :: GiteaClient -> Int -> IO Text
+getPrDiff gc n =
+  apiGetText gc (repoPath gc <> "/pulls/" <> T.pack (show n) <> ".diff")
+
+data GiteaComment = GiteaComment
+  { gcBody      :: Text
+  , gcUser      :: Text
+  , gcCreatedAt :: UTCTime
+  }
+
+instance FromJSON GiteaComment where
+  parseJSON = withObject "GiteaComment" $ \o -> do
+    body      <- o .: "body"
+    user      <- o .: "user" >>= (.: "login")
+    createdAt <- o .: "created_at"
+    pure GiteaComment
+      { gcBody      = body
+      , gcUser      = user
+      , gcCreatedAt = createdAt
+      }
+
+getIssueComments :: GiteaClient -> Int -> IO [GiteaComment]
+getIssueComments gc n =
+  apiGet gc (repoPath gc <> "/issues/" <> T.pack (show n) <> "/comments")
+
+data GiteaReview = GiteaReview
+  { grBody  :: Maybe Text
+  , grUser  :: Text
+  , grState :: Text
+  }
+
+instance FromJSON GiteaReview where
+  parseJSON = withObject "GiteaReview" $ \o -> do
+    body  <- o .:? "body"
+    user  <- o .: "user" >>= (.: "login")
+    state <- o .: "state"
+    pure GiteaReview
+      { grBody  = body
+      , grUser  = user
+      , grState = state
+      }
+
+getPrReviews :: GiteaClient -> Int -> IO [GiteaReview]
+getPrReviews gc n =
+  apiGet gc (repoPath gc <> "/pulls/" <> T.pack (show n) <> "/reviews")
+
+-- Returns the comment ID
+createComment :: GiteaClient -> Int -> Text -> IO Int
+createComment gc n body = do
+  let payload = object ["body" .= body]
+  v <- apiPost gc (repoPath gc <> "/issues/" <> T.pack (show n) <> "/comments") payload
+  case parseMaybe parseId (v :: Value) of
+    Just i  -> pure i
+    Nothing -> fail "createComment: missing 'id' field"
+  where
+    parseId = withObject "Comment" $ \o -> o .: "id"
+
+updateComment :: GiteaClient -> Int -> Text -> IO ()
+updateComment gc commentId body = do
+  let payload = object ["body" .= body]
+  apiPatch gc (repoPath gc <> "/issues/comments/" <> T.pack (show commentId)) payload
+
+data InlineComment = InlineComment
+  { icPath        :: Text
+  , icNewPosition :: Int
+  , icBody        :: Text
+  }
+
+postReview :: GiteaClient -> Int -> Text -> [InlineComment] -> IO ()
+postReview gc prNum body comments = do
+  let commentObjs = map (\ic -> object
+        [ "path"         .= icPath ic
+        , "new_position" .= icNewPosition ic
+        , "body"         .= icBody ic
+        ]) comments
+      payload = object
+        [ "body"     .= body
+        , "event"    .= ("COMMENT" :: Text)
+        , "comments" .= commentObjs
+        ]
+  (sc, respBody) <- apiPostRaw gc (repoPath gc <> "/pulls/" <> T.pack (show prNum) <> "/reviews") payload
+  if sc >= 200 && sc < 300
+    then pure ()
+    else fail $ "postReview failed with status " <> show sc
+      <> ": " <> BS.unpack (BL.toStrict respBody)

src/Bot/Prompt.hs

@@ -0,0 +1,150 @@
+module Bot.Prompt
+  ( PRContext (..)
+  , buildReviewPrompt
+  , buildReplyPrompt
+  ) where
+
+import Data.Maybe (fromMaybe)
+import Data.Text (Text)
+import Data.Text qualified as T
+import Data.Time (formatTime, defaultTimeLocale)
+
+import Bot.Config (Config (..))
+import Bot.Event
+import Bot.Gitea (PrInfo (..), GiteaComment (..), GiteaReview (..))
+
+data PRContext = PRContext
+  { ctxPrInfo   :: PrInfo
+  , ctxDiff     :: Text
+  , ctxComments :: [GiteaComment]
+  , ctxReviews  :: [GiteaReview]
+  }
+
+buildReviewPrompt :: Config -> Event -> PRContext -> Text
+buildReviewPrompt cfg event ctx =
+  T.unlines
+    [ "You are Claude, an AI assistant reviewing a Gitea pull request."
+    , ""
+    , "<context>"
+    , "PR Title: " <> piTitle (ctxPrInfo ctx)
+    , "PR Author: " <> piUser (ctxPrInfo ctx)
+    , "PR Branch: " <> piHead (ctxPrInfo ctx) <> " → " <> piBase (ctxPrInfo ctx)
+    , "</context>"
+    , ""
+    , "<pr_body>"
+    , fromMaybe "No description provided" (piBody (ctxPrInfo ctx))
+    , "</pr_body>"
+    , ""
+    , "<comments>"
+    , formatComments (ctxComments ctx)
+    , "</comments>"
+    , ""
+    , "<review_comments>"
+    , formatReviews (ctxReviews ctx)
+    , "</review_comments>"
+    , ""
+    , "<diff>"
+    , ctxDiff ctx
+    , "</diff>"
+    , ""
+    , "<metadata>"
+    , "repository: " <> cfgRepoOwner cfg <> "/" <> cfgRepoName cfg
+    , "pr_number: " <> T.pack (show (eventPRNumber event))
+    , "trigger: " <> triggerContext cfg event
+    , "triggered_by: " <> eventSender event
+    , "</metadata>"
+    , ""
+    , triggerCommentSection event
+    , "Provide a thorough code review. Focus on bugs, security, correctness, and suggestions."
+    , "Output your response as JSON with two fields:"
+    , "  - \"summary\": a markdown summary of your review"
+    , "  - \"comments\": an array of inline comments, each with \"path\" (file path), \"line\" (line number in the new file), and \"comment\" (your feedback)"
+    , "If you have no inline comments, return an empty array for \"comments\"."
+    ]
+
+buildReplyPrompt :: Config -> Text -> PRContext -> Text
+buildReplyPrompt cfg triggerBody ctx =
+  T.unlines
+    [ "You are Claude, an AI assistant helping with a Gitea pull request."
+    , ""
+    , "<context>"
+    , "PR Title: " <> piTitle (ctxPrInfo ctx)
+    , "PR Author: " <> piUser (ctxPrInfo ctx)
+    , "PR Branch: " <> piHead (ctxPrInfo ctx) <> " → " <> piBase (ctxPrInfo ctx)
+    , "</context>"
+    , ""
+    , "<pr_body>"
+    , fromMaybe "No description provided" (piBody (ctxPrInfo ctx))
+    , "</pr_body>"
+    , ""
+    , "<comments>"
+    , formatComments (ctxComments ctx)
+    , "</comments>"
+    , ""
+    , "<review_comments>"
+    , formatReviews (ctxReviews ctx)
+    , "</review_comments>"
+    , ""
+    , "<diff>"
+    , ctxDiff ctx
+    , "</diff>"
+    , ""
+    , "<metadata>"
+    , "repository: " <> cfgRepoOwner cfg <> "/" <> cfgRepoName cfg
+    , "</metadata>"
+    , ""
+    , "<trigger_comment>"
+    , triggerBody
+    , "</trigger_comment>"
+    , ""
+    , "Respond helpfully and concisely to the comment above in the context of this pull request."
+    ]
+
+-- Helpers
+
+formatComments :: [GiteaComment] -> Text
+formatComments [] = "No comments"
+formatComments cs = T.intercalate "\n" $ map formatComment cs
+  where
+    formatComment c =
+      "[" <> gcUser c <> " at " <> fmtTime (gcCreatedAt c) <> "]: " <> gcBody c
+    fmtTime = T.pack . formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S UTC"
+
+formatReviews :: [GiteaReview] -> Text
+formatReviews [] = "No review comments"
+formatReviews rs = T.intercalate "\n" $ map formatReview rs
+  where
+    formatReview r =
+      "[Review by " <> grUser r <> "]: " <> grState r
+      <> maybe "" (\b -> "\n  " <> b) (grBody r)
+
+eventPRNumber :: Event -> Int
+eventPRNumber = \case
+  EvPullRequest pre       -> preNumber pre
+  EvIssueComment ice      -> iceNumber ice
+  EvPRReview prre         -> prreNumber prre
+  EvPRReviewComment prrce -> prrceNumber prrce
+
+eventSender :: Event -> Text
+eventSender = \case
+  EvPullRequest pre       -> preSender pre
+  EvIssueComment ice      -> iceSender ice
+  EvPRReview prre         -> prreSender prre
+  EvPRReviewComment prrce -> prrceSender prrce
+
+triggerContext :: Config -> Event -> Text
+triggerContext cfg = \case
+  EvPullRequest pre       -> "pull request " <> preAction pre
+  EvIssueComment _        -> "issue comment with '" <> cfgTriggerPhrase cfg <> "'"
+  EvPRReview _            -> "PR review with '" <> cfgTriggerPhrase cfg <> "'"
+  EvPRReviewComment _     -> "PR review comment with '" <> cfgTriggerPhrase cfg <> "'"
+
+triggerCommentSection :: Event -> Text
+triggerCommentSection = \case
+  EvIssueComment ice ->
+    "<trigger_comment>\n" <> iceCommentBody ice <> "\n</trigger_comment>\n\n"
+  EvPRReview prre ->
+    "<trigger_comment>\n" <> prreReviewBody prre <> "\n</trigger_comment>\n\n"
+  EvPRReviewComment prrce ->
+    "<trigger_comment>\n" <> prrceCommentBody prrce <> "\n</trigger_comment>\n\n"
+  _ -> ""

src/Bot/Review.hs

@@ -0,0 +1,168 @@
+module Bot.Review
+  ( handleEvent
+  ) where
+
+import Control.Exception (SomeException, catch)
+import Data.Text (Text)
+import Data.Text qualified as T
+import System.IO (hPutStrLn, stderr)
+
+import Bot.Claude
+import Bot.Config (Config (..))
+import Bot.Event
+import Bot.Gitea
+import Bot.Prompt
+import Bot.Trigger
+
+handleEvent :: Config -> Event -> IO ()
+handleEvent cfg event = do
+  client <- newGiteaClient cfg
+
+  -- Auto-detect bot username for loop prevention
+  botUser <- getCurrentUser client
+  let cfg' = cfg { cfgBotUser = botUser }
+  putStrLn $ "Bot user: " <> T.unpack botUser
+
+  -- Check trigger
+  case checkTrigger cfg' event of
+    NotTriggered -> putStrLn "No trigger found, exiting."
+    Triggered prNum -> do
+      -- Loop prevention: skip events from bot itself
+      let sender = eventSender event
+      if sender == cfgBotUser cfg'
+        then putStrLn $ "Skipping event from bot user: " <> T.unpack sender
+        else dispatch cfg' client event prNum
+
+dispatch :: Config -> GiteaClient -> Event -> Int -> IO ()
+dispatch cfg client event prNum = do
+  -- Create tracking comment
+  commentId <- createComment client prNum "\x23F3 Thinking..."
+  putStrLn $ "Created tracking comment: " <> show commentId
+
+  -- Ensure tracking comment is updated even on error
+  let jobUrl = cfgGiteaUrl cfg <> "/" <> cfgRepoOwner cfg <> "/" <> cfgRepoName cfg
+             <> "/actions/runs/" <> cfgRunId cfg
+
+  let onError :: SomeException -> IO ()
+      onError ex = do
+        let errMsg = T.pack (show ex)
+        hPutStrLn stderr $ "Error: " <> T.unpack errMsg
+        let body = T.unlines
+              [ "**Claude** encountered an error \x2014 [View job run](" <> jobUrl <> ")"
+              , ""
+              , T.take 2000 errMsg
+              ]
+        updateComment client commentId body
+          `catch` \(_ :: SomeException) -> pure ()
+
+  let run = do
+        -- Gather PR context
+        ctx <- gatherContext client prNum
+
+        case event of
+          EvPullRequest _ -> do
+            handleReview cfg client event prNum commentId jobUrl ctx
+
+          EvIssueComment _ -> do
+            handleReview cfg client event prNum commentId jobUrl ctx
+
+          EvPRReview prre -> do
+            handleReply cfg client (prreReviewBody prre) prNum commentId jobUrl ctx
+
+          EvPRReviewComment prrce -> do
+            handleReply cfg client (prrceCommentBody prrce) prNum commentId jobUrl ctx
+
+  run `catch` onError
+
+gatherContext :: GiteaClient -> Int -> IO PRContext
+gatherContext client prNum = do
+  prInfo   <- getPrInfo client prNum
+  diff     <- getPrDiff client prNum
+  comments <- getIssueComments client prNum
+  reviews  <- getPrReviews client prNum
+  pure PRContext
+    { ctxPrInfo   = prInfo
+    , ctxDiff     = diff
+    , ctxComments = comments
+    , ctxReviews  = reviews
+    }
+
+handleReview :: Config -> GiteaClient -> Event -> Int -> Int -> Text -> PRContext -> IO ()
+handleReview cfg client event prNum commentId jobUrl ctx = do
+  let prompt = buildReviewPrompt cfg event ctx
+  result <- invokeClaudeReview prompt
+  case result of
+    Left err -> do
+      hPutStrLn stderr $ "Claude review error: " <> err
+      let body = T.unlines
+            [ "**Claude** encountered an error \x2014 [View job run](" <> jobUrl <> ")"
+            , ""
+            , T.pack err
+            ]
+      updateComment client commentId body
+
+    Right review -> do
+      -- Update tracking comment with summary
+      let sender = eventSender event
+          body = T.unlines
+            [ "**Claude** reviewed @" <> sender <> "'s PR \x2014 [View job run](" <> jobUrl <> ")"
+            , ""
+            , "---"
+            , ""
+            , roSummary review
+            ]
+      updateComment client commentId body
+
+      -- Post review with inline comments if any
+      let inlineComments = map toInlineComment (roComments review)
+      if null inlineComments
+        then pure ()
+        else postReviewWithFallback client prNum (roSummary review) inlineComments
+
+handleReply :: Config -> GiteaClient -> Text -> Int -> Int -> Text -> PRContext -> IO ()
+handleReply cfg client triggerBody _prNum commentId jobUrl ctx = do
+  let prompt = buildReplyPrompt cfg triggerBody ctx
+  result <- invokeClaudeReply prompt
+  case result of
+    Left err -> do
+      hPutStrLn stderr $ "Claude reply error: " <> err
+      let body = T.unlines
+            [ "**Claude** encountered an error \x2014 [View job run](" <> jobUrl <> ")"
+            , ""
+            , T.pack err
+            ]
+      updateComment client commentId body
+
+    Right replyText -> do
+      let body = T.unlines
+            [ "**Claude** responded \x2014 [View job run](" <> jobUrl <> ")"
+            , ""
+            , "---"
+            , ""
+            , replyText
+            ]
+      updateComment client commentId body
+
+toInlineComment :: ClaudeComment -> InlineComment
+toInlineComment cc = InlineComment
+  { icPath        = ccPath cc
+  , icNewPosition = ccLine cc
+  , icBody        = ccComment cc
+  }
+
+-- Try posting review with inline comments; on failure, retry with summary only
+postReviewWithFallback :: GiteaClient -> Int -> Text -> [InlineComment] -> IO ()
+postReviewWithFallback client prNum summary comments = do
+  postReview client prNum summary comments
+    `catch` \(_ :: SomeException) -> do
+      hPutStrLn stderr "Failed to post review with inline comments, retrying without..."
+      postReview client prNum summary []
+        `catch` \(_ :: SomeException) ->
+          hPutStrLn stderr "Failed to post summary-only review as well."
+
+eventSender :: Event -> Text
+eventSender = \case
+  EvPullRequest pre       -> preSender pre
+  EvIssueComment ice      -> iceSender ice
+  EvPRReview prre         -> prreSender prre
+  EvPRReviewComment prrce -> prrceSender prrce

src/Bot/Trigger.hs

@@ -0,0 +1,62 @@
+module Bot.Trigger
+  ( TriggerResult (..)
+  , checkTrigger
+  ) where
+
+import Data.Text (Text)
+import Data.Text qualified as T
+import Text.Regex.TDFA ((=~))
+
+import Bot.Config (Config (..))
+import Bot.Event
+
+data TriggerResult
+  = Triggered { trPRNumber :: Int }
+  | NotTriggered
+
+checkTrigger :: Config -> Event -> TriggerResult
+checkTrigger cfg = \case
+  EvPullRequest pre
+    | preAction pre `elem` ["opened", "reopened", "ready_for_review"] ->
+        if matchesTrigger phrase (preTitle pre)
+           || maybe False (matchesTrigger phrase) (preBody pre)
+        then Triggered (preNumber pre)
+        else NotTriggered
+    | otherwise -> NotTriggered
+
+  EvIssueComment ice
+    | iceAction ice == "created" && iceIsPull ice ->
+        if matchesTrigger phrase (iceCommentBody ice)
+        then Triggered (iceNumber ice)
+        else NotTriggered
+    | otherwise -> NotTriggered
+
+  EvPRReview prre
+    | prreAction prre == "submitted" ->
+        if matchesTrigger phrase (prreReviewBody prre)
+        then Triggered (prreNumber prre)
+        else NotTriggered
+    | otherwise -> NotTriggered
+
+  EvPRReviewComment prrce
+    | prrceAction prrce == "created" ->
+        if matchesTrigger phrase (prrceCommentBody prrce)
+        then Triggered (prrceNumber prrce)
+        else NotTriggered
+    | otherwise -> NotTriggered
+  where
+    phrase = cfgTriggerPhrase cfg
+
+matchesTrigger :: Text -> Text -> Bool
+matchesTrigger phrase text =
+  T.unpack text =~ pattern
+  where
+    pattern :: String
+    pattern = "(^|\\s)" <> escapeRegex (T.unpack phrase) <> "([\\s.,!?;:]|$)"
+
+escapeRegex :: String -> String
+escapeRegex = concatMap esc
+  where
+    esc c
+      | c `elem` (".*+?^${}()|[]\\" :: String) = ['\\', c]
+      | otherwise = [c]