diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Alexander Thiemann (c) 2020 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,5 @@ +# openai-servant + +Unofficial description of the OpenAI API using servant types. Contributions are welcome! + +For usage, see the [openai-hs](https://hackage.haskell.org/package/openai-hs) package. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/openai-servant.cabal b/openai-servant.cabal new file mode 100644 --- /dev/null +++ b/openai-servant.cabal @@ -0,0 +1,48 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.33.0. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 7d9611438da3fd219c80f23301bed8d6b0ed55b71c59d82b976a6e0704630db3 + +name: openai-servant +version: 0.1.0.0 +synopsis: Unofficial OpenAI servant types +description: Unofficial description of the OpenAI API using servant types +category: Web +homepage: https://github.com/agrafix/openai-hs#readme +bug-reports: https://github.com/agrafix/openai-hs/issues +author: Alexander Thiemann +maintainer: Alexander Thiemann +copyright: 2021 Alexander Thiemann +license: BSD3 +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + +source-repository head + type: git + location: https://github.com/agrafix/openai-hs + +library + exposed-modules: + OpenAI.Api + OpenAI.Internal.Aeson + OpenAI.Resources + other-modules: + Paths_openai_servant + hs-source-dirs: + src + default-extensions: OverloadedStrings DataKinds TypeOperators TypeFamilies GADTs FlexibleInstances FlexibleContexts MultiParamTypeClasses StrictData ScopedTypeVariables DeriveGeneric DeriveFunctor + ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates + build-depends: + aeson + , base >=4.7 && <5 + , casing + , servant + , text + , time + , vector + default-language: Haskell2010 diff --git a/src/OpenAI/Api.hs b/src/OpenAI/Api.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/Api.hs @@ -0,0 +1,21 @@ +-- | The API + +module OpenAI.Api where + +import OpenAI.Resources + +import Servant.API + +type OpenAIAuth = BasicAuth "OpenAI API" () + +type OpenAIApi + = "v1" :> OpenAIApiInternal + +type OpenAIApiInternal + = "engines" :> EnginesApi + +type EnginesApi + = OpenAIAuth :> Get '[JSON] (OpenAIList Engine) + :<|> OpenAIAuth :> Capture "engine_id" EngineId :> Get '[JSON] Engine + :<|> OpenAIAuth :> Capture "engine_id" EngineId :> "completions" :> ReqBody '[JSON] TextCompletionCreate :> Post '[JSON] TextCompletion + :<|> OpenAIAuth :> Capture "engine_id" EngineId :> "search" :> ReqBody '[JSON] SearchResultCreate :> Post '[JSON] (OpenAIList SearchResult) diff --git a/src/OpenAI/Internal/Aeson.hs b/src/OpenAI/Internal/Aeson.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/Internal/Aeson.hs @@ -0,0 +1,17 @@ +-- | + +module OpenAI.Internal.Aeson + ( jsonOpts, deriveJSON, ToJSON, FromJSON ) +where + +import Data.Aeson +import Data.Aeson.TH +import Text.Casing (quietSnake) + +jsonOpts :: Int -> Options +jsonOpts x = + defaultOptions + { fieldLabelModifier = quietSnake . drop x + , constructorTagModifier = quietSnake + , omitNothingFields = True + } diff --git a/src/OpenAI/Resources.hs b/src/OpenAI/Resources.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/Resources.hs @@ -0,0 +1,142 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +module OpenAI.Resources + ( -- * Core Types + TimeStamp(..), OpenAIList(..) + -- * Engine + , EngineId(..), Engine(..) + -- * Text completion + , TextCompletionId(..), TextCompletionChoice(..), TextCompletion(..), TextCompletionCreate(..) + , defaultTextCompletionCreate + -- * Searching + , SearchResult(..), SearchResultCreate(..) + ) +where + +import OpenAI.Internal.Aeson + +import Data.Time +import Data.Time.Clock.POSIX +import Servant.API +import qualified Data.Aeson as A +import qualified Data.Text as T +import qualified Data.Vector as V + +-- | A 'UTCTime' wrapper that has unix timestamp JSON representation +newtype TimeStamp + = TimeStamp { unTimeStamp :: UTCTime } + deriving (Show, Eq) + +instance A.ToJSON TimeStamp where + toJSON = A.Number . fromRational . toRational . utcTimeToPOSIXSeconds . unTimeStamp + +instance A.FromJSON TimeStamp where + parseJSON = + A.withScientific "unix timestamp" $ \sci -> + pure $ TimeStamp $ posixSecondsToUTCTime (fromRational $ toRational sci) + +instance ToHttpApiData TimeStamp where + toUrlPiece x = + let unix :: Int + unix = round . utcTimeToPOSIXSeconds . unTimeStamp $ x + in T.pack (show unix) + +-- | A 'V.Vector' wrapper. +newtype OpenAIList a + = OpenAIList + { olData :: V.Vector a + } deriving (Show, Eq, Functor) + +instance Semigroup (OpenAIList a) where + (<>) a b = OpenAIList (olData a <> olData b) + +instance Monoid (OpenAIList a) where + mempty = OpenAIList mempty + +instance Applicative OpenAIList where + pure = OpenAIList . pure + (<*>) go x = OpenAIList (olData go <*> olData x) + +newtype EngineId + = EngineId { unEngineId :: T.Text } + deriving (Show, Eq, ToJSON, FromJSON, ToHttpApiData) + +data Engine + = Engine + { eId :: EngineId + , eOwner :: T.Text + , eReady :: Bool + } deriving (Show, Eq) + + +newtype TextCompletionId + = TextCompletionId { unTextCompletionId :: T.Text } + deriving (Show, Eq, ToJSON, FromJSON, ToHttpApiData) + +data TextCompletionChoice + = TextCompletionChoice + { tccText :: T.Text + , tccIndex :: Int + , tccLogProps :: Maybe Int + , tccFinishReason :: T.Text + } deriving (Show, Eq) + +data TextCompletion + = TextCompletion + { tcId :: TextCompletionId + , tcCreated :: TimeStamp + , tcModel :: T.Text + , tcChoices :: V.Vector TextCompletionChoice + } deriving (Show, Eq) + +data TextCompletionCreate + = TextCompletionCreate + { tccrPrompt :: T.Text -- TODO: support lists of strings + , tccrMaxTokens :: Maybe Int + , tccrTemperature :: Maybe Double + , tccrTopP :: Maybe Double + , tccrN :: Maybe Int + , tccrLogprobs :: Maybe Int + , tccrEcho :: Maybe Bool + , tccrStop :: Maybe (V.Vector T.Text) + , tccrPresencePenalty :: Maybe Double + , tccrFrequencyPenalty :: Maybe Double + , tccrBestOf :: Maybe Int + } deriving (Show, Eq) + +-- | Applies API defaults, only passing a prompt. +defaultTextCompletionCreate :: T.Text -> TextCompletionCreate +defaultTextCompletionCreate prompt = + TextCompletionCreate + { tccrPrompt = prompt + , tccrMaxTokens = Nothing + , tccrTemperature = Nothing + , tccrTopP = Nothing + , tccrN = Nothing + , tccrLogprobs = Nothing + , tccrEcho = Nothing + , tccrStop = Nothing + , tccrPresencePenalty = Nothing + , tccrFrequencyPenalty = Nothing + , tccrBestOf = Nothing + } + +data SearchResult + = SearchResult + { srDocument :: Int + , srScore :: Double + } deriving (Show, Eq) + +data SearchResultCreate + = SearchResultCreate + { sccrDocuments :: V.Vector T.Text + , sccrQuery :: T.Text + } deriving (Show, Eq) + +$(deriveJSON (jsonOpts 2) ''OpenAIList) +$(deriveJSON (jsonOpts 1) ''Engine) +$(deriveJSON (jsonOpts 2) ''TextCompletion) +$(deriveJSON (jsonOpts 3) ''TextCompletionChoice) +$(deriveJSON (jsonOpts 4) ''TextCompletionCreate) +$(deriveJSON (jsonOpts 2) ''SearchResult) +$(deriveJSON (jsonOpts 4) ''SearchResultCreate)