diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,14 @@ +2.0 (2025-04-22) + + * Extensive redesign of this library + * Work done to support multiple LLM servers + * Redesigned how LLM options work using Semigroup + * Now supporting loading the API key from a file + * Added code to make the TLS request timeout longer + * Added and adjusted docs including Haddock API docs + * Redesigned failure with throwIO and a custom exception type + * Added keep_alive to the Ollama request + 1.3 (2025-03-27) * Initial release diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -3,16 +3,62 @@ ## Synopsis -Library and command line tool for interacting with various generative AI LLMs +A library for interacting with various generative AI LLMs ## Description -Library and command line tool for performing completions and chats with various -generative AI LLMs (Large Language Models). Works today with Ollama and some -work has been done to support OpenAI in the future. +A library for performing completions and chats with various generative AI LLMs +(Large Language Models). Works today with Ollama and OpenAI with more to come +in the future. This project is very much in-progress and incomplete. + + +## Using this library + +An example, more available in `src/example` + + import Control.Exception (Handler (..), catches) + import Data.Text.Lazy.IO qualified as TL + import GenAILib (ClientError, Request (..), jsonToText, mkRequest, numopt, + stringopt, systemmsg, usermsg) + import GenAILib.HTTP (GenAIException, openaiV1Chat, openaiV1ChatJ, + tokenFromFile) + import GenAILib.OpenAI (OpenAIRequest, getMessage) + + + main :: IO () + main = do + openaiJSON + openaiData + + -- A simple example with no error handling that expects an Aeson Value + -- (OpenAIRequest is an instance of ToJSON) and displays the encoded JSON + -- response + openaiJSON :: IO () + openaiJSON = do + let req :: OpenAIRequest = mkRequest "gpt-3.5-turbo" $ usermsg "Why is the sky blue?" + token <- tokenFromFile "path/to/openai/key" + TL.putStrLn . jsonToText =<< openaiV1ChatJ token Nothing req + + -- Another example with exception handling that expects an OpenAIResponse + -- data structure, displaying that and also just the response text + openaiData :: IO () + openaiData = do + let req :: OpenAIRequest = mkRequest "gpt-3.5-turbo" + ( systemmsg "Answer in the style of Bugs Bunny. Try to work the phrase \"What's up Doc?\" in somewhere." + <> usermsg "Why is the sky blue?" + <> numopt "temperature" 0.8 + <> stringopt "service_tier" "default" + ) + token <- tokenFromFile "path/to/openai/key" + res <- openaiV1Chat token Nothing req `catches` + [ Handler (\(e :: GenAIException) -> error . show $ e) + , Handler (\(e :: ClientError) -> error . show $ e) + ] + print res -- The entire OpenAIResponse + TL.putStrLn . getMessage $ res -- Just the response Message Content ## Getting source diff --git a/genai-lib.cabal b/genai-lib.cabal --- a/genai-lib.cabal +++ b/genai-lib.cabal @@ -1,11 +1,11 @@ cabal-version: 2.2 name: genai-lib -version: 1.3 -synopsis: Library and command line tool for interacting with various generative - AI LLMs -description: Library and command line tool for performing completions and chats - with various generative AI LLMs (Large Language Models). +version: 2.0 +synopsis: A library for interacting with various generative AI LLMs +description: A library for performing completions and chats with various + generative AI LLMs (Large Language Models). Works today with Ollama and + OpenAI with more to come in the future. author: Dino Morelli maintainer: dino@ui3.info copyright: 2024 Dino Morelli @@ -58,43 +58,48 @@ -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints - build-depends: - aeson >= 2.1.2 && < 2.2 - , base >= 3 && < 5 - , formatting >= 7.2.0 && < 7.3 - , text >= 1.2.5 && < 3 library import: lang exposed-modules: - GenAILib.Common + GenAILib GenAILib.HTTP + GenAILib.JSON GenAILib.Ollama - GenAILib.System.Log + GenAILib.OpenAI hs-source-dirs: src/lib build-depends: - bytestring >= 0.11.4 && < 0.12 - , hslogger >= 1.3.1 && < 1.4 + aeson >= 2.1.2 && < 2.2 + , base >= 3 && < 5 + , bytestring >= 0.11.4 && < 0.12 + , containers >= 0.6.7 && < 0.7 , http-client >= 0.7.16 && < 0.8 + , http-client-tls >= 0.3.6 && < 0.4 + , scientific >= 0.3.7 && < 0.4 , servant >= 0.20.1 && < 0.21 , servant-client >= 0.20 && < 0.21 , servant-client-core >= 0.20 && < 0.21 , string-conv >= 0.2.0 && < 0.3 + , text >= 1.2.5 && < 3 + , time >= 1.12.2 && < 1.13 -executable genai +executable ex-genai-ollama import: lang - main-is: Main.hs + main-is: ex-genai-ollama.hs hs-source-dirs: - src/app - other-modules: - GenAI.Common - GenAI.Opts - Paths_genai_lib - autogen-modules: - Paths_genai_lib + src/example build-depends: - heredoc >= 0.2.0 && < 0.3 + base >= 3 && < 5 , genai-lib - , optparse-applicative >= 0.17.1 && < 0.19 - , prettyprinter >= 1.7.1 && < 1.8 + , text >= 1.2.5 && < 3 + +executable ex-genai-openai + import: lang + main-is: ex-genai-openai.hs + hs-source-dirs: + src/example + build-depends: + base >= 3 && < 5 + , genai-lib + , text >= 1.2.5 && < 3 diff --git a/src/app/GenAI/Common.hs b/src/app/GenAI/Common.hs deleted file mode 100644 --- a/src/app/GenAI/Common.hs +++ /dev/null @@ -1,39 +0,0 @@ -{-# LANGUAGE OverloadedRecordDot #-} - -module GenAI.Common - where - -import Data.Aeson (Value (Object)) -import Data.Aeson.Types (emptyObject) -import Data.Text.Lazy qualified as TL -import GenAILib.Common (LLMOptions (..), Model, Prompt (..), RawOutput) -import GenAILib.Ollama (Host, OllamaRequest (..), Stream, System) -import GenAILib.System.Log (Priority (DEBUG)) - - -data CLIOptions = CLIOptions - { host :: Host - , system :: Maybe System - , llmOptions :: LLMOptions - , stream :: Stream - , rawOutput :: RawOutput - , verbose :: Verbose - , model :: Model - } - - -newtype Verbose = Verbose Bool - deriving Show - - -verbosityToPriority :: Verbose -> Maybe Priority -verbosityToPriority (Verbose True) = Just DEBUG -verbosityToPriority (Verbose False) = Nothing - - -mkLLMRequest :: CLIOptions -> TL.Text -> OllamaRequest -mkLLMRequest opts promptText = OllamaRequest opts.model opts.system - (Prompt promptText) opts.stream (wrapMaybe opts.llmOptions.v) - where - wrapMaybe o@(Object _) = if o == emptyObject then Nothing else Just o - wrapMaybe _ = Nothing diff --git a/src/app/GenAI/Opts.hs b/src/app/GenAI/Opts.hs deleted file mode 100644 --- a/src/app/GenAI/Opts.hs +++ /dev/null @@ -1,154 +0,0 @@ -{-# LANGUAGE DuplicateRecordFields, OverloadedRecordDot, QuasiQuotes #-} - -module GenAI.Opts - ( parseOpts - ) - where - -import Data.Text.Lazy (pack) -import Data.Version (showVersion) -import Formatting ((%+), format, formatToString, string) -import Formatting.ShortFormatters (s) -import GenAILib.Common (Model (..), RawOutput (..), convertOptions) -import GenAILib.Ollama (Host (..), Stream (..), - System (..), defaultHost, hostFromString) -import Options.Applicative -import Paths_genai_lib (version) -import Prettyprinter (pretty) -import System.Environment (getProgName) -import Text.Heredoc (here) - -import GenAI.Common (CLIOptions (..), Verbose (..)) - - -readHost :: ReadM Host -readHost = eitherReader (\hostPortStr -> - maybe - (Left $ formatToString - ("Unable to parse" %+ string %+ "into host and port parts") hostPortStr) - Right - $ hostFromString hostPortStr - ) - - -{- HLINT ignore "Functor law" -} -parser :: Parser CLIOptions -parser = CLIOptions - <$> option readHost - ( long "host" - <> short 'H' - <> metavar "HOST:PORT" - <> help "Host and port where ollama serve is running" - <> showDefault - <> value defaultHost - ) - -- NOTE: The inner <$> is for Maybe, the outer <$> is for Parser - <*> ( (System . pack <$>) <$> optional ( strOption - ( long "system" - <> short 's' - <> metavar "STR" - <> help "System parameter" - ) - )) - <*> ( convertOptions <$> many ( strOption - ( long "option" - <> short 'o' - <> metavar "KEY:VALUE" - <> help "Options for the LLM, repeat for each option pair. See LLM OPTIONS below" - ) - )) - <*> ( Stream <$> switch - ( long "stream" - <> help "Response will be returned as a stream of objects" - ) - ) - <*> ( RawOutput <$> switch - ( long "raw-output" - <> short 'r' - <> help "Output the entire JSON response from the LLM" - ) - ) - <*> ( Verbose <$> switch - ( long "verbose" - <> short 'v' - <> help "Enable verbose output. Note: All logging goes to stderr" - ) - ) - <*> ( Model . pack <$> argument str - ( metavar "MODEL_ID" - <> help "Model identifier, see available models with `ollama list`" - ) - ) - - -versionHelper :: String -> Parser (a -> a) -versionHelper progName = - infoOption (formatToString (s %+ s) progName (showVersion version)) $ mconcat - [ long "version" - , help "Show version information" - , hidden - ] - - -parseOpts :: IO CLIOptions -parseOpts = do - pn <- getProgName - execParser $ info (parser <**> helper <**> versionHelper pn) - ( header (formatToString (s %+ "- Command line tool for interacting with an ollama server") pn) - <> footer' - ) - - -footer' :: InfoMod a -footer' = footerDoc . Just . pretty . format content . showVersion $ version - where content = [here|OVERVIEW - -This software expects the prompt string on STDIN and will respond with the LLM -response on STDOUT - -example usage - - $ echo "Why is the sky blue?" | genai some-fancy-model - -WHY WAS THIS DONE? - -ollama ships with command-line ability to submit prompts and do completions: - - $ ollama MODEL [PROMPT] ... - -but as far as I can see there's no easy way to use this method to change -options like the temperature and seed. This software allows greater control -over the options. - - $ echo "Tell me a story" | genai some-other-model -o temperature:0.2 - -LLM OPTIONS - -Some settings are communicated to the LLM as a map of options. Use them like this - - -o temperature:0.2 - -Some useful options - - option name description default - ------------------------------------------------------------------------------------- - seed Sets the random number seed to use for generation. Setting 0 - this to a specific number will make the model generate the - same text for the same prompt. - temperature The temperature of the model. Increasing the temperature 0.8 - will make the model answer more creatively. - Range 0.0 to 1.0 - top_k Reduces the probability of generating nonsense. A higher 40 - value (e.g. 100) will give more diverse answers, while a - lower value (e.g. 10) will be more conservative. - Range 0 to 100 - top_p Works together with top-k. A higher value (e.g., 0.95) will 0.9 - lead to more diverse text, while a lower value (e.g., 0.5) - will generate more focused and conservative text. - Range unknown, guessing 0.0 to 1.0 - -For the complete list of LLM options, see - -https://github.com/ollama/ollama/blob/main/docs/modelfile.md#valid-parameters-and-values - -Version|] %+ s %+ " Dino Morelli " diff --git a/src/app/Main.hs b/src/app/Main.hs deleted file mode 100644 --- a/src/app/Main.hs +++ /dev/null @@ -1,22 +0,0 @@ -{-# LANGUAGE OverloadedRecordDot #-} - -import Data.Text.Lazy.IO qualified as TL -import GenAILib.HTTP (display, doCompletion) -import GenAILib.System.Log (infoM, initLogging, lname) -import System.IO (stdin) - -import GenAI.Common (CLIOptions (host, rawOutput, verbose), mkLLMRequest, - verbosityToPriority) -import GenAI.Opts (parseOpts) - - -main :: IO () -main = do - opts <- parseOpts - initLogging . verbosityToPriority . verbose $ opts - infoM lname "Logging configured" - infoM lname "Args parsed" - - promptText <- TL.hGetContents stdin - let or' = mkLLMRequest opts promptText - doCompletion opts.host or' >>= display opts.rawOutput diff --git a/src/example/ex-genai-ollama.hs b/src/example/ex-genai-ollama.hs new file mode 100644 --- /dev/null +++ b/src/example/ex-genai-ollama.hs @@ -0,0 +1,39 @@ +import Control.Exception (Handler (..), catches) +import Data.Text.Lazy.IO qualified as TL +import GenAILib (ClientError, Request (..), boolopt, jsonToText, mkRequest, + numopt, optional, systemmsg, usermsg) +import GenAILib.HTTP (GenAIException, ollamaChat, ollamaChatJ) +import GenAILib.Ollama (OllamaRequest, getMessage, keepalive) + + +main :: IO () +main = do + ollamaJSON + ollamaData + +-- A simple example with no error handling that expects an Aeson Value +-- (OllamaRequest is an instance of ToJSON) and displays the encoded JSON +-- response +ollamaJSON :: IO () +ollamaJSON = do + let req :: OllamaRequest = mkRequest "gemma3:1b" $ usermsg "Why is the sky blue?" + TL.putStrLn . jsonToText =<< ollamaChatJ Nothing req + +-- Another example with exception handling that expects an OllamaResponse +-- data structure, displaying that and also just the response text +ollamaData :: IO () +ollamaData = do + let mbDuration = Just "30m" + let req = mkRequest "gemma3:1b" + ( systemmsg "Answer in the style of Bugs Bunny. Try to work in the phrase \"What's up Doc?\" somewhere." + <> usermsg "Why is the sky blue?" + <> numopt "temperature" 0.1 + <> boolopt "penalize_newline" True + <> (keepalive `optional` mbDuration) + ) + res <- ollamaChat Nothing req `catches` + [ Handler (\(e :: GenAIException) -> error . show $ e) + , Handler (\(e :: ClientError) -> error . show $ e) + ] + print res -- The entire OllamaResponse + TL.putStrLn . getMessage $ res -- Just the response Message Content diff --git a/src/example/ex-genai-openai.hs b/src/example/ex-genai-openai.hs new file mode 100644 --- /dev/null +++ b/src/example/ex-genai-openai.hs @@ -0,0 +1,40 @@ +import Control.Exception (Handler (..), catches) +import Data.Text.Lazy.IO qualified as TL +import GenAILib (ClientError, Request (..), jsonToText, mkRequest, numopt, + stringopt, systemmsg, usermsg) +import GenAILib.HTTP (GenAIException, openaiV1Chat, openaiV1ChatJ, + tokenFromFile) +import GenAILib.OpenAI (OpenAIRequest, getMessage) + + +main :: IO () +main = do + openaiJSON + openaiData + +-- A simple example with no error handling that expects an Aeson Value +-- (OpenAIRequest is an instance of ToJSON) and displays the encoded JSON +-- response +openaiJSON :: IO () +openaiJSON = do + let req :: OpenAIRequest = mkRequest "gpt-3.5-turbo" $ usermsg "Why is the sky blue?" + token <- tokenFromFile "path/to/openai/key" + TL.putStrLn . jsonToText =<< openaiV1ChatJ token Nothing req + +-- Another example with exception handling that expects an OpenAIResponse +-- data structure, displaying that and also just the response text +openaiData :: IO () +openaiData = do + let req :: OpenAIRequest = mkRequest "gpt-3.5-turbo" + ( systemmsg "Answer in the style of Bugs Bunny. Try to work the phrase \"What's up Doc?\" in somewhere." + <> usermsg "Why is the sky blue?" + <> numopt "temperature" 0.8 + <> stringopt "service_tier" "default" + ) + token <- tokenFromFile "path/to/openai/key" + res <- openaiV1Chat token Nothing req `catches` + [ Handler (\(e :: GenAIException) -> error . show $ e) + , Handler (\(e :: ClientError) -> error . show $ e) + ] + print res -- The entire OpenAIResponse + TL.putStrLn . getMessage $ res -- Just the response Message Content diff --git a/src/lib/GenAILib.hs b/src/lib/GenAILib.hs new file mode 100644 --- /dev/null +++ b/src/lib/GenAILib.hs @@ -0,0 +1,209 @@ +module GenAILib + ( + -- * A library for interacting with LLM back-ends like Ollama and OpenAI + -- + -- | An example + -- + -- > import Control.Exception (Handler (..), catches) + -- > import Data.Text.Lazy.IO qualified as TL + -- > import GenAILib (ClientError, Request (..), jsonToText, mkRequest, numopt, + -- > stringopt, systemmsg, usermsg) + -- > import GenAILib.HTTP (GenAIException, openaiV1Chat, openaiV1ChatJ, + -- > tokenFromFile) + -- > import GenAILib.OpenAI (OpenAIRequest, getMessage) + -- > + -- > + -- > main :: IO () + -- > main = do + -- > openaiJSON + -- > openaiData + -- > + -- > -- A simple example with no error handling that expects an Aeson Value + -- > -- (OpenAIRequest is an instance of ToJSON) and displays the encoded JSON + -- > -- response + -- > openaiJSON :: IO () + -- > openaiJSON = do + -- > let req :: OpenAIRequest = mkRequest "gpt-3.5-turbo" $ usermsg "Why is the sky blue?" + -- > token <- tokenFromFile "path/to/openai/key" + -- > TL.putStrLn . jsonToText =<< openaiV1ChatJ token Nothing req + -- > + -- > -- Another example with exception handling that expects an OpenAIResponse + -- > -- data structure, displaying that and also just the response text + -- > openaiData :: IO () + -- > openaiData = do + -- > let req :: OpenAIRequest = mkRequest "gpt-3.5-turbo" + -- > ( systemmsg "Answer in the style of Bugs Bunny. Try to work the phrase \"What's up Doc?\" in somewhere." + -- > <> usermsg "Why is the sky blue?" + -- > <> numopt "temperature" 0.8 + -- > <> stringopt "service_tier" "default" + -- > ) + -- > token <- tokenFromFile "path/to/openai/key" + -- > res <- openaiV1Chat token Nothing req `catches` + -- > [ Handler (\(e :: GenAIException) -> error . show $ e) + -- > , Handler (\(e :: ClientError) -> error . show $ e) + -- > ] + -- > print res -- The entire OpenAIResponse + -- > TL.putStrLn . getMessage $ res -- Just the response Message Content + + Request (..) + , RequestMod (..) + , usermsg + , numopt + , boolopt + , stringopt + , systemmsg + , optional + , mkMessage + , mkMessageWithRole + , Model (..) + , Message (..) + , Role (..) + , Content (..) + , ImageData (..) + , Stream (..) + + -- re-exporting + , ClientError + , module GenAILib.JSON + ) + where + +import Data.Aeson (FromJSON, ToJSON, Value (Number, String)) +import Data.Aeson qualified as A +import Data.List.NonEmpty (NonEmpty) +import Data.Scientific (fromFloatDigits) +import Data.Text qualified as TS +import Data.Text.Lazy qualified as TL +import GHC.Generics (Generic) +import Servant.Client.Core (ClientError) + +import GenAILib.JSON + + +-- | The name of an LLM model +-- +-- This lets the back-end know which model we want to use by name. +newtype Model = Model TL.Text + deriving (Generic, Show) + +instance FromJSON Model +instance ToJSON Model + + +-- | Text values sent to and from LLMs like prompts and responses. +newtype Content = Content TL.Text + deriving (Generic, Show) + +instance FromJSON Content +instance ToJSON Content + + +-- | Which role is responsible for this content +-- +-- Valid values are 'system', 'user', 'assistant' or 'tool' +newtype Role = Role TL.Text + deriving (Generic, Show) + +instance FromJSON Role +instance ToJSON Role + + +-- | Base64 encoded image data for working with models +newtype ImageData = ImageData TL.Text + deriving (Generic, Show) + +instance FromJSON ImageData +instance ToJSON ImageData + + +-- | Requests and responses to and from LLMs contain one or more @Message@s +-- +-- These data structures always contain a @Role@ and some @Content@ and may +-- also optionally have an array of image data. +-- +-- NOTE: The images as base64 encoded @Text@ are specific to Ollama at this +-- time and work is ongoing to support OpenAI's APIs +data Message = Message + { role :: Role + , content :: Content + , images :: Maybe (NonEmpty ImageData) + } + deriving (Generic, Show) + +instance FromJSON Message +instance ToJSON Message + + +-- | Convenience function to create a simple @Message@ with the role of 'user', +-- some @Content@ (prompt text) and no image data. +mkMessage :: TL.Text -> Message +mkMessage = mkMessageWithRole $ Role "user" + + +-- | Convenience function to create a simple @Message@ with the specified role, +-- some @Content@ (prompt text) and no image data. +mkMessageWithRole :: Role -> TL.Text -> Message +mkMessageWithRole role' content = Message role' (Content content) Nothing + + +-- | Whether the back-end should use streaming to send response data in "chunks" +-- +-- NOTE: This is mostly unused at this time and the behavior is untested +newtype Stream = Stream Bool + deriving (Generic, Show) + +instance ToJSON Stream + + +class Request a where + -- | Append a @Message@ to an existing request + appendMessage :: Message -> a -> a + + -- | Construct a new @Request@ + -- Note: This request has no prompt data yet so at a minimum it must be used like this + -- + -- > mkRequest "somefabulousmodel" $ usermsg "some fabulous prompt" + mkRequest :: TL.Text -> RequestMod a -> a + + -- | Set an arbitrary LLM option given a name and JSON @Value@ + -- This is used internally by functions like boolopt, stringopt, ... + setOpt :: TS.Text -> Value -> a -> a + + +newtype RequestMod r = RequestMod (r -> r) + +instance Request r => Semigroup (RequestMod r) where + RequestMod f1 <> RequestMod f2 = RequestMod (f2 . f1) + + +-- | Append a system prompt +systemmsg :: Request r => TL.Text -> RequestMod r +systemmsg systemPrompt = RequestMod . appendMessage + $ mkMessageWithRole (Role "system") systemPrompt + + +-- | Append a user message (prompt) +usermsg :: Request r => TL.Text -> RequestMod r +usermsg prompt = RequestMod . appendMessage $ mkMessage prompt + + +-- | Apply a request modifier to a Maybe value +-- +-- > stringopt `optional` (Just "foo") +optional :: (a -> RequestMod r) -> Maybe a -> RequestMod r +optional = maybe $ RequestMod id + + +-- | Set an option with a @Bool@ value +boolopt :: Request r => TS.Text -> Bool -> RequestMod r +boolopt keystr = RequestMod . setOpt keystr . A.Bool + + +-- | Set an option with a @Double@ value +numopt :: Request r => TS.Text -> Double -> RequestMod r +numopt keystr = RequestMod . setOpt keystr . Number . fromFloatDigits + + +-- | Set an option with a @Text@ value +stringopt :: Request r => TS.Text -> TS.Text -> RequestMod r +stringopt keystr = RequestMod . setOpt keystr . String diff --git a/src/lib/GenAILib/Common.hs b/src/lib/GenAILib/Common.hs deleted file mode 100644 --- a/src/lib/GenAILib/Common.hs +++ /dev/null @@ -1,58 +0,0 @@ -{-# LANGUAGE DuplicateRecordFields #-} - -module GenAILib.Common - where - -import Control.Arrow ((&&&)) -import Control.Monad (when) -import Data.Aeson (Key, ToJSON, Value (Number, String), object, toJSON) -import Data.Aeson.Key (fromString) -import Data.Aeson.Types (Pair) -import Data.Maybe (mapMaybe) -import Data.String.Conv (toS) -import Data.Text.Lazy qualified as TL -import GHC.Generics (Generic) - - -newtype Model = Model TL.Text - deriving Generic - -instance ToJSON Model - - -newtype Prompt = Prompt TL.Text - deriving Generic - -instance ToJSON Prompt - - -splitAtColon :: String -> Maybe (String, String) -splitAtColon combinedStr = do - let (leftSide, rightSide) = takeWhile (/= ':') &&& dropWhile (/= ':') $ combinedStr - when (null rightSide) Nothing - pure (leftSide, tail rightSide) - - -newtype RawOutput = RawOutput Bool - - -newtype LLMOptions = LLMOptions { v :: Value } - deriving Generic - -instance ToJSON LLMOptions - - --- For debugging the LLM options parsing, unused most of the time -debugOptsJSON :: LLMOptions -> Value -debugOptsJSON = toJSON - -convertOptions :: [String] -> LLMOptions -convertOptions = LLMOptions . object . pairs' - -pairs' :: [String] -> [Pair] -pairs' = map convertTypes . mapMaybe splitAtColon - -convertTypes :: (String, String) -> (Key, Value) --- Turns out the only non-number option we're interested in for Ollama is "stop" -convertTypes (keystr@"stop", valstr) = (fromString keystr, String . toS $ valstr) -convertTypes (keystr, valstr) = (fromString keystr, Number . read $ valstr) diff --git a/src/lib/GenAILib/HTTP.hs b/src/lib/GenAILib/HTTP.hs --- a/src/lib/GenAILib/HTTP.hs +++ b/src/lib/GenAILib/HTTP.hs @@ -1,37 +1,57 @@ {-# LANGUAGE DataKinds, TypeOperators #-} module GenAILib.HTTP - ( display - , doChat - , doCompletion + ( BearerToken (..) + , GenAIException + , ollamaChat + , ollamaChatJ + , openaiV1Chat + , openaiV1ChatJ + , tokenFromText + , tokenFromFile ) where -import Data.Aeson (FromJSON, ToJSON, Value (Object, String), decode, encode) -import Data.Aeson.KeyMap qualified as A -import Data.ByteString.Lazy qualified as BL +import Control.Exception (Exception, throwIO) +import Data.Aeson (FromJSON, ToJSON, Value (Object), decode, encode, toJSON) import Data.Maybe (fromMaybe) import Data.Proxy (Proxy (..)) -import Data.String.Conv (toS) +import Data.Text qualified as TS import Data.Text.IO qualified as TS -import Formatting ((%+), formatToString, string) -import Network.HTTP.Client (defaultManagerSettings, managerResponseTimeout, - newManager, responseTimeoutMicro) -import Servant.API ((:<|>) (..), (:>), JSON, Post, ReqBody) -import Servant.Client (BaseUrl (..), Scheme (Http), ClientM, - mkClientEnv, runClientM) +import Data.Typeable (Typeable) +import Network.HTTP.Client (Manager, defaultManagerSettings, + managerResponseTimeout, newManager, responseTimeoutMicro) +import Network.HTTP.Client.TLS (newTlsManagerWith, tlsManagerSettings) +import Servant.API ((:<|>) (..), (:>), Header', JSON, Post, ReqBody, Required, + ToHttpApiData) +import Servant.Client (BaseUrl (..), ClientM, mkClientEnv, runClientM) import Servant.Client.Core (clientIn) -import System.Exit (exitFailure) -import GenAILib.Common (RawOutput (..)) -import GenAILib.Ollama (Host (..)) -import GenAILib.System.Log (debugM, emergencyM, errorM, lname) +import GenAILib.Ollama (OllamaResponse) +import GenAILib.Ollama qualified as Ollama +import GenAILib.OpenAI (OpenAIResponse) +import GenAILib.OpenAI qualified as OpenAI defaultHttpTimeout :: Int defaultHttpTimeout = 1_200_000_000 -- In microseconds, this is 2 minutes +-- | A type to contain the Authorization Bearer token data needed for some requests +newtype BearerToken = BearerToken TS.Text + deriving ToHttpApiData + + +-- | Construct bearer token authorization header data from @Text@ +tokenFromText :: TS.Text -> BearerToken +tokenFromText = BearerToken . ("Bearer " <>) . TS.strip + + +-- | Construct bearer token authorization header data from the contents of a file +tokenFromFile :: FilePath -> IO BearerToken +tokenFromFile path = tokenFromText <$> TS.readFile path + + {- NOTE: The reason we've chosen Aeson's Value type for the response is we want to do one of these things with these responses: @@ -41,9 +61,13 @@ We don't need to model the entire Ollama response JSON document to achieve these goals. -} +type CommonReqMethodRes = ReqBody '[JSON] Value :> Post '[JSON] Value + type API - = "api" :> "generate" :> ReqBody '[JSON] Value :> Post '[JSON] Value - :<|> "api" :> "chat" :> ReqBody '[JSON] Value :> Post '[JSON] Value + = "api" :> "chat" :> CommonReqMethodRes + :<|> "v1" :> "chat" :> "completions" + :> Header' '[Required] "Authorization" BearerToken + :> CommonReqMethodRes -- A Proxy to our API api :: Proxy API @@ -52,46 +76,47 @@ clientM :: Proxy ClientM clientM = Proxy -completion :: Value -> ClientM Value -chat :: Value -> ClientM Value -(completion :<|> chat) = api `clientIn` clientM +clientOllamaChat :: Value -> ClientM Value +clientOpenAIV1Chat :: BearerToken -> Value -> ClientM Value +(clientOllamaChat :<|> clientOpenAIV1Chat) = api `clientIn` clientM -doCompletion :: ToJSON j => Host -> j -> IO Value -doCompletion = doRequest completion +data GenAIException = PostMarshallingException | UnknownResponse String + deriving (Show, Typeable) -doChat :: ToJSON j => Host -> j -> IO Value -doChat = doRequest chat +instance Exception GenAIException -doRequest :: (FromJSON f, ToJSON t) => (f -> ClientM Value) -> Host -> t -> IO Value -doRequest client' (Host hostName port) bodyData = do - debugM lname . toS . encode $ bodyData - let - bodyDoc = fromMaybe (error "Something went wrong with JSON-ifying the POST data") - . decode . encode $ bodyData + +-- | Make a request to an Ollama server resulting in a JSON @Value@ +ollamaChatJ :: ToJSON j => Maybe BaseUrl -> j -> IO Value +ollamaChatJ mBaseUrl j = do manager' <- newManager $ defaultManagerSettings { managerResponseTimeout = responseTimeoutMicro defaultHttpTimeout } - eres <- runClientM (client' bodyDoc) - (mkClientEnv manager' (BaseUrl Http (toS hostName) port "")) - case eres of - Left err -> logAndExit $ show err - Right v@(Object _) -> pure v - Right somethingElse -> logAndExit $ show somethingElse + doRequest clientOllamaChat manager' (fromMaybe Ollama.defaultUrl mBaseUrl) j +-- | Make a request to an Ollama server resulting in a high-level Ollama response +ollamaChat :: ToJSON j => Maybe BaseUrl -> j -> IO OllamaResponse +ollamaChat mBaseUrl j = maybe + (throwIO . UnknownResponse $ "Unable to read JSON response as an OllamaResponse. Try using ollamaChatJ instead to inspect the bare JSON") pure . decode . encode =<< ollamaChatJ mBaseUrl j -logAndExit :: String -> IO a -logAndExit msg = do - errorM lname $ formatToString ("Can't continue:" %+ string) msg - exitFailure +-- | Make a request to an OpenAI server resulting in a JSON @Value@ +openaiV1ChatJ :: ToJSON j => BearerToken -> Maybe BaseUrl -> j -> IO Value +openaiV1ChatJ token mBaseUrl j = do + manager' <- newTlsManagerWith $ tlsManagerSettings + { managerResponseTimeout = responseTimeoutMicro defaultHttpTimeout } + doRequest (clientOpenAIV1Chat token) manager' (fromMaybe OpenAI.defaultUrl mBaseUrl) $ toJSON j +-- | Make a request to an OpenAI server resulting in a high-level OpenAI response +openaiV1Chat :: ToJSON j => BearerToken -> Maybe BaseUrl -> j -> IO OpenAIResponse +openaiV1Chat token mBaseUrl j = maybe + (throwIO . UnknownResponse $ "Unable to read JSON response as an OpenAIResponse. Try using openaiV1ChatJ instead to inspect the bare JSON") pure . decode . encode =<< openaiV1ChatJ token mBaseUrl j -display :: RawOutput -> Value -> IO () -display (RawOutput True) v = BL.putStr $ encode v <> "\n" - -display (RawOutput False) (Object keyMap) = case A.lookup "response" keyMap of - Just (String t) -> TS.putStrLn t - Just somethingElse -> emergencyM lname $ show somethingElse - Nothing -> emergencyM lname $ show keyMap - -display _ somethingElse = emergencyM lname $ show somethingElse +doRequest :: (FromJSON f, ToJSON t) => (f -> ClientM Value) -> Manager -> BaseUrl -> t -> IO Value +doRequest client' manager' baseUrl bodyData = do + bodyDoc <- maybe (throwIO PostMarshallingException) pure $ decode . encode $ bodyData + eres <- runClientM (client' bodyDoc) (mkClientEnv manager' baseUrl) + case eres of + Right v@(Object _) -> pure v + Left err -> throwIO err + Right somethingElse -> throwIO . UnknownResponse . show $ somethingElse diff --git a/src/lib/GenAILib/JSON.hs b/src/lib/GenAILib/JSON.hs new file mode 100644 --- /dev/null +++ b/src/lib/GenAILib/JSON.hs @@ -0,0 +1,61 @@ +module GenAILib.JSON + ( customJSONOptions + , flattenOptions + , jsonToText + ) + where + +import Data.Aeson (Options, Value (Object), defaultOptions, encode, + fieldLabelModifier, omitNothingFields) +import Data.Aeson.Key (fromText) +import Data.Aeson.KeyMap ((!?), delete, union) +import Data.String.Conv (toS) +import Data.Text.Lazy qualified as TL + + +stripInitialUnderscore :: String -> String +stripInitialUnderscore ('_' : fieldName) = fieldName +stripInitialUnderscore fieldName = fieldName + + +customJSONOptions :: Options +customJSONOptions = defaultOptions + { fieldLabelModifier = stripInitialUnderscore + , omitNothingFields = True + } + + +-- | Most LLM back-ends expect the options like temperature to be at the +-- top-level of the object. This function will move the options Object up and +-- merge it with the other keys, removing the options Object as well. +-- +-- Used internally by this library to construct LLM request bodies +-- +-- This +-- +-- > { "foo" : 1 +-- > , "bar" : 5 +-- > , "options" : { "bar" : 2, "baz" : 3 } +-- > } +-- +-- Becomes this +-- +-- > { "foo" : 1 +-- > , "bar" : 2 +-- > , "baz" : 3 +-- > } +flattenOptions :: Value -> Value + +flattenOptions (Object origKm) = Object newKm + where + optsKey = fromText "options" + newKm = case origKm !? optsKey of + (Just (Object optsKm)) -> delete optsKey origKm `union` optsKm + _ -> origKm + +flattenOptions nonObjValue = nonObjValue + + +-- | Convenience function to textify a JSON @Value@ +jsonToText :: Value -> TL.Text +jsonToText = toS . encode diff --git a/src/lib/GenAILib/Ollama.hs b/src/lib/GenAILib/Ollama.hs --- a/src/lib/GenAILib/Ollama.hs +++ b/src/lib/GenAILib/Ollama.hs @@ -1,72 +1,113 @@ -{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE DuplicateRecordFields, OverloadedRecordDot #-} module GenAILib.Ollama - ( Host (..) - , OllamaRequest (..) - , Stream (..) - , System (..) - , defaultHost - , hostFromString + ( OllamaRequest (..) + , defaultUrl + , KeepAlive (..) + , keepalive + , OllamaResponse (..) + , getMessage + -- , stream' ) where -import Data.Aeson (ToJSON, Value, defaultOptions, genericToEncoding, - genericToJSON, omitNothingFields, toEncoding, toJSON) -import Data.Aeson qualified as Aeson -import Data.String.Conv (toS) +import Data.Aeson (FromJSON, ToJSON, Value (Object), + genericToEncoding, genericToJSON, toEncoding, toJSON) +import Data.Aeson.Key (fromText) +import Data.Aeson.KeyMap (singleton, union) +import Data.Maybe (fromMaybe) +import Data.Sequence (Seq, (|>), empty) +import Data.Text qualified as TS import Data.Text.Lazy qualified as TL -import Formatting ((%), formatToString, int, text) +import Data.Time (UTCTime) import GHC.Generics (Generic) -import Text.Read (readMaybe) - -import GenAILib.Common (Model, Prompt, splitAtColon) - - -newtype Stream = Stream Bool - deriving Generic +import Servant.Client (BaseUrl, parseBaseUrl) -instance ToJSON Stream +import GenAILib (Content (..), Message (..), Model (..), Request (..), + RequestMod (..), Stream (..)) +import GenAILib.JSON (customJSONOptions) -{- ^ This data structure is used to construct the POST body for an Ollama REST call --} +-- | Data for making Ollama requests data OllamaRequest = OllamaRequest { model :: Model - , system :: Maybe System - , prompt :: Prompt - , stream :: Stream + , messages :: Seq Message , options :: Maybe Value + , stream :: Stream + , keep_alive :: Maybe KeepAlive } - deriving Generic - -customOptions :: Aeson.Options -customOptions = defaultOptions { omitNothingFields = True } + deriving (Generic, Show) instance ToJSON OllamaRequest where - toJSON = genericToJSON customOptions - toEncoding = genericToEncoding customOptions + toJSON = genericToJSON customJSONOptions + toEncoding = genericToEncoding customJSONOptions +instance Request OllamaRequest where + appendMessage :: Message -> OllamaRequest -> OllamaRequest + appendMessage newMessage oldReq = oldReq { messages = oldReq.messages |> newMessage } -data Host = Host TL.Text Int + mkRequest :: TL.Text -> RequestMod OllamaRequest -> OllamaRequest + mkRequest modelName (RequestMod optSetter) = optSetter + $ OllamaRequest (Model modelName) empty Nothing (Stream False) Nothing --- I don't normally do this because it harms debugging when we want to see the --- actual Haskell data structure serialized BUT this plays nicer with --- optparse-applicative's showDefault -instance Show Host where - show (Host hostName port) = formatToString (text % ":" % int) hostName port + setOpt :: TS.Text -> Value -> OllamaRequest -> OllamaRequest + setOpt keystr val req = req { options = Just . Object $ combinedKm } + where + newKm = singleton (fromText keystr) val + combinedKm = case options req of + (Just (Object existingKm)) -> existingKm `union` newKm + _ -> newKm -defaultHost :: Host -defaultHost = Host "localhost" 11434 +-- | How long an Ollama model is kept in memory before clean-up by the Ollama +-- daemon +-- +-- This is specific to Ollama. +newtype KeepAlive = KeepAlive TL.Text + deriving (Generic, Show) +instance ToJSON KeepAlive -hostFromString :: String -> Maybe Host -hostFromString combinedStr = do - (hostName, portStr) <- splitAtColon combinedStr - Host (toS hostName) <$> readMaybe portStr +-- FIXME streaming does not work yet for Ollama via this library +-- Enable or disable streaming +-- stream' :: Bool -> OllamaRequest -> OllamaRequest +-- stream' b req = req { stream = Stream b } -newtype System = System TL.Text - deriving Generic -instance ToJSON System +-- | Set the keep_alive duration +-- +-- This takes string duration values like '35m' or '1h' +keepalive :: TL.Text -> RequestMod OllamaRequest +keepalive ka = RequestMod (\req -> req { keep_alive = Just (KeepAlive ka) }) + + +-- | Data returned for Ollama requests +data OllamaResponse = OllamaResponse + { model :: Model + , created_at :: UTCTime + , message :: Message + , done :: Bool + -- Doubtful anyone really needs these fields + -- , total_duration :: Integer + -- , load_duration :: Integer + -- , prompt_eval_count :: Integer + -- , prompt_eval_duration :: Integer + -- , eval_count :: Integer + -- , eval_duration :: Integer + } + deriving (Generic, Show) + +instance FromJSON OllamaResponse + + +-- | The default URL for making Ollama REST calls +defaultUrl :: BaseUrl +defaultUrl = fromMaybe (error "Unable to construct the default url for Ollama!") + $ parseBaseUrl "localhost:11434" + + +-- | Convenience function to extract the response text +getMessage :: OllamaResponse -> TL.Text +getMessage res = assistantResponse + where (Content assistantResponse) = content . message $ res diff --git a/src/lib/GenAILib/OpenAI.hs b/src/lib/GenAILib/OpenAI.hs new file mode 100644 --- /dev/null +++ b/src/lib/GenAILib/OpenAI.hs @@ -0,0 +1,100 @@ +{-# LANGUAGE DuplicateRecordFields, OverloadedRecordDot #-} + +module GenAILib.OpenAI + ( OpenAIResponse (..) + , OpenAIRequest (..) + , defaultUrl + , getMessage + ) + where + +import Data.Aeson (FromJSON, ToJSON, Value (Object, String), (.:), + genericToEncoding, genericToJSON, parseJSON, toEncoding, toJSON) +import Data.Aeson.Key (fromText) +import Data.Aeson.KeyMap (singleton, union) +import Data.Aeson.Types (prependFailure, typeMismatch) +import Data.Maybe (fromMaybe) +import Data.Sequence (Seq, (|>), empty) +import Data.Text qualified as TS +import Data.Text.Lazy qualified as TL +import Data.Time (UTCTime) +import Data.Time.Clock.POSIX (posixSecondsToUTCTime) +import GHC.Generics (Generic) +import Servant.Client (BaseUrl, parseBaseUrl) + +import GenAILib (Content (..), Message (..), Model (..), Request (..), + RequestMod (..), Stream (..)) +import GenAILib.JSON (customJSONOptions, flattenOptions) + + +-- | Data for making OpenAI requests +data OpenAIRequest = OpenAIRequest + { model :: Model + , messages :: Seq Message + , options :: Maybe Value + , stream :: Maybe Stream + } + deriving (Generic, Show) + +instance ToJSON OpenAIRequest where + toJSON = flattenOptions . genericToJSON customJSONOptions + toEncoding = genericToEncoding customJSONOptions + +instance Request OpenAIRequest where + appendMessage :: Message -> OpenAIRequest -> OpenAIRequest + appendMessage newMessage oldReq = oldReq { messages = oldReq.messages |> newMessage } + + mkRequest :: TL.Text -> RequestMod OpenAIRequest -> OpenAIRequest + mkRequest modelName (RequestMod optSetter) = optSetter + $ OpenAIRequest (Model modelName) empty Nothing Nothing + + setOpt :: TS.Text -> Value -> OpenAIRequest -> OpenAIRequest + setOpt keystr val req = req { options = Just . Object $ combinedKm } + where + newKm = singleton (fromText keystr) val + combinedKm = case options req of + (Just (Object existingKm)) -> existingKm `union` newKm + _ -> newKm + + +-- | Data returned for OpenAI requests +data OpenAIResponse = OpenAIResponse + { model :: Model + , created :: UTCTime + , message :: Message + , done :: Bool + } + deriving (Generic, Show) + +-- Unfortunately, the OpenAI response JSON is a weird enough shape I decided to +-- take it apart it by-hand +{- HLINT ignore "Functor law" -} +instance FromJSON OpenAIResponse where + parseJSON (Object o) = do + choices <- o .: "choices" + choice <- if null choices + then fail "No elements in choices array, unable to decode this JSON" + else pure $ head choices + OpenAIResponse + <$> (Model <$> o .: "model") + <*> (posixSecondsToUTCTime <$> o .: "created") + <*> (parseJSON =<< choice .: "message") + <*> (isDone <$> choice .: "finish_reason") + parseJSON invalid = prependFailure "Parsing OpenAI chat completion response" + $ typeMismatch "Object" invalid + +isDone :: Value -> Bool +isDone (String s) = s == "stop" +isDone _ = False + + +-- | The default URL for OpenAI REST calls +defaultUrl :: BaseUrl +defaultUrl = fromMaybe (error "Unable to construct the default url for OpenAI!") + $ parseBaseUrl "https://api.openai.com" + + +-- | Convenience function to extract the response text +getMessage :: OpenAIResponse -> TL.Text +getMessage res = assistantResponse + where (Content assistantResponse) = content . message $ res diff --git a/src/lib/GenAILib/System/Log.hs b/src/lib/GenAILib/System/Log.hs deleted file mode 100644 --- a/src/lib/GenAILib/System/Log.hs +++ /dev/null @@ -1,47 +0,0 @@ -module GenAILib.System.Log - ( initLogging, lname - , logTest - - -- Re-exported from System.Log.Logger - , Priority (..), debugM, infoM, noticeM, warningM, errorM - , criticalM, alertM, emergencyM - ) - where - -import Data.Maybe (fromMaybe) -import System.IO (stderr) -import System.Log.Formatter (simpleLogFormatter) -import System.Log.Handler (setFormatter) -import System.Log.Handler.Simple (streamHandler) -import System.Log.Logger - - -lname :: String -lname = "normal-output" - - -initLogging :: Maybe Priority -> IO () -initLogging mLogPriority = do - let logPriority = fromMaybe NOTICE mLogPriority - - -- Remove the root logger's default handler that writes every - -- message to stderr! - updateGlobalLogger rootLoggerName removeHandler - - errH <- flip setFormatter (simpleLogFormatter "[$time : $prio] $msg") - <$> streamHandler stderr DEBUG - updateGlobalLogger lname $ setHandlers [errH] - updateGlobalLogger lname $ setLevel logPriority - - --- Test function to generate every kind of log message -logTest :: IO () -logTest = do - debugM lname "log test message DEBUG 1 of 8" - infoM lname "log test message INFO 2 of 8" - noticeM lname "log test message NOTICE 3 of 8" - warningM lname "log test message WARNING 4 of 8" - errorM lname "log test message ERROR 5 of 8" - criticalM lname "log test message CRITICAL 6 of 8" - alertM lname "log test message ALERT 7 of 8" - emergencyM lname "log test message EMERGENCY 8 of 8"