-- | @\/v1\/threads\/:thread_id\/runs@
module OpenAI.V1.Threads.Runs
    ( -- * Main types
      RunID(..)
    , CreateRun(..)
    , _CreateRun
    , CreateThreadAndRun(..)
    , _CreateThreadAndRun
    , ModifyRun(..)
    , _ModifyRun
    , SubmitToolOutputsToRun(..)
    , _SubmitToolOutputsToRun
    , RunObject(..)

      -- * Other types
    , TruncationStrategy(..)
    , SubmitToolOutputs(..)
    , RequiredAction(..)
    , IncompleteDetails(..)
    , ToolOutput(..)
    , Status(..)

      -- * Servant
    , API
    ) where

import OpenAI.Prelude
import OpenAI.V1.Assistants (AssistantID)
import OpenAI.V1.AutoOr
import OpenAI.V1.Error
import OpenAI.V1.ListOf
import OpenAI.V1.Message
import OpenAI.V1.Models (Model)
import OpenAI.V1.Order
import OpenAI.V1.ResponseFormat
import OpenAI.V1.Threads (Thread)
import OpenAI.V1.Tool
import OpenAI.V1.ToolCall
import OpenAI.V1.ToolResources
import OpenAI.V1.Threads (ThreadID)
import OpenAI.V1.Usage

-- | Run ID
newtype RunID = RunID{ RunID -> Text
text :: Text }
    deriving newtype (Maybe RunID
Value -> Parser [RunID]
Value -> Parser RunID
(Value -> Parser RunID)
-> (Value -> Parser [RunID]) -> Maybe RunID -> FromJSON RunID
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser RunID
parseJSON :: Value -> Parser RunID
$cparseJSONList :: Value -> Parser [RunID]
parseJSONList :: Value -> Parser [RunID]
$comittedField :: Maybe RunID
omittedField :: Maybe RunID
FromJSON, String -> RunID
(String -> RunID) -> IsString RunID
forall a. (String -> a) -> IsString a
$cfromString :: String -> RunID
fromString :: String -> RunID
IsString, Int -> RunID -> ShowS
[RunID] -> ShowS
RunID -> String
(Int -> RunID -> ShowS)
-> (RunID -> String) -> ([RunID] -> ShowS) -> Show RunID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunID -> ShowS
showsPrec :: Int -> RunID -> ShowS
$cshow :: RunID -> String
show :: RunID -> String
$cshowList :: [RunID] -> ShowS
showList :: [RunID] -> ShowS
Show, RunID -> Text
RunID -> ByteString
RunID -> Builder
(RunID -> Text)
-> (RunID -> Builder)
-> (RunID -> ByteString)
-> (RunID -> Text)
-> (RunID -> Builder)
-> ToHttpApiData RunID
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
$ctoUrlPiece :: RunID -> Text
toUrlPiece :: RunID -> Text
$ctoEncodedUrlPiece :: RunID -> Builder
toEncodedUrlPiece :: RunID -> Builder
$ctoHeader :: RunID -> ByteString
toHeader :: RunID -> ByteString
$ctoQueryParam :: RunID -> Text
toQueryParam :: RunID -> Text
$ctoEncodedQueryParam :: RunID -> Builder
toEncodedQueryParam :: RunID -> Builder
ToHttpApiData, [RunID] -> Value
[RunID] -> Encoding
RunID -> Bool
RunID -> Value
RunID -> Encoding
(RunID -> Value)
-> (RunID -> Encoding)
-> ([RunID] -> Value)
-> ([RunID] -> Encoding)
-> (RunID -> Bool)
-> ToJSON RunID
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: RunID -> Value
toJSON :: RunID -> Value
$ctoEncoding :: RunID -> Encoding
toEncoding :: RunID -> Encoding
$ctoJSONList :: [RunID] -> Value
toJSONList :: [RunID] -> Value
$ctoEncodingList :: [RunID] -> Encoding
toEncodingList :: [RunID] -> Encoding
$comitField :: RunID -> Bool
omitField :: RunID -> Bool
ToJSON)

-- | Controls for how a thread will be truncated prior to the run
data TruncationStrategy
    = Auto
    | Last_Messages{ TruncationStrategy -> Maybe Natural
last_messages :: Maybe Natural }
    deriving stock ((forall x. TruncationStrategy -> Rep TruncationStrategy x)
-> (forall x. Rep TruncationStrategy x -> TruncationStrategy)
-> Generic TruncationStrategy
forall x. Rep TruncationStrategy x -> TruncationStrategy
forall x. TruncationStrategy -> Rep TruncationStrategy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TruncationStrategy -> Rep TruncationStrategy x
from :: forall x. TruncationStrategy -> Rep TruncationStrategy x
$cto :: forall x. Rep TruncationStrategy x -> TruncationStrategy
to :: forall x. Rep TruncationStrategy x -> TruncationStrategy
Generic, Int -> TruncationStrategy -> ShowS
[TruncationStrategy] -> ShowS
TruncationStrategy -> String
(Int -> TruncationStrategy -> ShowS)
-> (TruncationStrategy -> String)
-> ([TruncationStrategy] -> ShowS)
-> Show TruncationStrategy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TruncationStrategy -> ShowS
showsPrec :: Int -> TruncationStrategy -> ShowS
$cshow :: TruncationStrategy -> String
show :: TruncationStrategy -> String
$cshowList :: [TruncationStrategy] -> ShowS
showList :: [TruncationStrategy] -> ShowS
Show)

truncationStrategyOptions :: Options
truncationStrategyOptions :: Options
truncationStrategyOptions = Options
aesonOptions
    { sumEncoding =
        TaggedObject{ tagFieldName = "type", contentsFieldName = "" }

    , tagSingleConstructors = True
    }

instance FromJSON TruncationStrategy where
    parseJSON :: Value -> Parser TruncationStrategy
parseJSON = Options -> Value -> Parser TruncationStrategy
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
truncationStrategyOptions

instance ToJSON TruncationStrategy where
    toJSON :: TruncationStrategy -> Value
toJSON = Options -> TruncationStrategy -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
truncationStrategyOptions

-- | Request body for @\/v1\/threads\/:thread_id\/runs@
data CreateRun = CreateRun
    { CreateRun -> AssistantID
assistant_id :: AssistantID
    , CreateRun -> Maybe Model
model :: Maybe Model
    , CreateRun -> Maybe Text
instructions :: Maybe Text
    , CreateRun -> Maybe Text
additional_instructions :: Maybe Text
    , CreateRun -> Maybe (Vector Message)
additional_messages :: Maybe (Vector Message)
    , CreateRun -> Maybe (Vector Tool)
tools :: Maybe (Vector Tool)
    , CreateRun -> Maybe (Map Text Text)
metadata :: Maybe (Map Text Text)
    , CreateRun -> Maybe Double
temperature :: Maybe Double
    , CreateRun -> Maybe Double
top_p :: Maybe Double
    , CreateRun -> Maybe Natural
max_prompt_tokens :: Maybe Natural
    , CreateRun -> Maybe Natural
max_completion_tokens :: Maybe Natural
    , CreateRun -> Maybe TruncationStrategy
truncation_strategy :: Maybe TruncationStrategy
    , CreateRun -> Maybe ToolChoice
tool_choice :: Maybe ToolChoice
    , CreateRun -> Maybe Bool
parallel_tool_calls :: Maybe Bool
    , CreateRun -> Maybe (AutoOr ResponseFormat)
response_format :: Maybe (AutoOr ResponseFormat)
    } deriving stock ((forall x. CreateRun -> Rep CreateRun x)
-> (forall x. Rep CreateRun x -> CreateRun) -> Generic CreateRun
forall x. Rep CreateRun x -> CreateRun
forall x. CreateRun -> Rep CreateRun x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CreateRun -> Rep CreateRun x
from :: forall x. CreateRun -> Rep CreateRun x
$cto :: forall x. Rep CreateRun x -> CreateRun
to :: forall x. Rep CreateRun x -> CreateRun
Generic, Int -> CreateRun -> ShowS
[CreateRun] -> ShowS
CreateRun -> String
(Int -> CreateRun -> ShowS)
-> (CreateRun -> String)
-> ([CreateRun] -> ShowS)
-> Show CreateRun
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateRun -> ShowS
showsPrec :: Int -> CreateRun -> ShowS
$cshow :: CreateRun -> String
show :: CreateRun -> String
$cshowList :: [CreateRun] -> ShowS
showList :: [CreateRun] -> ShowS
Show)

instance ToJSON CreateRun where
    toJSON :: CreateRun -> Value
toJSON = Options -> CreateRun -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonOptions

-- | Default `CreateRun`
_CreateRun :: CreateRun
_CreateRun :: CreateRun
_CreateRun = CreateRun
    { $sel:model:CreateRun :: Maybe Model
model = Maybe Model
forall a. Maybe a
Nothing
    , $sel:instructions:CreateRun :: Maybe Text
instructions = Maybe Text
forall a. Maybe a
Nothing
    , $sel:additional_instructions:CreateRun :: Maybe Text
additional_instructions = Maybe Text
forall a. Maybe a
Nothing
    , $sel:additional_messages:CreateRun :: Maybe (Vector Message)
additional_messages = Maybe (Vector Message)
forall a. Maybe a
Nothing
    , $sel:tools:CreateRun :: Maybe (Vector Tool)
tools = Maybe (Vector Tool)
forall a. Maybe a
Nothing
    , $sel:metadata:CreateRun :: Maybe (Map Text Text)
metadata = Maybe (Map Text Text)
forall a. Maybe a
Nothing
    , $sel:temperature:CreateRun :: Maybe Double
temperature = Maybe Double
forall a. Maybe a
Nothing
    , $sel:top_p:CreateRun :: Maybe Double
top_p = Maybe Double
forall a. Maybe a
Nothing
    , $sel:max_prompt_tokens:CreateRun :: Maybe Natural
max_prompt_tokens = Maybe Natural
forall a. Maybe a
Nothing
    , $sel:max_completion_tokens:CreateRun :: Maybe Natural
max_completion_tokens = Maybe Natural
forall a. Maybe a
Nothing
    , $sel:truncation_strategy:CreateRun :: Maybe TruncationStrategy
truncation_strategy = Maybe TruncationStrategy
forall a. Maybe a
Nothing
    , $sel:tool_choice:CreateRun :: Maybe ToolChoice
tool_choice = Maybe ToolChoice
forall a. Maybe a
Nothing
    , $sel:parallel_tool_calls:CreateRun :: Maybe Bool
parallel_tool_calls = Maybe Bool
forall a. Maybe a
Nothing
    , $sel:response_format:CreateRun :: Maybe (AutoOr ResponseFormat)
response_format = Maybe (AutoOr ResponseFormat)
forall a. Maybe a
Nothing
    }

-- | Request body for @\/v1\/threads\/runs@
data CreateThreadAndRun = CreateThreadAndRun
    { CreateThreadAndRun -> AssistantID
assistant_id :: AssistantID
    , CreateThreadAndRun -> Maybe Thread
thread :: Maybe Thread
    , CreateThreadAndRun -> Maybe Model
model :: Maybe Model
    , CreateThreadAndRun -> Maybe Text
instructions :: Maybe Text
    , CreateThreadAndRun -> Maybe (Vector Tool)
tools :: Maybe (Vector Tool)
    , CreateThreadAndRun -> Maybe ToolResources
toolResources :: Maybe ToolResources
    , CreateThreadAndRun -> Maybe (Map Text Text)
metadata :: Maybe (Map Text Text)
    , CreateThreadAndRun -> Maybe Double
temperature :: Maybe Double
    , CreateThreadAndRun -> Maybe Double
top_p :: Maybe Double
    , CreateThreadAndRun -> Maybe Natural
max_prompt_tokens :: Maybe Natural
    , CreateThreadAndRun -> Maybe Natural
max_completion_tokens :: Maybe Natural
    , CreateThreadAndRun -> Maybe TruncationStrategy
truncation_strategy :: Maybe TruncationStrategy
    , CreateThreadAndRun -> Maybe ToolChoice
tool_choice :: Maybe ToolChoice
    , CreateThreadAndRun -> Maybe Bool
parallel_tool_calls :: Maybe Bool
    , CreateThreadAndRun -> Maybe (AutoOr ResponseFormat)
response_format :: Maybe (AutoOr ResponseFormat)
    } deriving stock ((forall x. CreateThreadAndRun -> Rep CreateThreadAndRun x)
-> (forall x. Rep CreateThreadAndRun x -> CreateThreadAndRun)
-> Generic CreateThreadAndRun
forall x. Rep CreateThreadAndRun x -> CreateThreadAndRun
forall x. CreateThreadAndRun -> Rep CreateThreadAndRun x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CreateThreadAndRun -> Rep CreateThreadAndRun x
from :: forall x. CreateThreadAndRun -> Rep CreateThreadAndRun x
$cto :: forall x. Rep CreateThreadAndRun x -> CreateThreadAndRun
to :: forall x. Rep CreateThreadAndRun x -> CreateThreadAndRun
Generic, Int -> CreateThreadAndRun -> ShowS
[CreateThreadAndRun] -> ShowS
CreateThreadAndRun -> String
(Int -> CreateThreadAndRun -> ShowS)
-> (CreateThreadAndRun -> String)
-> ([CreateThreadAndRun] -> ShowS)
-> Show CreateThreadAndRun
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateThreadAndRun -> ShowS
showsPrec :: Int -> CreateThreadAndRun -> ShowS
$cshow :: CreateThreadAndRun -> String
show :: CreateThreadAndRun -> String
$cshowList :: [CreateThreadAndRun] -> ShowS
showList :: [CreateThreadAndRun] -> ShowS
Show)

instance ToJSON CreateThreadAndRun where
    toJSON :: CreateThreadAndRun -> Value
toJSON = Options -> CreateThreadAndRun -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonOptions

-- | Default `CreateThreadAndRun`
_CreateThreadAndRun :: CreateThreadAndRun
_CreateThreadAndRun :: CreateThreadAndRun
_CreateThreadAndRun = CreateThreadAndRun
    { $sel:thread:CreateThreadAndRun :: Maybe Thread
thread = Maybe Thread
forall a. Maybe a
Nothing
    , $sel:model:CreateThreadAndRun :: Maybe Model
model = Maybe Model
forall a. Maybe a
Nothing
    , $sel:instructions:CreateThreadAndRun :: Maybe Text
instructions = Maybe Text
forall a. Maybe a
Nothing
    , $sel:tools:CreateThreadAndRun :: Maybe (Vector Tool)
tools = Maybe (Vector Tool)
forall a. Maybe a
Nothing
    , $sel:toolResources:CreateThreadAndRun :: Maybe ToolResources
toolResources = Maybe ToolResources
forall a. Maybe a
Nothing
    , $sel:metadata:CreateThreadAndRun :: Maybe (Map Text Text)
metadata = Maybe (Map Text Text)
forall a. Maybe a
Nothing
    , $sel:temperature:CreateThreadAndRun :: Maybe Double
temperature = Maybe Double
forall a. Maybe a
Nothing
    , $sel:top_p:CreateThreadAndRun :: Maybe Double
top_p = Maybe Double
forall a. Maybe a
Nothing
    , $sel:max_prompt_tokens:CreateThreadAndRun :: Maybe Natural
max_prompt_tokens = Maybe Natural
forall a. Maybe a
Nothing
    , $sel:max_completion_tokens:CreateThreadAndRun :: Maybe Natural
max_completion_tokens = Maybe Natural
forall a. Maybe a
Nothing
    , $sel:truncation_strategy:CreateThreadAndRun :: Maybe TruncationStrategy
truncation_strategy = Maybe TruncationStrategy
forall a. Maybe a
Nothing
    , $sel:tool_choice:CreateThreadAndRun :: Maybe ToolChoice
tool_choice = Maybe ToolChoice
forall a. Maybe a
Nothing
    , $sel:parallel_tool_calls:CreateThreadAndRun :: Maybe Bool
parallel_tool_calls = Maybe Bool
forall a. Maybe a
Nothing
    , $sel:response_format:CreateThreadAndRun :: Maybe (AutoOr ResponseFormat)
response_format = Maybe (AutoOr ResponseFormat)
forall a. Maybe a
Nothing
    }

-- | Details on the tool outputs needed for this run to continue.
data SubmitToolOutputs = SubmitToolOutputs
    { SubmitToolOutputs -> Vector ToolCall
tool_calls :: Vector ToolCall
    } deriving stock ((forall x. SubmitToolOutputs -> Rep SubmitToolOutputs x)
-> (forall x. Rep SubmitToolOutputs x -> SubmitToolOutputs)
-> Generic SubmitToolOutputs
forall x. Rep SubmitToolOutputs x -> SubmitToolOutputs
forall x. SubmitToolOutputs -> Rep SubmitToolOutputs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SubmitToolOutputs -> Rep SubmitToolOutputs x
from :: forall x. SubmitToolOutputs -> Rep SubmitToolOutputs x
$cto :: forall x. Rep SubmitToolOutputs x -> SubmitToolOutputs
to :: forall x. Rep SubmitToolOutputs x -> SubmitToolOutputs
Generic, Int -> SubmitToolOutputs -> ShowS
[SubmitToolOutputs] -> ShowS
SubmitToolOutputs -> String
(Int -> SubmitToolOutputs -> ShowS)
-> (SubmitToolOutputs -> String)
-> ([SubmitToolOutputs] -> ShowS)
-> Show SubmitToolOutputs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SubmitToolOutputs -> ShowS
showsPrec :: Int -> SubmitToolOutputs -> ShowS
$cshow :: SubmitToolOutputs -> String
show :: SubmitToolOutputs -> String
$cshowList :: [SubmitToolOutputs] -> ShowS
showList :: [SubmitToolOutputs] -> ShowS
Show)
      deriving anyclass (Maybe SubmitToolOutputs
Value -> Parser [SubmitToolOutputs]
Value -> Parser SubmitToolOutputs
(Value -> Parser SubmitToolOutputs)
-> (Value -> Parser [SubmitToolOutputs])
-> Maybe SubmitToolOutputs
-> FromJSON SubmitToolOutputs
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser SubmitToolOutputs
parseJSON :: Value -> Parser SubmitToolOutputs
$cparseJSONList :: Value -> Parser [SubmitToolOutputs]
parseJSONList :: Value -> Parser [SubmitToolOutputs]
$comittedField :: Maybe SubmitToolOutputs
omittedField :: Maybe SubmitToolOutputs
FromJSON)

-- | The status of the run
data Status
    = Queued
    | In_Progress
    | Requires_Action
    | Cancelling
    | Cancelled
    | Failed
    | Completed
    | Incomplete
    | Expired
    deriving stock ((forall x. Status -> Rep Status x)
-> (forall x. Rep Status x -> Status) -> Generic Status
forall x. Rep Status x -> Status
forall x. Status -> Rep Status x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Status -> Rep Status x
from :: forall x. Status -> Rep Status x
$cto :: forall x. Rep Status x -> Status
to :: forall x. Rep Status x -> Status
Generic, Int -> Status -> ShowS
[Status] -> ShowS
Status -> String
(Int -> Status -> ShowS)
-> (Status -> String) -> ([Status] -> ShowS) -> Show Status
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Status -> ShowS
showsPrec :: Int -> Status -> ShowS
$cshow :: Status -> String
show :: Status -> String
$cshowList :: [Status] -> ShowS
showList :: [Status] -> ShowS
Show)

instance FromJSON Status where
    parseJSON :: Value -> Parser Status
parseJSON = Options -> Value -> Parser Status
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions

-- | Details on the action required to continue the run
data RequiredAction = RequiredAction_Submit_Tool_Outputs
    { RequiredAction -> SubmitToolOutputs
submit_tool_outputs :: SubmitToolOutputs
    } deriving stock ((forall x. RequiredAction -> Rep RequiredAction x)
-> (forall x. Rep RequiredAction x -> RequiredAction)
-> Generic RequiredAction
forall x. Rep RequiredAction x -> RequiredAction
forall x. RequiredAction -> Rep RequiredAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RequiredAction -> Rep RequiredAction x
from :: forall x. RequiredAction -> Rep RequiredAction x
$cto :: forall x. Rep RequiredAction x -> RequiredAction
to :: forall x. Rep RequiredAction x -> RequiredAction
Generic, Int -> RequiredAction -> ShowS
[RequiredAction] -> ShowS
RequiredAction -> String
(Int -> RequiredAction -> ShowS)
-> (RequiredAction -> String)
-> ([RequiredAction] -> ShowS)
-> Show RequiredAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RequiredAction -> ShowS
showsPrec :: Int -> RequiredAction -> ShowS
$cshow :: RequiredAction -> String
show :: RequiredAction -> String
$cshowList :: [RequiredAction] -> ShowS
showList :: [RequiredAction] -> ShowS
Show)

instance FromJSON RequiredAction where
    parseJSON :: Value -> Parser RequiredAction
parseJSON = Options -> Value -> Parser RequiredAction
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions
        { sumEncoding =
              TaggedObject{ tagFieldName = "type" }

        , tagSingleConstructors = True

        , constructorTagModifier = stripPrefix "RequiredAction_"
        }

-- | Details on why the run is incomplete
data IncompleteDetails = IncompleteDetails
    { IncompleteDetails -> Text
reason :: Text
    } deriving stock ((forall x. IncompleteDetails -> Rep IncompleteDetails x)
-> (forall x. Rep IncompleteDetails x -> IncompleteDetails)
-> Generic IncompleteDetails
forall x. Rep IncompleteDetails x -> IncompleteDetails
forall x. IncompleteDetails -> Rep IncompleteDetails x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IncompleteDetails -> Rep IncompleteDetails x
from :: forall x. IncompleteDetails -> Rep IncompleteDetails x
$cto :: forall x. Rep IncompleteDetails x -> IncompleteDetails
to :: forall x. Rep IncompleteDetails x -> IncompleteDetails
Generic, Int -> IncompleteDetails -> ShowS
[IncompleteDetails] -> ShowS
IncompleteDetails -> String
(Int -> IncompleteDetails -> ShowS)
-> (IncompleteDetails -> String)
-> ([IncompleteDetails] -> ShowS)
-> Show IncompleteDetails
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IncompleteDetails -> ShowS
showsPrec :: Int -> IncompleteDetails -> ShowS
$cshow :: IncompleteDetails -> String
show :: IncompleteDetails -> String
$cshowList :: [IncompleteDetails] -> ShowS
showList :: [IncompleteDetails] -> ShowS
Show)
      deriving anyclass (Maybe IncompleteDetails
Value -> Parser [IncompleteDetails]
Value -> Parser IncompleteDetails
(Value -> Parser IncompleteDetails)
-> (Value -> Parser [IncompleteDetails])
-> Maybe IncompleteDetails
-> FromJSON IncompleteDetails
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser IncompleteDetails
parseJSON :: Value -> Parser IncompleteDetails
$cparseJSONList :: Value -> Parser [IncompleteDetails]
parseJSONList :: Value -> Parser [IncompleteDetails]
$comittedField :: Maybe IncompleteDetails
omittedField :: Maybe IncompleteDetails
FromJSON)

-- | Represents an execution run on a thread.
data RunObject = RunObject
    { RunObject -> RunID
id :: RunID
    , RunObject -> Text
object :: Text
    , RunObject -> POSIXTime
created_at :: POSIXTime
    , RunObject -> ThreadID
thread_id :: ThreadID
    , RunObject -> AssistantID
assistant_id :: AssistantID
    , RunObject -> Status
status :: Status
    , RunObject -> Maybe RequiredAction
required_action :: Maybe RequiredAction
    , RunObject -> Maybe Error
last_error :: Maybe Error
    , RunObject -> Maybe POSIXTime
expires_at :: Maybe POSIXTime
    , RunObject -> Maybe POSIXTime
started_at :: Maybe POSIXTime
    , RunObject -> Maybe POSIXTime
cancelled_at :: Maybe POSIXTime
    , RunObject -> Maybe POSIXTime
failed_at :: Maybe POSIXTime
    , RunObject -> Maybe POSIXTime
completed_at :: Maybe POSIXTime
    , RunObject -> Maybe IncompleteDetails
incomplete_details :: Maybe IncompleteDetails
    , RunObject -> Model
model :: Model
    , RunObject -> Maybe Text
instructions :: Maybe Text
    , RunObject -> Vector Tool
tools :: Vector Tool
    , RunObject -> Map Text Text
metadata :: Map Text Text
    , RunObject -> Maybe (Usage (Maybe Void) (Maybe Void))
usage :: Maybe (Usage (Maybe Void) (Maybe Void))
    , RunObject -> Maybe Double
temperature :: Maybe Double
    , RunObject -> Maybe Double
top_p :: Maybe Double
    , RunObject -> Maybe Natural
max_prompt_tokens :: Maybe Natural
    , RunObject -> Maybe Natural
max_completion_tokens :: Maybe Natural
    , RunObject -> Maybe TruncationStrategy
truncation_strategy :: Maybe TruncationStrategy
    , RunObject -> ToolChoice
tool_choice :: ToolChoice
    , RunObject -> Bool
parallel_tool_calls :: Bool
    , RunObject -> AutoOr ResponseFormat
response_format :: AutoOr ResponseFormat
    } deriving stock ((forall x. RunObject -> Rep RunObject x)
-> (forall x. Rep RunObject x -> RunObject) -> Generic RunObject
forall x. Rep RunObject x -> RunObject
forall x. RunObject -> Rep RunObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RunObject -> Rep RunObject x
from :: forall x. RunObject -> Rep RunObject x
$cto :: forall x. Rep RunObject x -> RunObject
to :: forall x. Rep RunObject x -> RunObject
Generic, Int -> RunObject -> ShowS
[RunObject] -> ShowS
RunObject -> String
(Int -> RunObject -> ShowS)
-> (RunObject -> String)
-> ([RunObject] -> ShowS)
-> Show RunObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunObject -> ShowS
showsPrec :: Int -> RunObject -> ShowS
$cshow :: RunObject -> String
show :: RunObject -> String
$cshowList :: [RunObject] -> ShowS
showList :: [RunObject] -> ShowS
Show)
      deriving anyclass (Maybe RunObject
Value -> Parser [RunObject]
Value -> Parser RunObject
(Value -> Parser RunObject)
-> (Value -> Parser [RunObject])
-> Maybe RunObject
-> FromJSON RunObject
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser RunObject
parseJSON :: Value -> Parser RunObject
$cparseJSONList :: Value -> Parser [RunObject]
parseJSONList :: Value -> Parser [RunObject]
$comittedField :: Maybe RunObject
omittedField :: Maybe RunObject
FromJSON)

-- | Request body for @\/v1\/threads\/:thread_id\/runs\/:run_id@
data ModifyRun = ModifyRun
    { ModifyRun -> Maybe (Map Text Text)
metadata :: Maybe (Map Text Text)
    } deriving stock ((forall x. ModifyRun -> Rep ModifyRun x)
-> (forall x. Rep ModifyRun x -> ModifyRun) -> Generic ModifyRun
forall x. Rep ModifyRun x -> ModifyRun
forall x. ModifyRun -> Rep ModifyRun x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ModifyRun -> Rep ModifyRun x
from :: forall x. ModifyRun -> Rep ModifyRun x
$cto :: forall x. Rep ModifyRun x -> ModifyRun
to :: forall x. Rep ModifyRun x -> ModifyRun
Generic, Int -> ModifyRun -> ShowS
[ModifyRun] -> ShowS
ModifyRun -> String
(Int -> ModifyRun -> ShowS)
-> (ModifyRun -> String)
-> ([ModifyRun] -> ShowS)
-> Show ModifyRun
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModifyRun -> ShowS
showsPrec :: Int -> ModifyRun -> ShowS
$cshow :: ModifyRun -> String
show :: ModifyRun -> String
$cshowList :: [ModifyRun] -> ShowS
showList :: [ModifyRun] -> ShowS
Show)

instance ToJSON ModifyRun where
    toJSON :: ModifyRun -> Value
toJSON = Options -> ModifyRun -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonOptions

-- | Default `ModifyRun`
_ModifyRun :: ModifyRun
_ModifyRun :: ModifyRun
_ModifyRun = ModifyRun{ }

-- | A tool for which the output is being submitted
data ToolOutput = ToolOutput
    { ToolOutput -> Maybe Text
tool_call_id :: Maybe Text
    , ToolOutput -> Text
output :: Text
    } deriving stock ((forall x. ToolOutput -> Rep ToolOutput x)
-> (forall x. Rep ToolOutput x -> ToolOutput) -> Generic ToolOutput
forall x. Rep ToolOutput x -> ToolOutput
forall x. ToolOutput -> Rep ToolOutput x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ToolOutput -> Rep ToolOutput x
from :: forall x. ToolOutput -> Rep ToolOutput x
$cto :: forall x. Rep ToolOutput x -> ToolOutput
to :: forall x. Rep ToolOutput x -> ToolOutput
Generic, Int -> ToolOutput -> ShowS
[ToolOutput] -> ShowS
ToolOutput -> String
(Int -> ToolOutput -> ShowS)
-> (ToolOutput -> String)
-> ([ToolOutput] -> ShowS)
-> Show ToolOutput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ToolOutput -> ShowS
showsPrec :: Int -> ToolOutput -> ShowS
$cshow :: ToolOutput -> String
show :: ToolOutput -> String
$cshowList :: [ToolOutput] -> ShowS
showList :: [ToolOutput] -> ShowS
Show)
      deriving anyclass ([ToolOutput] -> Value
[ToolOutput] -> Encoding
ToolOutput -> Bool
ToolOutput -> Value
ToolOutput -> Encoding
(ToolOutput -> Value)
-> (ToolOutput -> Encoding)
-> ([ToolOutput] -> Value)
-> ([ToolOutput] -> Encoding)
-> (ToolOutput -> Bool)
-> ToJSON ToolOutput
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ToolOutput -> Value
toJSON :: ToolOutput -> Value
$ctoEncoding :: ToolOutput -> Encoding
toEncoding :: ToolOutput -> Encoding
$ctoJSONList :: [ToolOutput] -> Value
toJSONList :: [ToolOutput] -> Value
$ctoEncodingList :: [ToolOutput] -> Encoding
toEncodingList :: [ToolOutput] -> Encoding
$comitField :: ToolOutput -> Bool
omitField :: ToolOutput -> Bool
ToJSON)

-- | Request body for @\/v1\/threads\/:thread_id\/runs\/:run_id\/submit_tool_outputs@
data SubmitToolOutputsToRun = SubmitToolOutputsToRun
    { SubmitToolOutputsToRun -> Vector ToolOutput
tool_outputs :: Vector ToolOutput
    } deriving stock ((forall x. SubmitToolOutputsToRun -> Rep SubmitToolOutputsToRun x)
-> (forall x.
    Rep SubmitToolOutputsToRun x -> SubmitToolOutputsToRun)
-> Generic SubmitToolOutputsToRun
forall x. Rep SubmitToolOutputsToRun x -> SubmitToolOutputsToRun
forall x. SubmitToolOutputsToRun -> Rep SubmitToolOutputsToRun x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SubmitToolOutputsToRun -> Rep SubmitToolOutputsToRun x
from :: forall x. SubmitToolOutputsToRun -> Rep SubmitToolOutputsToRun x
$cto :: forall x. Rep SubmitToolOutputsToRun x -> SubmitToolOutputsToRun
to :: forall x. Rep SubmitToolOutputsToRun x -> SubmitToolOutputsToRun
Generic, Int -> SubmitToolOutputsToRun -> ShowS
[SubmitToolOutputsToRun] -> ShowS
SubmitToolOutputsToRun -> String
(Int -> SubmitToolOutputsToRun -> ShowS)
-> (SubmitToolOutputsToRun -> String)
-> ([SubmitToolOutputsToRun] -> ShowS)
-> Show SubmitToolOutputsToRun
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SubmitToolOutputsToRun -> ShowS
showsPrec :: Int -> SubmitToolOutputsToRun -> ShowS
$cshow :: SubmitToolOutputsToRun -> String
show :: SubmitToolOutputsToRun -> String
$cshowList :: [SubmitToolOutputsToRun] -> ShowS
showList :: [SubmitToolOutputsToRun] -> ShowS
Show)

instance ToJSON SubmitToolOutputsToRun where
    toJSON :: SubmitToolOutputsToRun -> Value
toJSON = Options -> SubmitToolOutputsToRun -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonOptions

-- | Default implementation of `SubmitToolOutputsToRun`
_SubmitToolOutputsToRun :: SubmitToolOutputsToRun
_SubmitToolOutputsToRun :: SubmitToolOutputsToRun
_SubmitToolOutputsToRun = SubmitToolOutputsToRun{ }

-- | Servant API
type API =
        "threads"
    :>  Header' '[Required, Strict] "OpenAI-Beta" Text
    :>  (         Capture "thread_id" ThreadID
              :>  "runs"
              :>  QueryParam "include[]" Text
              :>  ReqBody '[JSON] CreateRun
              :>  Post '[JSON] RunObject
        :<|>      "runs"
              :>  ReqBody '[JSON] CreateThreadAndRun
              :>  Post '[JSON] RunObject
        :<|>      Capture "thread_id" ThreadID
              :>  "runs"
              :>  QueryParam "limit" Natural
              :>  QueryParam "order" Order
              :>  QueryParam "after" Text
              :>  QueryParam "before" Text
              :>  Get '[JSON] (ListOf RunObject)
        :<|>      Capture "thread_id" ThreadID
              :>  "runs"
              :>  Capture "run_id" RunID
              :>  Get '[JSON] RunObject
        :<|>      Capture "thread_id" ThreadID
              :>  "runs"
              :>  Capture "run_id" RunID
              :>  ReqBody '[JSON] ModifyRun
              :>  Post '[JSON] RunObject
        :<|>      Capture "thread_id" ThreadID
              :>  "runs"
              :>  Capture "run_id" RunID
              :>  "submit_tool_outputs"
              :>  ReqBody '[JSON] SubmitToolOutputsToRun
              :>  Post '[JSON] RunObject
        :<|>      Capture "thread_id" ThreadID
              :>  "runs"
              :>  Capture "run_id" RunID
              :>  "cancel"
              :>  Post '[JSON] RunObject
        )