futur.blue / pegasus
objective categorical abstract machine language personal data server
65
fork

Configure Feed

Select the types of activity you want to include in your feed.

Fix oauth redirect uri construction

futurGH cd81316d 56ef5dd2

+24 -27
+24 -27
pegasus/lib/api/oauth_/authorize.ml
··· 1 1 open Oauth 2 2 open Oauth.Types 3 3 4 + let oauth_redirect req redirect_uri response_mode params = 5 + let uri = Uri.of_string redirect_uri in 6 + let encoded_params = 7 + String.concat "&" 8 + (List.map (fun (k, v) -> k ^ "=" ^ Uri.pct_encode v) params) 9 + in 10 + let url = 11 + match response_mode with 12 + | Some "fragment" -> 13 + Uri.with_fragment uri (Some encoded_params) |> Uri.to_string 14 + | _ -> 15 + let has_query = 16 + match Uri.verbatim_query uri with Some _ -> true | None -> false 17 + in 18 + let sep = if has_query then "&" else "?" in 19 + Uri.to_string uri ^ sep ^ encoded_params 20 + in 21 + Dream.redirect ~headers:[("Cache-Control", "no-store")] req url 22 + 4 23 let get_handler = 5 24 Xrpc.handler (fun ctx -> 6 25 let login_redirect = ··· 204 223 Queries.activate_auth_code ctx.db code did ~ip 205 224 ~user_agent 206 225 in 207 - let params = 226 + oauth_redirect ctx.req req.redirect_uri 227 + req.response_mode 208 228 [ ("code", code) 209 229 ; ("state", req.state) 210 230 ; ("iss", Env.host_endpoint) ] 211 - in 212 - let query = 213 - String.concat "&" 214 - (List.map 215 - (fun (k, v) -> k ^ "=" ^ Uri.pct_encode v) 216 - params ) 217 - in 218 - let separator = 219 - match req.response_mode with 220 - | Some "fragment" -> 221 - "#" 222 - | _ -> 223 - "?" 224 - in 225 - Dream.redirect ctx.req 226 - (req.redirect_uri ^ separator ^ query) 227 231 else 228 232 Uri.make ~path:"/account/login" 229 233 ~query: ··· 232 236 () 233 237 |> Uri.to_string |> Dream.redirect ctx.req 234 238 else 235 - let params = 239 + oauth_redirect ctx.req req.redirect_uri 240 + req.response_mode 236 241 [ ("error", "access_denied") 237 242 ; ("error_description", "Unable to authorize user.") 238 243 ; ("state", req.state) 239 - ; ("iss", Env.host_endpoint) ] 240 - in 241 - let query = 242 - String.concat "&" 243 - (List.map 244 - (fun (k, v) -> k ^ "=" ^ Uri.pct_encode v) 245 - params ) 246 - in 247 - Dream.redirect ctx.req (req.redirect_uri ^ "?" ^ query) ) 244 + ; ("iss", Env.host_endpoint) ] ) 248 245 | _ -> 249 246 Errors.invalid_request "invalid request" ) 250 247 | _ ->