module Claude.V1
(
Methods(..)
, getClientEnv
, makeMethods
, makeMethodsWith
, ClientOptions(..)
, defaultClientOptions
, API
) where
import Claude.Prelude
import Claude.V1.Messages
( CountTokensRequest
, CreateMessage
, MessageResponse
, MessageStreamEvent
, TokenCount
)
import Claude.V1.Messages.Batches
(BatchObject, CreateBatch, ListBatchesResponse)
import Control.Monad (foldM)
import Data.ByteString.Char8 ()
import Data.Proxy (Proxy(..))
import Servant.Client (ClientEnv)
import qualified Claude.V1.Messages as Messages
import qualified Claude.V1.Messages.Batches as Batches
import qualified Control.Exception as Exception
import qualified Data.Aeson as Aeson
import qualified Data.ByteString as SBS
import qualified Data.ByteString.Char8 as S8
import qualified Data.IORef as IORef
import qualified Data.Text as Text
import qualified Data.Text.Lazy as Text.Lazy
import qualified Data.Text.Lazy.Builder as Builder
import qualified Data.Text.Lazy.Builder.Int as Int
import qualified Network.HTTP.Client as HTTP.Client
import qualified Network.HTTP.Client.TLS as TLS
import qualified Network.HTTP.Types.Status as Status
import qualified Servant.Client as Client
getClientEnv
:: Text
-> IO ClientEnv
getClientEnv :: Text -> IO ClientEnv
getClientEnv Text
baseUrlText = do
BaseUrl
baseUrl <- String -> IO BaseUrl
forall (m :: * -> *). MonadThrow m => String -> m BaseUrl
Client.parseBaseUrl (Text -> String
Text.unpack Text
baseUrlText)
let managerSettings :: ManagerSettings
managerSettings = ManagerSettings
TLS.tlsManagerSettings
{ HTTP.Client.managerResponseTimeout =
HTTP.Client.responseTimeoutNone
}
Manager
manager <- ManagerSettings -> IO Manager
forall (m :: * -> *). MonadIO m => ManagerSettings -> m Manager
TLS.newTlsManagerWith ManagerSettings
managerSettings
ClientEnv -> IO ClientEnv
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Manager -> BaseUrl -> ClientEnv
Client.mkClientEnv Manager
manager BaseUrl
baseUrl)
data ClientOptions = ClientOptions
{ ClientOptions -> Text
apiKey :: Text
, ClientOptions -> Maybe Text
anthropicVersion :: Maybe Text
, ClientOptions -> Maybe Text
anthropicBeta :: Maybe Text
} deriving stock (Int -> ClientOptions -> ShowS
[ClientOptions] -> ShowS
ClientOptions -> String
(Int -> ClientOptions -> ShowS)
-> (ClientOptions -> String)
-> ([ClientOptions] -> ShowS)
-> Show ClientOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClientOptions -> ShowS
showsPrec :: Int -> ClientOptions -> ShowS
$cshow :: ClientOptions -> String
show :: ClientOptions -> String
$cshowList :: [ClientOptions] -> ShowS
showList :: [ClientOptions] -> ShowS
Show)
defaultClientOptions :: ClientOptions
defaultClientOptions :: ClientOptions
defaultClientOptions = ClientOptions
{ apiKey :: Text
apiKey = Text
""
, anthropicVersion :: Maybe Text
anthropicVersion = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"2023-06-01"
, anthropicBeta :: Maybe Text
anthropicBeta = Maybe Text
forall a. Maybe a
Nothing
}
makeMethods
:: ClientEnv
-> Text
-> Maybe Text
-> Methods
makeMethods :: ClientEnv -> Text -> Maybe Text -> Methods
makeMethods ClientEnv
clientEnv Text
key Maybe Text
version =
ClientEnv -> ClientOptions -> Methods
makeMethodsWith ClientEnv
clientEnv ClientOptions
{ apiKey :: Text
apiKey = Text
key
, anthropicVersion :: Maybe Text
anthropicVersion = Maybe Text
version
, anthropicBeta :: Maybe Text
anthropicBeta = Maybe Text
forall a. Maybe a
Nothing
}
makeMethodsWith
:: ClientEnv
-> ClientOptions
-> Methods
makeMethodsWith :: ClientEnv -> ClientOptions -> Methods
makeMethodsWith ClientEnv
clientEnv ClientOptions{ Text
apiKey :: ClientOptions -> Text
apiKey :: Text
apiKey, Maybe Text
anthropicVersion :: ClientOptions -> Maybe Text
anthropicVersion :: Maybe Text
anthropicVersion, Maybe Text
anthropicBeta :: ClientOptions -> Maybe Text
anthropicBeta :: Maybe Text
anthropicBeta } = Methods{Maybe Natural -> Maybe Text -> Maybe Text -> IO ListBatchesResponse
Text -> IO BatchObject
CountTokensRequest -> IO TokenCount
CreateMessage -> IO MessageResponse
CreateMessage -> (Either Text Value -> IO ()) -> IO ()
CreateMessage -> (Either Text MessageStreamEvent -> IO ()) -> IO ()
CreateBatch -> IO BatchObject
createMessage :: CreateMessage -> IO MessageResponse
countTokens :: CountTokensRequest -> IO TokenCount
createBatch :: CreateBatch -> IO BatchObject
retrieveBatch :: Text -> IO BatchObject
listBatches :: Maybe Natural -> Maybe Text -> Maybe Text -> IO ListBatchesResponse
cancelBatch :: Text -> IO BatchObject
createMessageStream :: CreateMessage -> (Either Text Value -> IO ()) -> IO ()
createMessageStreamTyped :: CreateMessage -> (Either Text MessageStreamEvent -> IO ()) -> IO ()
cancelBatch :: Text -> IO BatchObject
listBatches :: Maybe Natural -> Maybe Text -> Maybe Text -> IO ListBatchesResponse
retrieveBatch :: Text -> IO BatchObject
createBatch :: CreateBatch -> IO BatchObject
countTokens :: CountTokensRequest -> IO TokenCount
createMessageStreamTyped :: CreateMessage -> (Either Text MessageStreamEvent -> IO ()) -> IO ()
createMessageStream :: CreateMessage -> (Either Text Value -> IO ()) -> IO ()
createMessage :: CreateMessage -> IO MessageResponse
..}
where
((CreateMessage -> IO MessageResponse
createMessage_ :<|> CountTokensRequest -> IO TokenCount
countTokens_) :<|> (CreateBatch -> IO BatchObject
createBatch_ :<|> Text -> IO BatchObject
retrieveBatch_ :<|> Maybe Natural -> Maybe Text -> Maybe Text -> IO ListBatchesResponse
listBatches_ :<|> Text -> IO BatchObject
cancelBatch_)) =
forall api (m :: * -> *) (n :: * -> *).
HasClient ClientM api =>
Proxy api -> (forall a. m a -> n a) -> Client m api -> Client n api
Client.hoistClient @API Proxy API
forall {k} (t :: k). Proxy t
Proxy ClientM a -> IO a
forall a. ClientM a -> IO a
run (forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
Client.client @API Proxy API
forall {k} (t :: k). Proxy t
Proxy) Text
apiKey Maybe Text
anthropicVersion Maybe Text
anthropicBeta
run :: Client.ClientM a -> IO a
run :: forall a. ClientM a -> IO a
run ClientM a
clientM = do
Either ClientError a
result <- ClientM a -> ClientEnv -> IO (Either ClientError a)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
Client.runClientM ClientM a
clientM ClientEnv
clientEnv
case Either ClientError a
result of
Left ClientError
exception -> ClientError -> IO a
forall e a. Exception e => e -> IO a
Exception.throwIO ClientError
exception
Right a
a -> a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
createMessage :: CreateMessage -> IO MessageResponse
createMessage = CreateMessage -> IO MessageResponse
createMessage_
countTokens :: CountTokensRequest -> IO TokenCount
countTokens = CountTokensRequest -> IO TokenCount
countTokens_
createBatch :: CreateBatch -> IO BatchObject
createBatch = CreateBatch -> IO BatchObject
createBatch_
retrieveBatch :: Text -> IO BatchObject
retrieveBatch = Text -> IO BatchObject
retrieveBatch_
listBatches :: Maybe Natural -> Maybe Text -> Maybe Text -> IO ListBatchesResponse
listBatches = Maybe Natural -> Maybe Text -> Maybe Text -> IO ListBatchesResponse
listBatches_
cancelBatch :: Text -> IO BatchObject
cancelBatch = Text -> IO BatchObject
cancelBatch_
createMessageStream :: CreateMessage -> (Either Text Value -> IO ()) -> IO ()
createMessageStream CreateMessage
req Either Text Value -> IO ()
onEvent = do
let req' :: CreateMessage
req' = CreateMessage
req{ Messages.stream = Just True }
String -> CreateMessage -> (Either Text Value -> IO ()) -> IO ()
forall a.
ToJSON a =>
String -> a -> (Either Text Value -> IO ()) -> IO ()
ssePostJSON String
"/v1/messages" CreateMessage
req' Either Text Value -> IO ()
onEvent
createMessageStreamTyped
:: CreateMessage
-> (Either Text MessageStreamEvent -> IO ())
-> IO ()
createMessageStreamTyped :: CreateMessage -> (Either Text MessageStreamEvent -> IO ()) -> IO ()
createMessageStreamTyped CreateMessage
req Either Text MessageStreamEvent -> IO ()
onEvent =
CreateMessage -> (Either Text Value -> IO ()) -> IO ()
createMessageStream CreateMessage
req ((Either Text Value -> IO ()) -> IO ())
-> (Either Text Value -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Either Text Value
ev -> case Either Text Value
ev of
Left Text
err -> Either Text MessageStreamEvent -> IO ()
onEvent (Text -> Either Text MessageStreamEvent
forall a b. a -> Either a b
Left Text
err)
Right Value
val -> case Value -> Result MessageStreamEvent
forall a. FromJSON a => Value -> Result a
Aeson.fromJSON Value
val of
Aeson.Error String
msg -> Either Text MessageStreamEvent -> IO ()
onEvent (Text -> Either Text MessageStreamEvent
forall a b. a -> Either a b
Left (String -> Text
Text.pack String
msg))
Aeson.Success MessageStreamEvent
e -> Either Text MessageStreamEvent -> IO ()
onEvent (MessageStreamEvent -> Either Text MessageStreamEvent
forall a b. b -> Either a b
Right MessageStreamEvent
e)
ssePostJSON :: ToJSON a
=> String
-> a
-> (Either Text Aeson.Value -> IO ())
-> IO ()
ssePostJSON :: forall a.
ToJSON a =>
String -> a -> (Either Text Value -> IO ()) -> IO ()
ssePostJSON String
path a
body Either Text Value -> IO ()
onEvent = do
let base :: BaseUrl
base = ClientEnv -> BaseUrl
Client.baseUrl ClientEnv
clientEnv
let secure :: Bool
secure = case BaseUrl -> Scheme
Client.baseUrlScheme BaseUrl
base of
Scheme
Client.Http -> Bool
False
Scheme
Client.Https -> Bool
True
let host :: ByteString
host = String -> ByteString
S8.pack (BaseUrl -> String
Client.baseUrlHost BaseUrl
base)
let port :: Int
port = BaseUrl -> Int
Client.baseUrlPort BaseUrl
base
let basePath :: String
basePath = BaseUrl -> String
Client.baseUrlPath BaseUrl
base
let fullPath :: ByteString
fullPath = String -> ByteString
S8.pack (ShowS
normalizePath String
basePath String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
path)
let headers0 :: [(HeaderName, ByteString)]
headers0 =
[ (HeaderName
"x-api-key", String -> ByteString
S8.pack (Text -> String
Text.unpack Text
apiKey))
, (HeaderName
"Accept", ByteString
"text/event-stream")
, (HeaderName
"Content-Type", ByteString
"application/json")
]
let headers1 :: [(HeaderName, ByteString)]
headers1 = case Maybe Text
anthropicVersion of
Maybe Text
Nothing -> [(HeaderName, ByteString)]
headers0
Just Text
v -> (HeaderName
"anthropic-version", String -> ByteString
S8.pack (Text -> String
Text.unpack Text
v)) (HeaderName, ByteString)
-> [(HeaderName, ByteString)] -> [(HeaderName, ByteString)]
forall a. a -> [a] -> [a]
: [(HeaderName, ByteString)]
headers0
let headers :: [(HeaderName, ByteString)]
headers = case Maybe Text
anthropicBeta of
Maybe Text
Nothing -> [(HeaderName, ByteString)]
headers1
Just Text
b -> (HeaderName
"anthropic-beta", String -> ByteString
S8.pack (Text -> String
Text.unpack Text
b)) (HeaderName, ByteString)
-> [(HeaderName, ByteString)] -> [(HeaderName, ByteString)]
forall a. a -> [a] -> [a]
: [(HeaderName, ByteString)]
headers1
let request :: Request
request = Request
HTTP.Client.defaultRequest
{ HTTP.Client.secure = secure
, HTTP.Client.host = host
, HTTP.Client.port = port
, HTTP.Client.method = "POST"
, HTTP.Client.path = fullPath
, HTTP.Client.requestHeaders = headers
, HTTP.Client.requestBody = HTTP.Client.RequestBodyLBS (Aeson.encode body)
, HTTP.Client.responseTimeout = HTTP.Client.responseTimeoutNone
}
Request -> Manager -> (Response BodyReader -> IO ()) -> IO ()
forall a.
Request -> Manager -> (Response BodyReader -> IO a) -> IO a
HTTP.Client.withResponse Request
request (ClientEnv -> Manager
Client.manager ClientEnv
clientEnv) ((Response BodyReader -> IO ()) -> IO ())
-> (Response BodyReader -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Response BodyReader
response -> do
let st :: Status
st = Response BodyReader -> Status
forall body. Response body -> Status
HTTP.Client.responseStatus Response BodyReader
response
if Bool -> Bool
not (Status -> Bool
Status.statusIsSuccessful Status
st)
then do
[ByteString]
bodyChunks <- BodyReader -> IO [ByteString]
HTTP.Client.brConsume (Response BodyReader -> BodyReader
forall body. Response body -> body
HTTP.Client.responseBody Response BodyReader
response)
let errBody :: ByteString
errBody = [ByteString] -> ByteString
SBS.concat [ByteString]
bodyChunks
let msg :: Text
msg =
Text
"HTTP error "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall number. Integral number => number -> Text
renderIntegral (Status -> Int
Status.statusCode Status
st)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
Text.pack (ByteString -> String
S8.unpack (Status -> ByteString
Status.statusMessage Status
st)))
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if ByteString -> Bool
SBS.null ByteString
errBody then Text
"" else Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (ByteString -> String
S8.unpack ByteString
errBody))
Either Text Value -> IO ()
onEvent (Text -> Either Text Value
forall a b. a -> Either a b
Left Text
msg)
else do
let br :: BodyReader
br = Response BodyReader -> BodyReader
forall body. Response body -> body
HTTP.Client.responseBody Response BodyReader
response
IORef ByteString
lineBufRef <- ByteString -> IO (IORef ByteString)
forall a. a -> IO (IORef a)
IORef.newIORef ByteString
SBS.empty
IORef [ByteString]
eventBufRef <- [ByteString] -> IO (IORef [ByteString])
forall a. a -> IO (IORef a)
IORef.newIORef ([] :: [SBS.ByteString])
let flushEvent :: IO Bool
flushEvent = do
[ByteString]
es <- IORef [ByteString]
-> ([ByteString] -> ([ByteString], [ByteString]))
-> IO [ByteString]
forall a b. IORef a -> (a -> (a, b)) -> IO b
IORef.atomicModifyIORef IORef [ByteString]
eventBufRef (\[ByteString]
buf -> ([], [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
buf))
if [ByteString] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ByteString]
es
then Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
else do
let payload :: ByteString
payload = [ByteString] -> ByteString
S8.concat [ByteString]
es
case (ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict ByteString
payload :: Either String Aeson.Value) of
Left String
err -> Either Text Value -> IO ()
onEvent (Text -> Either Text Value
forall a b. a -> Either a b
Left (String -> Text
Text.pack String
err)) IO () -> IO Bool -> IO Bool
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
Right Value
val -> Either Text Value -> IO ()
onEvent (Value -> Either Text Value
forall a b. b -> Either a b
Right Value
val) IO () -> IO Bool -> IO Bool
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
let handleLine :: ByteString -> IO Bool
handleLine ByteString
line = do
let l :: ByteString
l = ByteString -> ByteString
stripCR ByteString
line
if ByteString -> Bool
S8.null ByteString
l
then IO Bool
flushEvent
else if ByteString
"data:" ByteString -> ByteString -> Bool
`S8.isPrefixOf` ByteString
l
then do
let d :: ByteString
d = (Char -> Bool) -> ByteString -> ByteString
S8.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
' ') (Int -> ByteString -> ByteString
S8.drop Int
5 ByteString
l)
IORef [ByteString] -> ([ByteString] -> [ByteString]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
IORef.modifyIORef' IORef [ByteString]
eventBufRef (ByteString
dByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:)
Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
else Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
let loop :: IO ()
loop = do
ByteString
chunk <- BodyReader -> BodyReader
HTTP.Client.brRead BodyReader
br
if ByteString -> Bool
SBS.null ByteString
chunk
then do
Bool
_ <- IO Bool
flushEvent
() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
else do
ByteString
prev <- IORef ByteString -> BodyReader
forall a. IORef a -> IO a
IORef.readIORef IORef ByteString
lineBufRef
let combined :: ByteString
combined = ByteString
prev ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
chunk
let ls :: [ByteString]
ls = Char -> ByteString -> [ByteString]
S8.split Char
'\n' ByteString
combined
case [ByteString] -> Maybe ([ByteString], ByteString)
forall {b}. [b] -> Maybe ([b], b)
unsnoc [ByteString]
ls of
Maybe ([ByteString], ByteString)
Nothing -> IO ()
loop
Just ([ByteString]
completeLines, ByteString
lastLine) -> do
IORef ByteString -> ByteString -> IO ()
forall a. IORef a -> a -> IO ()
IORef.writeIORef IORef ByteString
lineBufRef ByteString
lastLine
Bool
stop <- (Bool -> ByteString -> IO Bool) -> Bool -> [ByteString] -> IO Bool
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\Bool
acc ByteString
ln -> if Bool
acc then Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True else ByteString -> IO Bool
handleLine ByteString
ln) Bool
False [ByteString]
completeLines
if Bool
stop then () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure () else IO ()
loop
IO ()
loop
normalizePath :: ShowS
normalizePath String
p = case String
p of
String
"" -> String
""
(Char
'/':String
_) -> String
p
String
_ -> Char
'/'Char -> ShowS
forall a. a -> [a] -> [a]
:String
p
stripCR :: ByteString -> ByteString
stripCR ByteString
bs = case ByteString -> Maybe (ByteString, Char)
S8.unsnoc ByteString
bs of
Just (ByteString
initBs, Char
'\r') -> ByteString
initBs
Maybe (ByteString, Char)
_ -> ByteString
bs
unsnoc :: [b] -> Maybe ([b], b)
unsnoc [] = Maybe ([b], b)
forall a. Maybe a
Nothing
unsnoc [b]
xs = ([b], b) -> Maybe ([b], b)
forall a. a -> Maybe a
Just ([b] -> [b]
forall a. HasCallStack => [a] -> [a]
init [b]
xs, [b] -> b
forall a. HasCallStack => [a] -> a
last [b]
xs)
renderIntegral :: Integral number => number -> Text
renderIntegral :: forall number. Integral number => number -> Text
renderIntegral number
number = LazyText -> Text
Text.Lazy.toStrict (Builder -> LazyText
Builder.toLazyText Builder
builder)
where
builder :: Builder
builder = number -> Builder
forall a. Integral a => a -> Builder
Int.decimal number
number
data Methods = Methods
{ Methods -> CreateMessage -> IO MessageResponse
createMessage :: CreateMessage -> IO MessageResponse
, Methods -> CreateMessage -> (Either Text Value -> IO ()) -> IO ()
createMessageStream
:: CreateMessage
-> (Either Text Aeson.Value -> IO ())
-> IO ()
, Methods
-> CreateMessage
-> (Either Text MessageStreamEvent -> IO ())
-> IO ()
createMessageStreamTyped
:: CreateMessage
-> (Either Text MessageStreamEvent -> IO ())
-> IO ()
, Methods -> CountTokensRequest -> IO TokenCount
countTokens :: CountTokensRequest -> IO TokenCount
, Methods -> CreateBatch -> IO BatchObject
createBatch :: CreateBatch -> IO BatchObject
, Methods -> Text -> IO BatchObject
retrieveBatch :: Text -> IO BatchObject
, Methods
-> Maybe Natural
-> Maybe Text
-> Maybe Text
-> IO ListBatchesResponse
listBatches
:: Maybe Natural
-> Maybe Text
-> Maybe Text
-> IO ListBatchesResponse
, Methods -> Text -> IO BatchObject
cancelBatch :: Text -> IO BatchObject
}
type API
= Header' [ Required, Strict ] "x-api-key" Text
:> Header' [ Optional, Strict ] "anthropic-version" Text
:> Header' [ Optional, Strict ] "anthropic-beta" Text
:> "v1"
:> (Messages.API :<|> Batches.API)