never executed always true always false
1 module PureClaw.Auth.AnthropicOAuth
2 ( -- * Configuration
3 OAuthConfig (..)
4 , defaultOAuthConfig
5 -- * Redirect URIs (exported for testing)
6 , cliRedirectUri
7 -- * Tokens and handle
8 , OAuthTokens (..)
9 , OAuthHandle (..)
10 , mkOAuthHandle
11 -- * PKCE (exported for testing)
12 , generateCodeVerifier
13 , computeCodeChallenge
14 -- * URL building (exported for testing)
15 , buildAuthorizationUrl
16 -- * Code parsing (exported for testing)
17 , stripCodeFragment
18 -- * Token parsing (exported for testing)
19 , parseTokenResponse
20 -- * Vault serialization (exported for testing)
21 , serializeTokens
22 , deserializeTokens
23 -- * OAuth flows
24 , runOAuthFlow
25 , refreshOAuthToken
26 -- * Error type
27 , OAuthError (..)
28 ) where
29
30 import Control.Exception (Exception, throwIO, try, SomeException)
31 import Crypto.Hash (Digest, SHA256, hash)
32 import Crypto.Random qualified as CR
33 import Data.Aeson
34 import Data.Aeson.Types (parseEither)
35 import Data.ByteArray (convert)
36 import Data.ByteString (ByteString)
37 import Data.ByteString qualified as BS
38 import Data.ByteString.Base64.URL qualified as B64URL
39 import Data.ByteString.Lazy qualified as BL
40 import Data.IORef
41 import Data.Text (Text)
42 import Data.Text qualified as T
43 import Data.Text.Encoding qualified as TE
44 import Data.Text.IO qualified as TIO
45 import Data.Time.Clock (UTCTime, addUTCTime, getCurrentTime)
46 import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds)
47 import Network.HTTP.Client qualified as HTTP
48 import Network.HTTP.Types (Header, renderSimpleQuery)
49 import Network.HTTP.Types.Status qualified as Status
50 import System.Info (os)
51 import System.IO (hFlush, stdout)
52 import System.Process.Typed qualified as P
53
54 import PureClaw.Security.Secrets
55
56 -- | Configuration for the Anthropic OAuth 2.0 PKCE flow.
57 data OAuthConfig = OAuthConfig
58 { _oac_clientId :: Text -- ^ OAuth client ID
59 , _oac_authUrl :: String -- ^ Authorization endpoint URL
60 , _oac_tokenUrl :: String -- ^ Token endpoint URL
61 }
62
63 -- | Default config matching Claude Code's OAuth endpoints and client ID.
64 defaultOAuthConfig :: OAuthConfig
65 defaultOAuthConfig = OAuthConfig
66 { _oac_clientId = "9d1c250a-e61b-44d9-88ed-5944d1962f5e"
67 , _oac_authUrl = "https://claude.ai/oauth/authorize"
68 , _oac_tokenUrl = "https://console.anthropic.com/v1/oauth/token"
69 }
70
71 -- | Redirect URI for the CLI paste-code flow. Anthropic hosts a page at this
72 -- URL that displays the authorization code for the user to copy and paste
73 -- back into the CLI.
74 cliRedirectUri :: ByteString
75 cliRedirectUri = "https://console.anthropic.com/oauth/code/callback"
76
77 -- | OAuth tokens returned from a successful flow or refresh.
78 data OAuthTokens = OAuthTokens
79 { _oat_accessToken :: BearerToken -- ^ Access token for API calls
80 , _oat_refreshToken :: ByteString -- ^ Refresh token (opaque, stored for renewal)
81 , _oat_expiresAt :: UTCTime -- ^ When the access token expires
82 }
83
84 instance Show OAuthTokens where
85 show t = "OAuthTokens { expiresAt = " <> show (_oat_expiresAt t) <> ", <tokens redacted> }"
86
87 -- | Handle wrapping a mutable token store and a refresh function.
88 -- Passed to 'mkAnthropicProviderOAuth' so the provider can refresh tokens
89 -- automatically when they expire.
90 data OAuthHandle = OAuthHandle
91 { _oah_tokensRef :: IORef OAuthTokens
92 -- ^ Mutable reference — updated after each successful refresh.
93 , _oah_refresh :: ByteString -> IO OAuthTokens
94 -- ^ Given a refresh token, obtain fresh tokens.
95 }
96
97 -- | Construct an 'OAuthHandle' from an initial token set.
98 mkOAuthHandle :: OAuthConfig -> HTTP.Manager -> OAuthTokens -> IO OAuthHandle
99 mkOAuthHandle cfg manager initialTokens = do
100 ref <- newIORef initialTokens
101 pure OAuthHandle
102 { _oah_tokensRef = ref
103 , _oah_refresh = refreshOAuthToken cfg manager
104 }
105
106 -- | OAuth errors.
107 newtype OAuthError = OAuthError Text
108 deriving stock (Show)
109
110 instance Exception OAuthError
111
112 -- ---------------------------------------------------------------------------
113 -- PKCE helpers
114 -- ---------------------------------------------------------------------------
115
116 -- | Generate a PKCE code verifier: 32 random bytes encoded as URL-safe
117 -- base64 without padding (43 characters).
118 generateCodeVerifier :: IO ByteString
119 generateCodeVerifier = do
120 bytes <- CR.getRandomBytes 32
121 pure (stripPadding (B64URL.encode bytes))
122
123 -- | Compute the PKCE code challenge: BASE64URL(SHA256(verifier)).
124 -- The verifier is treated as raw bytes (it is already ASCII-safe base64url).
125 computeCodeChallenge :: ByteString -> ByteString
126 computeCodeChallenge verifier =
127 let digest = hash verifier :: Digest SHA256
128 digestBs = convert digest :: ByteString
129 in stripPadding (B64URL.encode digestBs)
130
131 -- | Strip '=' padding from a base64url-encoded string.
132 stripPadding :: ByteString -> ByteString
133 stripPadding = BS.filter (/= 0x3d)
134
135 -- ---------------------------------------------------------------------------
136 -- Authorization URL
137 -- ---------------------------------------------------------------------------
138
139 -- | Build the authorization URL.
140 -- 'redirectUri' is included verbatim — callers choose the redirect strategy
141 -- Use 'cliRedirectUri' for the paste-code flow.
142 buildAuthorizationUrl :: OAuthConfig -> ByteString -> ByteString -> ByteString -> Text
143 buildAuthorizationUrl cfg verifier state redirectUri =
144 let challenge = computeCodeChallenge verifier
145 qs = renderSimpleQuery True
146 [ ("response_type", "code")
147 , ("client_id", TE.encodeUtf8 (_oac_clientId cfg))
148 , ("redirect_uri", redirectUri)
149 , ("scope", "org:create_api_key user:profile user:inference")
150 , ("state", state)
151 , ("code_challenge", challenge)
152 , ("code_challenge_method", "S256")
153 ]
154 in T.pack (_oac_authUrl cfg) <> TE.decodeUtf8 qs
155
156 -- ---------------------------------------------------------------------------
157 -- Token response parsing
158 -- ---------------------------------------------------------------------------
159
160 -- | Parse a token response from the Anthropic token endpoint.
161 -- 'now' is the current time, used to compute the absolute expiry.
162 parseTokenResponse :: UTCTime -> BL.ByteString -> Either Text OAuthTokens
163 parseTokenResponse now bs =
164 case eitherDecode bs of
165 Left err -> Left (T.pack err)
166 Right val -> case parseEither parseTokens val of
167 Left err -> Left (T.pack err)
168 Right t -> Right t
169 where
170 parseTokens = withObject "TokenResponse" $ \o -> do
171 accessText <- o .: "access_token"
172 refreshText <- o .: "refresh_token"
173 expiresIn <- o .: "expires_in"
174 let expiresAt = addUTCTime (fromIntegral (expiresIn :: Int)) now
175 pure OAuthTokens
176 { _oat_accessToken = mkBearerToken (TE.encodeUtf8 accessText)
177 , _oat_refreshToken = TE.encodeUtf8 refreshText
178 , _oat_expiresAt = expiresAt
179 }
180
181 -- ---------------------------------------------------------------------------
182 -- Vault serialization
183 -- ---------------------------------------------------------------------------
184
185 -- | Serialize tokens to JSON bytes for vault storage.
186 serializeTokens :: OAuthTokens -> ByteString
187 serializeTokens tokens = BL.toStrict $ encode $ object
188 [ "access_token" .= TE.decodeUtf8 (withBearerToken (_oat_accessToken tokens) id)
189 , "refresh_token" .= TE.decodeUtf8 (_oat_refreshToken tokens)
190 , "expires_at" .= (round (utcTimeToPOSIXSeconds (_oat_expiresAt tokens)) :: Int)
191 ]
192
193 -- | Deserialize tokens from vault-stored JSON bytes.
194 deserializeTokens :: ByteString -> Either Text OAuthTokens
195 deserializeTokens bs =
196 case eitherDecodeStrict bs of
197 Left err -> Left (T.pack err)
198 Right val -> case parseEither parseStored val of
199 Left err -> Left (T.pack err)
200 Right t -> Right t
201 where
202 parseStored = withObject "StoredTokens" $ \o -> do
203 accessText <- o .: "access_token"
204 refreshText <- o .: "refresh_token"
205 expiresInt <- o .: "expires_at"
206 let expiresAt = posixSecondsToUTCTime (fromIntegral (expiresInt :: Int))
207 pure OAuthTokens
208 { _oat_accessToken = mkBearerToken (TE.encodeUtf8 accessText)
209 , _oat_refreshToken = TE.encodeUtf8 refreshText
210 , _oat_expiresAt = expiresAt
211 }
212
213 -- | Headers required for all requests to the Anthropic OAuth token endpoint.
214 oauthRequestHeaders :: [Header]
215 oauthRequestHeaders =
216 [ ("content-type", "application/json")
217 , ("anthropic-version", "2023-06-01")
218 , ("anthropic-beta", "oauth-2025-04-20")
219 ]
220
221 -- ---------------------------------------------------------------------------
222 -- OAuth flows
223 -- ---------------------------------------------------------------------------
224
225 -- | Run the OAuth 2.0 PKCE out-of-band flow:
226 -- 1. Generate PKCE verifier + state
227 -- 2. Print the authorization URL (and try to open the browser)
228 -- 3. Prompt the user to paste the authorization code displayed by the browser
229 -- 4. Exchange the code for tokens
230 runOAuthFlow :: OAuthConfig -> HTTP.Manager -> IO OAuthTokens
231 runOAuthFlow cfg manager = do
232 verifier <- generateCodeVerifier
233 -- Use verifier as state (matching the pi-ai / Claude Code convention)
234 let authUrl = buildAuthorizationUrl cfg verifier verifier cliRedirectUri
235 putStrLn "Anthropic OAuth login required."
236 putStrLn "Visit this URL to authenticate:"
237 TIO.putStrLn authUrl
238 putStr "(Attempting to open browser...) " >> hFlush stdout
239 tryOpenBrowser (T.unpack authUrl)
240 putStrLn ""
241 putStr "Paste the authorization code shown in your browser: " >> hFlush stdout
242 rawInput <- T.strip . T.pack <$> getLine
243 let code = T.takeWhile (/= '#') rawInput
244 state = T.drop 1 (T.dropWhile (/= '#') rawInput)
245 now <- getCurrentTime
246 exchangeCodeForTokens cfg manager verifier code state now
247
248 -- | Strip whitespace and any trailing @#fragment@ from a pasted authorization
249 -- code. The @platform.claude.com@ callback page appends @#state@ to the
250 -- displayed code.
251 stripCodeFragment :: Text -> Text
252 stripCodeFragment = T.takeWhile (/= '#') . T.strip
253
254 -- | Exchange an authorization code for tokens.
255 -- 'state' is the value from the @#fragment@ of the pasted callback code,
256 -- which equals the PKCE verifier (per the Anthropic convention).
257 exchangeCodeForTokens
258 :: OAuthConfig -> HTTP.Manager -> ByteString -> Text -> Text -> UTCTime -> IO OAuthTokens
259 exchangeCodeForTokens cfg manager verifier code state now = do
260 let body = encode $ object
261 [ "grant_type" .= ("authorization_code" :: Text)
262 , "client_id" .= _oac_clientId cfg
263 , "code" .= code
264 , "state" .= state
265 , "redirect_uri" .= TE.decodeUtf8 cliRedirectUri
266 , "code_verifier" .= TE.decodeUtf8 verifier
267 ]
268 req <- HTTP.parseRequest (_oac_tokenUrl cfg)
269 let httpReq = req
270 { HTTP.method = "POST"
271 , HTTP.requestBody = HTTP.RequestBodyLBS body
272 , HTTP.requestHeaders = oauthRequestHeaders
273 }
274 resp <- HTTP.httpLbs httpReq manager
275 let statusCode = Status.statusCode (HTTP.responseStatus resp)
276 if statusCode /= 200
277 then throwIO (OAuthError ("Token exchange failed with HTTP " <> T.pack (show statusCode)
278 <> ": " <> TE.decodeUtf8 (BL.toStrict (HTTP.responseBody resp))))
279 else case parseTokenResponse now (HTTP.responseBody resp) of
280 Left err -> throwIO (OAuthError ("Token parse error: " <> err))
281 Right tokens -> pure tokens
282
283 -- | Refresh an access token using a stored refresh token.
284 refreshOAuthToken :: OAuthConfig -> HTTP.Manager -> ByteString -> IO OAuthTokens
285 refreshOAuthToken cfg manager refreshTok = do
286 now <- getCurrentTime
287 let body = encode $ object
288 [ "grant_type" .= ("refresh_token" :: Text)
289 , "client_id" .= _oac_clientId cfg
290 , "refresh_token" .= TE.decodeUtf8 refreshTok
291 ]
292 req <- HTTP.parseRequest (_oac_tokenUrl cfg)
293 let httpReq = req
294 { HTTP.method = "POST"
295 , HTTP.requestBody = HTTP.RequestBodyLBS body
296 , HTTP.requestHeaders = oauthRequestHeaders
297 }
298 resp <- HTTP.httpLbs httpReq manager
299 let statusCode = Status.statusCode (HTTP.responseStatus resp)
300 if statusCode /= 200
301 then throwIO (OAuthError ("Token refresh failed with HTTP " <> T.pack (show statusCode)))
302 else case parseTokenResponse now (HTTP.responseBody resp) of
303 Left err -> throwIO (OAuthError ("Token parse error: " <> err))
304 Right tokens -> pure tokens
305
306 -- ---------------------------------------------------------------------------
307 -- Browser helper
308 -- ---------------------------------------------------------------------------
309
310 -- | Try to open a URL in the default browser. Ignores failures silently.
311 tryOpenBrowser :: String -> IO ()
312 tryOpenBrowser url = do
313 let cmd = case os of
314 "darwin" -> "open"
315 "mingw32" -> "start"
316 _ -> "xdg-open"
317 _ <- try @SomeException (P.runProcess_ (P.proc cmd [url]))
318 pure ()