ihp-openai: Improved error message when openai quota is exceeded

ihp-openai/IHP/OpenAI.hs

@@ -167,18 +167,30 @@ newCompletionRequest = CompletionRequest
     , tools = []
     }
 
-data CompletionResult = CompletionResult
+data CompletionResult
+    = CompletionResult
     { choices :: [Choice]
     }
+    | CompletionError
+    { message :: !Text
+    }
+    deriving (Eq, Show)
 
 instance FromJSON CompletionResult where
-    parseJSON = withObject "CompletionResult" $ \v -> CompletionResult
-        <$> v .: "choices"
+    parseJSON = withObject "CompletionResult" \v -> do
+        let result = CompletionResult <$> v .: "choices"
+        let error = do
+                errorObj <- v .: "error"
+                message <- errorObj .: "message"
+                pure CompletionError { message }
+
+        result <|> error
 
 -- [{"text": "Introdu", "index": 0, "logprobs": null, "finish_reason": null}]
 data Choice = Choice
     { text :: !Text
     }
+    deriving (Eq, Show)
 
 instance FromJSON Choice where
     parseJSON = withObject "Choice" $ \v -> do
@@ -308,15 +320,18 @@ fetchCompletion secretKey completionRequest = do
         result <- Retry.retrying retryPolicyDefault shouldRetry action
         case result of
             Left (e :: SomeException) -> Exception.throwIO e
-            Right result -> pure result
+            Right result ->
+                case result of
+                    CompletionResult { choices } -> pure (mconcat $ map (.text) choices)
+                    CompletionError { message } -> error (Text.unpack message)
     where
         shouldRetry retryStatus (Left _) = pure True
         shouldRetry retryStatus (Right _) = pure False
         action retryStatus = Exception.try (fetchCompletionWithoutRetry secretKey completionRequest)
 
         retryPolicyDefault = Retry.constantDelay 50000 <> Retry.limitRetries 10
 
-fetchCompletionWithoutRetry :: ByteString -> CompletionRequest -> IO Text
+fetchCompletionWithoutRetry :: ByteString -> CompletionRequest -> IO CompletionResult
 fetchCompletionWithoutRetry secretKey completionRequest = do
         modifyContextSSL (\context -> do
                 SSL.contextSetVerificationMode context SSL.VerifyNone
@@ -330,8 +345,7 @@ fetchCompletionWithoutRetry secretKey completionRequest = do
                                 Network.Http.Client.setHeader "Authorization" ("Bearer " <> secretKey)
 
                     sendRequest connection q (jsonBody completionRequest)
-                    completionResult :: CompletionResult <- receiveResponse connection jsonHandler
-                    pure (mconcat $ map (.text) completionResult.choices)
+                    receiveResponse connection jsonHandler
 
 enableStream :: CompletionRequest -> CompletionRequest
 enableStream completionRequest = completionRequest { stream = True }

ihp-openai/Test/IHP/OpenAISpec.hs

@@ -607,4 +607,47 @@ tests = do
             it "not render null description's for object properties" do
                 let object = JsonSchemaObject [Property { propertyName = "a", type_ = JsonSchemaString, required = True, description = Nothing } ]
 
-                encode object `shouldBe` "{\"properties\":{\"a\":{\"type\":\"string\"}},\"type\":\"object\"}"
+                encode object `shouldBe` "{\"properties\":{\"a\":{\"type\":\"string\"}},\"type\":\"object\"}"
+
+        describe "FromJSON CompletionResult" do
+            it "should decode a successful response" do
+                let response = [trimming|
+                    {
+                        "id": "chatcmpl-abc123",
+                        "object": "chat.completion",
+                        "created": 1677858242,
+                        "model": "gpt-3.5-turbo-0613",
+                        "usage": {
+                            "prompt_tokens": 13,
+                            "completion_tokens": 7,
+                            "total_tokens": 20
+                        },
+                        "choices": [
+                            {
+                                "message": {
+                                    "role": "assistant",
+                                    "content": "\n\nThis is a test!"
+                                },
+                                "logprobs": null,
+                                "finish_reason": "stop",
+                                "index": 0
+                            }
+                        ]
+                    }
+                |]
+
+                decodeStrictText (response) `shouldBe` (Just CompletionResult { choices = [ Choice { text = "\n\nThis is a test!" } ] })
+
+            it "should decode an error response" do
+                let response = [trimming|
+                    {
+                        "error": {
+                            "message": "You exceeded your current quota, please check your plan and billing details. For more information on this error, read the docs: https://platform.openai.com/docs/guides/error-codes/api-errors.",
+                            "type": "insufficient_quota",
+                            "param": null,
+                            "code": "insufficient_quota"
+                        }
+                    }
+                |]
+
+                decodeStrictText (response) `shouldBe` (Just CompletionError { message = "You exceeded your current quota, please check your plan and billing details. For more information on this error, read the docs: https://platform.openai.com/docs/guides/error-codes/api-errors." })