langchain-hs-gemini (empty) → 0.0.6.0
raw patch · 14 files changed
+2877/−0 lines, 14 filesdep +aesondep +aeson-qqdep +base
Dependencies added: aeson, aeson-qq, base, bytestring, conduit, containers, directory, filepath, http-client, http-client-tls, http-conduit, http-types, langchain-hs-core, langchain-hs-gemini, mtl, resourcet, servant, servant-client, servant-client-core, tasty, tasty-hunit, text, wai, warp
Files
- CHANGELOG.md +6/−0
- LICENSE +20/−0
- README.md +102/−0
- langchain-hs-gemini.cabal +99/−0
- src/Gemini/Client.hs +116/−0
- src/Gemini/Client/API.hs +78/−0
- src/Gemini/Client/Env.hs +137/−0
- src/Gemini/Client/Types.hs +931/−0
- src/Langchain/Embeddings/Gemini.hs +100/−0
- src/Langchain/Provider/Gemini.hs +334/−0
- test/Spec.hs +18/−0
- test/Test/Gemini/Client/InteractionsSpec.hs +651/−0
- test/Test/Gemini/Client/TypesSpec.hs +51/−0
- test/Test/Langchain/Provider/GeminiSpec.hs +234/−0
+ CHANGELOG.md view
@@ -0,0 +1,6 @@+# Changelog for langchain-hs-gemini++## 0.0.6.0 - 2026-10-02++- Initial release. Split from the monolithic `langchain-hs` package.+- Provides `Langchain.Provider.Gemini`.
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2025 Tushar Adhatrao++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,102 @@+# langchain-hs-gemini++Google Gemini Interactions v1 API client and LangChain provider for [langchain-hs](https://hackage.haskell.org/package/langchain-hs).++Built using type-safe **Servant bindings** over the official Google GenAI OpenAPI specification ([Interactions v1 API](https://ai.google.dev/api/interactions-api-v1)), following the design patterns of [`MercuryTechnologies/openai`](https://github.com/MercuryTechnologies/openai).++## Features++- **Type-Safe Servant Bindings (`Gemini.Client`)**:+ - `createInteraction` (`POST /v1/interactions`)+ - `getInteraction` (`GET /v1/interactions/{id}`)+ - `cancelInteraction` (`POST /v1/interactions/{id}/cancel`)+ - `deleteInteraction` (`DELETE /v1/interactions/{id}`)+ - `embedContent` (`POST /v1/models/{model}:embedContent`)+ - `batchEmbedContents` (`POST /v1/models/{model}:batchEmbedContents`)+ - SSE Streaming (`streamGeminiInteraction`)+- **LangChain ChatModel Provider (`Langchain.Provider.Gemini`)**:+ - Full `ChatModel` instance supporting synchronous `invoke` and streaming `stream`.+ - Multi-turn conversation mapping and system instructions.+ - Multi-modal content support (Base64 images, audio, documents).+ - Function calling & tool binding via `ToolBinder`.+ - Built-in tools: Code Execution, Google Search, Google Maps, File Search, URL Context.+- **LangChain Embeddings (`Langchain.Embeddings.Gemini`)**:+ - Effect-polymorphic `Embeddings` instance (`embedQuery` and `embedDocuments`).++## Installation++```yaml+# package.yaml / .cabal+dependencies:+ - langchain-hs-gemini+ - langchain-hs-core+```++## Quick Start++### 1. ChatModel Provider++```haskell+{-# LANGUAGE OverloadedStrings #-}++import Control.Monad.Except (runExceptT)+import Langchain.Model+import Langchain.Provider.Gemini++main :: IO ()+main = do+ let provider = newGemini "AIzaSy..." "gemini-3.6-flash" Nothing+ res <- runExceptT $ invoke provider [userMessage "Why is the sky blue?"] Nothing+ case res of+ Left err -> putStrLn $ "Error: " ++ show err+ Right msg -> putStrLn $ extractMessageText msg+```++### 2. Streaming with Conduit++```haskell+import Control.Monad.Trans.Resource (runResourceT)+import Control.Monad.Except (runExceptT)+import Langchain.Model+import Langchain.Provider.Gemini+import Langchain.Stream (collectEvents)++main :: IO ()+main = do+ let provider = newGemini "AIzaSy..." "gemini-3.6-flash" Nothing+ eEvents <- runResourceT $ runExceptT $ collectEvents $ stream provider [userMessage "Tell me a short story"] Nothing+ case eEvents of+ Left err -> print err+ Right events -> mapM_ print events+```++### 3. Embeddings++```haskell+import Control.Monad.Except (runExceptT)+import Langchain.Embeddings.Core (Embeddings (..))+import Langchain.Embeddings.Gemini (defaultGeminiEmbeddings)++main :: IO ()+main = do+ let embeddings = defaultGeminiEmbeddings "AIzaSy..."+ res <- runExceptT $ embedQuery embeddings "Functional programming in Haskell"+ case res of+ Left err -> print err+ Right vec -> putStrLn $ "Generated vector with dimension: " ++ show (length vec)+```++### 4. Direct Servant Client++```haskell+import Gemini.Client++main :: IO ()+main = do+ env <- newGeminiClientEnv "AIzaSy..."+ let req = createModelInteraction "gemini-3.6-flash" (TextInput "Explain quantum computing in one sentence")+ res <- runGeminiClient env (createInteraction "AIzaSy..." req)+ case res of+ Left clientErr -> print clientErr+ Right interaction -> print (interactionSteps interaction)+```
+ langchain-hs-gemini.cabal view
@@ -0,0 +1,99 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.39.6.+--+-- see: https://github.com/sol/hpack++name: langchain-hs-gemini+version: 0.0.6.0+synopsis: Google Gemini provider for langchain-hs+description: Google Gemini ChatModel provider for langchain-hs. Supports multi-modal content, streaming via Server-Sent Events, and function calling. Does not depend on OpenAI or Ollama packages.+category: AI+homepage: https://github.com/tusharad/langchain-hs#readme+bug-reports: https://github.com/tusharad/langchain-hs/issues+author: Tushar Adhatrao+maintainer: tusharadhatrao@gmail.com+copyright: 2025-2026 Tushar Adhatrao+license: MIT+license-file: LICENSE+build-type: Simple+tested-with:+ GHC == 9.12.4+ , GHC == 9.10.3+ , GHC == 9.8.4+extra-source-files:+ README.md+ CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/tusharad/langchain-hs++library+ exposed-modules:+ Gemini.Client+ Gemini.Client.API+ Gemini.Client.Env+ Gemini.Client.Types+ Langchain.Provider.Gemini+ Langchain.Embeddings.Gemini+ other-modules:+ Paths_langchain_hs_gemini+ hs-source-dirs:+ src+ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints+ build-depends:+ aeson >=2.0 && <3+ , base >=4.17 && <5+ , bytestring >=0.10 && <0.13+ , conduit ==1.3.*+ , containers >=0.6 && <0.9+ , http-client ==0.7.*+ , http-client-tls >=0.3 && <0.5+ , http-conduit ==2.*+ , langchain-hs-core ==0.0.6.*+ , mtl >=2.2 && <2.4+ , resourcet >=1.2 && <1.4+ , servant >=0.19 && <0.21+ , servant-client >=0.19 && <0.21+ , servant-client-core >=0.19 && <0.21+ , text >=1.2 && <3+ default-language: Haskell2010++test-suite langchain-hs-gemini-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Test.Gemini.Client.InteractionsSpec+ Test.Gemini.Client.TypesSpec+ Test.Langchain.Provider.GeminiSpec+ Paths_langchain_hs_gemini+ hs-source-dirs:+ test+ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ aeson+ , aeson-qq+ , base >=4.17 && <5+ , bytestring+ , conduit ==1.3.*+ , containers+ , directory+ , filepath+ , http-client ==0.7.*+ , http-client-tls >=0.3 && <0.5+ , http-conduit ==2.*+ , http-types+ , langchain-hs-core+ , langchain-hs-gemini+ , mtl >=2.2 && <2.4+ , resourcet+ , servant >=0.19 && <0.21+ , servant-client >=0.19 && <0.21+ , servant-client-core >=0.19 && <0.21+ , tasty+ , tasty-hunit+ , text+ , wai+ , warp+ default-language: Haskell2010
+ src/Gemini/Client.hs view
@@ -0,0 +1,116 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wno-missing-signatures #-}++{- |+Module : Gemini.Client+Description : Servant client bindings for Google Gemini Interactions v1 API & Embeddings+Copyright : (c) 2025-2026 Tushar Adhatrao+License : MIT+Maintainer : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability : experimental++Type-safe HTTP client functions generated directly from the Servant API specification+for the Google Gemini Interactions v1 API (<https://ai.google.dev/api/interactions-api-v1>).+-}+module Gemini.Client+ ( -- * Client Operations+ createInteraction+ , getInteraction+ , cancelInteraction+ , deleteInteraction+ , embedContent+ , batchEmbedContents++ -- * Client Environment+ , module Gemini.Client.Env++ -- * Data Models+ , module Gemini.Client.Types+ ) where++import Data.Aeson (Value)+import Data.Text (Text)+import Servant.API ((:<|>) (..))+import Servant.Client (ClientM, client)++import Gemini.Client.API (geminiApi)+import Gemini.Client.Env+import Gemini.Client.Types++-- Internal servant client functions derived from the API type+createInteractionInternal+ :<|> getInteractionInternal+ :<|> cancelInteractionInternal+ :<|> deleteInteractionInternal+ :<|> embedContentInternal+ :<|> batchEmbedContentsInternal =+ client geminiApi++-- | Create a new interaction (model-based or agent-based).+createInteraction ::+ -- | Google Gemini API key+ Text ->+ -- | Interaction request payload+ CreateInteractionRequest ->+ ClientM Interaction+createInteraction apiKey = createInteractionInternal (Just apiKey)++-- | Retrieve full details of an interaction by ID.+getInteraction ::+ -- | Google Gemini API key+ Text ->+ -- | Interaction ID+ Text ->+ -- | Optional stream parameter+ Maybe Bool ->+ -- | Optional last event ID+ Maybe Text ->+ ClientM Interaction+getInteraction apiKey interId =+ getInteractionInternal interId (Just apiKey)++-- | Cancel a background interaction by ID.+cancelInteraction ::+ -- | Google Gemini API key+ Text ->+ -- | Interaction ID+ Text ->+ ClientM Interaction+cancelInteraction apiKey interId =+ cancelInteractionInternal interId (Just apiKey)++-- | Delete an interaction by ID.+deleteInteraction ::+ -- | Google Gemini API key+ Text ->+ -- | Interaction ID+ Text ->+ ClientM Value+deleteInteraction apiKey interId =+ deleteInteractionInternal interId (Just apiKey)++-- | Generate embeddings for single content via @POST \/v1\/models\/{model}:embedContent@.+embedContent ::+ -- | Google Gemini API key+ Text ->+ -- | Model name (e.g. @"gemini-embedding-001"@)+ Text ->+ -- | Content payload+ EmbedContentRequest ->+ ClientM EmbedContentResponse+embedContent apiKey modelName req =+ let modelAction = modelName <> ":embedContent"+ in embedContentInternal modelAction (Just apiKey) req++-- | Generate batch embeddings via @POST \/v1\/models\/{model}:batchEmbedContents@.+batchEmbedContents ::+ -- | Google Gemini API key+ Text ->+ -- | Model name (e.g. @"gemini-embedding-001"@)+ Text ->+ -- | Batch request payload+ BatchEmbedContentsRequest ->+ ClientM BatchEmbedContentsResponse+batchEmbedContents apiKey modelName req =+ let modelAction = modelName <> ":batchEmbedContents"+ in batchEmbedContentsInternal modelAction (Just apiKey) req
+ src/Gemini/Client/API.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}++{- |+Module : Gemini.Client.API+Description : Servant API definition for Google Gemini Interactions v1 & Embeddings+Copyright : (c) 2025-2026 Tushar Adhatrao+License : MIT+Maintainer : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability : experimental++Servant type definitions describing the Gemini Interactions v1 API endpoints+and embedding operations according to the Google GenAI OpenAPI specification.+-}+module Gemini.Client.API+ ( GeminiAPI+ , geminiApi+ ) where++import Data.Aeson (Value)+import Data.Proxy (Proxy (..))+import Data.Text (Text)+import Servant.API++import Gemini.Client.Types++-- | Complete Servant API specification for Gemini Interactions v1 & Embeddings.+type GeminiAPI =+ -- POST /v1/interactions+ "v1"+ :> "interactions"+ :> Header "x-goog-api-key" Text+ :> ReqBody '[JSON] CreateInteractionRequest+ :> Post '[JSON] Interaction+ :<|>+ -- GET /v1/interactions/:id+ "v1"+ :> "interactions"+ :> Capture "id" Text+ :> Header "x-goog-api-key" Text+ :> QueryParam "stream" Bool+ :> QueryParam "last_event_id" Text+ :> Get '[JSON] Interaction+ :<|>+ -- POST /v1/interactions/:id/cancel+ "v1"+ :> "interactions"+ :> Capture "id" Text+ :> "cancel"+ :> Header "x-goog-api-key" Text+ :> Post '[JSON] Interaction+ :<|>+ -- DELETE /v1/interactions/:id+ "v1"+ :> "interactions"+ :> Capture "id" Text+ :> Header "x-goog-api-key" Text+ :> Delete '[JSON] Value+ :<|>+ -- POST /v1/models/:modelAction (e.g. "gemini-embedding-001:embedContent")+ "v1"+ :> "models"+ :> Capture "modelAction" Text+ :> Header "x-goog-api-key" Text+ :> ReqBody '[JSON] EmbedContentRequest+ :> Post '[JSON] EmbedContentResponse+ :<|>+ -- POST /v1/models/:modelAction (e.g. "gemini-embedding-001:batchEmbedContents")+ "v1"+ :> "models"+ :> Capture "modelAction" Text+ :> Header "x-goog-api-key" Text+ :> ReqBody '[JSON] BatchEmbedContentsRequest+ :> Post '[JSON] BatchEmbedContentsResponse++-- | Proxy for 'GeminiAPI'.+geminiApi :: Proxy GeminiAPI+geminiApi = Proxy
+ src/Gemini/Client/Env.hs view
@@ -0,0 +1,137 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++{- |+Module : Gemini.Client.Env+Description : Client environment, execution runner, and SSE streaming conduit+Copyright : (c) 2025-2026 Tushar Adhatrao+License : MIT+Maintainer : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability : experimental++Environment configuration and request runners for the Google Gemini client,+including HTTP connection management, API key authentication, and SSE event streaming.+-}+module Gemini.Client.Env+ ( GeminiClientEnv (..)+ , newGeminiClientEnv+ , newGeminiClientEnvWithBaseUrl+ , runGeminiClient+ , streamGeminiInteraction+ ) where++import Control.Monad (unless)+import Control.Monad.Trans.Resource (MonadResource)+import Data.Aeson (decodeStrict, encode)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC+import Data.Conduit (ConduitT, await, yield, (.|))+import qualified Data.Conduit.Combinators as CC+import Data.Foldable (for_)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import Network.HTTP.Client+ ( Manager+ , ManagerSettings+ , managerResponseTimeout+ , newManager+ , responseTimeoutMicro+ )+import Network.HTTP.Client.TLS (tlsManagerSettings)+import Network.HTTP.Simple+import Servant.Client (ClientError, ClientM, mkClientEnv, runClientM)+import Servant.Client.Core.BaseUrl (BaseUrl (..), Scheme (..), parseBaseUrl)++import Gemini.Client.Types++-- | Environment holding HTTP connection manager, base URL, and API key.+data GeminiClientEnv = GeminiClientEnv+ { clientManager :: !Manager+ , clientBaseUrl :: !BaseUrl+ , clientApiKey :: !Text+ }++-- | Default Gemini endpoint @https://generativelanguage.googleapis.com@.+defaultBaseUrl :: BaseUrl+defaultBaseUrl = BaseUrl Https "generativelanguage.googleapis.com" 443 ""++geminiManagerSettings :: Network.HTTP.Client.ManagerSettings+geminiManagerSettings =+ tlsManagerSettings+ { managerResponseTimeout = responseTimeoutMicro (120 * 1000000)+ }++-- | Initialize a new t'GeminiClientEnv' targeting the default Gemini endpoint.+newGeminiClientEnv :: Text -> IO GeminiClientEnv+newGeminiClientEnv apiKey = do+ mgr <- newManager geminiManagerSettings+ pure $ GeminiClientEnv mgr defaultBaseUrl apiKey++-- | Initialize a new t'GeminiClientEnv' targeting a custom base URL.+newGeminiClientEnvWithBaseUrl :: Text -> Text -> IO GeminiClientEnv+newGeminiClientEnvWithBaseUrl rawUrl apiKey = do+ mgr <- newManager geminiManagerSettings+ bUrl <- parseBaseUrl (T.unpack rawUrl)+ pure $ GeminiClientEnv mgr bUrl apiKey++-- | Execute a Servant 'ClientM' request in 'IO'.+runGeminiClient :: GeminiClientEnv -> ClientM a -> IO (Either ClientError a)+runGeminiClient GeminiClientEnv {..} action = do+ let env = mkClientEnv clientManager clientBaseUrl+ runClientM action env++-- | Stream events from @POST /v1/interactions@ with SSE.+streamGeminiInteraction ::+ (MonadResource m) =>+ GeminiClientEnv ->+ CreateInteractionRequest ->+ ConduitT () InteractionSseEvent m ()+streamGeminiInteraction GeminiClientEnv {..} reqBody = do+ let schemeStr = case baseUrlScheme clientBaseUrl of+ Https -> "https"+ Http -> "http"+ portStr = case (baseUrlScheme clientBaseUrl, baseUrlPort clientBaseUrl) of+ (Https, 443) -> ""+ (Http, 80) -> ""+ (_, p) -> ":" ++ show p+ url = schemeStr ++ "://" ++ baseUrlHost clientBaseUrl ++ portStr ++ "/v1/interactions"+ streamReq = reqBody {reqStream = Just True}+ httpReq =+ setRequestMethod "POST" $+ setRequestHeader "x-goog-api-key" [TE.encodeUtf8 clientApiKey] $+ setRequestHeader "Content-Type" ["application/json"] $+ setRequestHeader "Accept" ["text/event-stream"] $+ setRequestBodyLBS (encode streamReq) $+ parseRequest_ url++ httpSource httpReq $ \res ->+ getResponseBody res .| CC.linesUnboundedAscii .| parseSseLines+ where+ parseSseLines = loop Nothing []+ where+ loop mbEvent accData =+ await >>= \case+ Nothing -> pure ()+ Just rawLine -> do+ let line = BSC.dropWhile (== ' ') rawLine+ if BS.null line+ then do+ -- End of SSE block, dispatch+ unless (null accData) $ do+ let combined = BS.intercalate "\n" (reverse accData)+ for_ (decodeStrict combined) yield+ loop Nothing []+ else+ if "event:" `BS.isPrefixOf` line+ then do+ let evName = TE.decodeUtf8 (BS.drop 6 line)+ loop (Just (T.strip evName)) accData+ else+ if "data:" `BS.isPrefixOf` line+ then do+ let chunk = BS.drop 5 line+ trimmed = BSC.dropWhile (== ' ') chunk+ loop mbEvent (trimmed : accData)+ else loop mbEvent accData
+ src/Gemini/Client/Types.hs view
@@ -0,0 +1,931 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -Wno-partial-fields #-}++{- |+Module : Gemini.Client.Types+Description : Typed data models for Google Gemini Interactions v1 API and Embeddings+Copyright : (c) 2025-2026 Tushar Adhatrao+License : MIT+Maintainer : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability : experimental++Fully-typed OpenAPI data models corresponding to the Google Gemini Interactions v1 API+(<https://ai.google.dev/static/api/interactions-v1.openapi.json>) and Embeddings endpoints.+-}+module Gemini.Client.Types+ ( -- * Interactions+ Interaction (..)+ , InteractionStatus (..)+ , CreateInteractionRequest (..)+ , defaultCreateInteractionRequest+ , createModelInteraction+ , createAgentInteraction++ -- * Inputs and Contents+ , InteractionsInput (..)+ , Content (..)++ -- * Steps+ , Step (..)+ , GoogleSearchResultItem (..)++ -- * Tools+ , Tool (..)+ , functionTool++ -- * Generation and Output+ , GenerationConfig (..)+ , defaultGenerationConfig+ , ResponseFormat (..)+ , jsonResponseFormat+ , Usage (..)+ , ErrorDetail (..)++ -- * Streaming Events+ , InteractionSseEvent (..)+ , StepDeltaData (..)++ -- * Embeddings+ , EmbedContentRequest (..)+ , EmbedContentPayload (..)+ , EmbedPart (..)+ , EmbedContentResponse (..)+ , EmbeddingValues (..)+ , BatchEmbedContentsRequest (..)+ , BatchEmbedRequestItem (..)+ , BatchEmbedContentsResponse (..)+ ) where++import Control.Applicative ((<|>))+import Data.Aeson+import qualified Data.Aeson.KeyMap as KM+import Data.Maybe (catMaybes)+import Data.Text (Text)+import qualified Data.Text as T+import GHC.Generics (Generic)++-- ---------------------------------------------------------------------------+-- Interaction & Status+-- ---------------------------------------------------------------------------++-- | Lifecycle status of an Interaction.+data InteractionStatus+ = StatusInProgress+ | StatusRequiresAction+ | StatusCompleted+ | StatusFailed+ | StatusCancelled+ | StatusIncomplete+ deriving (Eq, Show, Generic)++instance ToJSON InteractionStatus where+ toJSON = \case+ StatusInProgress -> "in_progress"+ StatusRequiresAction -> "requires_action"+ StatusCompleted -> "completed"+ StatusFailed -> "failed"+ StatusCancelled -> "cancelled"+ StatusIncomplete -> "incomplete"++instance FromJSON InteractionStatus where+ parseJSON = withText "InteractionStatus" $ \case+ "in_progress" -> pure StatusInProgress+ "requires_action" -> pure StatusRequiresAction+ "completed" -> pure StatusCompleted+ "failed" -> pure StatusFailed+ "cancelled" -> pure StatusCancelled+ "incomplete" -> pure StatusIncomplete+ other -> fail $ "Unknown InteractionStatus: " ++ T.unpack other++-- | An Interaction resource generated by Gemini.+data Interaction = Interaction+ { interactionId :: !Text+ , interactionObject :: !(Maybe Text)+ , interactionModel :: !(Maybe Text)+ , interactionAgent :: !(Maybe Text)+ , interactionStatus :: !InteractionStatus+ , interactionSteps :: ![Step]+ , interactionUsage :: !(Maybe Usage)+ , interactionCreated :: !(Maybe Text)+ , interactionUpdated :: !(Maybe Text)+ , interactionBackground :: !(Maybe Bool)+ , interactionStore :: !(Maybe Bool)+ , interactionStream :: !(Maybe Bool)+ , interactionSystemInstruction :: !(Maybe Text)+ , interactionTools :: !(Maybe [Tool])+ , interactionGenerationConfig :: !(Maybe GenerationConfig)+ , interactionResponseFormat :: !(Maybe ResponseFormat)+ , interactionPreviousInteractionId :: !(Maybe Text)+ , interactionErrors :: !(Maybe [ErrorDetail])+ }+ deriving (Eq, Show, Generic)++instance FromJSON Interaction where+ parseJSON = withObject "Interaction" $ \o -> do+ interactionId <- o .:? "id" .!= ""+ interactionObject <- o .:? "object"+ interactionModel <- o .:? "model"+ interactionAgent <- o .:? "agent"+ interactionStatus <- o .:? "status" .!= StatusCompleted+ interactionSteps <- o .:? "steps" .!= []+ interactionUsage <- o .:? "usage"+ interactionCreated <- o .:? "created"+ interactionUpdated <- o .:? "updated"+ interactionBackground <- o .:? "background"+ interactionStore <- o .:? "store"+ interactionStream <- o .:? "stream"+ interactionSystemInstruction <- o .:? "system_instruction"+ interactionTools <- o .:? "tools"+ interactionGenerationConfig <- o .:? "generation_config"+ interactionResponseFormat <- o .:? "response_format"+ interactionPreviousInteractionId <- o .:? "previous_interaction_id"+ interactionErrors <- o .:? "errors"+ pure Interaction {..}++instance ToJSON Interaction where+ toJSON Interaction {..} =+ object $+ catMaybes+ [ Just ("id" .= interactionId)+ , ("object" .=) <$> interactionObject+ , ("model" .=) <$> interactionModel+ , ("agent" .=) <$> interactionAgent+ , Just ("status" .= interactionStatus)+ , Just ("steps" .= interactionSteps)+ , ("usage" .=) <$> interactionUsage+ , ("created" .=) <$> interactionCreated+ , ("updated" .=) <$> interactionUpdated+ , ("background" .=) <$> interactionBackground+ , ("store" .=) <$> interactionStore+ , ("stream" .=) <$> interactionStream+ , ("system_instruction" .=) <$> interactionSystemInstruction+ , ("tools" .=) <$> interactionTools+ , ("generation_config" .=) <$> interactionGenerationConfig+ , ("response_format" .=) <$> interactionResponseFormat+ , ("previous_interaction_id" .=) <$> interactionPreviousInteractionId+ , ("errors" .=) <$> interactionErrors+ ]++-- | Diagnostics and error records.+data ErrorDetail = ErrorDetail+ { errorCode :: !(Maybe Text)+ , errorMessage :: !Text+ }+ deriving (Eq, Show, Generic, ToJSON, FromJSON)++-- ---------------------------------------------------------------------------+-- Contents+-- ---------------------------------------------------------------------------++-- | Multimodal content part.+data Content+ = TextContent !Text+ | -- | mime_type, base64 data+ ImageContent !Text !Text+ | -- | mime_type, base64 data+ AudioContent !Text !Text+ | -- | mime_type, base64 data+ DocumentContent !Text !Text+ deriving (Eq, Show, Generic)++instance ToJSON Content where+ toJSON = \case+ TextContent txt ->+ object ["type" .= ("text" :: Text), "text" .= txt]+ ImageContent mime b64 ->+ object ["type" .= ("image" :: Text), "mime_type" .= mime, "data" .= b64]+ AudioContent mime b64 ->+ object ["type" .= ("audio" :: Text), "mime_type" .= mime, "data" .= b64]+ DocumentContent mime b64 ->+ object ["type" .= ("document" :: Text), "mime_type" .= mime, "data" .= b64]++instance FromJSON Content where+ parseJSON = withObject "Content" $ \o -> do+ t <- o .: "type"+ case (t :: Text) of+ "text" -> TextContent <$> o .: "text"+ "image" -> ImageContent <$> o .: "mime_type" <*> o .: "data"+ "audio" -> AudioContent <$> o .: "mime_type" <*> o .: "data"+ "document" -> DocumentContent <$> o .: "mime_type" <*> o .: "data"+ other -> fail $ "Unknown Content type: " ++ T.unpack other++-- ---------------------------------------------------------------------------+-- Steps+-- ---------------------------------------------------------------------------++-- | Single step within an interaction turn.+data Step+ = UserInputStep ![Content]+ | ModelOutputStep ![Content]+ | FunctionCallStep+ { callName :: !Text+ , callArguments :: !Value+ , callId :: !Text+ }+ | FunctionResultStep+ { resultCallId :: !Text+ , resultName :: !(Maybe Text)+ , resultPayload :: !Value+ , resultIsError :: !(Maybe Bool)+ }+ | ThoughtStep+ { thoughtSignature :: !(Maybe Text)+ , thoughtSummary :: !(Maybe [Content])+ }+ | CodeExecutionCallStep+ { codeCallId :: !Text+ , codeCallCode :: !Text+ , codeCallSignature :: !(Maybe Text)+ }+ | CodeExecutionResultStep+ { codeResultCallId :: !Text+ , codeResultOutput :: !Text+ , codeResultIsError :: !(Maybe Bool)+ }+ | GoogleSearchCallStep+ { searchCallId :: !Text+ , searchQuery :: !Text+ , searchType :: !(Maybe Text)+ }+ | GoogleSearchResultStep+ { searchResultCallId :: !Text+ , searchResultItems :: ![GoogleSearchResultItem]+ }+ | GoogleMapsCallStep+ { mapsCallId :: !Text+ , mapsQuery :: !(Maybe Text)+ }+ | GoogleMapsResultStep+ { mapsResultCallId :: !Text+ , mapsResultPayload :: !(Maybe Value)+ }+ | FileSearchCallStep+ { fileSearchCallId :: !Text+ , fileSearchQuery :: !(Maybe Text)+ }+ | FileSearchResultStep+ { fileSearchResultCallId :: !Text+ , fileSearchResultPayload :: !(Maybe Value)+ }+ | UrlContextCallStep+ { urlCallId :: !Text+ , urlQuery :: !(Maybe Text)+ }+ | UrlContextResultStep+ { urlResultCallId :: !Text+ , urlResultPayload :: !(Maybe Value)+ }+ deriving (Eq, Show, Generic)++-- | Google Search result snippet.+data GoogleSearchResultItem = GoogleSearchResultItem+ { searchTitle :: !(Maybe Text)+ , searchUrl :: !(Maybe Text)+ , searchSnippet :: !(Maybe Text)+ }+ deriving (Eq, Show, Generic)++instance FromJSON GoogleSearchResultItem where+ parseJSON = withObject "GoogleSearchResultItem" $ \o -> do+ searchTitle <- o .:? "title"+ searchUrl <- o .:? "url"+ searchSnippet <- o .:? "snippet"+ pure GoogleSearchResultItem {..}++instance ToJSON GoogleSearchResultItem where+ toJSON GoogleSearchResultItem {..} =+ object $+ catMaybes+ [ ("title" .=) <$> searchTitle+ , ("url" .=) <$> searchUrl+ , ("snippet" .=) <$> searchSnippet+ ]++instance ToJSON Step where+ toJSON = \case+ UserInputStep cs ->+ object ["type" .= ("user_input" :: Text), "content" .= cs]+ ModelOutputStep cs ->+ object ["type" .= ("model_output" :: Text), "content" .= cs]+ FunctionCallStep {..} ->+ object+ [ "type" .= ("function_call" :: Text)+ , "name" .= callName+ , "arguments" .= callArguments+ , "id" .= callId+ ]+ FunctionResultStep {..} ->+ object $+ [ "type" .= ("function_result" :: Text)+ , "call_id" .= resultCallId+ , "result" .= resultPayload+ ]+ ++ catMaybes+ [ ("name" .=) <$> resultName+ , ("is_error" .=) <$> resultIsError+ ]+ ThoughtStep {..} ->+ object $+ ("type" .= ("thought" :: Text))+ : catMaybes+ [ ("signature" .=) <$> thoughtSignature+ , ("summary" .=) <$> thoughtSummary+ ]+ CodeExecutionCallStep {..} ->+ object $+ [ "type" .= ("code_execution_call" :: Text)+ , "id" .= codeCallId+ , "arguments" .= object ["code" .= codeCallCode]+ ]+ ++ catMaybes [("signature" .=) <$> codeCallSignature]+ CodeExecutionResultStep {..} ->+ object $+ [ "type" .= ("code_execution_result" :: Text)+ , "call_id" .= codeResultCallId+ , "result" .= codeResultOutput+ ]+ ++ catMaybes [("is_error" .=) <$> codeResultIsError]+ GoogleSearchCallStep {..} ->+ object $+ [ "type" .= ("google_search_call" :: Text)+ , "id" .= searchCallId+ , "arguments" .= object ["query" .= searchQuery]+ ]+ ++ catMaybes [("search_type" .=) <$> searchType]+ GoogleSearchResultStep {..} ->+ object+ [ "type" .= ("google_search_result" :: Text)+ , "call_id" .= searchResultCallId+ , "result" .= searchResultItems+ ]+ GoogleMapsCallStep {..} ->+ object $+ ("type" .= ("google_maps_call" :: Text))+ : ("id" .= mapsCallId)+ : catMaybes [("query" .=) <$> mapsQuery]+ GoogleMapsResultStep {..} ->+ object $+ ("type" .= ("google_maps_result" :: Text))+ : ("call_id" .= mapsResultCallId)+ : catMaybes [("result" .=) <$> mapsResultPayload]+ FileSearchCallStep {..} ->+ object $+ ("type" .= ("file_search_call" :: Text))+ : ("id" .= fileSearchCallId)+ : catMaybes [("query" .=) <$> fileSearchQuery]+ FileSearchResultStep {..} ->+ object $+ ("type" .= ("file_search_result" :: Text))+ : ("call_id" .= fileSearchResultCallId)+ : catMaybes [("result" .=) <$> fileSearchResultPayload]+ UrlContextCallStep {..} ->+ object $+ ("type" .= ("url_context_call" :: Text))+ : ("id" .= urlCallId)+ : catMaybes [("query" .=) <$> urlQuery]+ UrlContextResultStep {..} ->+ object $+ ("type" .= ("url_context_result" :: Text))+ : ("call_id" .= urlResultCallId)+ : catMaybes [("result" .=) <$> urlResultPayload]++instance FromJSON Step where+ parseJSON = withObject "Step" $ \o -> do+ t <- o .: "type"+ case (t :: Text) of+ "user_input" -> UserInputStep <$> (o .:? "content" .!= [])+ "model_output" -> ModelOutputStep <$> (o .:? "content" .!= [])+ "function_call" -> do+ callName <- o .: "name"+ callArguments <- o .:? "arguments" .!= object []+ callId <- o .:? "id" .!= ""+ pure FunctionCallStep {..}+ "function_result" -> do+ resultCallId <- o .: "call_id"+ resultName <- o .:? "name"+ resultPayload <- o .: "result"+ resultIsError <- o .:? "is_error"+ pure FunctionResultStep {..}+ "thought" -> do+ thoughtSignature <- o .:? "signature"+ thoughtSummary <- o .:? "summary"+ pure ThoughtStep {..}+ "code_execution_call" -> do+ codeCallId <- o .:? "id" .!= ""+ args <- o .:? "arguments" .!= object []+ codeCallCode <- case args of+ Object ao -> ao .:? "code" .!= ""+ _ -> pure ""+ codeCallSignature <- o .:? "signature"+ pure CodeExecutionCallStep {..}+ "code_execution_result" -> do+ codeResultCallId <- o .: "call_id"+ codeResultOutput <- o .:? "result" .!= ""+ codeResultIsError <- o .:? "is_error"+ pure CodeExecutionResultStep {..}+ "google_search_call" -> do+ searchCallId <- o .:? "id" .!= ""+ args <- o .:? "arguments" .!= object []+ searchQuery <- case args of+ Object ao -> ao .:? "query" .!= ""+ _ -> pure ""+ searchType <- o .:? "search_type"+ pure GoogleSearchCallStep {..}+ "google_search_result" -> do+ searchResultCallId <- o .: "call_id"+ searchResultItems <- o .:? "result" .!= []+ pure GoogleSearchResultStep {..}+ "google_maps_call" -> do+ mapsCallId <- o .:? "id" .!= ""+ mapsQuery <- o .:? "query"+ pure GoogleMapsCallStep {..}+ "google_maps_result" -> do+ mapsResultCallId <- o .: "call_id"+ mapsResultPayload <- o .:? "result"+ pure GoogleMapsResultStep {..}+ "file_search_call" -> do+ fileSearchCallId <- o .:? "id" .!= ""+ fileSearchQuery <- o .:? "query"+ pure FileSearchCallStep {..}+ "file_search_result" -> do+ fileSearchResultCallId <- o .: "call_id"+ fileSearchResultPayload <- o .:? "result"+ pure FileSearchResultStep {..}+ "url_context_call" -> do+ urlCallId <- o .:? "id" .!= ""+ urlQuery <- o .:? "query"+ pure UrlContextCallStep {..}+ "url_context_result" -> do+ urlResultCallId <- o .: "call_id"+ urlResultPayload <- o .:? "result"+ pure UrlContextResultStep {..}+ other -> fail $ "Unknown Step type: " ++ T.unpack other++-- ---------------------------------------------------------------------------+-- InteractionsInput+-- ---------------------------------------------------------------------------++-- | Flexible input format for Interaction creation.+data InteractionsInput+ = TextInput !Text+ | ContentInput !Content+ | ContentListInput ![Content]+ | StepListInput ![Step]+ deriving (Eq, Show, Generic)++instance ToJSON InteractionsInput where+ toJSON = \case+ TextInput t -> toJSON t+ ContentInput c -> toJSON c+ ContentListInput cs -> toJSON cs+ StepListInput ss -> toJSON ss++instance FromJSON InteractionsInput where+ parseJSON v = case v of+ String s -> pure $ TextInput s+ Array arr ->+ (StepListInput <$> parseJSON (Array arr))+ <|> (ContentListInput <$> parseJSON (Array arr))+ Object _ -> ContentInput <$> parseJSON v+ _ -> fail "Invalid InteractionsInput format"++-- ---------------------------------------------------------------------------+-- Tools+-- ---------------------------------------------------------------------------++-- | Built-in or custom tool declared for the model.+data Tool+ = FunctionTool+ { functionName :: !Text+ , functionDescription :: !(Maybe Text)+ , functionParameters :: !(Maybe Value)+ }+ | GoogleSearchTool+ | GoogleMapsTool+ { mapsLatitude :: !(Maybe Double)+ , mapsLongitude :: !(Maybe Double)+ }+ | CodeExecutionTool+ | FileSearchTool+ { fileSearchStoreNames :: !(Maybe [Text])+ }+ | UrlContextTool+ deriving (Eq, Show, Generic)++-- | Construct a standard function tool.+functionTool :: Text -> Maybe Text -> Maybe Value -> Tool+functionTool = FunctionTool++instance ToJSON Tool where+ toJSON = \case+ FunctionTool {..} ->+ object $+ [ "type" .= ("function" :: Text)+ , "name" .= functionName+ ]+ ++ catMaybes+ [ ("description" .=) <$> functionDescription+ , ("parameters" .=) <$> functionParameters+ ]+ GoogleSearchTool ->+ object ["type" .= ("google_search" :: Text)]+ GoogleMapsTool {..} ->+ object $+ ("type" .= ("google_maps" :: Text))+ : catMaybes+ [ ("latitude" .=) <$> mapsLatitude+ , ("longitude" .=) <$> mapsLongitude+ ]+ CodeExecutionTool ->+ object ["type" .= ("code_execution" :: Text)]+ FileSearchTool {..} ->+ object $+ ("type" .= ("file_search" :: Text))+ : catMaybes [("file_search_store_names" .=) <$> fileSearchStoreNames]+ UrlContextTool ->+ object ["type" .= ("url_context" :: Text)]++instance FromJSON Tool where+ parseJSON = withObject "Tool" $ \o -> do+ t <- o .: "type"+ case (t :: Text) of+ "function" -> do+ functionName <- o .: "name"+ functionDescription <- o .:? "description"+ functionParameters <- o .:? "parameters"+ pure FunctionTool {..}+ "google_search" -> pure GoogleSearchTool+ "google_maps" -> do+ mapsLatitude <- o .:? "latitude"+ mapsLongitude <- o .:? "longitude"+ pure GoogleMapsTool {..}+ "code_execution" -> pure CodeExecutionTool+ "file_search" -> do+ fileSearchStoreNames <- o .:? "file_search_store_names"+ pure FileSearchTool {..}+ "url_context" -> pure UrlContextTool+ other -> fail $ "Unknown Tool type: " ++ T.unpack other++-- ---------------------------------------------------------------------------+-- GenerationConfig & ResponseFormat+-- ---------------------------------------------------------------------------++-- | Model generation parameters.+data GenerationConfig = GenerationConfig+ { maxOutputTokens :: !(Maybe Int)+ , seed :: !(Maybe Int)+ , stopSequences :: !(Maybe [Text])+ , thinkingLevel :: !(Maybe Text)+ , thinkingSummaries :: !(Maybe Bool)+ , toolChoice :: !(Maybe Text)+ }+ deriving (Eq, Show, Generic)++-- | Default generation configuration with all options unset.+defaultGenerationConfig :: GenerationConfig+defaultGenerationConfig = GenerationConfig Nothing Nothing Nothing Nothing Nothing Nothing++instance ToJSON GenerationConfig where+ toJSON GenerationConfig {..} =+ object $+ catMaybes+ [ ("max_output_tokens" .=) <$> maxOutputTokens+ , ("seed" .=) <$> seed+ , ("stop_sequences" .=) <$> stopSequences+ , ("thinking_level" .=) <$> thinkingLevel+ , ("thinking_summaries" .=) <$> thinkingSummaries+ , ("tool_choice" .=) <$> toolChoice+ ]++instance FromJSON GenerationConfig where+ parseJSON = withObject "GenerationConfig" $ \o -> do+ maxOutputTokens <- o .:? "max_output_tokens"+ seed <- o .:? "seed"+ stopSequences <- o .:? "stop_sequences"+ thinkingLevel <- o .:? "thinking_level"+ thinkingSummaries <- o .:? "thinking_summaries"+ toolChoice <- o .:? "tool_choice"+ pure GenerationConfig {..}++-- | Structured output format specification.+data ResponseFormat+ = TextResponseFormat+ { responseMimeType :: !(Maybe Text)+ , responseSchema :: !(Maybe Value)+ }+ deriving (Eq, Show, Generic)++-- | Construct a JSON Schema response format constraint.+jsonResponseFormat :: Value -> ResponseFormat+jsonResponseFormat s = TextResponseFormat (Just "application/json") (Just s)++instance ToJSON ResponseFormat where+ toJSON (TextResponseFormat mime sch) =+ object $+ ("type" .= ("text" :: Text))+ : catMaybes+ [ ("mime_type" .=) <$> mime+ , ("schema" .=) <$> sch+ ]++instance FromJSON ResponseFormat where+ parseJSON = withObject "ResponseFormat" $ \o -> do+ responseMimeType <- o .:? "mime_type"+ responseSchema <- o .:? "schema"+ pure TextResponseFormat {..}++-- ---------------------------------------------------------------------------+-- Usage+-- ---------------------------------------------------------------------------++-- | Token usage statistics.+data Usage = Usage+ { totalInputTokens :: !(Maybe Int)+ , totalOutputTokens :: !(Maybe Int)+ , totalTokens :: !(Maybe Int)+ , totalThoughtTokens :: !(Maybe Int)+ , totalToolUseTokens :: !(Maybe Int)+ , totalCachedTokens :: !(Maybe Int)+ }+ deriving (Eq, Show, Generic)++instance FromJSON Usage where+ parseJSON = withObject "Usage" $ \o -> do+ totalInputTokens <- o .:? "total_input_tokens"+ totalOutputTokens <- o .:? "total_output_tokens"+ totalTokens <- o .:? "total_tokens"+ totalThoughtTokens <- o .:? "total_thought_tokens"+ totalToolUseTokens <- o .:? "total_tool_use_tokens"+ totalCachedTokens <- o .:? "total_cached_tokens"+ pure Usage {..}++instance ToJSON Usage where+ toJSON Usage {..} =+ object $+ catMaybes+ [ ("total_input_tokens" .=) <$> totalInputTokens+ , ("total_output_tokens" .=) <$> totalOutputTokens+ , ("total_tokens" .=) <$> totalTokens+ , ("total_thought_tokens" .=) <$> totalThoughtTokens+ , ("total_tool_use_tokens" .=) <$> totalToolUseTokens+ , ("total_cached_tokens" .=) <$> totalCachedTokens+ ]++-- ---------------------------------------------------------------------------+-- CreateInteractionRequest+-- ---------------------------------------------------------------------------++-- | Request envelope for POST \/v1\/interactions.+data CreateInteractionRequest = CreateInteractionRequest+ { reqModel :: !(Maybe Text)+ , reqAgent :: !(Maybe Text)+ , reqInput :: !InteractionsInput+ , reqSystemInstruction :: !(Maybe Text)+ , reqTools :: !(Maybe [Tool])+ , reqGenerationConfig :: !(Maybe GenerationConfig)+ , reqResponseFormat :: !(Maybe ResponseFormat)+ , reqPreviousInteractionId :: !(Maybe Text)+ , reqBackground :: !(Maybe Bool)+ , reqStore :: !(Maybe Bool)+ , reqStream :: !(Maybe Bool)+ }+ deriving (Eq, Show, Generic)++-- | Construct a base request.+defaultCreateInteractionRequest :: InteractionsInput -> CreateInteractionRequest+defaultCreateInteractionRequest input =+ CreateInteractionRequest+ { reqModel = Nothing+ , reqAgent = Nothing+ , reqInput = input+ , reqSystemInstruction = Nothing+ , reqTools = Nothing+ , reqGenerationConfig = Nothing+ , reqResponseFormat = Nothing+ , reqPreviousInteractionId = Nothing+ , reqBackground = Nothing+ , reqStore = Nothing+ , reqStream = Nothing+ }++-- | Helper to create a model-based interaction.+createModelInteraction :: Text -> InteractionsInput -> CreateInteractionRequest+createModelInteraction modelName input =+ (defaultCreateInteractionRequest input) {reqModel = Just modelName}++-- | Helper to create an agent-based interaction.+createAgentInteraction :: Text -> InteractionsInput -> CreateInteractionRequest+createAgentInteraction agentName input =+ (defaultCreateInteractionRequest input) {reqAgent = Just agentName}++instance ToJSON CreateInteractionRequest where+ toJSON CreateInteractionRequest {..} =+ object $+ ("input" .= reqInput)+ : catMaybes+ [ ("model" .=) <$> reqModel+ , ("agent" .=) <$> reqAgent+ , ("system_instruction" .=) <$> reqSystemInstruction+ , ("tools" .=) <$> reqTools+ , ("generation_config" .=) <$> reqGenerationConfig+ , ("response_format" .=) <$> reqResponseFormat+ , ("previous_interaction_id" .=) <$> reqPreviousInteractionId+ , ("background" .=) <$> reqBackground+ , ("store" .=) <$> reqStore+ , ("stream" .=) <$> reqStream+ ]++instance FromJSON CreateInteractionRequest where+ parseJSON = withObject "CreateInteractionRequest" $ \o -> do+ reqModel <- o .:? "model"+ reqAgent <- o .:? "agent"+ reqInput <- o .: "input"+ reqSystemInstruction <- o .:? "system_instruction"+ reqTools <- o .:? "tools"+ reqGenerationConfig <- o .:? "generation_config"+ reqResponseFormat <- o .:? "response_format"+ reqPreviousInteractionId <- o .:? "previous_interaction_id"+ reqBackground <- o .:? "background"+ reqStore <- o .:? "store"+ reqStream <- o .:? "stream"+ pure CreateInteractionRequest {..}++-- ---------------------------------------------------------------------------+-- Server-Sent Events (SSE) Streaming+-- ---------------------------------------------------------------------------++-- | Incremental delta updates emitted during streaming.+data StepDeltaData+ = TextDelta !Text+ | ArgumentsDelta !Text+ | ThoughtSignatureDelta !Text+ | OtherDelta !Text !Value+ deriving (Eq, Show, Generic)++instance FromJSON StepDeltaData where+ parseJSON = withObject "StepDeltaData" $ \o -> do+ t <- o .: "type"+ case (t :: Text) of+ "text" -> TextDelta <$> o .: "text"+ "arguments" -> ArgumentsDelta <$> o .: "arguments"+ "thought_signature" -> ThoughtSignatureDelta <$> o .: "signature"+ other -> pure $ OtherDelta other (Object o)++instance ToJSON StepDeltaData where+ toJSON = \case+ TextDelta txt -> object ["type" .= ("text" :: Text), "text" .= txt]+ ArgumentsDelta args -> object ["type" .= ("arguments" :: Text), "arguments" .= args]+ ThoughtSignatureDelta sig -> object ["type" .= ("thought_signature" :: Text), "signature" .= sig]+ OtherDelta _ val -> val++-- | SSE event types dispatched on the interaction stream.+data InteractionSseEvent+ = SseInteractionCreated !Interaction+ | SseInteractionStatusUpdate !Text !InteractionStatus+ | SseStepStart !Int !Step+ | SseStepDelta !Int !StepDeltaData+ | SseStepStop !Int+ | SseInteractionCompleted !Interaction+ | SseError !Text !Text+ | SseOther !Text !Value+ deriving (Eq, Show, Generic)++instance FromJSON InteractionSseEvent where+ parseJSON = withObject "InteractionSseEvent" $ \o -> do+ evType <- o .: "event_type"+ case (evType :: Text) of+ "interaction.created" -> SseInteractionCreated <$> o .: "interaction"+ "interaction.completed" -> SseInteractionCompleted <$> o .: "interaction"+ "interaction.status_update" ->+ SseInteractionStatusUpdate <$> o .: "interaction_id" <*> o .: "status"+ "step.start" -> SseStepStart <$> o .: "index" <*> o .: "step"+ "step.delta" -> SseStepDelta <$> o .: "index" <*> o .: "delta"+ "step.stop" -> SseStepStop <$> o .: "index"+ "error" -> do+ errObj <- o .: "error"+ c <- errObj .:? "code" .!= ""+ m <- errObj .:? "message" .!= ""+ pure $ SseError c m+ other -> pure $ SseOther other (Object o)++instance ToJSON InteractionSseEvent where+ toJSON = \case+ SseInteractionCreated inter ->+ object ["event_type" .= ("interaction.created" :: Text), "interaction" .= inter]+ SseInteractionCompleted inter ->+ object ["event_type" .= ("interaction.completed" :: Text), "interaction" .= inter]+ SseInteractionStatusUpdate iid st ->+ object+ ["event_type" .= ("interaction.status_update" :: Text), "interaction_id" .= iid, "status" .= st]+ SseStepStart idx step ->+ object ["event_type" .= ("step.start" :: Text), "index" .= idx, "step" .= step]+ SseStepDelta idx d ->+ object ["event_type" .= ("step.delta" :: Text), "index" .= idx, "delta" .= d]+ SseStepStop idx ->+ object ["event_type" .= ("step.stop" :: Text), "index" .= idx]+ SseError code msg ->+ object ["event_type" .= ("error" :: Text), "error" .= object ["code" .= code, "message" .= msg]]+ SseOther ev val -> case val of+ Object o -> Object (KM.insert "event_type" (String ev) o)+ _ -> object ["event_type" .= ev, "data" .= val]++-- ---------------------------------------------------------------------------+-- Embeddings+-- ---------------------------------------------------------------------------++-- | Single text part within embedding payload.+newtype EmbedPart = EmbedPart {partText :: Text}+ deriving (Eq, Show, Generic)++instance ToJSON EmbedPart where+ toJSON (EmbedPart t) = object ["text" .= t]++instance FromJSON EmbedPart where+ parseJSON = withObject "EmbedPart" $ \o -> EmbedPart <$> o .: "text"++-- | Content payload container for embedding.+newtype EmbedContentPayload = EmbedContentPayload {payloadParts :: [EmbedPart]}+ deriving (Eq, Show, Generic)++instance ToJSON EmbedContentPayload where+ toJSON (EmbedContentPayload ps) = object ["parts" .= ps]++instance FromJSON EmbedContentPayload where+ parseJSON = withObject "EmbedContentPayload" $ \o -> EmbedContentPayload <$> o .: "parts"++-- | Single embedContent request body.+newtype EmbedContentRequest = EmbedContentRequest {requestContent :: EmbedContentPayload}+ deriving (Eq, Show, Generic)++instance ToJSON EmbedContentRequest where+ toJSON (EmbedContentRequest p) = object ["content" .= p]++instance FromJSON EmbedContentRequest where+ parseJSON = withObject "EmbedContentRequest" $ \o -> EmbedContentRequest <$> o .: "content"++-- | Embedding vector result.+newtype EmbeddingValues = EmbeddingValues {embeddingValues :: [Float]}+ deriving (Eq, Show, Generic)++instance FromJSON EmbeddingValues where+ parseJSON = withObject "EmbeddingValues" $ \o -> EmbeddingValues <$> o .: "values"++instance ToJSON EmbeddingValues where+ toJSON (EmbeddingValues vs) = object ["values" .= vs]++-- | Response from embedContent.+newtype EmbedContentResponse = EmbedContentResponse {responseEmbedding :: EmbeddingValues}+ deriving (Eq, Show, Generic)++instance FromJSON EmbedContentResponse where+ parseJSON = withObject "EmbedContentResponse" $ \o -> EmbedContentResponse <$> o .: "embedding"++instance ToJSON EmbedContentResponse where+ toJSON (EmbedContentResponse ev) = object ["embedding" .= ev]++-- | Single item in batchEmbedContents.+data BatchEmbedRequestItem = BatchEmbedRequestItem+ { itemModel :: !Text+ , itemContent :: !EmbedContentPayload+ }+ deriving (Eq, Show, Generic)++instance ToJSON BatchEmbedRequestItem where+ toJSON BatchEmbedRequestItem {..} =+ object ["model" .= itemModel, "content" .= itemContent]++instance FromJSON BatchEmbedRequestItem where+ parseJSON = withObject "BatchEmbedRequestItem" $ \o -> do+ itemModel <- o .: "model"+ itemContent <- o .: "content"+ pure BatchEmbedRequestItem {..}++-- | Batch embed request body.+newtype BatchEmbedContentsRequest = BatchEmbedContentsRequest+ { batchRequests :: [BatchEmbedRequestItem]+ }+ deriving (Eq, Show, Generic)++instance ToJSON BatchEmbedContentsRequest where+ toJSON (BatchEmbedContentsRequest reqs) = object ["requests" .= reqs]++instance FromJSON BatchEmbedContentsRequest where+ parseJSON = withObject "BatchEmbedContentsRequest" $ \o ->+ BatchEmbedContentsRequest <$> o .: "requests"++-- | Response from batchEmbedContents.+newtype BatchEmbedContentsResponse = BatchEmbedContentsResponse+ { batchEmbeddings :: [EmbeddingValues]+ }+ deriving (Eq, Show, Generic)++instance FromJSON BatchEmbedContentsResponse where+ parseJSON = withObject "BatchEmbedContentsResponse" $ \o ->+ BatchEmbedContentsResponse <$> o .: "embeddings"++instance ToJSON BatchEmbedContentsResponse where+ toJSON (BatchEmbedContentsResponse evs) = object ["embeddings" .= evs]
+ src/Langchain/Embeddings/Gemini.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++{- |+Module : Langchain.Embeddings.Gemini+Description : Google Gemini integration for text embeddings+Copyright : (c) 2025-2026 Tushar Adhatrao+License : MIT+Maintainer : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability : experimental++Gemini implementation of LangChain's 'Embeddings' interface using Servant bindings.+-}+module Langchain.Embeddings.Gemini+ ( GeminiEmbeddings (..)+ , defaultGeminiEmbeddings+ , newGeminiEmbeddings+ ) where++import Control.Monad.Except (throwError)+import Control.Monad.IO.Class (liftIO)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import GHC.Generics (Generic)++import Gemini.Client+ ( BatchEmbedContentsRequest (..)+ , BatchEmbedContentsResponse (..)+ , BatchEmbedRequestItem (..)+ , EmbedContentPayload (..)+ , EmbedContentRequest (..)+ , EmbedContentResponse (..)+ , EmbedPart (..)+ , EmbeddingValues (..)+ , batchEmbedContents+ , embedContent+ , newGeminiClientEnv+ , newGeminiClientEnvWithBaseUrl+ , runGeminiClient+ )+import Langchain.DocumentLoader.Core (Document (..))+import Langchain.Embeddings.Core (Embeddings (..))+import Langchain.Error (llmError)++-- | Configuration for Gemini embeddings.+data GeminiEmbeddings = GeminiEmbeddings+ { embeddingApiKey :: !Text+ -- ^ Gemini API key+ , embeddingModel :: !Text+ -- ^ Model name, e.g. @"gemini-embedding-001"@+ , embeddingBaseUrl :: !(Maybe Text)+ -- ^ Optional custom base URL+ }+ deriving (Eq, Show, Generic)++-- | Default embedding configuration using @gemini-embedding-001@.+defaultGeminiEmbeddings :: Text -> GeminiEmbeddings+defaultGeminiEmbeddings key = GeminiEmbeddings key "gemini-embedding-001" Nothing++-- | Create a custom Gemini embedding configuration.+newGeminiEmbeddings :: Text -> Text -> Maybe Text -> GeminiEmbeddings+newGeminiEmbeddings = GeminiEmbeddings++instance Embeddings GeminiEmbeddings where+ embedDocuments _ [] = pure []+ embedDocuments GeminiEmbeddings {..} docs = do+ env <- liftIO $ case embeddingBaseUrl of+ Just u -> newGeminiClientEnvWithBaseUrl u embeddingApiKey+ Nothing -> newGeminiClientEnv embeddingApiKey+ let items =+ [ BatchEmbedRequestItem+ { itemModel = "models/" <> embeddingModel+ , itemContent = EmbedContentPayload [EmbedPart (TL.toStrict (pageContent doc))]+ }+ | doc <- docs+ ]+ req = BatchEmbedContentsRequest items+ eRes <- liftIO $ runGeminiClient env (batchEmbedContents embeddingApiKey embeddingModel req)+ case eRes of+ Left err ->+ throwError $+ llmError (T.pack (show err)) (Just "GeminiEmbeddings") Nothing+ Right resp ->+ pure [embeddingValues ev | ev <- batchEmbeddings resp]++ embedQuery GeminiEmbeddings {..} query = do+ env <- liftIO $ case embeddingBaseUrl of+ Just u -> newGeminiClientEnvWithBaseUrl u embeddingApiKey+ Nothing -> newGeminiClientEnv embeddingApiKey+ let req = EmbedContentRequest (EmbedContentPayload [EmbedPart query])+ eRes <- liftIO $ runGeminiClient env (embedContent embeddingApiKey embeddingModel req)+ case eRes of+ Left err ->+ throwError $+ llmError (T.pack (show err)) (Just "GeminiEmbeddings") Nothing+ Right resp ->+ pure $ embeddingValues (responseEmbedding resp)
+ src/Langchain/Provider/Gemini.hs view
@@ -0,0 +1,334 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}++{- |+Module : Langchain.Provider.Gemini+Description : Google Gemini provider implementing ChatModel via Servant Interactions v1 API+Copyright : (c) 2025-2026 Tushar Adhatrao+License : MIT+Maintainer : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability : experimental++Gemini provider built on the Google Gemini Interactions v1 API using Servant client bindings.+Supports multi-modal content, multi-turn dialogues, tool calling, and SSE streaming.+-}+module Langchain.Provider.Gemini+ ( Gemini (..)+ , GeminiConfig (..)+ , defaultGeminiConfig+ , newGemini+ , messagesToInteractionsInput+ , interactionToMessage+ ) where++import Control.Applicative ((<|>))+import Control.Monad.Except (throwError)+import Control.Monad.IO.Class (liftIO)+import Data.Aeson (FromJSON, ToJSON, decodeStrict, object, toJSON, (.=))+import Data.Conduit (await, yield, (.|))+import qualified Data.List as List+import qualified Data.List.NonEmpty as NonEmpty+import qualified Data.Map.Strict as Map+import Data.Maybe (fromMaybe)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import GHC.Generics (Generic)++import Gemini.Client+ ( CreateInteractionRequest (..)+ , GenerationConfig (..)+ , Interaction (..)+ , InteractionSseEvent (..)+ , InteractionsInput (..)+ , ResponseFormat (..)+ , Step (..)+ , StepDeltaData (..)+ , Usage (..)+ , createInteraction+ , defaultCreateInteractionRequest+ , newGeminiClientEnv+ , newGeminiClientEnvWithBaseUrl+ , runGeminiClient+ , streamGeminiInteraction+ )+import qualified Gemini.Client.Types as GTypes+import Langchain.Cache.Core (CacheableChatModel (..))+import Langchain.Error (llmError)+import Langchain.Model+import Langchain.Stream (StreamEvent (..), TokenUsage (..))+import qualified Langchain.Tool as CoreTool+import Langchain.Tool.Binding (ToolBinder (..))++-- | Runtime configuration for Gemini interactions.+data GeminiConfig = GeminiConfig+ { configTools :: !(Maybe [GTypes.Tool])+ -- ^ Tools (functions, Google Search, Code Execution, etc.) available to the model.+ , configGenerationConfig :: !(Maybe GenerationConfig)+ -- ^ Generation parameters such as token limits, stop sequences, and thinking level.+ , configResponseFormat :: !(Maybe ResponseFormat)+ -- ^ Output format constraints, e.g. JSON schema enforcement.+ , configSystemInstruction :: !(Maybe Text)+ -- ^ System instructions directing the model's persona or constraints.+ , configPreviousInteractionId :: !(Maybe Text)+ -- ^ Interaction ID to continue an ongoing session.+ }+ deriving (Eq, Show, Generic, ToJSON, FromJSON)++-- | Default empty Gemini configuration.+defaultGeminiConfig :: GeminiConfig+defaultGeminiConfig =+ GeminiConfig+ { configTools = Nothing+ , configGenerationConfig = Nothing+ , configResponseFormat = Nothing+ , configSystemInstruction = Nothing+ , configPreviousInteractionId = Nothing+ }++-- | Gemini ChatModel provider instance.+data Gemini = Gemini+ { apiKey :: !Text+ , model :: !Text+ , baseUrl :: !(Maybe Text)+ }+ deriving (Eq, Show, Generic)++-- | Create a new Gemini provider instance.+newGemini ::+ -- | Google Gemini API key+ Text ->+ -- | Model name (e.g. @"gemini-3.6-flash"@)+ Text ->+ -- | Optional custom base URL+ Maybe Text ->+ Gemini+newGemini = Gemini++-- | Convert Langchain ContentBlock to Gemini Content.+contentBlockToGemini :: ContentBlock -> GTypes.Content+contentBlockToGemini (TextBlock t) = GTypes.TextContent t+contentBlockToGemini (ImageBlock ImageContent {imageSource = ImageBase64 (Just mime) b64}) =+ GTypes.ImageContent mime b64+contentBlockToGemini (ImageBlock ImageContent {imageSource = ImageBase64 Nothing b64}) =+ GTypes.ImageContent "image/jpeg" b64+contentBlockToGemini (ImageBlock ImageContent {imageSource = ImageUrl url}) =+ GTypes.TextContent ("[Image URL: " <> url <> "]")+contentBlockToGemini (AudioBlock mime b64) = GTypes.AudioContent mime b64+contentBlockToGemini (DataBlock _) = GTypes.TextContent "[Data block]"++-- | Convert a Langchain Message to Gemini Step(s).+messageToSteps :: [ToolCall] -> Message -> [Step]+messageToSteps priorToolCalls msg = case messageRole msg of+ User ->+ let contents = map contentBlockToGemini (NonEmpty.toList (messageContents msg))+ in [UserInputStep contents]+ Assistant ->+ let contents = map contentBlockToGemini (NonEmpty.toList (messageContents msg))+ textContent = [c | c@(GTypes.TextContent t) <- contents, not (T.null t)]+ outputSteps = [ModelOutputStep textContent | not (null textContent)]+ toolSteps = case messageToolCalls msg of+ Nothing -> []+ Just tcs ->+ [ FunctionCallStep+ { callName = toolCallName tc+ , callArguments = toolCallArguments tc+ , callId = toolCallId tc+ }+ | tc <- tcs+ ]+ in outputSteps ++ toolSteps+ Tool ->+ let payload = parseOrWrap (extractMessageText msg)+ tId = fromMaybe "" (messageToolId msg)+ tName = messageName msg <|> lookupToolName tId priorToolCalls+ in [FunctionResultStep tId tName payload Nothing]+ Function ->+ let payload = parseOrWrap (extractMessageText msg)+ tId = fromMaybe "" (messageToolId msg)+ tName = messageName msg <|> lookupToolName tId priorToolCalls+ in [FunctionResultStep tId tName payload Nothing]+ System ->+ -- System instructions are extracted separately when possible+ let contents = map contentBlockToGemini (NonEmpty.toList (messageContents msg))+ in [UserInputStep contents]+ Developer ->+ let contents = map contentBlockToGemini (NonEmpty.toList (messageContents msg))+ in [UserInputStep contents]+ where+ lookupToolName toolId calls =+ toolCallName <$> List.find ((== toolId) . toolCallId) calls++ parseOrWrap rawTxt =+ case decodeStrict (TE.encodeUtf8 rawTxt) of+ Just val -> val+ Nothing -> object ["result" .= rawTxt]++-- | Convert a list of Langchain Messages to an 'InteractionsInput'.+messagesToInteractionsInput :: [Message] -> (Maybe Text, InteractionsInput)+messagesToInteractionsInput msgs =+ case msgs of+ [singleMsg]+ | messageRole singleMsg == User+ , [TextBlock t] <- NonEmpty.toList (messageContents singleMsg) ->+ (Nothing, TextInput t)+ _ ->+ let (sysMsgs, nonSysMsgs) = List.partition isSystem msgs+ extractedSys = case sysMsgs of+ [] -> Nothing+ _ -> Just $ T.intercalate "\n" (map extractMessageText sysMsgs)+ priorToolCalls = concatMap (fromMaybe [] . messageToolCalls) msgs+ allSteps = concatMap (messageToSteps priorToolCalls) nonSysMsgs+ in (extractedSys, StepListInput allSteps)+ where+ isSystem m = messageRole m `elem` [System, Developer]++-- | Convert an t'Interaction' result to a Langchain t'Message'.+interactionToMessage :: Interaction -> Message+interactionToMessage Interaction {..} =+ let outputTexts =+ [ t+ | ModelOutputStep cs <- interactionSteps+ , GTypes.TextContent t <- cs+ ]+ toolCalls =+ [ ToolCall+ { toolCallId = callId+ , toolCallType = "function"+ , toolCallName = callName+ , toolCallArguments = callArguments+ }+ | FunctionCallStep {..} <- interactionSteps+ ]+ thoughtSigs =+ [ sig+ | ThoughtStep {thoughtSignature = Just sig} <- interactionSteps+ ]+ base = assistantMessage (T.intercalate "\n" outputTexts)+ withCalls =+ if null toolCalls+ then base+ else base {messageToolCalls = Just toolCalls}+ withMeta =+ if null thoughtSigs+ then withCalls+ else+ withCalls+ { messageMetadata =+ Map.insert+ "langchain.gemini.thoughtSignatures"+ (toJSON thoughtSigs)+ (messageMetadata withCalls)+ }+ in withMeta++-- | Build a t'CreateInteractionRequest' from Gemini configuration and messages.+buildCreateRequest :: Gemini -> [Message] -> Maybe GeminiConfig -> CreateInteractionRequest+buildCreateRequest Gemini {..} msgs mbConfig =+ let (mbExtractedSys, input) = messagesToInteractionsInput msgs+ cfg = fromMaybe defaultGeminiConfig mbConfig+ finalSys = configSystemInstruction cfg <|> mbExtractedSys+ baseReq = defaultCreateInteractionRequest input+ in baseReq+ { reqModel = Just model+ , reqSystemInstruction = finalSys+ , reqTools = configTools cfg+ , reqGenerationConfig = configGenerationConfig cfg+ , reqResponseFormat = configResponseFormat cfg+ , reqPreviousInteractionId = configPreviousInteractionId cfg+ }++instance ChatModel Gemini where+ type ModelConfig Gemini = GeminiConfig++ invoke provider msgs mbConfig = do+ let req = buildCreateRequest provider msgs mbConfig+ env <- liftIO $ case baseUrl provider of+ Just u -> newGeminiClientEnvWithBaseUrl u (apiKey provider)+ Nothing -> newGeminiClientEnv (apiKey provider)+ eRes <- liftIO $ runGeminiClient env (createInteraction (apiKey provider) req)+ case eRes of+ Left err ->+ throwError $+ llmError (redactKey (apiKey provider) (T.pack (show err))) Nothing Nothing+ Right interaction -> pure $ interactionToMessage interaction++ stream provider msgs mbConfig = do+ let rId = "gemini-stream-run"+ mName = model provider+ yield $ LLMStart rId mName msgs++ env <- liftIO $ case baseUrl provider of+ Just u -> newGeminiClientEnvWithBaseUrl u (apiKey provider)+ Nothing -> newGeminiClientEnv (apiKey provider)+ let req = buildCreateRequest provider msgs mbConfig++ (accumulated, mbCompletedInter) <-+ streamGeminiInteraction env req .| consumeStream rId "" Nothing++ case mbCompletedInter of+ Just completedInter -> do+ let finalMsg = interactionToMessage completedInter+ usage = toTokenUsage (interactionUsage completedInter)+ yield $ LLMEnd rId finalMsg usage+ Nothing -> do+ let finalMsg = assistantMessage accumulated+ yield $ LLMEnd rId finalMsg Nothing+ where+ consumeStream rId acc mbCompleted =+ await >>= \case+ Nothing -> pure (acc, mbCompleted)+ Just (SseStepDelta _ (TextDelta txt)) -> do+ yield $ LLMChunk rId txt Nothing+ consumeStream rId (acc <> txt) mbCompleted+ Just (SseInteractionCompleted inter) ->+ consumeStream rId acc (Just inter)+ Just (SseError code msg) ->+ throwError $+ llmError (code <> ": " <> msg) Nothing Nothing+ Just _ ->+ consumeStream rId acc mbCompleted++ toTokenUsage Nothing = Nothing+ toTokenUsage (Just Usage {..}) =+ Just $+ TokenUsage+ { promptTokens = fromMaybe 0 totalInputTokens+ , completionTokens = fromMaybe 0 totalOutputTokens+ , totalTokens = fromMaybe 0 totalTokens+ }++instance ToolBinder Gemini m where+ bindToolsConfig tools mbConfig =+ let cfg = fromMaybe defaultGeminiConfig mbConfig+ geminiTools = map toGeminiTool tools+ mergedTools = case configTools cfg of+ Nothing -> Just geminiTools+ Just existing -> Just (existing ++ geminiTools)+ in Just cfg {configTools = mergedTools}+ where+ toGeminiTool t =+ GTypes.FunctionTool+ (CoreTool.toolName t)+ (Just $ CoreTool.toolDescription t)+ (Just $ CoreTool.toolSchema t)++instance CacheableChatModel Gemini where+ cacheModelIdentity Gemini {model = mName} _ =+ object+ [ "provider" .= ("gemini" :: Text)+ , "model" .= mName+ ]++-- | Redact API key from strings to prevent accidental leakage in errors.+redactKey :: Text -> Text -> Text+redactKey key txt+ | T.null key = txt+ | otherwise = T.replace key "[REDACTED]" txt
+ test/Spec.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE OverloadedStrings #-}++module Main (main) where++import qualified Test.Gemini.Client.InteractionsSpec as InteractionsSpec+import qualified Test.Gemini.Client.TypesSpec as TypesSpec+import qualified Test.Langchain.Provider.GeminiSpec as GeminiSpec+import Test.Tasty++main :: IO ()+main =+ defaultMain $+ testGroup+ "langchain-hs-gemini Test Suite"+ [ TypesSpec.tests+ , InteractionsSpec.tests+ , GeminiSpec.tests+ ]
+ test/Test/Gemini/Client/InteractionsSpec.hs view
@@ -0,0 +1,651 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -Wno-unused-matches -Wno-incomplete-patterns #-}++{- |+Module : Test.Gemini.Client.InteractionsSpec+Description : Test every single example from https://ai.google.dev/api/interactions-api-v1+-}+module Test.Gemini.Client.InteractionsSpec (tests) where++import Data.Aeson (encode)+import Data.Aeson.QQ (aesonQQ)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.IO as TIO+import Network.HTTP.Types (status200, status404)+import Network.Wai (Application, rawPathInfo, requestMethod, responseLBS, strictRequestBody)+import Network.Wai.Handler.Warp (testWithApplication)+import System.Directory (doesFileExist, getHomeDirectory)+import System.Environment (lookupEnv)+import System.FilePath ((</>))+import Test.Tasty+import Test.Tasty.HUnit++import Gemini.Client++-- | Helper to start a local mock Warp server on a free port+withMockServer :: Application -> (Text -> IO a) -> IO a+withMockServer app action =+ testWithApplication (pure app) $ \port ->+ action ("http://127.0.0.1:" <> T.pack (show port))++-- | Read GEMINI API KEY from env or ~/.gemini_api_key+getLiveApiKey :: IO (Maybe Text)+getLiveApiKey = do+ mbEnv <- lookupEnv "GEMINI_API_KEY"+ case mbEnv of+ Just k | not (null k) -> pure (Just (T.pack k))+ _ -> do+ home <- getHomeDirectory+ let p = home </> ".gemini_api_key"+ exists <- doesFileExist p+ if exists+ then do+ txt <- T.strip <$> TIO.readFile p+ pure $ if T.null txt then Nothing else Just txt+ else pure Nothing++tests :: TestTree+tests =+ testGroup+ "Gemini.Client.InteractionsSpec (All Documentation Examples)"+ [ mockExamplesTests+ , liveExamplesTests+ ]++-- ---------------------------------------------------------------------------+-- 1. Mock Server Tests (Verifies all 14 examples against exact API contracts)+-- ---------------------------------------------------------------------------++mockExamplesTests :: TestTree+mockExamplesTests =+ testGroup+ "Mock API Contract Tests"+ [ testCase "Example 1: Simple Request" $ do+ let app req respond = do+ body <- strictRequestBody req+ let expectedResp =+ [aesonQQ|{+ "id": "v1_mock_simple",+ "object": "interaction",+ "status": "completed",+ "model": "gemini-3.6-flash",+ "steps": [+ {+ "type": "model_output",+ "content": [{"type": "text", "text": "Why did the chicken cross the road? To get to the other side!"}]+ }+ ]+ }|]+ respond $ responseLBS status200 [("Content-Type", "application/json")] (encode expectedResp)+ withMockServer app $ \base -> do+ env <- newGeminiClientEnvWithBaseUrl base "fake-key"+ let req = createModelInteraction "gemini-3.6-flash" (TextInput "Tell me a joke")+ res <- runGeminiClient env (createInteraction "fake-key" req)+ case res of+ Left err -> assertFailure (show err)+ Right inter -> do+ interactionId inter @?= "v1_mock_simple"+ interactionStatus inter @?= StatusCompleted+ case interactionSteps inter of+ [ModelOutputStep [TextContent txt]] ->+ assertBool "contains joke" ("chicken" `T.isInfixOf` txt)+ other -> assertFailure ("Unexpected steps: " ++ show other)+ , testCase "Example 2: Multi-turn Conversation" $ do+ let app req respond = do+ body <- strictRequestBody req+ let expectedResp =+ [aesonQQ|{+ "id": "v1_mock_multiturn",+ "object": "interaction",+ "status": "completed",+ "steps": [+ {+ "type": "model_output",+ "content": [{"type": "text", "text": "Your name is Bob."}]+ }+ ]+ }|]+ respond $ responseLBS status200 [("Content-Type", "application/json")] (encode expectedResp)+ withMockServer app $ \base -> do+ env <- newGeminiClientEnvWithBaseUrl base "fake-key"+ let steps =+ [ UserInputStep [TextContent "Hi, I am Bob"]+ , ModelOutputStep [TextContent "Hello Bob! Nice to meet you."]+ , UserInputStep [TextContent "What is my name?"]+ ]+ req = createModelInteraction "gemini-3.6-flash" (StepListInput steps)+ res <- runGeminiClient env (createInteraction "fake-key" req)+ case res of+ Left err -> assertFailure (show err)+ Right inter -> interactionStatus inter @?= StatusCompleted+ , testCase "Example 3: Multimodal - Image Input" $ do+ let app req respond = do+ body <- strictRequestBody req+ let expectedResp =+ [aesonQQ|{+ "id": "v1_mock_image",+ "status": "completed",+ "steps": [+ {+ "type": "model_output",+ "content": [{"type": "text", "text": "This is a red circle."}]+ }+ ]+ }|]+ respond $ responseLBS status200 [("Content-Type", "application/json")] (encode expectedResp)+ withMockServer app $ \base -> do+ env <- newGeminiClientEnvWithBaseUrl base "fake-key"+ let contents =+ [ TextContent "What is in this image?"+ , ImageContent+ "image/png"+ "iVBORw0KGgoAAAANSUhEUgAAAAEAAAABCAQAAAC1HAwCAAAAC0lEQVR42mNk+A8AAQUBAScY42YAAAAASUVORK5CYII="+ ]+ req = createModelInteraction "gemini-3.6-flash" (ContentListInput contents)+ res <- runGeminiClient env (createInteraction "fake-key" req)+ case res of+ Left err -> assertFailure (show err)+ Right inter -> interactionStatus inter @?= StatusCompleted+ , testCase "Example 4: Function Calling (requires_action -> function_result)" $ do+ let app req respond = do+ body <- strictRequestBody req+ let isFollowUp = "\"function_result\"" `BS.isInfixOf` LBS.toStrict body+ resp =+ if isFollowUp+ then+ [aesonQQ|{+ "id": "v1_mock_fc_step2",+ "status": "completed",+ "steps": [+ {+ "type": "model_output",+ "content": [{"type": "text", "text": "The weather in Tokyo is 20°C and sunny."}]+ }+ ]+ }|]+ else+ [aesonQQ|{+ "id": "v1_mock_fc_step1",+ "status": "requires_action",+ "steps": [+ {+ "type": "function_call",+ "id": "call_tokyo",+ "name": "get_weather",+ "arguments": {"location": "Tokyo"}+ }+ ]+ }|]+ respond $ responseLBS status200 [("Content-Type", "application/json")] (encode resp)+ withMockServer app $ \base -> do+ env <- newGeminiClientEnvWithBaseUrl base "fake-key"+ let tool = functionTool "get_weather" (Just "Get current weather") (Just [aesonQQ|{"type": "object"}|])+ req1 =+ (createModelInteraction "gemini-3.6-flash" (TextInput "What is the weather in Tokyo?"))+ { reqTools = Just [tool]+ }+ res1 <- runGeminiClient env (createInteraction "fake-key" req1)+ case res1 of+ Left err -> assertFailure (show err)+ Right inter1 -> do+ interactionStatus inter1 @?= StatusRequiresAction+ case interactionSteps inter1 of+ [FunctionCallStep {callId = cid, callName = cname}] -> do+ cid @?= "call_tokyo"+ cname @?= "get_weather"+ -- Follow up with function_result+ let resultStep = FunctionResultStep cid (Just cname) [aesonQQ|{"temperature": 20, "condition": "sunny"}|] Nothing+ req2 =+ (defaultCreateInteractionRequest (StepListInput [resultStep]))+ { reqModel = Just "gemini-3.6-flash"+ , reqPreviousInteractionId = Just (interactionId inter1)+ }+ res2 <- runGeminiClient env (createInteraction "fake-key" req2)+ case res2 of+ Left err2 -> assertFailure (show err2)+ Right inter2 -> interactionStatus inter2 @?= StatusCompleted+ other -> assertFailure ("Expected FunctionCallStep, got: " ++ show other)+ , testCase "Example 5: Deep Research Agent" $ do+ let app req respond = do+ body <- strictRequestBody req+ let expectedResp =+ [aesonQQ|{+ "id": "v1_mock_deep_research",+ "agent": "deep-research",+ "status": "completed",+ "steps": [+ {+ "type": "model_output",+ "content": [{"type": "text", "text": "Deep research findings on quantum computing."}]+ }+ ]+ }|]+ respond $ responseLBS status200 [("Content-Type", "application/json")] (encode expectedResp)+ withMockServer app $ \base -> do+ env <- newGeminiClientEnvWithBaseUrl base "fake-key"+ let req = createAgentInteraction "deep-research" (TextInput "Research quantum computing breakthroughs")+ res <- runGeminiClient env (createInteraction "fake-key" req)+ case res of+ Left err -> assertFailure (show err)+ Right inter -> do+ interactionAgent inter @?= Just "deep-research"+ interactionStatus inter @?= StatusCompleted+ , testCase "Example 6: Antigravity Agent" $ do+ let app req respond = do+ body <- strictRequestBody req+ let expectedResp =+ [aesonQQ|{+ "id": "v1_mock_antigravity",+ "agent": "antigravity",+ "status": "completed",+ "steps": [+ {+ "type": "model_output",+ "content": [{"type": "text", "text": "Antigravity task completed."}]+ }+ ]+ }|]+ respond $ responseLBS status200 [("Content-Type", "application/json")] (encode expectedResp)+ withMockServer app $ \base -> do+ env <- newGeminiClientEnvWithBaseUrl base "fake-key"+ let req = createAgentInteraction "antigravity" (TextInput "Solve the algorithmic puzzle")+ res <- runGeminiClient env (createInteraction "fake-key" req)+ case res of+ Left err -> assertFailure (show err)+ Right inter -> do+ interactionAgent inter @?= Just "antigravity"+ interactionStatus inter @?= StatusCompleted+ , testCase "Example 7: Reuse Env (previous_interaction_id)" $ do+ let app req respond = do+ body <- strictRequestBody req+ let expectedResp =+ [aesonQQ|{+ "id": "v1_mock_reuse",+ "previous_interaction_id": "v1_mock_prev",+ "status": "completed",+ "steps": [+ {+ "type": "model_output",+ "content": [{"type": "text", "text": "Continuing previous session."}]+ }+ ]+ }|]+ respond $ responseLBS status200 [("Content-Type", "application/json")] (encode expectedResp)+ withMockServer app $ \base -> do+ env <- newGeminiClientEnvWithBaseUrl base "fake-key"+ let req =+ (createModelInteraction "gemini-3.6-flash" (TextInput "Continue our conversation"))+ { reqPreviousInteractionId = Just "v1_mock_prev"+ }+ res <- runGeminiClient env (createInteraction "fake-key" req)+ case res of+ Left err -> assertFailure (show err)+ Right inter -> interactionPreviousInteractionId inter @?= Just "v1_mock_prev"+ , testCase "Example 8: With Sources / Grounding" $ do+ let app req respond = do+ body <- strictRequestBody req+ let expectedResp =+ [aesonQQ|{+ "id": "v1_mock_sources",+ "status": "completed",+ "steps": [+ {+ "type": "google_search_result",+ "call_id": "call_search_1",+ "result": [+ {+ "title": "Example Source",+ "url": "https://example.com/source",+ "snippet": "Information from source"+ }+ ]+ },+ {+ "type": "model_output",+ "content": [{"type": "text", "text": "According to Example Source, ..."}]+ }+ ]+ }|]+ respond $ responseLBS status200 [("Content-Type", "application/json")] (encode expectedResp)+ withMockServer app $ \base -> do+ env <- newGeminiClientEnvWithBaseUrl base "fake-key"+ let req =+ (createModelInteraction "gemini-3.6-flash" (TextInput "Find recent news"))+ { reqTools = Just [GoogleSearchTool]+ }+ res <- runGeminiClient env (createInteraction "fake-key" req)+ case res of+ Left err -> assertFailure (show err)+ Right inter -> do+ let searchSteps = [s | s@(GoogleSearchResultStep {}) <- interactionSteps inter]+ assertBool "Contains google_search_result step" (not (null searchSteps))+ , testCase "Example 9: Custom Agent / System Instruction" $ do+ let app req respond = do+ body <- strictRequestBody req+ let expectedResp =+ [aesonQQ|{+ "id": "v1_mock_pirate",+ "status": "completed",+ "system_instruction": "You are a pirate.",+ "steps": [+ {+ "type": "model_output",+ "content": [{"type": "text", "text": "Ahoy matey!"}]+ }+ ]+ }|]+ respond $ responseLBS status200 [("Content-Type", "application/json")] (encode expectedResp)+ withMockServer app $ \base -> do+ env <- newGeminiClientEnvWithBaseUrl base "fake-key"+ let req =+ (createModelInteraction "gemini-3.6-flash" (TextInput "Hello"))+ { reqSystemInstruction = Just "You are a pirate."+ }+ res <- runGeminiClient env (createInteraction "fake-key" req)+ case res of+ Left err -> assertFailure (show err)+ Right inter -> interactionSystemInstruction inter @?= Just "You are a pirate."+ , testCase+ "Example 10: Built-in Tools (CodeExecution, GoogleSearch, GoogleMaps, FileSearch, UrlContext)"+ $ do+ let app req respond = do+ body <- strictRequestBody req+ let expectedResp =+ [aesonQQ|{+ "id": "v1_mock_tools",+ "status": "completed",+ "steps": [+ {+ "type": "code_execution_call",+ "id": "call_py",+ "arguments": {"code": "print(2+2)"}+ },+ {+ "type": "code_execution_result",+ "call_id": "call_py",+ "result": "4\n"+ },+ {+ "type": "model_output",+ "content": [{"type": "text", "text": "2 + 2 = 4"}]+ }+ ]+ }|]+ respond $ responseLBS status200 [("Content-Type", "application/json")] (encode expectedResp)+ withMockServer app $ \base -> do+ env <- newGeminiClientEnvWithBaseUrl base "fake-key"+ let tools =+ [ CodeExecutionTool+ , GoogleSearchTool+ , GoogleMapsTool (Just 37.77) (Just (-122.41))+ , FileSearchTool (Just ["my-store"])+ , UrlContextTool+ ]+ req =+ (createModelInteraction "gemini-3.6-flash" (TextInput "Run math code"))+ { reqTools = Just tools+ }+ res <- runGeminiClient env (createInteraction "fake-key" req)+ case res of+ Left err -> assertFailure (show err)+ Right inter -> do+ let pyCalls = [s | s@(CodeExecutionCallStep {}) <- interactionSteps inter]+ assertBool "Contains CodeExecutionCallStep" (not (null pyCalls))+ , testCase "Example 11: Cancel Interaction" $ do+ let app req respond = do+ let p = rawPathInfo req+ m = requestMethod req+ if m == "POST" && "/cancel" `BS.isSuffixOf` p+ then do+ let expectedResp = [aesonQQ|{"id": "v1_cancel_me", "status": "cancelled", "steps": []}|]+ respond $ responseLBS status200 [("Content-Type", "application/json")] (encode expectedResp)+ else respond $ responseLBS status404 [] "not found"+ withMockServer app $ \base -> do+ env <- newGeminiClientEnvWithBaseUrl base "fake-key"+ res <- runGeminiClient env (cancelInteraction "fake-key" "v1_cancel_me")+ case res of+ Left err -> assertFailure (show err)+ Right inter -> interactionStatus inter @?= StatusCancelled+ , testCase "Example 12: Get Interaction" $ do+ let app req respond = do+ let expectedResp = [aesonQQ|{"id": "v1_got_it", "status": "completed", "steps": []}|]+ respond $ responseLBS status200 [("Content-Type", "application/json")] (encode expectedResp)+ withMockServer app $ \base -> do+ env <- newGeminiClientEnvWithBaseUrl base "fake-key"+ res <- runGeminiClient env (getInteraction "fake-key" "v1_got_it" Nothing Nothing)+ case res of+ Left err -> assertFailure (show err)+ Right inter -> interactionId inter @?= "v1_got_it"+ , testCase "Example 13: Delete Interaction" $ do+ let app req respond = do+ respond $ responseLBS status200 [("Content-Type", "application/json")] "{}"+ withMockServer app $ \base -> do+ env <- newGeminiClientEnvWithBaseUrl base "fake-key"+ res <- runGeminiClient env (deleteInteraction "fake-key" "v1_del_me")+ case res of+ Left err -> assertFailure (show err)+ Right val -> val @?= [aesonQQ|{}|]+ , testCase "Example 14: Embeddings (embedContent and batchEmbedContents)" $ do+ let app req respond = do+ let p = rawPathInfo req+ if ":embedContent" `BS.isSuffixOf` p+ then do+ let resp = [aesonQQ|{"embedding": {"values": [0.1, 0.2, 0.3]}}|]+ respond $ responseLBS status200 [("Content-Type", "application/json")] (encode resp)+ else+ if ":batchEmbedContents" `BS.isSuffixOf` p+ then do+ let resp = [aesonQQ|{"embeddings": [{"values": [0.1, 0.2]}, {"values": [0.3, 0.4]}]}|]+ respond $ responseLBS status200 [("Content-Type", "application/json")] (encode resp)+ else respond $ responseLBS status404 [] "not found"+ withMockServer app $ \base -> do+ env <- newGeminiClientEnvWithBaseUrl base "fake-key"+ -- Single+ let singleReq = EmbedContentRequest (EmbedContentPayload [EmbedPart "Query text"])+ res1 <- runGeminiClient env (embedContent "fake-key" "gemini-embedding-001" singleReq)+ case res1 of+ Left err -> assertFailure (show err)+ Right r -> embeddingValues (responseEmbedding r) @?= [0.1, 0.2, 0.3]+ -- Batch+ let batchReq =+ BatchEmbedContentsRequest+ [ BatchEmbedRequestItem "models/gemini-embedding-001" (EmbedContentPayload [EmbedPart "Doc 1"])+ , BatchEmbedRequestItem "models/gemini-embedding-001" (EmbedContentPayload [EmbedPart "Doc 2"])+ ]+ res2 <- runGeminiClient env (batchEmbedContents "fake-key" "gemini-embedding-001" batchReq)+ case res2 of+ Left err -> assertFailure (show err)+ Right r -> length (batchEmbeddings r) @?= 2+ ]++-- ---------------------------------------------------------------------------+-- 2. Live API Tests (executed when ~/.gemini_api_key or GEMINI_API_KEY is present)+-- ---------------------------------------------------------------------------++liveExamplesTests :: TestTree+liveExamplesTests =+ testGroup+ "Live Google Gemini API Tests (~/.gemini_api_key)"+ [ testCase "Live: Simple Request, Get, and Delete Interaction lifecycle" $ do+ mbKey <- getLiveApiKey+ case mbKey of+ Nothing -> pure () -- Skip if no live key available+ Just key -> do+ env <- newGeminiClientEnv key+ let req = createModelInteraction "gemini-3.6-flash" (TextInput "Reply with the exact word PONG")+ resCreate <- runGeminiClient env (createInteraction key req)+ case resCreate of+ Left err -> assertFailure ("Live createInteraction failed: " ++ show err)+ Right inter -> do+ let interId = interactionId inter+ assertBool "Interaction ID is non-empty" (not (T.null interId))+ -- Test GET interaction+ resGet <- runGeminiClient env (getInteraction key interId Nothing Nothing)+ case resGet of+ Left err -> assertFailure ("Live getInteraction failed: " ++ show err)+ Right gotInter -> interactionId gotInter @?= interId+ -- Test DELETE interaction+ resDel <- runGeminiClient env (deleteInteraction key interId)+ case resDel of+ Left err -> assertFailure ("Live deleteInteraction failed: " ++ show err)+ Right _ -> pure ()+ , testCase "Live: Multi-turn Conversation" $ do+ mbKey <- getLiveApiKey+ case mbKey of+ Nothing -> pure ()+ Just key -> do+ env <- newGeminiClientEnv key+ let steps =+ [ UserInputStep [TextContent "My favorite fruit is Mango."]+ , ModelOutputStep [TextContent "Got it! Your favorite fruit is Mango."]+ , UserInputStep [TextContent "What is my favorite fruit? Reply in one word."]+ ]+ req = createModelInteraction "gemini-3.6-flash" (StepListInput steps)+ res <- runGeminiClient env (createInteraction key req)+ case res of+ Left err -> assertFailure ("Live multi-turn failed: " ++ show err)+ Right inter -> do+ interactionStatus inter @?= StatusCompleted+ -- Clean up+ _ <- runGeminiClient env (deleteInteraction key (interactionId inter))+ pure ()+ , testCase "Live: Function Calling (Tool use)" $ do+ mbKey <- getLiveApiKey+ case mbKey of+ Nothing -> pure ()+ Just key -> do+ env <- newGeminiClientEnv key+ let weatherTool =+ functionTool+ "get_weather"+ (Just "Get the weather for a location")+ ( Just+ [aesonQQ|{+ "type": "object",+ "properties": {+ "location": {"type": "string"}+ },+ "required": ["location"]+ }|]+ )+ req =+ (createModelInteraction "gemini-3.6-flash" (TextInput "What is the weather in Tokyo?"))+ { reqTools = Just [weatherTool]+ }+ res <- runGeminiClient env (createInteraction key req)+ case res of+ Left err -> assertFailure ("Live tool call failed: " ++ show err)+ Right inter -> do+ interactionStatus inter @?= StatusRequiresAction+ case [s | s@(FunctionCallStep {}) <- interactionSteps inter] of+ (FunctionCallStep {..} : _) -> do+ callName @?= "get_weather"+ -- Follow up with tool result+ let resultStep =+ FunctionResultStep+ callId+ (Just callName)+ [aesonQQ|{"temperature": 22, "condition": "Sunny"}|]+ Nothing+ followUp =+ (defaultCreateInteractionRequest (StepListInput [resultStep]))+ { reqModel = Just "gemini-3.6-flash"+ , reqPreviousInteractionId = Just (interactionId inter)+ }+ resFollowUp <- runGeminiClient env (createInteraction key followUp)+ case resFollowUp of+ Left fErr -> assertFailure ("Live follow-up failed: " ++ show fErr)+ Right completedInter -> do+ interactionStatus completedInter @?= StatusCompleted+ -- Clean up+ _ <- runGeminiClient env (deleteInteraction key (interactionId completedInter))+ pure ()+ [] -> assertFailure "Expected FunctionCallStep in interaction steps"+ _ <- runGeminiClient env (deleteInteraction key (interactionId inter))+ pure ()+ , testCase "Live: Built-in Code Execution Tool" $ do+ mbKey <- getLiveApiKey+ case mbKey of+ Nothing -> pure ()+ Just key -> do+ env <- newGeminiClientEnv key+ let req =+ (createModelInteraction "gemini-3.6-flash" (TextInput "Run python code to compute 999 * 333"))+ { reqTools = Just [CodeExecutionTool]+ }+ res <- runGeminiClient env (createInteraction key req)+ case res of+ Left err -> assertFailure ("Live code execution failed: " ++ show err)+ Right inter -> do+ interactionStatus inter @?= StatusCompleted+ _ <- runGeminiClient env (deleteInteraction key (interactionId inter))+ pure ()+ , testCase "Live: Built-in Google Search Tool" $ do+ mbKey <- getLiveApiKey+ case mbKey of+ Nothing -> pure ()+ Just key -> do+ env <- newGeminiClientEnv key+ let req =+ (createModelInteraction "gemini-3.6-flash" (TextInput "Who won the cricket world cup in 2023?"))+ { reqTools = Just [GoogleSearchTool]+ }+ res <- runGeminiClient env (createInteraction key req)+ case res of+ Left err -> assertFailure ("Live google search failed: " ++ show err)+ Right inter -> do+ interactionStatus inter @?= StatusCompleted+ _ <- runGeminiClient env (deleteInteraction key (interactionId inter))+ pure ()+ , testCase "Live: Background Interaction and Cancel" $ do+ mbKey <- getLiveApiKey+ case mbKey of+ Nothing -> pure ()+ Just key -> do+ env <- newGeminiClientEnv key+ let req =+ (createModelInteraction "gemini-3.6-flash" (TextInput "Write a detailed history of the universe"))+ { reqBackground = Just True+ }+ resCreate <- runGeminiClient env (createInteraction key req)+ case resCreate of+ Left err -> assertFailure ("Live background create failed: " ++ show err)+ Right inter -> do+ let interId = interactionId inter+ resCancel <- runGeminiClient env (cancelInteraction key interId)+ case resCancel of+ Left err -> assertFailure ("Live cancel failed: " ++ show err)+ Right cancelled -> do+ interactionStatus cancelled @?= StatusCancelled+ _ <- runGeminiClient env (deleteInteraction key interId)+ pure ()+ , testCase "Live: Embeddings (gemini-embedding-001)" $ do+ mbKey <- getLiveApiKey+ case mbKey of+ Nothing -> pure ()+ Just key -> do+ env <- newGeminiClientEnv key+ -- Single embed+ let singleReq = EmbedContentRequest (EmbedContentPayload [EmbedPart "Haskell LangChain"])+ resSingle <- runGeminiClient env (embedContent key "gemini-embedding-001" singleReq)+ case resSingle of+ Left err -> assertFailure ("Live embedContent failed: " ++ show err)+ Right resp -> do+ let vec = embeddingValues (responseEmbedding resp)+ assertBool "Embedding dimension > 0" (not (null vec))+ -- Batch embed+ let batchReq =+ BatchEmbedContentsRequest+ [ BatchEmbedRequestItem "models/gemini-embedding-001" (EmbedContentPayload [EmbedPart "Hello"])+ , BatchEmbedRequestItem "models/gemini-embedding-001" (EmbedContentPayload [EmbedPart "World"])+ ]+ resBatch <- runGeminiClient env (batchEmbedContents key "gemini-embedding-001" batchReq)+ case resBatch of+ Left err -> assertFailure ("Live batchEmbedContents failed: " ++ show err)+ Right resp -> length (batchEmbeddings resp) @?= 2+ ]
+ test/Test/Gemini/Client/TypesSpec.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Gemini.Client.TypesSpec (tests) where++import Data.Aeson (decode, encode)+import qualified Data.ByteString.Lazy as LBS+import Test.Tasty+import Test.Tasty.HUnit++import Gemini.Client.Types++tests :: TestTree+tests =+ testGroup+ "Gemini.Client.TypesSpec"+ [ testGroup+ "InteractionStatus JSON"+ [ testCase "encodes and decodes all statuses" $ do+ let statuses =+ [ (StatusInProgress, "\"in_progress\"")+ , (StatusRequiresAction, "\"requires_action\"")+ , (StatusCompleted, "\"completed\"")+ , (StatusFailed, "\"failed\"")+ , (StatusCancelled, "\"cancelled\"")+ , (StatusIncomplete, "\"incomplete\"")+ ]+ mapM_ (\(st, raw) -> encode st @?= raw) statuses+ mapM_ (\(st, raw) -> decode raw @?= Just st) statuses+ ]+ , testGroup+ "SSE Events JSON"+ [ testCase "SseStepDelta TextDelta" $ do+ let raw =+ "{\"event_type\": \"step.delta\", \"index\": 0, \"delta\": {\"type\": \"text\", \"text\": \"chunk\"}}" ::+ LBS.ByteString+ case decode raw of+ Just (SseStepDelta idx (TextDelta txt)) -> do+ idx @?= 0+ txt @?= "chunk"+ other -> assertFailure ("Unexpected decode result: " ++ show other)+ , testCase "SseInteractionCompleted" $ do+ let raw =+ "{\"event_type\": \"interaction.completed\", \"interaction\": {\"id\": \"v1_abc\", \"status\": \"completed\", \"steps\": []}}" ::+ LBS.ByteString+ case decode raw of+ Just (SseInteractionCompleted inter) -> do+ interactionId inter @?= "v1_abc"+ interactionStatus inter @?= StatusCompleted+ other -> assertFailure ("Unexpected decode result: " ++ show other)+ ]+ ]
+ test/Test/Langchain/Provider/GeminiSpec.hs view
@@ -0,0 +1,234 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TypeApplications #-}+{-# OPTIONS_GHC -Wno-unused-matches #-}++module Test.Langchain.Provider.GeminiSpec (tests) where++import Control.Monad.Except (runExceptT)+import Control.Monad.Trans.Resource (runResourceT)+import Data.Aeson (encode)+import Data.Aeson.QQ (aesonQQ)+import qualified Data.Map.Strict as Map+import qualified Data.Text as T+import qualified Data.Text.IO as TIO+import qualified Data.Text.Lazy as TL+import Network.HTTP.Types (status200, status500)+import Network.Wai (Application, responseLBS, responseStream)+import Network.Wai.Handler.Warp (testWithApplication)+import System.Directory (doesFileExist, getHomeDirectory)+import System.Environment (lookupEnv)+import System.FilePath ((</>))+import Test.Tasty+import Test.Tasty.HUnit++import qualified Data.ByteString.Builder as Builder+import Gemini.Client (InteractionsInput (..))+import Langchain.Cache.Core (CacheableChatModel (..))+import Langchain.DocumentLoader.Core (Document (..))+import Langchain.Embeddings.Core (Embeddings (..))+import Langchain.Embeddings.Gemini (GeminiEmbeddings (..), defaultGeminiEmbeddings)+import Langchain.Model+import Langchain.Provider.Gemini+import Langchain.Stream (StreamEvent (..), collectEvents)+import Langchain.Tool (Tool (..), createTool)+import Langchain.Tool.Binding (ToolBinder (..))++withMockServer :: Application -> (T.Text -> IO a) -> IO a+withMockServer app action =+ testWithApplication (pure app) $ \port ->+ action $ "http://127.0.0.1:" <> T.pack (show port)++getLiveApiKey :: IO (Maybe T.Text)+getLiveApiKey = do+ mbEnv <- lookupEnv "GEMINI_API_KEY"+ case mbEnv of+ Just k | not (null k) -> pure (Just (T.pack k))+ _ -> do+ home <- getHomeDirectory+ let p = home </> ".gemini_api_key"+ exists <- doesFileExist p+ if exists+ then do+ txt <- T.strip <$> TIO.readFile p+ pure $ if T.null txt then Nothing else Just txt+ else pure Nothing++tests :: TestTree+tests =+ testGroup+ "Langchain.Provider.GeminiSpec"+ [ testGroup+ "Provider Initialization and Config"+ [ testCase "newGemini initializes correctly" $ do+ let p = newGemini "my-api-key" "gemini-3.6-flash" (Just "http://custom")+ apiKey p @?= "my-api-key"+ model p @?= "gemini-3.6-flash"+ baseUrl p @?= Just "http://custom"+ , testCase "defaultGeminiConfig has empty fields" $ do+ let cfg = defaultGeminiConfig+ configTools cfg @?= Nothing+ configSystemInstruction cfg @?= Nothing+ , testCase "cacheModelIdentity returns correct identity" $ do+ let p = newGemini "key" "gemini-3.6-flash" Nothing+ identity = cacheModelIdentity p (Just defaultGeminiConfig)+ identity @?= [aesonQQ|{"provider": "gemini", "model": "gemini-3.6-flash"}|]+ ]+ , testGroup+ "Message to InteractionsInput mapping"+ [ testCase "single user message maps to TextInput" $ do+ let msgs = [userMessage "Hello world"]+ (mbSys, input) = messagesToInteractionsInput msgs+ mbSys @?= Nothing+ case input of+ TextInput t -> t @?= "Hello world"+ other -> assertFailure ("Expected TextInput, got: " ++ show other)+ , testCase "system and user messages extract system instruction" $ do+ let msgs = [systemMessage "Be brief", userMessage "Hello"]+ (mbSys, _input) = messagesToInteractionsInput msgs+ mbSys @?= Just "Be brief"+ ]+ , testGroup+ "ChatModel invoke (Mock)"+ [ testCase "invoke returns assistant message" $ do+ let app _req respond = do+ let resp =+ [aesonQQ|{+ "id": "v1_test_invoke",+ "status": "completed",+ "steps": [+ {+ "type": "model_output",+ "content": [{"type": "text", "text": "Hello from Gemini"}]+ }+ ]+ }|]+ respond $ responseLBS status200 [("Content-Type", "application/json")] (encode resp)+ withMockServer app $ \url -> do+ let provider = newGemini "fake-key" "gemini-3.6-flash" (Just url)+ eRes <- runExceptT $ invoke provider [userMessage "Hi"] Nothing+ case eRes of+ Left err -> assertFailure (show err)+ Right msg -> do+ messageRole msg @?= Assistant+ extractMessageText msg @?= "Hello from Gemini"+ , testCase "invoke redacts API key on error" $ do+ let app _req respond = respond $ responseLBS status500 [] "Internal Server Error"+ withMockServer app $ \url -> do+ let provider = newGemini "SECRET_KEY_12345" "gemini-3.6-flash" (Just url)+ eRes <- runExceptT $ invoke provider [userMessage "Hi"] Nothing+ case eRes of+ Left err -> do+ let errStr = T.pack (show err)+ assertBool "Does not contain raw secret key" (not ("SECRET_KEY_12345" `T.isInfixOf` errStr))+ Right _ -> assertFailure "Expected failure on HTTP 500"+ ]+ , testGroup+ "ToolBinder integration"+ [ testCase "bindToolsConfig binds function tool to GeminiConfig" $ do+ let dummyTool :: Tool IO+ dummyTool =+ createTool+ "calculator"+ "Do math"+ [aesonQQ|{"type": "object"}|]+ (\_ -> pure (Right "42"))+ cfg :: Maybe GeminiConfig+ cfg = bindToolsConfig @Gemini [dummyTool] Nothing+ case cfg of+ Nothing -> assertFailure "Expected Just GeminiConfig"+ Just c -> case configTools c of+ Just [_] -> pure ()+ other -> assertFailure ("Expected tool in configTools, got: " ++ show other)+ ]+ , testGroup+ "ChatModel stream (Mock)"+ [ testCase "stream yields LLMStart, LLMChunk, and LLMEnd" $ do+ let sseBody =+ "data: {\"event_type\": \"step.delta\", \"index\": 0, \"delta\": {\"type\": \"text\", \"text\": \"Hello \"}}\n\n"+ <> "data: {\"event_type\": \"step.delta\", \"index\": 0, \"delta\": {\"type\": \"text\", \"text\": \"World!\"}}\n\n"+ <> "data: {\"event_type\": \"interaction.completed\", \"interaction\": {\"id\": \"v1_st\", \"status\": \"completed\", \"steps\": [{\"type\": \"model_output\", \"content\": [{\"type\": \"text\", \"text\": \"Hello World!\"}]}]}}\n\n"+ app _req respond =+ respond $+ responseStream status200 [("Content-Type", "text/event-stream")] $ \write flush -> do+ write (Builder.lazyByteString sseBody)+ flush+ withMockServer app $ \url -> do+ let provider = newGemini "fake-key" "gemini-3.6-flash" (Just url)+ eEvents <- runResourceT $ runExceptT $ collectEvents $ stream provider [userMessage "Hi"] Nothing+ case eEvents of+ Left err -> assertFailure (show err)+ Right events -> do+ assertBool "Has at least 3 events" (length events >= 3)+ case (events, reverse events) of+ (LLMStart {} : _, LLMEnd {} : _) -> pure ()+ other -> assertFailure ("Unexpected events: " ++ show other)+ ]+ , testGroup+ "Embeddings GeminiEmbeddings (Mock)"+ [ testCase "embedQuery and embedDocuments return vectors" $ do+ let app req respond = do+ let resp =+ [aesonQQ|{+ "embedding": {"values": [0.1, 0.2, 0.3]},+ "embeddings": [{"values": [0.1, 0.2]}, {"values": [0.3, 0.4]}]+ }|]+ respond $ responseLBS status200 [("Content-Type", "application/json")] (encode resp)+ withMockServer app $ \url -> do+ let emb = GeminiEmbeddings "fake-key" "gemini-embedding-001" (Just url)+ -- Query+ eQ <- runExceptT $ embedQuery emb "query text"+ case eQ of+ Left err -> assertFailure (show err)+ Right vec -> vec @?= [0.1, 0.2, 0.3]+ -- Docs+ let doc1 = Document (TL.pack "doc1") Map.empty+ doc2 = Document (TL.pack "doc2") Map.empty+ eD <- runExceptT $ embedDocuments emb [doc1, doc2]+ case eD of+ Left err -> assertFailure (show err)+ Right vecs -> length vecs @?= 2+ ]+ , testGroup+ "Live Langchain Integration Tests (~/.gemini_api_key)"+ [ testCase "Live invoke ChatModel" $ do+ mbKey <- getLiveApiKey+ case mbKey of+ Nothing -> pure ()+ Just key -> do+ let provider = newGemini key "gemini-3.6-flash" Nothing+ eRes <- runExceptT $ invoke provider [userMessage "Say 'LANGCHAIN_OK'"] Nothing+ case eRes of+ Left err -> assertFailure ("Live invoke failed: " ++ show err)+ Right msg -> do+ messageRole msg @?= Assistant+ assertBool "Contains text" (not (T.null (extractMessageText msg)))+ , testCase "Live stream ChatModel" $ do+ mbKey <- getLiveApiKey+ case mbKey of+ Nothing -> pure ()+ Just key -> do+ let provider = newGemini key "gemini-3.6-flash" Nothing+ eEvents <-+ runResourceT $ runExceptT $ collectEvents $ stream provider [userMessage "Count 1, 2, 3"] Nothing+ case eEvents of+ Left err -> assertFailure ("Live stream failed: " ++ show err)+ Right events -> do+ assertBool "Received streaming events" (not (null events))+ , testCase "Live Embeddings (query & docs)" $ do+ mbKey <- getLiveApiKey+ case mbKey of+ Nothing -> pure ()+ Just key -> do+ let emb = defaultGeminiEmbeddings key+ eQ <- runExceptT $ embedQuery emb "Haskell LangChain"+ case eQ of+ Left err -> assertFailure ("Live embedQuery failed: " ++ show err)+ Right vec -> assertBool "Dimension > 0" (not (null vec))+ let docs = [Document "Document one" Map.empty, Document "Document two" Map.empty]+ eD <- runExceptT $ embedDocuments emb docs+ case eD of+ Left err -> assertFailure ("Live embedDocuments failed: " ++ show err)+ Right vecs -> length vecs @?= 2+ ]+ ]