Skip to content

Commit 360e5c1

Browse files
NickSeagullNickSeagullBotclaude
authored
feat(azureai): add Azure AI chat-completions integration (#702)
* chore(azureai): open design-review PR (#700) * feat(azureai): add Azure AI chat-completions integration Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com> * fix(azureai): close host-suffix label-boundary bypass + address review CodeRabbit flagged the endpoint allowlist as a critical issue: the suffix check used a plain `Text.endsWith suffix host`, so a host that merely ends with the literal suffix string — e.g. "notazure.us" for the sovereign suffix "azure.us", or "evilopenai.azure.com" for "openai.azure.com" — would pass and receive the api-key. These are attacker-registrable domains. - azureEndpointAllowing now requires a label boundary: host == suffix, or host ends with ".<suffix>". Closes the SEC-001 key-destination bypass at the type level (the tests only covered append-spoofing before). - Add three regression tests: notazure.us rejected, evilopenai.azure.com rejected, exact openai.azure.com accepted. - Fix the broken Quick Start haddock (Integration.AzureAI.Message does not exist; use the AzureAI.system/AzureAI.user re-exports) in the facade and the Request.chatCompletion example. - Replace persona-name doc comments (Nick/Jess) with neutral technical wording in shipped haddock. - Remove a redundant lambda in RequestSpec (hlint, CI treats as error). Skipped CodeRabbit's import-pairing nitpick: the suggested qualified aliases (Maybe, Integration, Message) are unused, so importing them would trip -Wunused-imports under the repo's warnings-as-errors build. cabal test nhintegrations-test: 606 examples, 0 failures. hlint: No hints. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com> --------- Co-authored-by: NickSeagullBot <bot@nickseagull.dev> Co-authored-by: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
1 parent e55fdf6 commit 360e5c1

6 files changed

Lines changed: 1318 additions & 0 deletions

File tree

Lines changed: 73 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,73 @@
1+
-- | Azure AI Foundry chat completions integration for NeoHaskell.
2+
--
3+
-- Provides access to Azure AI Foundry's Model Inference API for chat completions,
4+
-- including GPT-4o and other Azure-hosted models.
5+
--
6+
-- == Quick Start
7+
--
8+
-- @
9+
-- import Integration qualified
10+
-- import Integration.AzureAI qualified as AzureAI
11+
--
12+
-- case AzureAI.azureEndpoint "https://my-res.openai.azure.com" of
13+
-- Result.Ok endpoint ->
14+
-- AzureAI.chatCompletion
15+
-- endpoint
16+
-- [AzureAI.system "Be concise.", AzureAI.user question]
17+
-- "gpt-4o"
18+
-- (\\response -> GotAnswer { response })
19+
-- (\\err -> AiError { err })
20+
-- |> Integration.outbound
21+
-- Result.Err reason ->
22+
-- Integration.none
23+
-- @
24+
--
25+
-- == Configuration
26+
--
27+
-- Add to your @Config.hs@:
28+
--
29+
-- @
30+
-- Config.field @(Redacted Text) "azureAiApiKey"
31+
-- |> Config.doc "Azure AI API key (from the Azure Portal)"
32+
-- |> Config.required
33+
-- |> Config.envVar "AZURE_AI_API_KEY"
34+
-- |> Config.secret
35+
-- @
36+
module Integration.AzureAI
37+
( -- * Endpoint validation
38+
AzureEndpoint
39+
, azureEndpoint
40+
, azureEndpointAllowing
41+
, defaultAzureHostSuffixes
42+
43+
-- * Request building
44+
, chatCompletion
45+
, Request (..)
46+
, Config (..)
47+
, defaultConfig
48+
49+
-- * Advanced escape hatch
50+
, toHttpRequest
51+
52+
-- * Response types (reused from OpenRouter, no new definitions)
53+
, Response (..)
54+
, Choice (..)
55+
, Usage (..)
56+
, FinishReason (..)
57+
58+
-- * Message types (reused from OpenRouter, no new definitions)
59+
, Message (..)
60+
, Role (..)
61+
, Content (..)
62+
, ContentPart (..)
63+
, ImageUrl (..)
64+
, user
65+
, assistant
66+
, system
67+
, userWithAttachment
68+
) where
69+
70+
import Integration.AzureAI.Internal (toHttpRequest)
71+
import Integration.AzureAI.Request (AzureEndpoint, Config (..), Request (..), azureEndpoint, azureEndpointAllowing, chatCompletion, defaultAzureHostSuffixes, defaultConfig)
72+
import Integration.OpenRouter.Message (Content (..), ContentPart (..), ImageUrl (..), Message (..), Role (..), assistant, system, user, userWithAttachment)
73+
import Integration.OpenRouter.Response (Choice (..), FinishReason (..), Response (..), Usage (..))
Lines changed: 183 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,183 @@
1+
{-# LANGUAGE UndecidableInstances #-}
2+
3+
-- | Internal implementation for Azure AI chat-completions integration.
4+
--
5+
-- Contains the transformation from 'Request' to 'Http.Request', the single
6+
-- 'Redacted.unwrap' site for the API key, and the 'ToAction (Request command)'
7+
-- instance that enables 'Integration.outbound'.
8+
--
9+
-- __This module is not re-exported from 'Integration.AzureAI'__ (only
10+
-- 'toHttpRequest' is re-exported from the facade as an advanced escape hatch).
11+
module Integration.AzureAI.Internal
12+
( -- * Transformation (exported for testing)
13+
toHttpRequest
14+
15+
-- * Internal types and helpers (exported for tests)
16+
, RequestBody (..)
17+
, buildRequestBody
18+
, sanitizeApiVersion
19+
, handleSuccess
20+
, handleError
21+
) where
22+
23+
import Array (Array)
24+
import Array qualified
25+
import Basics
26+
import Char (Char)
27+
import Char qualified
28+
import Integration (ToAction (..))
29+
import Integration.AzureAI.Request (Config (..), Request (..), endpointUrl)
30+
import Integration.Http qualified as Http
31+
import Integration.OpenRouter.Message (Message)
32+
import Integration.OpenRouter.Response ()
33+
import Json qualified
34+
import Maybe (Maybe (..))
35+
import Redacted qualified
36+
import Result (Result (..))
37+
import Service.Command.Core (NameOf)
38+
import Text (Text)
39+
import Text qualified
40+
41+
42+
-- | Internal wire-format JSON body, not exposed to Integration.AzureAI callers.
43+
-- Mirrors 'Integration.OpenRouter.Internal.RequestBody' minus tools/tool_choice.
44+
data RequestBody = RequestBody
45+
{ messages :: Array Message
46+
, model :: Text
47+
, stream :: Bool
48+
, temperature :: Maybe Float
49+
, max_tokens :: Maybe Int
50+
, top_p :: Maybe Float
51+
, frequency_penalty :: Maybe Float
52+
, presence_penalty :: Maybe Float
53+
}
54+
deriving (Show, Eq, Generic)
55+
56+
57+
-- | Hand-written ToJSON: messages/model/stream always present; sampling fields
58+
-- omitted (never serialised as null) when Nothing. Mirrors OpenRouter.Internal.
59+
instance Json.ToJSON RequestBody where
60+
toJSON body = do
61+
let required =
62+
[ ("messages", Json.toJSON body.messages)
63+
, ("model", Json.toJSON body.model)
64+
, ("stream", Json.toJSON body.stream)
65+
]
66+
let optionalFields =
67+
[ body.temperature |> fmap (\v -> ("temperature", Json.toJSON v))
68+
, body.max_tokens |> fmap (\v -> ("max_tokens", Json.toJSON v))
69+
, body.top_p |> fmap (\v -> ("top_p", Json.toJSON v))
70+
, body.frequency_penalty |> fmap (\v -> ("frequency_penalty", Json.toJSON v))
71+
, body.presence_penalty |> fmap (\v -> ("presence_penalty", Json.toJSON v))
72+
]
73+
|> Array.getJusts
74+
let allFields = required |> Array.append optionalFields |> Array.toLinkedList
75+
Json.object allFields
76+
77+
78+
-- | ToAction instance: pure delegation through toHttpRequest.
79+
-- No Result branch — AzureEndpoint type proves https+allowlist at construction time.
80+
-- The simpler OpenRouter form (not ACS's planAction) because the type, not a
81+
-- runtime check, carries the security invariant.
82+
instance
83+
(Json.ToJSON command, KnownSymbol (NameOf command)) =>
84+
ToAction (Request command)
85+
where
86+
toAction req =
87+
req
88+
|> toHttpRequest
89+
|> Integration.toAction
90+
91+
92+
-- | Bridge a Request into an Http.Request. The ONLY Redacted.unwrap site.
93+
-- The endpoint is already https+allowlisted by construction (AzureEndpoint),
94+
-- so there is no runtime https branch here — that guard moved to azureEndpoint.
95+
--
96+
-- @
97+
-- case AzureAI.azureEndpoint "https://my-res.openai.azure.com" of
98+
-- Result.Ok endpoint ->
99+
-- AzureAI.chatCompletion endpoint msgs "gpt-4o" onOk onErr
100+
-- |> AzureAI.toHttpRequest
101+
-- |> Integration.outbound
102+
-- Result.Err reason -> Integration.none
103+
-- @
104+
toHttpRequest :: forall command. Request command -> Http.Request command
105+
toHttpRequest req =
106+
do
107+
let endpointBase = endpointUrl req.config.endpoint
108+
let apiVersion = sanitizeApiVersion req.config.apiVersion
109+
let url = [fmt|#{endpointBase}/models/chat/completions?api-version=#{apiVersion}|]
110+
let keyValue = Redacted.unwrap req.apiKey -- the ONLY Redacted.unwrap in this integration
111+
let body = buildRequestBody req
112+
Http.Request
113+
{ method = Http.POST
114+
, url
115+
, headers = Array.empty
116+
, body = Http.json body
117+
, onSuccess = handleSuccess req
118+
, onError = Just (handleError req)
119+
, auth = Http.ApiKey "api-key" keyValue
120+
, retry = Http.noRetry
121+
, timeoutSeconds = req.config.timeoutSeconds
122+
}
123+
124+
125+
-- | Build the JSON request body from a Request.
126+
-- Call sites: (1) toHttpRequest (production), (2) InternalSpec body-shape tests.
127+
buildRequestBody :: forall command. Request command -> RequestBody
128+
buildRequestBody req =
129+
RequestBody
130+
{ messages = req.messages
131+
, model = req.model
132+
, stream = False
133+
, temperature = req.config.temperature
134+
, max_tokens = req.config.maxTokens
135+
, top_p = req.config.topP
136+
, frequency_penalty = req.config.frequencyPenalty
137+
, presence_penalty = req.config.presencePenalty
138+
}
139+
140+
141+
-- | Allowed characters in an api-version string: alphanumeric and dash.
142+
-- Module-private helper for 'sanitizeApiVersion'.
143+
isApiVersionChar :: Char -> Bool
144+
isApiVersionChar c = Char.isAlphaNum c || c == '-'
145+
146+
147+
-- | Neutralise query-parameter injection through apiVersion (SEC-003).
148+
-- Keeps only [A-Za-z0-9-]; drops '&', '?', '#', whitespace, and all else.
149+
-- Legitimate values ("2024-10-21", "2024-05-01-preview") pass through unchanged.
150+
-- Call sites: (1) toHttpRequest (production), (2) InternalSpec SEC-003 tests.
151+
sanitizeApiVersion :: Text -> Text
152+
sanitizeApiVersion raw =
153+
raw |> Text.filter isApiVersionChar
154+
155+
156+
-- | Dispatch the Model Inference HTTP response on status code.
157+
-- 2xx: decode as Response and call onSuccess; errors: sanitised onError
158+
-- (no key, no raw body). Mirrors OpenRouter.Internal.handleSuccess with
159+
-- Azure-branded messages.
160+
-- Call sites: (1) toHttpRequest (as Http.Request.onSuccess), (2) InternalSpec.
161+
handleSuccess :: forall command. Request command -> Http.Response -> command
162+
handleSuccess req httpResponse =
163+
case httpResponse.statusCode of
164+
code | code >= 200 && code < 300 ->
165+
case httpResponse.body |> Json.decode of
166+
Result.Err _parseError ->
167+
req.onError "Failed to parse Azure AI response"
168+
Result.Ok response ->
169+
req.onSuccess response
170+
429 ->
171+
req.onError "Azure AI rate limit exceeded"
172+
code | code >= 400 && code < 500 ->
173+
req.onError [fmt|Azure AI request error (HTTP #{code})|]
174+
code ->
175+
req.onError [fmt|Azure AI server error (HTTP #{code})|]
176+
177+
178+
-- | Pass a transport-level error through to onError unchanged.
179+
-- Integration.Http already sanitises transport errors.
180+
-- Call sites: (1) toHttpRequest (as Http.Request.onError), (2) InternalSpec.
181+
handleError :: forall command. Request command -> Text -> command
182+
handleError req errorText =
183+
req.onError errorText

0 commit comments

Comments
 (0)