Adds an OpenAI Behavior

Author: solomon-b

app/Main.hs

@@ -13,7 +13,10 @@ import Control.Monad.Except
 import Control.Monad.IO.Class (liftIO)
 import Data.Foldable
 import GHC.Conc (threadDelay)
+import Network.HTTP.Client qualified as HTTP
+import Network.HTTP.Client.TLS qualified as HTTP.TLS
 import Network.Matrix.Client
+import OpenAI.Client (makeOpenAIClient)
 import Options.Applicative qualified as Opt
 import OptionsParser
 import System.Environment.XDG.BaseDir (getUserCacheDir)
@@ -23,17 +26,17 @@ main :: IO ()
 main = do
   command <- Opt.execParser parserInfo
   xdgCache <- getUserCacheDir "cofree-bot"
-
+  httpManager <- HTTP.newManager HTTP.TLS.tlsManagerSettings
   case command of
-    LoginCmd cred -> do
+    LoginCmd cred openAIKey -> do
       session <- login cred
-      matrixMain session xdgCache
-    TokenCmd TokenCredentials {..} -> do
+      matrixMain session xdgCache httpManager openAIKey
+    TokenCmd TokenCredentials {..} openAIKey -> do
       session <- createSession (getMatrixServer matrixServer) matrixToken
-      matrixMain session xdgCache
-    CLI -> cliMain xdgCache
+      matrixMain session xdgCache httpManager openAIKey
+    CLI openAIKey -> cliMain xdgCache httpManager openAIKey
 
-bot process =
+bot process manager (OpenAIKey aiKey) =
   let calcBot =
         embedTextBot $
           simplifySessionBot printCalcOutput statementP $
@@ -43,29 +46,31 @@ bot process =
       coinFlipBot' = embedTextBot $ simplifyCoinFlipBot coinFlipBot
       ghciBot' = embedTextBot $ ghciBot process
       magic8BallBot' = embedTextBot $ simplifyMagic8BallBot magic8BallBot
+      openAIBot' = openAIBot $ makeOpenAIClient aiKey manager 2
    in calcBot
         /.\ coinFlipBot'
         /.\ helloBot
         /.\ ghciBot'
         /.\ magic8BallBot'
         /.\ updogMatrixBot
         /.\ embedTextBot jitsiBot
+        /.\ embedTextBot openAIBot'
 
-cliMain :: FilePath -> IO ()
-cliMain xdgCache = withProcessWait_ ghciConfig $ \process -> do
+cliMain :: FilePath -> HTTP.Manager -> OpenAIKey -> IO ()
+cliMain xdgCache manager openAIKey = withProcessWait_ ghciConfig $ \process -> do
   void $ threadDelay 1e6
   void $ hGetOutput (getStdout process)
   state <- readState xdgCache
-  fixedBot <- flip (fixBotPersistent xdgCache) (fold state) $ simplifyMatrixBot $ bot process
+  fixedBot <- flip (fixBotPersistent xdgCache) (fold state) $ simplifyMatrixBot $ bot process manager openAIKey
   void $ loop $ annihilate repl fixedBot
 
 unsafeCrashInIO :: Show e => ExceptT e IO a -> IO a
 unsafeCrashInIO = runExceptT >=> either (fail . show) pure
 
-matrixMain :: ClientSession -> FilePath -> IO ()
-matrixMain session xdgCache = withProcessWait_ ghciConfig $ \process -> do
+matrixMain :: ClientSession -> FilePath -> HTTP.Manager -> OpenAIKey -> IO ()
+matrixMain session xdgCache manager openAIKey = withProcessWait_ ghciConfig $ \process -> do
   void $ threadDelay 1e6
   void $ hGetOutput (getStdout process)
   state <- readState xdgCache
-  fixedBot <- flip (fixBotPersistent xdgCache) (fold state) $ hoistBot liftIO $ bot process
+  fixedBot <- flip (fixBotPersistent xdgCache) (fold state) $ hoistBot liftIO $ bot process manager openAIKey
   unsafeCrashInIO $ loop $ annihilate (matrix session xdgCache) $ batch fixedBot

app/OptionsParser.hs

@@ -1,5 +1,6 @@
 module OptionsParser where
 
+import Control.Applicative
 import Data.Text qualified as T
 import Network.Matrix.Client
 import Options.Applicative qualified as Opt
@@ -93,30 +94,46 @@ parseServer =
             "Matrix Homeserver"
       )
 
+-----------------------
+--- Behavior Config ---
+-----------------------
+
+newtype OpenAIKey = OpenAIKey T.Text
+
+parseOpenAIKey :: Opt.Parser OpenAIKey
+parseOpenAIKey =
+  OpenAIKey
+    <$> Opt.strOption
+      ( Opt.long "openai_key"
+          <> Opt.metavar "OPENAI_KEY"
+          <> Opt.help
+            "OpenAI API Key"
+      )
+
 -------------------
 --- Main Parser ---
 -------------------
 
-data Command = LoginCmd LoginCredentials | TokenCmd TokenCredentials | CLI
+data Command = LoginCmd LoginCredentials OpenAIKey | TokenCmd TokenCredentials OpenAIKey | CLI OpenAIKey
 
 mainParser :: Opt.Parser Command
 mainParser =
   Opt.subparser
     ( Opt.command
         "gen-token"
         ( Opt.info
-            (fmap LoginCmd parseLogin)
+            (liftA2 LoginCmd parseLogin parseOpenAIKey)
             (Opt.progDesc "Generate a token from a username/password")
         )
         <> Opt.command
           "run"
           ( Opt.info
-              (fmap TokenCmd parseTokenCredentials)
+              (liftA2 TokenCmd parseTokenCredentials parseOpenAIKey)
               (Opt.progDesc "Run the bot with an auth token")
           )
         <> Opt.command
           "cli"
-          (Opt.info (pure CLI) (Opt.progDesc "Run the bot in the CLI"))
+          (Opt.info (fmap CLI parseOpenAIKey) (Opt.progDesc "Run the bot in the CLI"))
     )
 
 parserInfo :: Opt.ParserInfo Command

cofree-bot.cabal

@@ -67,7 +67,10 @@ executable cofree-bot
   hs-source-dirs: app
   build-depends:
     , cofree-bot
+    , http-client
+    , http-client-tls
     , mtl
+    , openai-hs
     , optparse-applicative
     , xdg-basedir
 
@@ -93,6 +96,7 @@ library
     CofreeBot.Bot.Behaviors.Jitsi
     CofreeBot.Bot.Behaviors.Jitsi.Dictionary
     CofreeBot.Bot.Behaviors.Magic8Ball
+    CofreeBot.Bot.Behaviors.OpenAI
     CofreeBot.Bot.Behaviors.Updog
     CofreeBot.Bot.Context
     CofreeBot.Utils
@@ -110,6 +114,7 @@ library
     , lens
     , monad-loops
     , mtl
+    , openai-hs
     , pretty-simple
     , process
     , random

src/CofreeBot/Bot/Behaviors.hs

@@ -5,6 +5,7 @@ module CofreeBot.Bot.Behaviors
     module Hello,
     module Jitsi,
     module Magic8Ball,
+    module OpenAI,
     module Updog,
   )
 where
@@ -15,4 +16,5 @@ import CofreeBot.Bot.Behaviors.GHCI as GHCI
 import CofreeBot.Bot.Behaviors.Hello as Hello
 import CofreeBot.Bot.Behaviors.Jitsi as Jitsi
 import CofreeBot.Bot.Behaviors.Magic8Ball as Magic8Ball
+import CofreeBot.Bot.Behaviors.OpenAI as OpenAI
 import CofreeBot.Bot.Behaviors.Updog as Updog

src/CofreeBot/Bot/Behaviors/OpenAI.hs

@@ -0,0 +1,40 @@
+{-# LANGUAGE ViewPatterns #-}
+
+-- | A bot for general interactions with OpenAI's GPT LLM.
+module CofreeBot.Bot.Behaviors.OpenAI
+  ( openAIBot,
+  )
+where
+
+--------------------------------------------------------------------------------
+
+import CofreeBot.Bot
+import CofreeBot.Utils.ListT (emptyListT)
+import Control.Monad.IO.Class (MonadIO (..))
+import Data.Attoparsec.Text
+import Data.Text (Text)
+import Data.Text qualified as T
+import Data.Vector qualified as V
+import OpenAI.Client qualified as OpenAI
+
+--------------------------------------------------------------------------------
+
+openAIBot :: OpenAI.OpenAIClient -> Bot IO () Text Text
+openAIBot client =
+  contraMapMaybeBot (either (const Nothing) Just . parseOnly openAIBotParser) $
+    Bot $ \s (buildPrompt -> i) -> do
+      liftIO (OpenAI.completeText client (OpenAI.EngineId "text-davinci-003") (i {OpenAI.tccrMaxTokens = Just 2096})) >>= \case
+        Left _err -> emptyListT
+        Right OpenAI.TextCompletion {tcChoices} ->
+          let OpenAI.TextCompletionChoice {..} = V.head tcChoices
+           in pure (T.strip tccText, s)
+
+buildPrompt :: Text -> OpenAI.TextCompletionCreate
+buildPrompt input =
+  let preamble = "You are a friendly chat bot named Cofree-Bot on a server dedicated to functional programming. Please respond to the following prompt:"
+   in OpenAI.defaultTextCompletionCreate $ preamble <> input
+
+openAIBotParser :: Parser Text
+openAIBotParser = do
+  _ <- "chat: "
+  T.pack <$> many1 anyChar