66 lines
1.8 KiB
Haskell
66 lines
1.8 KiB
Haskell
|
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
|