├── .github └── workflows │ └── push.yml ├── .gitignore ├── README.md ├── hie.yaml ├── openai-hs ├── .gitignore ├── .hlint.yaml ├── LICENSE ├── README.md ├── Setup.hs ├── openai-hs.cabal ├── package.yaml ├── src │ └── OpenAI │ │ ├── Client.hs │ │ └── Client │ │ └── Internal │ │ └── Helpers.hs └── test │ ├── ApiSpec.hs │ ├── HelperSpec.hs │ └── Spec.hs ├── openai-servant ├── .gitignore ├── .hlint.yaml ├── LICENSE ├── README.md ├── Setup.hs ├── openai-servant.cabal ├── package.yaml └── src │ └── OpenAI │ ├── Api.hs │ ├── Internal │ └── Aeson.hs │ └── Resources.hs ├── scripts └── make-release.sh ├── stack.yaml └── stack.yaml.lock /.github/workflows/push.yml: -------------------------------------------------------------------------------- 1 | # adapted from simonmichael/hledger 2 | 3 | name: push CI 4 | 5 | on: 6 | push: 7 | branches: [ main ] 8 | 9 | jobs: 10 | build: 11 | runs-on: ubuntu-latest 12 | strategy: 13 | fail-fast: false 14 | matrix: 15 | plan: 16 | - { ghc: "8_8_4" , stack: "stack --stack-yaml=stack.yaml" } 17 | 18 | steps: 19 | 20 | - name: Check out 21 | uses: actions/checkout@v2 22 | 23 | # things to be cached/restored: 24 | 25 | - name: Cache stack global package db 26 | id: stack-global 27 | uses: actions/cache@v2 28 | with: 29 | path: ~/.stack 30 | key: ${{ runner.os }}-stack-global-${{ matrix.plan.ghc }}-${{ hashFiles('**.yaml') }} 31 | restore-keys: | 32 | ${{ runner.os }}-stack-global-${{ matrix.plan.ghc }} 33 | 34 | - name: Cache stack-installed programs in ~/.local/bin 35 | id: stack-programs 36 | uses: actions/cache@v2 37 | with: 38 | path: ~/.local/bin 39 | key: ${{ runner.os }}-stack-programs-${{ matrix.plan.ghc }}-${{ hashFiles('**.yaml') }} 40 | restore-keys: | 41 | ${{ runner.os }}-stack-programs-${{ matrix.plan.ghc }} 42 | 43 | - name: Cache .stack-work 44 | uses: actions/cache@v2 45 | with: 46 | path: .stack-work 47 | key: ${{ runner.os }}-stack-work-${{ matrix.plan.ghc }}-${{ hashFiles('**.yaml') }} 48 | restore-keys: | 49 | ${{ runner.os }}-stack-work-${{ matrix.plan.ghc }} 50 | 51 | - name: Cache openai-hs/.stack-work 52 | uses: actions/cache@v2 53 | with: 54 | path: openai-hs/.stack-work 55 | key: ${{ runner.os }}-openai-hs-stack-work-${{ matrix.plan.ghc }}-${{ hashFiles('openai-hs/package.yaml') }} 56 | restore-keys: | 57 | ${{ runner.os }}-openai-hs-stack-work-${{ matrix.plan.ghc }} 58 | 59 | - name: Cache openai-servant/.stack-work 60 | uses: actions/cache@v2 61 | with: 62 | path: openai-servant/.stack-work 63 | key: ${{ runner.os }}-openai-servant-stack-work-${{ matrix.plan.ghc }}-${{ hashFiles('openai-servant/package.yaml') }} 64 | restore-keys: | 65 | ${{ runner.os }}-openai-servant-stack-work-${{ matrix.plan.ghc }} 66 | 67 | # actions: 68 | 69 | - name: Install stack 70 | run: | 71 | mkdir -p ~/.local/bin 72 | export PATH=~/.local/bin:$PATH 73 | if [[ ! -x ~/.local/bin/stack ]]; then curl -sL https://get.haskellstack.org/stable/linux-x86_64.tar.gz | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'; chmod a+x ~/.local/bin/stack; fi 74 | stack --version 75 | 76 | - name: Install GHC 77 | env: 78 | stack: ${{ matrix.plan.stack }} 79 | run: | 80 | $stack setup --install-ghc 81 | 82 | - name: Install haskell deps 83 | env: 84 | stack: ${{ matrix.plan.stack }} 85 | run: | 86 | $stack build --only-dependencies 87 | 88 | - name: Build everything fast 89 | env: 90 | stack: ${{ matrix.plan.stack }} 91 | run: | 92 | $stack build --fast --pedantic --force-dirty 93 | 94 | # TODO: run the tests! needs openai secrets 95 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .DS_Store 2 | .stack-work/ 3 | *~ 4 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Unofficial OpenAI Haskell Bindings 2 | 3 | Unofficial OpenAI SDK/client for Haskell. It's generated via `servant-client` from `openai-servant` with a small amount of hand-written code. Contributions are welcome! 4 | 5 | See [openai-hs](openai-hs) for more details. 6 | -------------------------------------------------------------------------------- /hie.yaml: -------------------------------------------------------------------------------- 1 | cradle: 2 | stack: 3 | stackYaml: "stack.yaml" 4 | components: 5 | - path: "./openai-servant/src" 6 | component: "openai-servant:lib" 7 | - path: "./openai-hs/src" 8 | component: "openai-hs:lib" 9 | - path: "./openai-hs/test" 10 | component: "openai-hs:test:openai-hs-test" 11 | -------------------------------------------------------------------------------- /openai-hs/.gitignore: -------------------------------------------------------------------------------- 1 | .stack-work/ 2 | *~ -------------------------------------------------------------------------------- /openai-hs/.hlint.yaml: -------------------------------------------------------------------------------- 1 | - ignore: {name: Use newtype instead of data} 2 | - ignore: {name: Eta reduce} 3 | - ignore: {name: Use lambda-case} 4 | -------------------------------------------------------------------------------- /openai-hs/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Author name here (c) 2021-2022 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Author name here nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /openai-hs/README.md: -------------------------------------------------------------------------------- 1 | # openai-hs 2 | 3 | Unofficial OpenAI SDK/client for Haskell. It's generated via `servant-client` from `openai-servant` with a small amount of hand-written code. Contributions are welcome! 4 | 5 | ## Install 6 | 7 | ``` sh 8 | # stack 9 | stack install openai-hs 10 | 11 | # cabal 12 | cabal install openai-hs 13 | ``` 14 | 15 | ## Example 16 | 17 | ``` haskell 18 | {-# LANGUAGE OverloadedStrings #-} 19 | import OpenAI.Client 20 | 21 | import Network.HTTP.Client 22 | import Network.HTTP.Client.TLS 23 | import System.Environment (getEnv) 24 | import qualified Data.Text as T 25 | 26 | request :: ChatCompletionRequest 27 | request = ChatCompletionRequest 28 | { chcrModel = ModelId "gpt-3.5-turbo" 29 | , chcrMessages = 30 | [ChatMessage { chmContent = Just "Write a hello world program in Haskell" 31 | , chmRole = "user" 32 | , chmFunctionCall = Nothing 33 | , chmName = Nothing 34 | } 35 | ] 36 | , chcrFunctions = Nothing 37 | , chcrFunctionCall = Nothing 38 | , chcrTemperature = Nothing 39 | , chcrTopP = Nothing 40 | , chcrN = Nothing 41 | , chcrSeed = Nothing 42 | , chcrStream = Nothing 43 | , chcrStop = Nothing 44 | , chcrMaxTokens = Nothing 45 | , chcrPresencePenalty = Nothing 46 | , chcrResponseFormat = Nothing 47 | , chcrFrequencyPenalty = Nothing 48 | , chcrLogitBias = Nothing 49 | , chcrUser = Nothing 50 | } 51 | 52 | main :: IO () 53 | main = 54 | do manager <- newManager tlsManagerSettings 55 | apiKey <- T.pack <$> getEnv "OPENAI_KEY" 56 | -- create a openai client that automatically retries up to 4 times on network 57 | -- errors 58 | let client = makeOpenAIClient apiKey manager 4 59 | result <- completeChat client request 60 | case result of 61 | Left failure -> print failure 62 | Right success -> print $ chrChoices success 63 | ``` 64 | 65 | ## Features 66 | 67 | Supported actions: 68 | 69 | * List engines 70 | * Retrieve engine 71 | * Create text completion 72 | * Run semantic search 73 | 74 | ## Running the tests 75 | 76 | You can run all tests with `stack test`. You'll need an OpenAI API Key assigned to the `OPENAI_KEY` environment variable. 77 | -------------------------------------------------------------------------------- /openai-hs/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | 3 | main = defaultMain 4 | -------------------------------------------------------------------------------- /openai-hs/openai-hs.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.12 2 | 3 | -- This file has been generated from package.yaml by hpack version 0.36.0. 4 | -- 5 | -- see: https://github.com/sol/hpack 6 | -- 7 | -- hash: 07b1c878dc58fbadef2ced7a76a9aee5233a21e8f8b727916096d8888f09cc15 8 | 9 | name: openai-hs 10 | version: 0.3.0.1 11 | synopsis: Unofficial OpenAI client 12 | description: Unofficial OpenAI client 13 | category: Web 14 | homepage: https://github.com/agrafix/openai-hs#readme 15 | bug-reports: https://github.com/agrafix/openai-hs/issues 16 | author: Alexander Thiemann 17 | maintainer: Alexander Thiemann 18 | copyright: 2021-2023 Alexander Thiemann 19 | license: BSD3 20 | license-file: LICENSE 21 | build-type: Simple 22 | extra-source-files: 23 | README.md 24 | 25 | source-repository head 26 | type: git 27 | location: https://github.com/agrafix/openai-hs 28 | 29 | library 30 | exposed-modules: 31 | OpenAI.Client 32 | OpenAI.Client.Internal.Helpers 33 | other-modules: 34 | Paths_openai_hs 35 | hs-source-dirs: 36 | src 37 | default-extensions: 38 | OverloadedStrings 39 | DataKinds 40 | TypeOperators 41 | TypeFamilies 42 | GADTs 43 | FlexibleInstances 44 | FlexibleContexts 45 | MultiParamTypeClasses 46 | StrictData 47 | ScopedTypeVariables 48 | DeriveGeneric 49 | DeriveFunctor 50 | ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates 51 | build-tools: 52 | cpphs >=1.20 53 | build-depends: 54 | aeson 55 | , base >=4.7 && <5 56 | , bytestring 57 | , casing 58 | , cpphs 59 | , http-client 60 | , http-types 61 | , openai-servant >=0.2.1 62 | , servant 63 | , servant-auth-client 64 | , servant-client 65 | , servant-multipart-client 66 | , text 67 | default-language: Haskell2010 68 | 69 | test-suite openai-hs-test 70 | type: exitcode-stdio-1.0 71 | main-is: Spec.hs 72 | other-modules: 73 | ApiSpec 74 | HelperSpec 75 | Paths_openai_hs 76 | hs-source-dirs: 77 | test 78 | default-extensions: 79 | OverloadedStrings 80 | DataKinds 81 | TypeOperators 82 | TypeFamilies 83 | GADTs 84 | FlexibleInstances 85 | FlexibleContexts 86 | MultiParamTypeClasses 87 | StrictData 88 | ScopedTypeVariables 89 | DeriveGeneric 90 | DeriveFunctor 91 | ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -threaded -rtsopts -with-rtsopts=-N 92 | build-depends: 93 | aeson 94 | , base >=4.7 && <5 95 | , bytestring 96 | , casing 97 | , containers 98 | , cpphs 99 | , hspec 100 | , http-client 101 | , http-client-tls 102 | , http-types 103 | , openai-hs 104 | , openai-servant >=0.2.1 105 | , servant 106 | , servant-auth-client 107 | , servant-client 108 | , servant-client-core 109 | , servant-multipart-client 110 | , text 111 | , vector 112 | default-language: Haskell2010 113 | -------------------------------------------------------------------------------- /openai-hs/package.yaml: -------------------------------------------------------------------------------- 1 | name: openai-hs 2 | version: 0.3.0.1 3 | github: "agrafix/openai-hs" 4 | license: BSD3 5 | author: "Alexander Thiemann " 6 | maintainer: "Alexander Thiemann " 7 | copyright: "2021-2023 Alexander Thiemann " 8 | 9 | extra-source-files: 10 | - README.md 11 | 12 | synopsis: Unofficial OpenAI client 13 | category: Web 14 | 15 | description: Unofficial OpenAI client 16 | 17 | dependencies: 18 | - base >= 4.7 && < 5 19 | - openai-servant >= 0.2.1 20 | - aeson 21 | - casing 22 | - text 23 | - servant 24 | - servant-auth-client 25 | - servant-client 26 | - servant-multipart-client 27 | - http-client 28 | - bytestring 29 | - cpphs 30 | - http-types 31 | 32 | ghc-options: 33 | - -Wall 34 | - -fwarn-tabs 35 | - -fwarn-incomplete-uni-patterns 36 | - -fwarn-incomplete-record-updates 37 | 38 | default-extensions: 39 | - OverloadedStrings 40 | - DataKinds 41 | - TypeOperators 42 | - TypeFamilies 43 | - GADTs 44 | - FlexibleInstances 45 | - FlexibleContexts 46 | - MultiParamTypeClasses 47 | - StrictData 48 | - ScopedTypeVariables 49 | - DeriveGeneric 50 | - DeriveFunctor 51 | 52 | library: 53 | source-dirs: src 54 | build-tools: cpphs:cpphs >= 1.20 55 | 56 | tests: 57 | openai-hs-test: 58 | main: Spec.hs 59 | source-dirs: test 60 | ghc-options: 61 | - -threaded 62 | - -rtsopts 63 | - -with-rtsopts=-N 64 | dependencies: 65 | - openai-hs 66 | - hspec 67 | - http-client-tls 68 | - vector 69 | - bytestring 70 | - containers 71 | - servant-client-core 72 | -------------------------------------------------------------------------------- /openai-hs/src/OpenAI/Client.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# OPTIONS_GHC -cpp -pgmP "cpphs --cpp" #-} 3 | 4 | module OpenAI.Client 5 | ( -- * Basics 6 | ApiKey, 7 | OpenAIClient, 8 | makeOpenAIClient, 9 | makeOpenAIClient', 10 | ClientError (..), 11 | 12 | -- * Helper types 13 | TimeStamp (..), 14 | OpenAIList (..), 15 | Usage (..), 16 | 17 | -- * Models 18 | Model (..), 19 | ModelId (..), 20 | listModels, 21 | getModel, 22 | 23 | -- * Completion 24 | CompletionCreate (..), 25 | CompletionChoice (..), 26 | CompletionResponse (..), 27 | defaultCompletionCreate, 28 | completeText, 29 | 30 | -- * Chat 31 | ChatFunction (..), 32 | ChatFunctionCall (..), 33 | ChatFunctionCallStrategy (..), 34 | ChatMessage (..), 35 | ChatCompletionRequest (..), 36 | ChatChoice (..), 37 | ChatResponse (..), 38 | ChatResponseFormat(..), 39 | defaultChatCompletionRequest, 40 | completeChat, 41 | 42 | -- * Images 43 | ImageResponse (..), 44 | ImageResponseData (..), 45 | ImageResponseFormat (..), 46 | ImageCreate (..), 47 | ImageEditRequest (..), 48 | ImageVariationRequest (..), 49 | generateImage, 50 | createImageEdit, 51 | createImageVariation, 52 | 53 | -- * Embeddings 54 | EmbeddingCreate (..), 55 | EmbeddingResponseData (..), 56 | EmbeddingUsage (..), 57 | EmbeddingResponse (..), 58 | createEmbedding, 59 | 60 | -- * Audio 61 | AudioResponseData (..), 62 | AudioTranscriptionRequest (..), 63 | AudioTranslationRequest (..), 64 | createTranscription, 65 | createAudioTranslation, 66 | 67 | -- * Engine (deprecated) 68 | EngineId (..), 69 | Engine (..), 70 | listEngines, 71 | getEngine, 72 | 73 | -- * Engine-based text completion (deprecated) 74 | TextCompletionId (..), 75 | TextCompletionChoice (..), 76 | TextCompletion (..), 77 | TextCompletionCreate (..), 78 | defaultEngineTextCompletionCreate, 79 | engineCompleteText, 80 | 81 | -- * Engine-based embeddings (deprecated) 82 | EngineEmbeddingCreate (..), 83 | EngineEmbedding (..), 84 | engineCreateEmbedding, 85 | 86 | -- * Fine tunes (out of date) 87 | FineTuneId (..), 88 | FineTuneCreate (..), 89 | defaultFineTuneCreate, 90 | FineTune (..), 91 | FineTuneEvent (..), 92 | createFineTune, 93 | listFineTunes, 94 | getFineTune, 95 | cancelFineTune, 96 | listFineTuneEvents, 97 | 98 | -- * File API (out of date) 99 | FileCreate (..), 100 | File (..), 101 | FileId (..), 102 | FileHunk (..), 103 | FineTuneHunk (..), 104 | FileDeleteConfirmation (..), 105 | createFile, 106 | deleteFile, 107 | ) 108 | where 109 | 110 | import Control.Monad.IO.Class (MonadIO(..)) 111 | import qualified Data.ByteString.Lazy as BSL 112 | import Data.Proxy 113 | import qualified Data.Text as T 114 | import qualified Data.Text.Encoding as T 115 | import Network.HTTP.Client (Manager) 116 | import OpenAI.Api 117 | import OpenAI.Client.Internal.Helpers 118 | import OpenAI.Resources 119 | import Servant.API 120 | import Servant.Auth.Client 121 | import Servant.Client 122 | import qualified Servant.Multipart.Client as MP 123 | 124 | -- | Your OpenAI API key. Can be obtained from the OpenAI dashboard. Format: @sk-@ 125 | type ApiKey = T.Text 126 | 127 | -- | Holds a 'Manager' and your API key. 128 | data OpenAIClient = OpenAIClient 129 | { scBaseUrl :: BaseUrl, 130 | scToken :: Token, 131 | scManager :: Manager, 132 | scMaxRetries :: Int 133 | } 134 | 135 | -- | Construct a 'OpenAIClient'. Note that the passed 'Manager' must support https (e.g. via @http-client-tls@) 136 | makeOpenAIClient' :: 137 | BaseUrl -> 138 | ApiKey -> 139 | Manager -> 140 | -- | Number of automatic retries the library should attempt. 141 | Int -> 142 | OpenAIClient 143 | makeOpenAIClient' u k = OpenAIClient u (Token (T.encodeUtf8 k)) 144 | 145 | -- | method using default remote base url 146 | makeOpenAIClient :: 147 | ApiKey -> 148 | Manager -> 149 | Int -> 150 | OpenAIClient 151 | makeOpenAIClient = makeOpenAIClient' openaiBaseUrl 152 | 153 | api :: Proxy OpenAIApi 154 | api = Proxy 155 | 156 | openaiBaseUrl :: BaseUrl 157 | openaiBaseUrl = BaseUrl Https "api.openai.com" 443 "" 158 | 159 | #define EP0(N, R) \ 160 | N##' :: Token -> ClientM R;\ 161 | N :: MonadIO m => OpenAIClient -> m (Either ClientError R);\ 162 | N sc = liftIO . runRequest (scMaxRetries sc) 0 $ runClientM (N##' (scToken sc)) (mkClientEnv (scManager sc) (scBaseUrl sc)) 163 | 164 | #define EP1(N, ARG, R) \ 165 | N##' :: Token -> ARG -> ClientM R;\ 166 | N :: MonadIO m => OpenAIClient -> ARG -> m (Either ClientError R);\ 167 | N sc a = liftIO . runRequest (scMaxRetries sc) 0 $ runClientM (N##' (scToken sc) a) (mkClientEnv (scManager sc) (scBaseUrl sc)) 168 | 169 | #define EP2(N, ARG, ARG2, R) \ 170 | N##' :: Token -> ARG -> ARG2 -> ClientM R;\ 171 | N :: MonadIO m => OpenAIClient -> ARG -> ARG2 -> m (Either ClientError R);\ 172 | N sc a b = liftIO . runRequest (scMaxRetries sc) 0 $ runClientM (N##' (scToken sc) a b) (mkClientEnv (scManager sc) (scBaseUrl sc)) 173 | 174 | EP0 (listModels, (OpenAIList Model)) 175 | EP1 (getModel, ModelId, Model) 176 | 177 | EP1 (completeText, CompletionCreate, CompletionResponse) 178 | 179 | EP1 (completeChat, ChatCompletionRequest, ChatResponse) 180 | 181 | EP1 (generateImage, ImageCreate, ImageResponse) 182 | EP1 (createImageEdit, ImageEditRequest, ImageResponse) 183 | EP1 (createImageVariation, ImageVariationRequest, ImageResponse) 184 | 185 | EP1 (createEmbedding, EmbeddingCreate, EmbeddingResponse) 186 | 187 | createTranscription :: MonadIO m => OpenAIClient -> AudioTranscriptionRequest -> m (Either ClientError AudioResponseData) 188 | createTranscription sc atr = 189 | do 190 | bnd <- liftIO MP.genBoundary 191 | createTranscriptionInternal sc (bnd, atr) 192 | 193 | createAudioTranslation :: MonadIO m => OpenAIClient -> AudioTranslationRequest -> m (Either ClientError AudioResponseData) 194 | createAudioTranslation sc atr = 195 | do 196 | bnd <- liftIO MP.genBoundary 197 | createAudioTranslationInternal sc (bnd, atr) 198 | 199 | EP1 (createTranscriptionInternal, (BSL.ByteString, AudioTranscriptionRequest), AudioResponseData) 200 | EP1 (createAudioTranslationInternal, (BSL.ByteString, AudioTranslationRequest), AudioResponseData) 201 | 202 | createFile :: MonadIO m => OpenAIClient -> FileCreate -> m (Either ClientError File) 203 | createFile sc rfc = 204 | do 205 | bnd <- liftIO MP.genBoundary 206 | createFileInternal sc (bnd, rfc) 207 | 208 | EP1 (createFileInternal, (BSL.ByteString, FileCreate), File) 209 | EP1 (deleteFile, FileId, FileDeleteConfirmation) 210 | 211 | EP1 (createFineTune, FineTuneCreate, FineTune) 212 | EP0 (listFineTunes, (OpenAIList FineTune)) 213 | EP1 (getFineTune, FineTuneId, FineTune) 214 | EP1 (cancelFineTune, FineTuneId, FineTune) 215 | EP1 (listFineTuneEvents, FineTuneId, (OpenAIList FineTuneEvent)) 216 | 217 | EP0 (listEngines, (OpenAIList Engine)) 218 | EP1 (getEngine, EngineId, Engine) 219 | EP2 (engineCompleteText, EngineId, TextCompletionCreate, TextCompletion) 220 | EP2 (engineCreateEmbedding, EngineId, EngineEmbeddingCreate, (OpenAIList EngineEmbedding)) 221 | 222 | ( ( listModels' 223 | :<|> getModel' 224 | ) 225 | :<|> (completeText') 226 | :<|> (completeChat') 227 | :<|> ( generateImage' 228 | :<|> createImageEdit' 229 | :<|> createImageVariation' 230 | ) 231 | :<|> (createEmbedding') 232 | :<|> ( createTranscriptionInternal' 233 | :<|> createAudioTranslationInternal' 234 | ) 235 | :<|> (createFileInternal' :<|> deleteFile') 236 | :<|> ( createFineTune' 237 | :<|> listFineTunes' 238 | :<|> getFineTune' 239 | :<|> cancelFineTune' 240 | :<|> listFineTuneEvents' 241 | ) 242 | :<|> ( listEngines' 243 | :<|> getEngine' 244 | :<|> engineCompleteText' 245 | :<|> engineCreateEmbedding' 246 | ) 247 | ) = 248 | client api 249 | -------------------------------------------------------------------------------- /openai-hs/src/OpenAI/Client/Internal/Helpers.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | 3 | -- | Private helper functions. Note that all contents of this module are excluded 4 | -- from the versioning scheme. 5 | module OpenAI.Client.Internal.Helpers where 6 | 7 | import Network.HTTP.Types.Status 8 | import Servant.Client 9 | 10 | runRequest :: Int -> Int -> IO (Either ClientError a) -> IO (Either ClientError a) 11 | runRequest maxRetries !retryCount makeRequest = 12 | do 13 | res <- makeRequest 14 | case res of 15 | Right ok -> pure (Right ok) 16 | Left err@(ConnectionError _) -> maybeRetry err 17 | Left err@(FailureResponse _ resp) 18 | | responseStatusCode resp == conflict409 -> maybeRetry err 19 | | statusCode (responseStatusCode resp) >= 500 -> maybeRetry err 20 | | otherwise -> pure (Left err) 21 | Left err -> pure (Left err) 22 | where 23 | maybeRetry err = 24 | if retryCount + 1 >= maxRetries 25 | then pure (Left err) 26 | else runRequest maxRetries (retryCount + 1) makeRequest 27 | -------------------------------------------------------------------------------- /openai-hs/test/ApiSpec.hs: -------------------------------------------------------------------------------- 1 | module ApiSpec (apiSpec) where 2 | 3 | import qualified Data.Text as T 4 | import qualified Data.Vector as V 5 | import Network.HTTP.Client 6 | import Network.HTTP.Client.TLS 7 | import OpenAI.Client 8 | import System.Environment (getEnv) 9 | import Test.Hspec 10 | 11 | makeClient :: IO OpenAIClient 12 | makeClient = 13 | do 14 | manager <- newManager tlsManagerSettings 15 | apiKey <- T.pack <$> getEnv "OPENAI_KEY" 16 | pure (makeOpenAIClient apiKey manager 2) 17 | 18 | forceSuccess :: (MonadFail m, Show a) => m (Either a b) -> m b 19 | forceSuccess req = 20 | req >>= \res -> 21 | case res of 22 | Left err -> fail (show err) 23 | Right ok -> pure ok 24 | 25 | apiSpec :: Spec 26 | apiSpec = do 27 | describe "2022 core api" apiTests2022 28 | describe "March 2023 core API" apiTests2023 29 | 30 | --------------------------------- 31 | ------- 2023 API tests ---------- 32 | --------------------------------- 33 | 34 | apiTests2023 :: SpecWith () 35 | apiTests2023 = 36 | beforeAll makeClient $ do 37 | describe "models api" $ do 38 | it "list models" $ \cli -> do 39 | res <- forceSuccess $ listModels cli 40 | (V.length (olData res) > 5) `shouldBe` True 41 | let modelId = ModelId "text-embedding-3-small" 42 | case V.find (\m -> mId m == modelId) (olData res) of 43 | Nothing -> expectationFailure $ "could not find matching model in response " <> show modelId 44 | Just m -> mOwnedBy m `shouldBe` "system" 45 | 46 | it "retrieve model" $ \cli -> do 47 | model <- forceSuccess $ getModel cli (ModelId "text-embedding-3-small") 48 | mOwnedBy model `shouldBe` "system" 49 | 50 | describe "completions api" $ do 51 | it "create completion" $ \cli -> do 52 | let completion = 53 | (defaultCompletionCreate (ModelId "gpt-3.5-turbo-instruct") "The opposite of up is") 54 | { ccrMaxTokens = Just 1, 55 | ccrTemperature = Just 0.1, 56 | ccrN = Just 1 57 | } 58 | res <- forceSuccess $ completeText cli completion 59 | crChoices res `shouldNotBe` [] 60 | cchText (head (crChoices res)) `shouldBe` " down" 61 | 62 | describe "chat api" $ do 63 | it "create chat completion" $ \cli -> do 64 | let completion = 65 | defaultChatCompletionRequest 66 | (ModelId "gpt-3.5-turbo") 67 | [ ChatMessage 68 | { chmRole = "user", 69 | chmContent = Just "What is the opposite of up? Answer in one word with no punctuation.", 70 | chmFunctionCall = Nothing, 71 | chmName = Nothing 72 | } 73 | ] 74 | res <- forceSuccess $ completeChat cli completion 75 | chrChoices res `shouldNotBe` [] 76 | chmContent (chchMessage (head (chrChoices res))) `shouldBe` Just "down" 77 | it "'content' is a required property" $ \cli -> do 78 | let completion = 79 | defaultChatCompletionRequest 80 | (ModelId "gpt-3.5-turbo") 81 | [ ChatMessage 82 | { chmRole = "assistant", 83 | chmContent = Nothing, 84 | chmFunctionCall = Just $ ChatFunctionCall { chfcName = "f", chfcArguments = "{}" }, 85 | chmName = Nothing 86 | }, 87 | ChatMessage 88 | { chmRole = "function", 89 | chmContent = Just "x", 90 | chmFunctionCall = Nothing, 91 | chmName = Just "f" 92 | } 93 | ] 94 | res <- forceSuccess $ completeChat cli completion 95 | chrChoices res `shouldNotBe` [] 96 | 97 | -- TODO (2023.03.22): Create tests for images, audio APIs 98 | 99 | describe "embeddings api" $ do 100 | it "create embeddings" $ \cli -> do 101 | let embedding = EmbeddingCreate {embcModel = ModelId "text-embedding-ada-002", embcInput = "Hello", embcUser = Nothing} 102 | res <- forceSuccess $ createEmbedding cli embedding 103 | embrData res `shouldNotBe` [] 104 | V.length (embdEmbedding (head $ embrData res)) `shouldBe` 1536 105 | 106 | --------------------------------- 107 | ------- 2022 API tests ---------- 108 | --------------------------------- 109 | 110 | apiTests2022 :: SpecWith () 111 | apiTests2022 = 112 | beforeAll makeClient $ 113 | do 114 | describe "embeddings" $ do 115 | it "computes embeddings" $ \cli -> do 116 | res <- forceSuccess $ engineCreateEmbedding cli (EngineId "text-embedding-3-small") (EngineEmbeddingCreate "This is nice") 117 | V.null (olData res) `shouldBe` False 118 | let embedding = V.head (olData res) 119 | V.length (eneEmbedding embedding) `shouldBe` 2048 120 | describe "fine tuning" $ do 121 | it "allows creating fine-tuning" $ \cli -> do 122 | let file = 123 | FileCreate 124 | { fcPurpose = "fine-tune", 125 | fcDocuments = 126 | [ FhFineTune $ FineTuneHunk "So sad. Label:" "sad", 127 | FhFineTune $ FineTuneHunk "So happy. Label:" "happy" 128 | ] 129 | } 130 | createRes <- forceSuccess $ createFile cli file 131 | let ftc = defaultFineTuneCreate (fId createRes) 132 | res <- forceSuccess $ createFineTune cli ftc 133 | ftStatus res `shouldBe` "pending" 134 | describe "engines" $ 135 | do 136 | it "lists engines" $ \cli -> 137 | do 138 | res <- forceSuccess $ listEngines cli 139 | V.null (olData res) `shouldBe` False 140 | it "retrieve engine" $ \cli -> 141 | do 142 | engineList <- forceSuccess $ listEngines cli 143 | let firstEngine = V.head (olData engineList) 144 | engine <- forceSuccess $ getEngine cli (eId firstEngine) 145 | engine `shouldBe` firstEngine 146 | describe "text completion" $ 147 | do 148 | it "works (smoke test)" $ \cli -> 149 | do 150 | completionResults <- 151 | forceSuccess $ 152 | engineCompleteText cli (EngineId "gpt-3.5-turbo-instruct") $ 153 | (defaultEngineTextCompletionCreate "Why is the house ") 154 | { tccrMaxTokens = Just 2 155 | } 156 | V.length (tcChoices completionResults) `shouldBe` 1 157 | T.length (tccText (V.head (tcChoices completionResults))) `shouldNotBe` 0 158 | -------------------------------------------------------------------------------- /openai-hs/test/HelperSpec.hs: -------------------------------------------------------------------------------- 1 | module HelperSpec (helperSpec) where 2 | 3 | import Control.Exception.Base 4 | import qualified Data.ByteString as BS 5 | import Data.IORef 6 | import Data.Maybe 7 | import qualified Data.Sequence as Seq 8 | import Network.HTTP.Types.Header 9 | import Network.HTTP.Types.Status 10 | import Network.HTTP.Types.Version 11 | import OpenAI.Client.Internal.Helpers 12 | import Servant.Client 13 | import Servant.Client.Core.Request 14 | import System.Exit 15 | import Test.Hspec 16 | 17 | helperSpec :: Spec 18 | helperSpec = 19 | do describe "retries" retryTests 20 | 21 | makeFakeAction :: 22 | (Int -> Either ClientError a) -> 23 | IO (IO Int, IO (Either ClientError a)) 24 | makeFakeAction makeResult = 25 | do 26 | calls <- newIORef 0 27 | let action = 28 | do 29 | call <- atomicModifyIORef calls $ \i -> (i + 1, i) 30 | pure (makeResult call) 31 | pure (readIORef calls, action) 32 | 33 | dummyReq :: RequestF () (BaseUrl, BS.ByteString) 34 | dummyReq = 35 | defaultRequest 36 | { requestBody = Nothing, 37 | requestPath = (fromJust $ parseBaseUrl "api.example.com", "") 38 | } 39 | 40 | retryAction :: 41 | Int -> 42 | Status -> 43 | Seq.Seq Header -> 44 | IO (ClientError, IO Int, IO (Either ClientError Bool)) 45 | retryAction n status headers = 46 | do 47 | let errResp = 48 | Response 49 | { responseStatusCode = status, 50 | responseHeaders = headers, 51 | responseHttpVersion = http11, 52 | responseBody = mempty 53 | } 54 | err = FailureResponse dummyReq errResp 55 | (getCalls, action) <- 56 | makeFakeAction $ \call -> 57 | if call < n 58 | then Left $ err 59 | else Right True 60 | pure (err, getCalls, action) 61 | 62 | retryTests :: SpecWith () 63 | retryTests = 64 | do 65 | it "does not retry on success" $ 66 | do 67 | (getCalls, action) <- makeFakeAction (const $ Right True) 68 | runRequest 10 0 action `shouldReturn` Right True 69 | getCalls `shouldReturn` 1 70 | it "retries on connection errors" $ 71 | do 72 | (getCalls, action) <- 73 | makeFakeAction $ \call -> 74 | if call == 0 75 | then Left (ConnectionError $ toException ExitSuccess) 76 | else Right True 77 | runRequest 10 0 action `shouldReturn` Right True 78 | getCalls `shouldReturn` 2 79 | it "retries on 409 status code" $ 80 | do 81 | (_, getCalls, action) <- 82 | retryAction 1 status409 mempty 83 | runRequest 10 0 action `shouldReturn` Right True 84 | getCalls `shouldReturn` 2 85 | it "retries on 500 status code" $ 86 | do 87 | (_, getCalls, action) <- 88 | retryAction 1 status500 mempty 89 | runRequest 10 0 action `shouldReturn` Right True 90 | getCalls `shouldReturn` 2 91 | it "does not retry on status 500 if limit exceeded" $ 92 | do 93 | (err, getCalls, action) <- 94 | retryAction 11 status500 mempty 95 | runRequest 10 0 action `shouldReturn` Left err 96 | getCalls `shouldReturn` 10 97 | -------------------------------------------------------------------------------- /openai-hs/test/Spec.hs: -------------------------------------------------------------------------------- 1 | import ApiSpec 2 | import HelperSpec 3 | import Test.Hspec 4 | 5 | main :: IO () 6 | main = 7 | hspec $ 8 | do 9 | apiSpec 10 | helperSpec 11 | -------------------------------------------------------------------------------- /openai-servant/.gitignore: -------------------------------------------------------------------------------- 1 | .stack-work/ 2 | *~ -------------------------------------------------------------------------------- /openai-servant/.hlint.yaml: -------------------------------------------------------------------------------- 1 | - ignore: {name: Use newtype instead of data} 2 | - ignore: {name: Eta reduce} 3 | -------------------------------------------------------------------------------- /openai-servant/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Alexander Thiemann (c) 2021-2022 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Author name here nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /openai-servant/README.md: -------------------------------------------------------------------------------- 1 | # openai-servant 2 | 3 | Unofficial description of the OpenAI API using servant types. Contributions are welcome! 4 | 5 | For usage, see the [openai-hs](https://hackage.haskell.org/package/openai-hs) package. 6 | -------------------------------------------------------------------------------- /openai-servant/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | 3 | main = defaultMain 4 | -------------------------------------------------------------------------------- /openai-servant/openai-servant.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.12 2 | 3 | -- This file has been generated from package.yaml by hpack version 0.35.2. 4 | -- 5 | -- see: https://github.com/sol/hpack 6 | 7 | name: openai-servant 8 | version: 0.3.0.1 9 | synopsis: Unofficial OpenAI servant types 10 | description: Unofficial description of the OpenAI API using servant types 11 | category: Web 12 | homepage: https://github.com/agrafix/openai-hs#readme 13 | bug-reports: https://github.com/agrafix/openai-hs/issues 14 | author: Alexander Thiemann 15 | maintainer: Alexander Thiemann 16 | copyright: 2021-2023 Alexander Thiemann 17 | license: BSD3 18 | license-file: LICENSE 19 | build-type: Simple 20 | extra-source-files: 21 | README.md 22 | 23 | source-repository head 24 | type: git 25 | location: https://github.com/agrafix/openai-hs 26 | 27 | library 28 | exposed-modules: 29 | OpenAI.Api 30 | OpenAI.Internal.Aeson 31 | OpenAI.Resources 32 | other-modules: 33 | Paths_openai_servant 34 | hs-source-dirs: 35 | src 36 | default-extensions: 37 | OverloadedStrings 38 | DataKinds 39 | TypeOperators 40 | TypeFamilies 41 | GADTs 42 | FlexibleInstances 43 | FlexibleContexts 44 | MultiParamTypeClasses 45 | StrictData 46 | ScopedTypeVariables 47 | DeriveGeneric 48 | DeriveFunctor 49 | ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates 50 | build-depends: 51 | aeson 52 | , base >=4.7 && <5 53 | , bytestring 54 | , casing 55 | , mime-types 56 | , servant 57 | , servant-auth 58 | , servant-auth-client 59 | , servant-multipart-api 60 | , text 61 | , time 62 | , vector 63 | default-language: Haskell2010 64 | -------------------------------------------------------------------------------- /openai-servant/package.yaml: -------------------------------------------------------------------------------- 1 | name: openai-servant 2 | version: 0.3.0.1 3 | github: "agrafix/openai-hs" 4 | license: BSD3 5 | author: "Alexander Thiemann " 6 | maintainer: "Alexander Thiemann " 7 | copyright: "2021-2023 Alexander Thiemann " 8 | 9 | extra-source-files: 10 | - README.md 11 | 12 | synopsis: Unofficial OpenAI servant types 13 | category: Web 14 | 15 | description: Unofficial description of the OpenAI API using servant types 16 | 17 | dependencies: 18 | - base >= 4.7 && < 5 19 | - aeson 20 | - casing 21 | - text 22 | - servant 23 | - servant-auth 24 | - servant-auth-client 25 | - servant-multipart-api 26 | - bytestring 27 | - time 28 | - vector 29 | - mime-types 30 | 31 | ghc-options: 32 | - -Wall 33 | - -fwarn-tabs 34 | - -fwarn-incomplete-uni-patterns 35 | - -fwarn-incomplete-record-updates 36 | 37 | default-extensions: 38 | - OverloadedStrings 39 | - DataKinds 40 | - TypeOperators 41 | - TypeFamilies 42 | - GADTs 43 | - FlexibleInstances 44 | - FlexibleContexts 45 | - MultiParamTypeClasses 46 | - StrictData 47 | - ScopedTypeVariables 48 | - DeriveGeneric 49 | - DeriveFunctor 50 | 51 | library: 52 | source-dirs: src 53 | -------------------------------------------------------------------------------- /openai-servant/src/OpenAI/Api.hs: -------------------------------------------------------------------------------- 1 | -- | The API 2 | module OpenAI.Api where 3 | 4 | import OpenAI.Resources 5 | import Servant.API 6 | import Servant.Auth 7 | import Servant.Auth.Client 8 | import Servant.Multipart.API 9 | 10 | type OpenAIAuth = Auth '[Bearer] () 11 | 12 | type OpenAIApi = 13 | "v1" :> OpenAIApiInternal 14 | 15 | type OpenAIApiInternal = 16 | "models" :> ModelsApi 17 | :<|> "completions" :> CompletionsApi 18 | :<|> "chat" :> ChatApi 19 | :<|> "images" :> ImagesApi 20 | :<|> "embeddings" :> EmbeddingsApi 21 | :<|> "audio" :> AudioApi 22 | :<|> "files" :> FilesApi 23 | :<|> FineTuneApi 24 | :<|> "engines" :> EnginesApi 25 | 26 | type ModelsApi = 27 | OpenAIAuth :> Get '[JSON] (OpenAIList Model) 28 | :<|> OpenAIAuth :> Capture "model_id" ModelId :> Get '[JSON] Model 29 | 30 | type CompletionsApi = 31 | OpenAIAuth :> ReqBody '[JSON] CompletionCreate :> Post '[JSON] CompletionResponse 32 | 33 | type ChatApi = 34 | OpenAIAuth :> "completions" :> ReqBody '[JSON] ChatCompletionRequest :> Post '[JSON] ChatResponse 35 | 36 | type ImagesApi = 37 | OpenAIAuth :> "generations" :> ReqBody '[JSON] ImageCreate :> Post '[JSON] ImageResponse 38 | :<|> OpenAIAuth :> "edits" :> ReqBody '[JSON] ImageEditRequest :> Post '[JSON] ImageResponse 39 | :<|> OpenAIAuth :> "variations" :> ReqBody '[JSON] ImageVariationRequest :> Post '[JSON] ImageResponse 40 | 41 | type EmbeddingsApi = 42 | OpenAIAuth :> ReqBody '[JSON] EmbeddingCreate :> Post '[JSON] EmbeddingResponse 43 | 44 | type AudioApi = 45 | OpenAIAuth :> "transcriptions" :> MultipartForm Tmp AudioTranscriptionRequest :> Post '[JSON] AudioResponseData 46 | :<|> OpenAIAuth :> "translations" :> MultipartForm Tmp AudioTranslationRequest :> Post '[JSON] AudioResponseData 47 | 48 | type FilesApi = 49 | OpenAIAuth :> MultipartForm Mem FileCreate :> Post '[JSON] File 50 | :<|> OpenAIAuth :> Capture "file_id" FileId :> Delete '[JSON] FileDeleteConfirmation 51 | 52 | type FineTuneApi = 53 | OpenAIAuth :> "fine-tunes" :> ReqBody '[JSON] FineTuneCreate :> Post '[JSON] FineTune 54 | :<|> OpenAIAuth :> "fine-tunes" :> Get '[JSON] (OpenAIList FineTune) 55 | :<|> OpenAIAuth :> "fine-tunes" :> Capture "fine_tune_id" FineTuneId :> Get '[JSON] FineTune 56 | :<|> OpenAIAuth :> "fine-tunes" :> Capture "fine_tune_id" FineTuneId :> "cancel" :> Post '[JSON] FineTune 57 | :<|> OpenAIAuth :> "fine-tunes" :> Capture "fine_tune_id" FineTuneId :> "events" :> Get '[JSON] (OpenAIList FineTuneEvent) 58 | 59 | type EnginesApi = 60 | OpenAIAuth :> Get '[JSON] (OpenAIList Engine) 61 | :<|> OpenAIAuth :> Capture "engine_id" EngineId :> Get '[JSON] Engine 62 | :<|> OpenAIAuth :> Capture "engine_id" EngineId :> "completions" :> ReqBody '[JSON] TextCompletionCreate :> Post '[JSON] TextCompletion 63 | :<|> OpenAIAuth :> Capture "engine_id" EngineId :> "embeddings" :> ReqBody '[JSON] EngineEmbeddingCreate :> Post '[JSON] (OpenAIList EngineEmbedding) 64 | -------------------------------------------------------------------------------- /openai-servant/src/OpenAI/Internal/Aeson.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | module OpenAI.Internal.Aeson (jsonOpts, deriveJSON, ToJSON, FromJSON) where 3 | 4 | import Data.Aeson 5 | import Data.Aeson.TH ( deriveJSON ) 6 | import Text.Casing (quietSnake) 7 | 8 | jsonOpts :: Int -> Options 9 | jsonOpts x = 10 | defaultOptions 11 | { fieldLabelModifier = quietSnake . drop x, 12 | constructorTagModifier = quietSnake, 13 | omitNothingFields = True 14 | } 15 | -------------------------------------------------------------------------------- /openai-servant/src/OpenAI/Resources.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DerivingStrategies #-} 2 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 3 | {-# LANGUAGE InstanceSigs #-} 4 | {-# LANGUAGE LambdaCase #-} 5 | {-# LANGUAGE TemplateHaskell #-} 6 | {-# LANGUAGE UndecidableInstances #-} 7 | 8 | module OpenAI.Resources 9 | ( -- * Core Types 10 | TimeStamp (..), 11 | OpenAIList (..), 12 | Usage (..), 13 | 14 | -- * Models 15 | Model (..), 16 | ModelId (..), 17 | 18 | -- * Completion 19 | CompletionCreate (..), 20 | CompletionChoice (..), 21 | CompletionResponse (..), 22 | defaultCompletionCreate, 23 | 24 | -- * Chat 25 | ChatFunction (..), 26 | ChatFunctionCall (..), 27 | ChatFunctionCallStrategy (..), 28 | ChatMessage (..), 29 | ChatCompletionRequest (..), 30 | ChatChoice (..), 31 | ChatResponse (..), 32 | ChatResponseFormat(..), 33 | defaultChatCompletionRequest, 34 | 35 | -- * Images 36 | ImageResponse (..), 37 | ImageResponseData (..), 38 | ImageResponseFormat (..), 39 | ImageCreate (..), 40 | ImageEditRequest (..), 41 | ImageVariationRequest (..), 42 | 43 | -- * Embeddings 44 | EmbeddingCreate (..), 45 | EmbeddingResponseData (..), 46 | EmbeddingUsage (..), 47 | EmbeddingResponse (..), 48 | 49 | -- * Audio 50 | AudioResponseData (..), 51 | AudioTranscriptionRequest (..), 52 | AudioTranslationRequest (..), 53 | 54 | -- * Fine tuning (out of date) 55 | FineTuneId (..), 56 | FineTuneCreate (..), 57 | defaultFineTuneCreate, 58 | FineTune (..), 59 | FineTuneEvent (..), 60 | 61 | -- * File API (out of date) 62 | FileCreate (..), 63 | FileId (..), 64 | File (..), 65 | FileHunk (..), 66 | FineTuneHunk (..), 67 | FileDeleteConfirmation (..), 68 | 69 | -- * Engine (deprecated) 70 | EngineId (..), 71 | Engine (..), 72 | 73 | -- * Engine text completion (deprecated) 74 | TextCompletionId (..), 75 | TextCompletionChoice (..), 76 | TextCompletion (..), 77 | TextCompletionCreate (..), 78 | defaultEngineTextCompletionCreate, 79 | 80 | -- * Engine Embeddings (deprecated) 81 | EngineEmbeddingCreate (..), 82 | EngineEmbedding (..), 83 | ) 84 | where 85 | 86 | import Control.Applicative ((<|>)) 87 | import qualified Data.Aeson as A 88 | import qualified Data.ByteString.Lazy as BSL 89 | import Data.Maybe (catMaybes) 90 | import qualified Data.Text as T 91 | import Data.String (IsString(..)) 92 | import Data.Time 93 | import Data.Time.Clock.POSIX 94 | import qualified Data.Vector as V 95 | import qualified Data.Text.Encoding as T 96 | import GHC.Exts (IsList) 97 | import Network.Mime (defaultMimeLookup) 98 | import OpenAI.Internal.Aeson 99 | import Servant.API 100 | import Servant.Multipart.API 101 | 102 | -- | A 'UTCTime' wrapper that has unix timestamp JSON representation 103 | newtype TimeStamp = TimeStamp {unTimeStamp :: UTCTime} 104 | deriving stock (Show, Eq) 105 | 106 | instance A.ToJSON TimeStamp where 107 | toJSON = A.Number . fromRational . toRational . utcTimeToPOSIXSeconds . unTimeStamp 108 | 109 | instance A.FromJSON TimeStamp where 110 | parseJSON = 111 | A.withScientific "unix timestamp" $ \sci -> 112 | pure $ TimeStamp $ posixSecondsToUTCTime (fromRational $ toRational sci) 113 | 114 | instance ToHttpApiData TimeStamp where 115 | toUrlPiece x = 116 | let unix :: Int 117 | unix = round . utcTimeToPOSIXSeconds . unTimeStamp $ x 118 | in T.pack (show unix) 119 | 120 | -- | A 'V.Vector' wrapper. 121 | newtype OpenAIList a = OpenAIList 122 | { olData :: V.Vector a 123 | } 124 | deriving stock (Eq, Functor) 125 | deriving newtype (Applicative, IsList, Monoid, Semigroup, Show) 126 | 127 | $(deriveJSON (jsonOpts 2) ''OpenAIList) 128 | 129 | data Usage = Usage 130 | { usPromptTokens :: Int, 131 | usCompletionTokens :: Int, 132 | usTotalTokens :: Int 133 | } 134 | deriving (Show, Eq) 135 | 136 | $(deriveJSON (jsonOpts 2) ''Usage) 137 | 138 | instance Semigroup Usage where 139 | Usage a1 a2 a3 <> Usage b1 b2 b3 = Usage (a1 + b1) (a2 + b2) (a3 + b3) 140 | 141 | instance Monoid Usage where 142 | mempty = Usage 0 0 0 143 | 144 | ------------------------ 145 | ------ Model API 146 | ------------------------ 147 | 148 | data Model = Model 149 | { mId :: ModelId, 150 | mObject :: T.Text, 151 | mOwnedBy :: T.Text 152 | } 153 | deriving (Show, Eq) 154 | 155 | newtype ModelId = ModelId {unModelId :: T.Text} 156 | deriving (Show, Eq, ToJSON, FromJSON, ToHttpApiData) 157 | 158 | $(deriveJSON (jsonOpts 1) ''Model) 159 | 160 | ------------------------ 161 | ------ Completions API (legacy) 162 | ------------------------ 163 | 164 | data CompletionCreate = CompletionCreate 165 | { ccrModel :: ModelId, 166 | ccrPrompt :: Maybe T.Text, 167 | ccrSuffix :: Maybe T.Text, 168 | ccrMaxTokens :: Maybe Int, 169 | ccrTemperature :: Maybe Double, 170 | ccrTopP :: Maybe Double, 171 | ccrN :: Maybe Int, 172 | ccrStream :: Maybe Bool, 173 | ccrLogprobs :: Maybe Int, 174 | ccrEcho :: Maybe Bool, 175 | ccrStop :: Maybe (V.Vector T.Text), 176 | ccrPresencePenalty :: Maybe Double, 177 | ccrFrequencyPenalty :: Maybe Double, 178 | ccrBestOf :: Maybe Int, 179 | ccrLogitBias :: Maybe (V.Vector Double), 180 | ccrUser :: Maybe String 181 | } 182 | deriving (Show, Eq) 183 | 184 | defaultCompletionCreate :: ModelId -> T.Text -> CompletionCreate 185 | defaultCompletionCreate model prompt = 186 | CompletionCreate 187 | { ccrModel = model, 188 | ccrPrompt = Just prompt, 189 | ccrSuffix = Nothing, 190 | ccrMaxTokens = Nothing, 191 | ccrTemperature = Nothing, 192 | ccrTopP = Nothing, 193 | ccrN = Nothing, 194 | ccrStream = Nothing, 195 | ccrLogprobs = Nothing, 196 | ccrEcho = Nothing, 197 | ccrStop = Nothing, 198 | ccrPresencePenalty = Nothing, 199 | ccrFrequencyPenalty = Nothing, 200 | ccrBestOf = Nothing, 201 | ccrLogitBias = Nothing, 202 | ccrUser = Nothing 203 | } 204 | 205 | data CompletionChoice = CompletionChoice 206 | { cchText :: T.Text, 207 | cchIndex :: Int, 208 | cchLogprobs :: Maybe (V.Vector Double), 209 | cchFinishReason :: Maybe T.Text 210 | } 211 | deriving (Show, Eq) 212 | 213 | data CompletionResponse = CompletionResponse 214 | { crId :: T.Text, 215 | crObject :: T.Text, 216 | crCreated :: Int, 217 | crModel :: ModelId, 218 | crChoices :: [CompletionChoice], 219 | crUsage :: A.Object 220 | } 221 | deriving (Show, Eq) 222 | 223 | $(deriveJSON (jsonOpts 3) ''CompletionCreate) 224 | $(deriveJSON (jsonOpts 3) ''CompletionChoice) 225 | $(deriveJSON (jsonOpts 2) ''CompletionResponse) 226 | 227 | ------------------------ 228 | ------ Chat API 229 | ------------------------ 230 | 231 | data ChatFunctionCall = ChatFunctionCall 232 | { chfcName :: T.Text, 233 | chfcArguments :: A.Value 234 | } 235 | deriving (Eq, Show) 236 | 237 | instance A.FromJSON ChatFunctionCall where 238 | parseJSON = A.withObject "ChatFunctionCall" $ \obj -> do 239 | name <- obj A..: "name" 240 | arguments <- obj A..: "arguments" >>= A.withEmbeddedJSON "Arguments" pure 241 | 242 | pure $ ChatFunctionCall {chfcName = name, chfcArguments = arguments} 243 | 244 | instance A.ToJSON ChatFunctionCall where 245 | toJSON (ChatFunctionCall {chfcName = name, chfcArguments = arguments}) = 246 | A.object 247 | [ "name" A..= name, 248 | "arguments" A..= T.decodeUtf8 (BSL.toStrict (A.encode arguments)) 249 | ] 250 | 251 | data ChatMessage = ChatMessage 252 | { chmContent :: Maybe T.Text, 253 | chmRole :: T.Text, 254 | chmFunctionCall :: Maybe ChatFunctionCall, 255 | chmName :: Maybe T.Text 256 | } 257 | deriving (Show, Eq) 258 | 259 | instance A.FromJSON ChatMessage where 260 | parseJSON = A.withObject "ChatMessage" $ \obj -> 261 | ChatMessage <$> obj A..:? "content" 262 | <*> obj A..: "role" 263 | <*> obj A..:? "function_call" 264 | <*> obj A..:? "name" 265 | 266 | instance A.ToJSON ChatMessage where 267 | toJSON (ChatMessage {chmContent = content, chmRole = role, chmFunctionCall = functionCall, chmName = name}) = 268 | A.object $ 269 | [ "content" A..= content, 270 | "role" A..= role 271 | ] ++ catMaybes 272 | [ ("function_call" A..=) <$> functionCall, 273 | ("name" A..=) <$> name 274 | ] 275 | 276 | data ChatFunction = ChatFunction 277 | { chfName :: T.Text, 278 | chfDescription :: T.Text, 279 | chfParameters :: A.Value 280 | } 281 | deriving (Show, Eq) 282 | 283 | data ChatFunctionCallStrategy = 284 | CFCS_auto 285 | | CFCS_none 286 | | CFCS_name T.Text 287 | deriving (Show, Eq) 288 | 289 | instance ToJSON ChatFunctionCallStrategy where 290 | toJSON = \case 291 | CFCS_auto -> A.String "auto" 292 | CFCS_none -> A.String "none" 293 | CFCS_name functionName -> A.object [ "name" A..= A.toJSON functionName ] 294 | 295 | instance FromJSON ChatFunctionCallStrategy where 296 | parseJSON (A.String "auto") = pure CFCS_auto 297 | parseJSON (A.String "none") = pure CFCS_none 298 | parseJSON xs = flip (A.withObject "ChatFunctionCallStrategy") xs $ \o -> do 299 | functionName <- o A..: "name" 300 | pure $ CFCS_name functionName 301 | 302 | data ChatCompletionRequest = ChatCompletionRequest 303 | { chcrModel :: ModelId, 304 | chcrMessages :: [ChatMessage], 305 | chcrFunctions :: Maybe [ChatFunction], 306 | chcrFunctionCall :: Maybe ChatFunctionCallStrategy, 307 | chcrTemperature :: Maybe Double, 308 | chcrTopP :: Maybe Double, 309 | chcrN :: Maybe Int, 310 | chcrSeed :: Maybe Int, 311 | chcrStream :: Maybe Bool, 312 | chcrStop :: Maybe (V.Vector T.Text), 313 | chcrMaxTokens :: Maybe Int, 314 | chcrPresencePenalty :: Maybe Double, 315 | chcrResponseFormat :: Maybe ChatResponseFormat, 316 | chcrFrequencyPenalty :: Maybe Double, 317 | chcrLogitBias :: Maybe (V.Vector Double), 318 | chcrUser :: Maybe String 319 | } 320 | deriving (Show, Eq) 321 | 322 | data ChatResponseFormat 323 | = RF_text 324 | | RF_json_object 325 | deriving (Show, Eq) 326 | 327 | instance ToJSON ChatResponseFormat where 328 | toJSON = \case 329 | RF_text -> A.object [ "type" A..= A.String "text" ] 330 | RF_json_object -> A.object [ "type" A..= A.String "json_object" ] 331 | 332 | instance FromJSON ChatResponseFormat where 333 | parseJSON = A.withObject "ChatResponseFormat" $ \o -> do 334 | rt <- o A..: "type" 335 | case rt of 336 | "text" 337 | -> pure RF_text 338 | "json_object" 339 | -> pure RF_json_object 340 | xs 341 | -> fail $ "ChatResponseFormat unexpected type: " <> T.unpack xs 342 | 343 | defaultChatCompletionRequest :: ModelId -> [ChatMessage] -> ChatCompletionRequest 344 | defaultChatCompletionRequest model messages = 345 | ChatCompletionRequest 346 | { chcrModel = model, 347 | chcrMessages = messages, 348 | chcrFunctions = Nothing, 349 | chcrFunctionCall = Nothing, 350 | chcrTemperature = Nothing, 351 | chcrTopP = Nothing, 352 | chcrN = Nothing, 353 | chcrSeed = Nothing, 354 | chcrStream = Nothing, 355 | chcrStop = Nothing, 356 | chcrMaxTokens = Nothing, 357 | chcrPresencePenalty = Nothing, 358 | chcrResponseFormat = Nothing, 359 | chcrFrequencyPenalty = Nothing, 360 | chcrLogitBias = Nothing, 361 | chcrUser = Nothing 362 | } 363 | 364 | data ChatChoice = ChatChoice 365 | { chchIndex :: Int, 366 | chchMessage :: ChatMessage, 367 | chchFinishReason :: Maybe T.Text 368 | } 369 | deriving (Show, Eq) 370 | 371 | data ChatResponse = ChatResponse 372 | { chrId :: T.Text, 373 | chrObject :: T.Text, 374 | chrCreated :: Int, 375 | chrChoices :: [ChatChoice], 376 | chrUsage :: Usage 377 | } 378 | 379 | $(deriveJSON (jsonOpts 3) ''ChatFunction) 380 | $(deriveJSON (jsonOpts 4) ''ChatCompletionRequest) 381 | $(deriveJSON (jsonOpts 4) ''ChatChoice) 382 | $(deriveJSON (jsonOpts 3) ''ChatResponse) 383 | 384 | ------------------------ 385 | ------ Images API 386 | ------------------------ 387 | 388 | data ImageResponseData 389 | = IRD_url T.Text 390 | | IRD_b64_json T.Text 391 | deriving (Show, Eq) 392 | 393 | instance ToJSON ImageResponseData where 394 | toJSON = \case 395 | IRD_url d -> A.object [ "url" A..= A.String d ] 396 | IRD_b64_json d -> A.object [ "b64_json" A..= A.String d ] 397 | 398 | instance FromJSON ImageResponseData where 399 | parseJSON = A.withObject "ImageResponseData" $ \o -> 400 | (IRD_url <$> (o A..: "url")) <|> 401 | (IRD_b64_json <$> (o A..: "b64_json")) <|> 402 | fail "ImageResponseData unexpected data" 403 | 404 | data ImageResponse = ImageResponse 405 | { irCreated :: TimeStamp, 406 | irData :: [ImageResponseData] 407 | } 408 | deriving (Show, Eq) 409 | 410 | $(deriveJSON (jsonOpts 2) ''ImageResponse) 411 | 412 | data ImageResponseFormat 413 | = IRF_url 414 | | IRF_b64_json 415 | deriving (Show, Eq) 416 | 417 | instance ToJSON ImageResponseFormat where 418 | toJSON = \case 419 | IRF_url -> A.String "url" 420 | IRF_b64_json -> A.String "b64_json" 421 | 422 | instance FromJSON ImageResponseFormat where 423 | parseJSON = A.withText "ImageResponseFormat" $ \t -> do 424 | case t of 425 | "url" 426 | -> pure IRF_url 427 | "b64_json" 428 | -> pure IRF_b64_json 429 | xs 430 | -> fail $ "ImageResponseFormat unexpected type: " <> T.unpack xs 431 | 432 | -- | Image create API 433 | data ImageCreate = ImageCreate 434 | { icPrompt :: T.Text, 435 | icModel :: Maybe ModelId, 436 | icN :: Maybe Int, 437 | icSize :: Maybe T.Text, 438 | icResponseFormat :: Maybe ImageResponseFormat, 439 | icUser :: Maybe T.Text 440 | } 441 | deriving (Show, Eq) 442 | 443 | $(deriveJSON (jsonOpts 2) ''ImageCreate) 444 | 445 | -- | Image edit API 446 | data ImageEditRequest = ImageEditRequest 447 | { ierImage :: T.Text, 448 | ierMask :: Maybe T.Text, 449 | ierPrompt :: T.Text, 450 | ierN :: Maybe Int, 451 | ierSize :: Maybe T.Text, 452 | ierResponseFormat :: Maybe T.Text, 453 | ierUser :: Maybe T.Text 454 | } 455 | deriving (Show, Eq) 456 | 457 | $(deriveJSON (jsonOpts 3) ''ImageEditRequest) 458 | 459 | -- | Image variation API 460 | data ImageVariationRequest = ImageVariationRequest 461 | { ivrImage :: T.Text, 462 | ivrN :: Maybe Int, 463 | ivrSize :: Maybe T.Text, 464 | ivrResponseFormat :: Maybe T.Text, 465 | ivrUser :: Maybe T.Text 466 | } 467 | deriving (Show, Eq) 468 | 469 | $(deriveJSON (jsonOpts 3) ''ImageVariationRequest) 470 | 471 | ------------------------ 472 | ------ Embeddings API 473 | ------------------------ 474 | 475 | data EmbeddingCreate = EmbeddingCreate 476 | { embcModel :: ModelId, 477 | embcInput :: T.Text, -- TODO (2023.02.23): Extend to allow taking in array of strings or token arrays 478 | embcUser :: Maybe T.Text 479 | } 480 | deriving (Show, Eq) 481 | 482 | data EmbeddingResponseData = EmbeddingResponseData 483 | { embdObject :: T.Text, 484 | embdEmbedding :: V.Vector Double, 485 | embdIndex :: Int 486 | } 487 | deriving (Show, Eq) 488 | 489 | data EmbeddingUsage = EmbeddingUsage 490 | { embuPromptTokens :: Int, 491 | embuTotalTokens :: Int 492 | } 493 | deriving (Show, Eq) 494 | 495 | data EmbeddingResponse = EmbeddingResponse 496 | { embrObject :: T.Text, 497 | embrData :: [EmbeddingResponseData], 498 | embrModel :: ModelId, 499 | embrUsage :: EmbeddingUsage 500 | } 501 | deriving (Show, Eq) 502 | 503 | $(deriveJSON (jsonOpts 4) ''EmbeddingCreate) 504 | $(deriveJSON (jsonOpts 4) ''EmbeddingResponseData) 505 | $(deriveJSON (jsonOpts 4) ''EmbeddingUsage) 506 | $(deriveJSON (jsonOpts 4) ''EmbeddingResponse) 507 | 508 | ------------------------ 509 | ------ Audio API 510 | ------------------------ 511 | 512 | data AudioResponseData = AudioResponseData 513 | { audrdText :: T.Text 514 | } 515 | deriving (Show, Eq) 516 | 517 | $(deriveJSON (jsonOpts 5) ''AudioResponseData) 518 | 519 | -- | Audio create API 520 | data AudioTranscriptionRequest = AudioTranscriptionRequest 521 | { audtsrFile :: FilePath, 522 | audtsrModel :: ModelId, 523 | audtsrPrompt :: Maybe T.Text, 524 | audtsrResponseFormat :: Maybe T.Text, 525 | audtsrTemperature :: Maybe Double, 526 | audtsrLanguage :: Maybe T.Text 527 | } 528 | deriving (Show, Eq) 529 | 530 | instance ToMultipart Tmp AudioTranscriptionRequest where 531 | toMultipart atr = 532 | MultipartData 533 | ( catMaybes 534 | [ Input "model" . unModelId <$> Just (audtsrModel atr), 535 | Input "prompt" <$> audtsrPrompt atr, 536 | Input "response_format" <$> audtsrResponseFormat atr, 537 | Input "temperature" . T.pack . show <$> audtsrTemperature atr, 538 | Input "language" <$> audtsrLanguage atr 539 | ] 540 | ) 541 | [ FileData "file" (T.pack . audtsrFile $ atr) (T.decodeUtf8 . defaultMimeLookup . T.pack $ audtsrFile atr) (audtsrFile atr) 542 | ] 543 | 544 | $(deriveJSON (jsonOpts 6) ''AudioTranscriptionRequest) 545 | 546 | -- | Audio translation API 547 | data AudioTranslationRequest = AudioTranslationRequest 548 | { audtlrFile :: FilePath, 549 | audtlrModel :: ModelId, 550 | audtlrPrompt :: Maybe T.Text, 551 | audtlrResponseFormat :: Maybe T.Text, 552 | audtlrTemperature :: Maybe Double 553 | } 554 | deriving (Show, Eq) 555 | 556 | instance ToMultipart Tmp AudioTranslationRequest where 557 | toMultipart atr = 558 | MultipartData 559 | ( catMaybes 560 | [ Input "model" . unModelId <$> Just (audtlrModel atr), 561 | Input "prompt" <$> audtlrPrompt atr, 562 | Input "response_format" <$> audtlrResponseFormat atr, 563 | Input "temperature" . T.pack . show <$> audtlrTemperature atr 564 | ] 565 | ) 566 | [ FileData "file" (T.pack . audtlrFile $ atr) (T.decodeUtf8 . defaultMimeLookup . T.pack $ audtlrFile atr) (audtlrFile atr) 567 | ] 568 | 569 | $(deriveJSON (jsonOpts 6) ''AudioTranslationRequest) 570 | 571 | ------------------------ 572 | ------ Files API 573 | ------------------------ 574 | 575 | data FineTuneHunk = FineTuneHunk 576 | { fthPrompt :: T.Text, 577 | fthCompletion :: T.Text 578 | } 579 | deriving (Show, Eq) 580 | 581 | data FileHunk 582 | = FhFineTune FineTuneHunk 583 | deriving stock (Show, Eq) 584 | 585 | $(deriveJSON (jsonOpts 3) ''FineTuneHunk) 586 | 587 | newtype FileId = FileId {unFileId :: T.Text} 588 | deriving stock (Eq) 589 | deriving newtype (IsString, ToJSON, FromJSON, ToHttpApiData, Show) 590 | 591 | data File = File 592 | { fId :: FileId, 593 | fObject :: T.Text, 594 | fBytes :: Int, 595 | fCreatedAt :: TimeStamp, 596 | fFilename :: T.Text, 597 | fPurpose :: T.Text 598 | } 599 | deriving stock (Show, Eq) 600 | 601 | $(deriveJSON (jsonOpts 1) ''File) 602 | 603 | -- | File upload API 604 | data FileCreate = FileCreate 605 | { fcPurpose :: T.Text, 606 | fcDocuments :: [FileHunk] 607 | } 608 | deriving stock (Show, Eq) 609 | 610 | packDocuments :: [FileHunk] -> BSL.ByteString 611 | packDocuments docs = 612 | BSL.intercalate "\n" $ 613 | map 614 | ( \t -> A.encode $ 615 | case t of 616 | FhFineTune x -> A.toJSON x 617 | ) 618 | docs 619 | 620 | instance ToMultipart Mem FileCreate where 621 | toMultipart rfc = 622 | MultipartData 623 | [ Input "purpose" (fcPurpose rfc) 624 | ] 625 | [ FileData "file" "data.jsonl" "application/json" (packDocuments $ fcDocuments rfc) 626 | ] 627 | 628 | -- | File delete API 629 | newtype FileDeleteConfirmation = FileDeleteConfirmation 630 | { fdcId :: FileId 631 | } 632 | deriving stock (Eq) 633 | deriving newtype (IsString, Show) 634 | 635 | 636 | $(deriveJSON (jsonOpts 3) ''FileDeleteConfirmation) 637 | 638 | -- | File retrieve API 639 | -- TODO 640 | 641 | -- | File retrieve content API 642 | -- TODO 643 | 644 | ------------------------ 645 | ------ Engine API (deprecated) 646 | ------------------------ 647 | 648 | newtype EngineId = EngineId {unEngineId :: T.Text} 649 | deriving stock (Eq) 650 | deriving newtype (IsString, ToJSON, FromJSON, ToHttpApiData, Show) 651 | 652 | data Engine = Engine 653 | { eId :: EngineId, 654 | eOwner :: T.Text, 655 | eReady :: Bool 656 | } 657 | deriving stock (Show, Eq) 658 | 659 | $(deriveJSON (jsonOpts 1) ''Engine) 660 | 661 | ------------------------ 662 | ------ Engine completions API (deprecated) 663 | ------------------------ 664 | 665 | newtype TextCompletionId = TextCompletionId {unTextCompletionId :: T.Text} 666 | deriving stock (Eq) 667 | deriving newtype (IsString, ToJSON, FromJSON, ToHttpApiData, Show) 668 | 669 | data TextCompletionChoice = TextCompletionChoice 670 | { tccText :: T.Text, 671 | tccIndex :: Int, 672 | tccLogProps :: Maybe Int, 673 | tccFinishReason :: T.Text 674 | } 675 | deriving stock (Show, Eq) 676 | 677 | data TextCompletion = TextCompletion 678 | { tcId :: TextCompletionId, 679 | tcCreated :: TimeStamp, 680 | tcModel :: T.Text, 681 | tcChoices :: V.Vector TextCompletionChoice 682 | } 683 | deriving stock (Show, Eq) 684 | 685 | data TextCompletionCreate = TextCompletionCreate 686 | { tccrPrompt :: T.Text, -- TODO: support lists of strings 687 | tccrMaxTokens :: Maybe Int, 688 | tccrTemperature :: Maybe Double, 689 | tccrTopP :: Maybe Double, 690 | tccrN :: Maybe Int, 691 | tccrLogprobs :: Maybe Int, 692 | tccrEcho :: Maybe Bool, 693 | tccrStop :: Maybe (V.Vector T.Text), 694 | tccrPresencePenalty :: Maybe Double, 695 | tccrFrequencyPenalty :: Maybe Double, 696 | tccrBestOf :: Maybe Int 697 | } 698 | deriving stock (Show, Eq) 699 | 700 | -- | Applies API defaults, only passing a prompt. 701 | defaultEngineTextCompletionCreate :: T.Text -> TextCompletionCreate 702 | defaultEngineTextCompletionCreate prompt = 703 | TextCompletionCreate 704 | { tccrPrompt = prompt, 705 | tccrMaxTokens = Nothing, 706 | tccrTemperature = Nothing, 707 | tccrTopP = Nothing, 708 | tccrN = Nothing, 709 | tccrLogprobs = Nothing, 710 | tccrEcho = Nothing, 711 | tccrStop = Nothing, 712 | tccrPresencePenalty = Nothing, 713 | tccrFrequencyPenalty = Nothing, 714 | tccrBestOf = Nothing 715 | } 716 | 717 | $(deriveJSON (jsonOpts 3) ''TextCompletionChoice) 718 | $(deriveJSON (jsonOpts 2) ''TextCompletion) 719 | $(deriveJSON (jsonOpts 4) ''TextCompletionCreate) 720 | 721 | ------------------------ 722 | ------ EngineEmbeddings API (deprecated) 723 | ------------------------ 724 | 725 | newtype EngineEmbeddingCreate = EngineEmbeddingCreate 726 | {enecInput :: T.Text} 727 | deriving stock (Eq) 728 | deriving newtype (IsString, Show) 729 | 730 | data EngineEmbedding = EngineEmbedding 731 | {eneEmbedding :: V.Vector Double, eneIndex :: Int} 732 | deriving stock (Show, Eq) 733 | 734 | $(deriveJSON (jsonOpts 4) ''EngineEmbeddingCreate) 735 | $(deriveJSON (jsonOpts 3) ''EngineEmbedding) 736 | 737 | ------------------------ 738 | ------ Old stuff; not touching 739 | ------ TODO 2023.03.22: Not touching this; unchanged since last year 740 | ------------------------ 741 | 742 | newtype FineTuneId = FineTuneId {unFineTuneId :: T.Text} 743 | deriving stock (Eq) 744 | deriving newtype (IsString, ToJSON, FromJSON, ToHttpApiData, Show) 745 | 746 | data FineTuneCreate = FineTuneCreate 747 | { ftcTrainingFile :: FileId, 748 | ftcValidationFile :: Maybe FileId, 749 | ftcModel :: Maybe T.Text, 750 | ftcBatchSize :: Maybe Int, 751 | ftcNEpochs :: Maybe T.Text, 752 | ftcLearningRateMultiplier :: Maybe Double, 753 | ftcPromptLossWeight :: Maybe Double, 754 | ftcComputeClassificationMetrics :: Maybe Bool, 755 | ftcClassificationNClasses :: Maybe Int, 756 | ftcClassificationPositiveClass :: Maybe T.Text 757 | } 758 | deriving stock (Show, Eq) 759 | 760 | defaultFineTuneCreate :: FileId -> FineTuneCreate 761 | defaultFineTuneCreate file = 762 | FineTuneCreate 763 | { ftcTrainingFile = file, 764 | ftcValidationFile = Nothing, 765 | ftcModel = Nothing, 766 | ftcBatchSize = Nothing, 767 | ftcNEpochs = Nothing, 768 | ftcLearningRateMultiplier = Nothing, 769 | ftcPromptLossWeight = Nothing, 770 | ftcComputeClassificationMetrics = Nothing, 771 | ftcClassificationNClasses = Nothing, 772 | ftcClassificationPositiveClass = Nothing 773 | } 774 | 775 | data FineTuneEvent = FineTuneEvent 776 | { fteCreatedAt :: Int, 777 | fteLevel :: T.Text, 778 | fteMessage :: T.Text 779 | } 780 | deriving stock (Show, Eq) 781 | 782 | data FineTune = FineTune 783 | { ftId :: FineTuneId, 784 | ftModel :: T.Text, 785 | ftCreatedAt :: Int, 786 | ftEvents :: V.Vector FineTuneEvent, 787 | ftTunedModel :: Maybe T.Text, 788 | ftStatus :: T.Text 789 | } 790 | deriving stock (Show, Eq) 791 | 792 | $(deriveJSON (jsonOpts 3) ''FineTuneCreate) 793 | $(deriveJSON (jsonOpts 3) ''FineTuneEvent) 794 | $(deriveJSON (jsonOpts 2) ''FineTune) 795 | -------------------------------------------------------------------------------- /scripts/make-release.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | set -euo pipefail 3 | 4 | if [[ -n $(git status -s) ]]; then 5 | echo "Working directory has changes. Commit them first." 6 | exit 1 7 | fi 8 | 9 | VERSION="$1" 10 | 11 | echo "Bumping version to $VERSION ..." 12 | 13 | find . -name 'package.yaml' -type f -exec sed -i '' "s/^version:.*/version: $VERSION/g" {} + 14 | 15 | stack build --fast --pedantic 16 | 17 | git add . 18 | git commit -m "version bump" 19 | 20 | stack upload openai-hs 21 | stack upload openai-servant 22 | 23 | git tag -a "$VERSION" -m "Hackage version $VERSION" 24 | git push 25 | git push --tags 26 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: 2 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/28.yaml 3 | packages: 4 | - openai-hs 5 | - openai-servant 6 | extra-deps: 7 | -------------------------------------------------------------------------------- /stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: [] 7 | snapshots: 8 | - completed: 9 | sha256: 87da71cb0ae9ee1ea1bf51a8eb9812f39f779be76abc0a3c926defd8afda05d1 10 | size: 719139 11 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/28.yaml 12 | original: 13 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/28.yaml 14 | --------------------------------------------------------------------------------