From 0ac7d90e30c5496289188e706347de4950bc0baf Mon Sep 17 00:00:00 2001 From: KtorZ Date: Tue, 4 Sep 2018 01:03:47 +0200 Subject: [PATCH] Completely review internal implementation & exposed API - Some stuff exposed from OAuth.Decode didn't make much sense to be exposed, removing the need for having such module prevents us from having to expose them. Plus, it re-enable a clearer division of one module per flow - Also made the 'Token' type opaque - The 'Authentication' ADT has been broke down into 4 different records that are now only exposed in their respective modules. - The Internals of the 'Token' type isn't exposed anymore' - JSON decoders and Querystring parsers have been more-or-less unified. Note that there's still work to do on them to fully capture all possible errors. - We now expose a 'OAuth.Refresh' module, not sure why it wasn't exposed before... - Some documentation quirks have been fixed - Some renaming to increase consistency and readability (e.g. 'use' -> 'useToken', 'Err' -> 'ErrorResponse' etc.) - The 'ParseErr' has been renamed and reviewed into a 'ParseResult' which now contains a 'Success' branch. This avoids the cumbersome 'Result ParseErr a' with 'ParseErr' being an ADT - Mostly, I was wrongly re-using structures for authorization / authentication between flows whereas there is subtles differences (especially about this `state`) parameter. - Put a great amount of efforts in "normalizing" decoders and query parsers to have them more 'pure' and operating at one level at a time - Remove the 'FailedToParse' and 'InvalidResponse' from the parsers results, in favor of Empty. It means that all-in-all, we can't really make the difference between an invalid response from the server and an absence of token. That's a debatable choice. - More renaming for consistency - Fixed an issue where 'ErrorCode' wouldn't parse if provided with a custom code. This commi ditches the 'Unknown' constructor in favor of 'Custom String'. For now, we don't enforce any rules on that 'String' which is wrong since the spec clearly make a statement about the shape of that error code. Will do. --- elm.json | 13 +- examples/implicit/Main.elm | 162 ++------- src/Internal.elm | 603 ++++++++++++++++++++++---------- src/OAuth.elm | 346 +++--------------- src/OAuth/AuthorizationCode.elm | 204 ++++++++--- src/OAuth/ClientCredentials.elm | 89 +++-- src/OAuth/Decode.elm | 213 ----------- src/OAuth/Implicit.elm | 120 ++++--- src/OAuth/Password.elm | 93 +++-- src/OAuth/Refresh.elm | 98 ++++++ 10 files changed, 993 insertions(+), 948 deletions(-) delete mode 100644 src/OAuth/Decode.elm create mode 100644 src/OAuth/Refresh.elm diff --git a/elm.json b/elm.json index b899ed1..18a5cc2 100644 --- a/elm.json +++ b/elm.json @@ -1,7 +1,7 @@ { "type": "package", "name": "truqu/elm-oauth2", - "version": "3.0.0", + "version": "4.0.0", "license": "MIT", "summary": "OAuth 2.0 client-side utils", "exposed-modules": [ @@ -10,16 +10,17 @@ "OAuth.Implicit", "OAuth.ClientCredentials", "OAuth.Password", - "OAuth.Decode" + "OAuth.Refresh" ], "dependencies": { - "elm/url": "1.0.0 <= v < 2.0.0", "elm/core": "1.0.0 <= v < 2.0.0", - "elm/html": "1.0.0 <= v < 2.0.0", + "elm/url": "1.0.0 <= v < 2.0.0", "elm/http": "1.0.0 <= v < 2.0.0", - "elm/browser": "1.0.0 <= v < 2.0.0", "elm/json": "1.0.0 <= v < 2.0.0", - "truqu/elm-base64": "2.0.0 <= v < 3.0.0" + "truqu/elm-base64": "2.0.0 <= v < 3.0.0", + + "elm/html": "1.0.0 <= v < 2.0.0", + "elm/browser": "1.0.0 <= v < 2.0.0" }, "test-dependencies": {}, "elm-version": "0.19.0 <= v < 0.20.0" diff --git a/examples/implicit/Main.elm b/examples/implicit/Main.elm index b1c9101..c198fd1 100644 --- a/examples/implicit/Main.elm +++ b/examples/implicit/Main.elm @@ -30,6 +30,7 @@ main = type alias Model = { redirectUri : Url + , state : String , error : Maybe String , token : Maybe OAuth.Token , profile : Maybe Profile @@ -51,27 +52,6 @@ profileDecoder = (Json.field "picture" Json.string) -preModel : Int -> Model -> String -preModel n model = - preRecord n - "Model" - [ ( "redirectUri", preString 30 <| Url.toString model.redirectUri ) - , ( "error", preMaybe (preString 30) model.error ) - , ( "token", preMaybe (\s -> preString 30 <| OAuth.showToken s) model.token ) - , ( "profile", preMaybe (preProfile (n + 1)) model.profile ) - ] - - -preProfile : Int -> Profile -> String -preProfile n profile = - preRecord n - "Profile" - [ ( "email", preString 30 profile.email ) - , ( "name", preString 30 profile.name ) - , ( "picture", preString 30 profile.picture ) - ] - - -- Msg @@ -90,24 +70,33 @@ type -- init +makeInitModel : Url -> Model +makeInitModel origin = + { redirectUri = { origin | query = Nothing, fragment = Nothing } + , state = "CSRF" -- NOTE In theory, this state is securely generated before each request and stored somewhere. + , error = Nothing + , token = Nothing + , profile = Nothing + } + + init : () -> Url -> Key -> ( Model, Cmd Msg ) -init _ origin navKey = +init _ origin _ = let model = - { redirectUri = origin - , error = Nothing - , token = Nothing - , profile = Nothing - } + makeInitModel origin in - case OAuth.Implicit.parse origin of - Ok { token } -> + case OAuth.Implicit.parseToken origin of + OAuth.Implicit.Success { token } -> ( { model | token = Just token } , getUserProfile profileEndpoint token ) - Err err -> - ( { model | error = showParseErr err } + OAuth.Implicit.Empty -> + ( model, Cmd.none ) + + OAuth.Implicit.Error { error } -> + ( { model | error = Just <| OAuth.errorCodeToString error } , Cmd.none ) @@ -118,7 +107,7 @@ getUserProfile endpoint token = Http.request { method = "GET" , body = Http.emptyBody - , headers = OAuth.use token [] + , headers = OAuth.useToken token [] , withCredentials = False , url = Url.toString endpoint , expect = Http.expectJson profileDecoder @@ -126,25 +115,6 @@ getUserProfile endpoint token = } -showParseErr : OAuth.ParseErr -> Maybe String -showParseErr oauthErr = - case oauthErr of - OAuth.Empty -> - Nothing - - OAuth.OAuthErr err -> - Just <| OAuth.showErrCode err.error - - OAuth.FailedToParse -> - Just "Failed to parse the origin URL" - - OAuth.Missing params -> - Just <| "Missing expected parameter(s) from the response: " ++ String.join ", " params - - OAuth.Invalid params -> - Just <| "Invalid parameter(s) from the response: " ++ String.join ", " params - - -- update @@ -156,15 +126,17 @@ update msg model = ( model, Cmd.none ) SignInRequested -> + let + auth = + { clientId = clientId + , redirectUri = model.redirectUri + , scope = [ "email", "profile" ] + , state = Nothing + , url = authorizationEndpoint + } + in ( model - , OAuth.Implicit.authorize - { clientId = clientId - , redirectUri = model.redirectUri - , responseType = OAuth.Token - , scope = [ "email", "profile" ] - , state = Nothing - , url = authorizationEndpoint - } + , auth |> OAuth.Implicit.makeAuthUrl |> Url.toString |> Navigation.load ) GotUserInfo res -> @@ -230,27 +202,10 @@ viewBody model content = , style "color" "#ffffff" ] [ text msg ] - , div - [ style "display" "flex" - , style "align-items" "center" - , style "justify-content" "center" - , style "width" "70%" - ] - [ content - , pre [ style "padding" "2em" ] [ text (preModel 1 model) ] - ] + , content ] - --- type alias Model = --- { redirectUri : Url --- , error : Maybe String --- , token : Maybe OAuth.Token --- , profile : Maybe Profile --- } - - viewSignInButton : Html Msg viewSignInButton = button @@ -306,67 +261,20 @@ viewProfile profile = --- Formatting Helpers - - -preString : Int -> String -> String -preString maxSize str = - if String.length str > maxSize then - String.left maxSize str ++ "..." - - else - str - - -preRecord : Int -> String -> List ( String, String ) -> String -preRecord n name fields = - let - preField ( k, v ) = - k ++ " = " ++ v - - padded s = - "\n" ++ String.repeat (n * 2) " " ++ s - in - case fields of - [] -> - name - - [ fst ] -> - name ++ " = { " ++ preField fst ++ " }" - - fst :: rest -> - String.concat - [ name ++ " =" ++ padded "{ " ++ preField fst ++ padded ", " - , String.join (padded ", ") (List.map preField rest) - , padded "}" - ] - - -preMaybe : (a -> String) -> Maybe a -> String -preMaybe pre m = - case m of - Nothing -> - "Nothing" - - Just a -> - "Just (" ++ pre a ++ ")" - - - -- Constants / Google APIs endpoints -- Demo clientId, configured to target the github repository's gh-pages only clientId : String clientId = - "909608474358-sucp6e4js3nvfkfnab5t69qoelampt3t.apps.googleusercontent.com" + "909608474358-apio86lq9hvjobd3hiepgtrclthnc4q0.apps.googleusercontent.com" authorizationEndpoint : Url authorizationEndpoint = { protocol = Https , host = "accounts.google.com" - , path = "/o/oauth2/v2/auth/" + , path = "/o/oauth2/v2/auth" , port_ = Nothing , query = Nothing , fragment = Nothing @@ -377,7 +285,7 @@ profileEndpoint : Url profileEndpoint = { protocol = Https , host = "www.googleapis.com" - , path = "/oauth2/v1/userinfo/" + , path = "/oauth2/v1/userinfo" , port_ = Nothing , query = Nothing , fragment = Nothing diff --git a/src/Internal.elm b/src/Internal.elm index 7c7cda3..66fa080 100644 --- a/src/Internal.elm +++ b/src/Internal.elm @@ -1,189 +1,423 @@ -module Internal exposing - ( authHeader - , authenticate - , authorize - , makeRequest - , parseAuthorizationCode - , parseError - , parseToken - , qsSpaceSeparatedList - , urlAddList - , urlAddMaybe - ) +module Internal exposing (AuthenticationError, AuthenticationSuccess, Authorization, AuthorizationError, RequestParts, ResponseType(..), TokenString, TokenType, authenticationErrorDecoder, authenticationSuccessDecoder, authorizationErrorParser, decoderFromJust, decoderFromResult, errorDecoder, errorDescriptionDecoder, errorDescriptionParser, errorParser, errorUriDecoder, errorUriParser, expiresInDecoder, expiresInParser, extractTokenString, lenientScopeDecoder, makeAuthUrl, makeHeaders, makeRedirectUri, makeRefreshToken, makeRequest, makeToken, maybeAndThen2, parseUrlQuery, protocolToString, refreshTokenDecoder, responseTypeToString, scopeDecoder, scopeParser, spaceSeparatedListParser, stateDecoder, stateParser, tokenDecoder, tokenParser, urlAddList, urlAddMaybe) import Base64 -import Browser.Navigation as Navigation import Http as Http +import Json.Decode as Json import OAuth exposing (..) -import OAuth.Decode exposing (..) import Url exposing (Protocol(..), Url) -import Url.Builder as Url exposing (QueryParameter) +import Url.Builder as Builder exposing (QueryParameter) +import Url.Parser as Url import Url.Parser.Query as Query -authorize : Authorization -> Cmd msg -authorize { clientId, url, redirectUri, responseType, scope, state } = - let - qs = - [ Url.string "client_id" clientId - , Url.string "redirect_uri" (fmtRedirectUri redirectUri) - , Url.string "response_type" (showResponseType responseType) - ] - |> urlAddList "scope" scope - |> urlAddMaybe "state" state - |> Url.toQuery +{-| Parts required to build a request. This record is given to `Http.request` in order +to create a new request and may be adjusted at will. +-} +type alias RequestParts a = + { method : String + , headers : List Http.Header + , url : String + , body : Http.Body + , expect : Http.Expect a + , timeout : Maybe Float + , withCredentials : Bool + } - targetUrl = - case url.query of - Nothing -> - String.dropRight 1 (Url.toString url) ++ qs - Just _ -> - String.dropRight 1 (Url.toString url) ++ "&" ++ String.dropLeft 1 qs - in - Navigation.load targetUrl - - -authenticate : AdjustRequest ResponseToken -> Authentication -> Http.Request ResponseToken -authenticate adjust authentication = - case authentication of - AuthorizationCode { credentials, code, redirectUri, scope, state, url } -> - let - body = - [ Url.string "grant_type" "authorization_code" - , Url.string "client_id" credentials.clientId - , Url.string "redirect_uri" (fmtRedirectUri redirectUri) - , Url.string "code" code - ] - |> urlAddList "scope" scope - |> urlAddMaybe "state" state - |> Url.toQuery - |> String.dropLeft 1 - - headers = - authHeader <| - if String.isEmpty credentials.secret then - Nothing - - else - Just credentials - in - makeRequest adjust url headers body - - ClientCredentials { credentials, scope, state, url } -> - let - body = - [ Url.string "grant_type" "client_credentials" ] - |> urlAddList "scope" scope - |> urlAddMaybe "state" state - |> Url.toQuery - |> String.dropLeft 1 - - headers = - authHeader (Just { clientId = credentials.clientId, secret = credentials.secret }) - in - makeRequest adjust url headers body - - Password { credentials, password, scope, state, url, username } -> - let - body = - [ Url.string "grant_type" "password" - , Url.string "username" username - , Url.string "password" password - ] - |> urlAddList "scope" scope - |> urlAddMaybe "state" state - |> Url.toQuery - |> String.dropLeft 1 - - headers = - authHeader credentials - in - makeRequest adjust url headers body - - Refresh { credentials, scope, token, url } -> - let - refreshToken = - case token of - Bearer t -> - t - - body = - [ Url.string "grant_type" "refresh_token" - , Url.string "refresh_token" refreshToken +{-| Request configuration for an authorization (Authorization Code & Implicit flows) +-} +type alias Authorization = + { clientId : String + , url : Url + , redirectUri : Url + , scope : List String + , state : Maybe String + } + + +{-| Describes an OAuth error as a result of an authorization request failure + + - error (_REQUIRED_): + A single ASCII error code. + + - errorDescription (_OPTIONAL_) + Human-readable ASCII text providing additional information, used to assist the client developer in + understanding the error that occurred. Values for the `errorDescription` parameter MUST NOT + include characters outside the set `%x20-21 / %x23-5B / %x5D-7E`. + + - errorUri (_OPTIONAL_): + A URI identifying a human-readable web page with information about the error, used to + provide the client developer with additional information about the error. Values for the + `errorUri` parameter MUST conform to the URI-reference syntax and thus MUST NOT include + characters outside the set `%x21 / %x23-5B / %x5D-7E`. + + - state (_REQUIRED if `state` was present in the authorization request_): + The exact value received from the client + +-} +type alias AuthorizationError e = + { error : e + , errorDescription : Maybe String + , errorUri : Maybe String + , state : Maybe String + } + + +{-| The response obtained as a result of an authentication (implicit or not) + + - token (_REQUIRED_): + The access token issued by the authorization server. + + - refreshToken (_OPTIONAL_): + The refresh token, which can be used to obtain new access tokens using the same authorization + grant as described in [Section 6](https://tools.ietf.org/html/rfc6749#section-6). + + - expiresIn (_RECOMMENDED_): + The lifetime in seconds of the access token. For example, the value "3600" denotes that the + access token will expire in one hour from the time the response was generated. If omitted, the + authorization server SHOULD provide the expiration time via other means or document the default + value. + + - scope (_OPTIONAL, if identical to the scope requested; otherwise, REQUIRED_): + The scope of the access token as described by [Section 3.3](https://tools.ietf.org/html/rfc6749#section-3.3). + +-} +type alias AuthenticationSuccess = + { token : Token + , refreshToken : Maybe Token + , expiresIn : Maybe Int + , scope : List String + } + + +{-| Describes an OAuth error as a result of a request failure + + - error (_REQUIRED_): + A single ASCII error code. + + - errorDescription (_OPTIONAL_) + Human-readable ASCII text providing additional information, used to assist the client developer in + understanding the error that occurred. Values for the `errorDescription` parameter MUST NOT + include characters outside the set `%x20-21 / %x23-5B / %x5D-7E`. + + - errorUri (_OPTIONAL_): + A URI identifying a human-readable web page with information about the error, used to + provide the client developer with additional information about the error. Values for the + `errorUri` parameter MUST conform to the URI-reference syntax and thus MUST NOT include + characters outside the set `%x21 / %x23-5B / %x5D-7E`. + +-} +type alias AuthenticationError e = + { error : e + , errorDescription : Maybe String + , errorUri : Maybe String + } + + +{-| Describes the desired type of response to an authorization. Use `Code` to ask for an +authorization code and continue with the according flow. Use `Token` to do an implicit +authentication and directly retrieve a `Token` from the authorization. +-} +type ResponseType + = Code + | Token + + + +-- +-- Json Decoders +-- + + +{-| Json decoder for a response. You may provide a custom response decoder using other decoders +from this module, or some of your own craft. +-} +authenticationSuccessDecoder : Json.Decoder AuthenticationSuccess +authenticationSuccessDecoder = + Json.map4 AuthenticationSuccess + tokenDecoder + refreshTokenDecoder + expiresInDecoder + scopeDecoder + + +authenticationErrorDecoder : Json.Decoder e -> Json.Decoder (AuthenticationError e) +authenticationErrorDecoder errorCodeDecoder = + Json.map3 AuthenticationError + errorCodeDecoder + errorDescriptionDecoder + errorUriDecoder + + +{-| Json decoder for an expire timestamp +-} +expiresInDecoder : Json.Decoder (Maybe Int) +expiresInDecoder = + Json.maybe <| Json.field "expires_in" Json.int + + +{-| Json decoder for a scope +-} +scopeDecoder : Json.Decoder (List String) +scopeDecoder = + Json.map (Maybe.withDefault []) <| Json.maybe <| Json.field "scope" (Json.list Json.string) + + +{-| Json decoder for a scope, allowing comma- or space-separated scopes +-} +lenientScopeDecoder : Json.Decoder (List String) +lenientScopeDecoder = + Json.map (Maybe.withDefault []) <| + Json.maybe <| + Json.field "scope" <| + Json.oneOf + [ Json.list Json.string + , Json.map (String.split ",") Json.string ] - |> urlAddList "scope" scope - |> Url.toQuery - |> String.dropLeft 1 - headers = - authHeader credentials - in - makeRequest adjust url headers body + +{-| Json decoder for a state +-} +stateDecoder : Json.Decoder (Maybe String) +stateDecoder = + Json.maybe <| Json.field "state" Json.string + + +{-| Json decoder for an access token +-} +tokenDecoder : Json.Decoder Token +tokenDecoder = + Json.andThen decoderFromResult <| + Json.map2 makeToken + (Json.field "token_type" Json.string |> Json.map Just) + (Json.field "access_token" Json.string |> Json.map Just) + + +{-| Json decoder for a refresh token +-} +refreshTokenDecoder : Json.Decoder (Maybe Token) +refreshTokenDecoder = + Json.andThen decoderFromResult <| + Json.map2 makeRefreshToken + (Json.field "token_type" Json.string) + (Json.field "refresh_token" Json.string |> Json.maybe) + + +{-| Json decoder for 'error' field +-} +errorDecoder : (String -> a) -> Json.Decoder a +errorDecoder errorCodeFromString = + Json.map errorCodeFromString <| Json.field "error" Json.string + + +{-| Json decoder for 'error\_description' field +-} +errorDescriptionDecoder : Json.Decoder (Maybe String) +errorDescriptionDecoder = + Json.maybe <| Json.field "error_description" Json.string + + +{-| Json decoder for 'error\_uri' field +-} +errorUriDecoder : Json.Decoder (Maybe String) +errorUriDecoder = + Json.maybe <| Json.field "error_uri" Json.string + -makeRequest : AdjustRequest ResponseToken -> Url -> List Http.Header -> String -> Http.Request ResponseToken -makeRequest adjust url headers body = +-- +-- Query Parsers +-- + + +authorizationErrorParser : e -> Query.Parser (AuthorizationError e) +authorizationErrorParser errorCode = + Query.map3 (AuthorizationError errorCode) + errorDescriptionParser + errorUriParser + stateParser + + +tokenParser : Query.Parser (Result String Token) +tokenParser = + Query.map2 makeToken + (Query.string "token_type") + (Query.string "access_token") + + +errorParser : (String -> e) -> Query.Parser (Maybe e) +errorParser errorCodeFromString = + Query.map (Maybe.map errorCodeFromString) + (Query.string "error") + + +expiresInParser : Query.Parser (Maybe Int) +expiresInParser = + Query.int "expires_in" + + +scopeParser : Query.Parser (List String) +scopeParser = + spaceSeparatedListParser "scope" + + +stateParser : Query.Parser (Maybe String) +stateParser = + Query.string "state" + + +errorDescriptionParser : Query.Parser (Maybe String) +errorDescriptionParser = + Query.string "error_description" + + +errorUriParser : Query.Parser (Maybe String) +errorUriParser = + Query.string "error_uri" + + +spaceSeparatedListParser : String -> Query.Parser (List String) +spaceSeparatedListParser param = + Query.map (\s -> Maybe.withDefault "" s |> String.split " ") (Query.string param) + + + +-- +-- Smart Constructors +-- + + +makeAuthUrl : ResponseType -> Authorization -> Url +makeAuthUrl responseType { clientId, url, redirectUri, scope, state } = let - requestParts = - { method = "POST" - , headers = headers - , url = Url.toString url - , body = Http.stringBody "application/x-www-form-urlencoded" body - , expect = Http.expectJson responseDecoder - , timeout = Nothing - , withCredentials = False - } + query = + [ Builder.string "client_id" clientId + , Builder.string "redirect_uri" (makeRedirectUri redirectUri) + , Builder.string "response_type" (responseTypeToString responseType) + ] + |> urlAddList "scope" scope + |> urlAddMaybe "state" state + |> Builder.toQuery + |> String.dropLeft 1 in - requestParts - |> adjust - |> Http.request + case url.query of + Nothing -> + { url | query = Just query } + Just baseQuery -> + { url | query = Just (baseQuery ++ "&" ++ query) } -authHeader : Maybe Credentials -> List Http.Header -authHeader credentials = + +makeRequest : Url -> List Http.Header -> String -> RequestParts AuthenticationSuccess +makeRequest url headers body = + { method = "POST" + , headers = headers + , url = Url.toString url + , body = Http.stringBody "application/x-www-form-urlencoded" body + , expect = Http.expectJson authenticationSuccessDecoder + , timeout = Nothing + , withCredentials = False + } + + +makeHeaders : Maybe { clientId : String, secret : String } -> List Http.Header +makeHeaders credentials = credentials |> Maybe.map (\{ clientId, secret } -> Base64.encode (clientId ++ ":" ++ secret)) |> Maybe.map (\s -> [ Http.header "Authorization" ("Basic " ++ s) ]) |> Maybe.withDefault [] -parseError : String -> Maybe String -> Maybe String -> Maybe String -> Result ParseErr a -parseError error errorDescription errorUri state = - Result.Err <| - OAuthErr - { error = errCodeFromString error - , errorDescription = errorDescription - , errorUri = errorUri - , state = state - } - - -parseToken : String -> Maybe String -> Maybe Int -> List String -> Maybe String -> Result ParseErr ResponseToken -parseToken accessToken mTokenType mExpiresIn scope state = - case Maybe.map String.toLower mTokenType of - Just "bearer" -> - Ok <| - { expiresIn = mExpiresIn - , refreshToken = Nothing - , scope = scope - , state = state - , token = Bearer accessToken - } - - Just _ -> - Result.Err <| Invalid [ "token_type" ] +makeRedirectUri : Url -> String +makeRedirectUri url = + String.concat + [ protocolToString url.protocol + , "://" + , url.host + , Maybe.withDefault "" (Maybe.map (\i -> ":" ++ String.fromInt i) url.port_) + , url.path + , Maybe.withDefault "" (Maybe.map (\q -> "?" ++ q) url.query) + ] + + +type alias TokenType = + String + + +type alias TokenString = + String + + +makeToken : Maybe TokenType -> Maybe TokenString -> Result String Token +makeToken mTokenType mToken = + let + construct a b = + tokenFromString (a ++ " " ++ b) + in + case maybeAndThen2 construct mTokenType mToken of + Just token -> + Ok <| token + + _ -> + Err "missing or invalid combination of 'access_token' and 'token_type' field(s)" + + +makeRefreshToken : TokenType -> Maybe TokenString -> Result String (Maybe Token) +makeRefreshToken tokenType mToken = + let + construct a b = + tokenFromString (a ++ " " ++ b) + in + case ( mToken, maybeAndThen2 construct (Just tokenType) mToken ) of + ( Nothing, _ ) -> + Ok <| Nothing + + ( _, Just token ) -> + Ok <| Just token + + _ -> + Err "missing or invalid combination of 'refresh_token' and 'token_type' field(s)" + + + +-- +-- String utilities +-- - Nothing -> - Result.Err <| Missing [ "token_type" ] +{-| Gets the `String` representation of a `ResponseType`. +-} +responseTypeToString : ResponseType -> String +responseTypeToString r = + case r of + Code -> + "code" -parseAuthorizationCode : String -> Maybe String -> Result a ResponseCode -parseAuthorizationCode code state = - Ok <| - { code = code - , state = state - } + Token -> + "token" + + +{-| Gets the `String` representation of an `Protocol` +-} +protocolToString : Protocol -> String +protocolToString protocol = + case protocol of + Http -> + "http" + + Https -> + "https" + + + +-- +-- Utils +-- + + +maybeAndThen2 : (a -> b -> Maybe c) -> Maybe a -> Maybe b -> Maybe c +maybeAndThen2 fn ma mb = + Maybe.andThen identity (Maybe.map2 fn ma mb) urlAddList : String -> List String -> List QueryParameter -> List QueryParameter @@ -194,7 +428,7 @@ urlAddList param xs qs = [] _ -> - [ Url.string param (String.join " " xs) ] + [ Builder.string param (String.join " " xs) ] ) @@ -206,32 +440,39 @@ urlAddMaybe param ms qs = [] Just s -> - [ Url.string param s ] + [ Builder.string param s ] ) -qsSpaceSeparatedList : String -> Query.Parser (List String) -qsSpaceSeparatedList param = - Query.map (\s -> Maybe.withDefault "" s |> String.split " ") (Query.string param) +parseUrlQuery : Url -> a -> Query.Parser a -> a +parseUrlQuery url def parser = + Maybe.withDefault def <| Url.parse (Url.query parser) url -showProtocol : Protocol -> String -showProtocol protocol = - case protocol of - Http -> - "http" +{-| Extracts the intrinsic value of a `Token`. Careful with this, we don't have +access to the `Token` constructors, so it's a bit Houwje-Touwje +-} +extractTokenString : Token -> String +extractTokenString = + tokenToString >> String.dropLeft 7 - Https -> - "https" +{-| Combinator for JSON decoders to extract values from a `Maybe` or fail +with the given message (when `Nothing` is encountered) +-} +decoderFromJust : String -> Maybe a -> Json.Decoder a +decoderFromJust msg = + Maybe.map Json.succeed >> Maybe.withDefault (Json.fail msg) -fmtRedirectUri : Url -> String -fmtRedirectUri url = - String.concat - [ showProtocol url.protocol - , "://" - , url.host - , Maybe.withDefault "" (Maybe.map (\i -> ":" ++ String.fromInt i) url.port_) - , url.path - , Maybe.withDefault "" (Maybe.map (\q -> "?" ++ q) url.query) - ] + +{-| Combinator for JSON decoders to extact values from a `Result _ _` or fail +with an appropriate message +-} +decoderFromResult : Result String a -> Json.Decoder a +decoderFromResult res = + case res of + Err msg -> + Json.fail msg + + Ok a -> + Json.succeed a diff --git a/src/OAuth.elm b/src/OAuth.elm index 51b8cca..9684a47 100644 --- a/src/OAuth.elm +++ b/src/OAuth.elm @@ -1,7 +1,7 @@ module OAuth exposing - ( use - , Authorization, Authentication(..), Credentials, ResponseType(..), showResponseType - , ResponseToken, ResponseCode, Token(..), Err, ParseErr(..), ErrCode(..), showToken, showErrCode, errCodeFromString, errDecoder + ( Token, useToken + , ErrorCode(..), errorCodeToString, errorCodeFromString + , tokenFromString, tokenToString ) {-| Utility library to manage client-side OAuth 2.0 authentications @@ -31,250 +31,49 @@ In practice, you most probably want to use the _OAuth.Implicit_ module which is used. -## Use a token +## Token -@docs use +@docs Token, useToken, tokenToString. tokenFromString -## Requests +## ErrorCode -@docs Authorization, Authentication, Credentials, ResponseType, showResponseType +@docs ErrorCode, errorCodeToString, errorCodeFromString - -## Responses - -@docs ResponseToken, ResponseCode, Token, Err, ParseErr, ErrCode, showToken, showErrCode, errCodeFromString, errDecoder - --} - -import Http -import Json.Decode as Json -import Url exposing (Url) - - -{-| Request configuration for an authorization (Authorization Code & Implicit flows) --} -type alias Authorization = - { clientId : String - , url : Url - , redirectUri : Url - , responseType : ResponseType - , scope : List String - , state : Maybe String - } - - -{-| Request configuration for an authentication (Authorization Code, Password & Client Credentials -flows) - - -- AuthorizationCode - let req = OAuth.AuthorizationCode - { credentials = - -- Only the clientId is required. Specify a secret - -- if a Basic OAuth is required by the resource - -- provider - { clientId = "" - , secret = "" - } - -- Authorization code from the authorization result - , code = "" - -- Token endpoint of the resource provider - , url = "" - -- Redirect Uri to your webserver - , redirectUri = "" - -- Scopes requested, can be empty - , scope = ["read:whatever"] - -- A state, echoed back by the resource provider - , state = Just "whatever" - } - - -- ClientCredentials - let req = OAuth.ClientCredentials - { credentials = - -- Credentials passed along via Basic auth - { clientId = "" - , secret = "" - } - -- Token endpoint of the resource provider - , url = "" - -- Scopes requested, can be empty - , scope = ["read:whatever"] - -- A state, echoed back by the resource provider - , state = Just "whatever" - } - - -- Password - let req = OAuth.Password - { credentials = Just - -- Optional, unless required by the resource provider - { clientId = "" - , secret = "" - } - -- Resource owner's password - , password = "" - -- Scopes requested, can be empty - , scope = ["read:whatever"] - -- A state, echoed back by the resource provider - , state = Just "whatever" - -- Token endpoint of the resource provider - , url = "" - -- Resource owner's username - , username = "" - } - - -- Refresh - let req = OAuth.Refresh - -- Optional, unless required by the resource provider - { credentials = Nothing - -- Scopes requested, can be empty - , scope = ["read:whatever"] - -- A refresh token previously delivered - , token = OAuth.Bearer "abcdef1234567890" - -- Token endpoint of the resource provider - , url = "" - } - --} -type Authentication - = AuthorizationCode - { credentials : Credentials - , code : String - , redirectUri : Url - , scope : List String - , state : Maybe String - , url : Url - } - | ClientCredentials - { credentials : Credentials - , scope : List String - , state : Maybe String - , url : Url - } - | Password - { credentials : Maybe Credentials - , password : String - , scope : List String - , state : Maybe String - , url : Url - , username : String - } - | Refresh - { credentials : Maybe Credentials - , token : Token - , scope : List String - , url : Url - } - - -{-| Describes a couple of client credentials used for Basic authentication --} -type alias Credentials = - { clientId : String, secret : String } - - -{-| Describes the desired type of response to an authorization. Use `Code` to ask for an -authorization code and continue with the according flow. Use `Token` to do an implicit -authentication and directly retrieve a `Token` from the authorization. -} -type ResponseType - = Code - | Token - -{-| The response obtained as a result of an authentication (implicit or not) +import Http as Http - - expiresIn (_RECOMMENDED_): - The lifetime in seconds of the access token. For example, the value "3600" denotes that the - access token will expire in one hour from the time the response was generated. If omitted, the - authorization server SHOULD provide the expiration time via other means or document the default - value. - - refreshToken (_OPTIONAL_): - The refresh token, which can be used to obtain new access tokens using the same authorization - grant as described in [Section 6](https://tools.ietf.org/html/rfc6749#section-6). - - scope (_OPTIONAL, if identical to the scope requested; otherwise, REQUIRED_): - The scope of the access token as described by [Section 3.3](https://tools.ietf.org/html/rfc6749#section-3.3). +-- +-- Token +-- - - state (_REQUIRED if `state` was present in the authentication request_): - The exact value received from the client - - token (_REQUIRED_): - The access token issued by the authorization server. - --} -type alias ResponseToken = - { expiresIn : Maybe Int - , refreshToken : Maybe Token - , scope : List String - , state : Maybe String - , token : Token - } - - -{-| The response obtained as a result of an authorization +{-| Describes the type of access token to use. - - code (_REQUIRED_): - The authorization code generated by the authorization server. The authorization code MUST expire - shortly after it is issued to mitigate the risk of leaks. A maximum authorization code lifetime of - 10 minutes is RECOMMENDED. The client MUST NOT use the authorization code more than once. If an - authorization code is used more than once, the authorization server MUST deny the request and - SHOULD revoke (when possible) all tokens previously issued based on that authorization code. The - authorization code is bound to the client identifier and redirection URI. + - Bearer: Utilized by simply including the access token string in the request + [rfc6750](https://tools.ietf.org/html/rfc6750) - - state (_REQUIRED if `state` was present in the authorization request_): - The exact value received from the client + - Mac: Not yet supported. -} -type alias ResponseCode = - { code : String - , state : Maybe String - } - - -{-| Describes errors coming from attempting to parse a url after an OAuth redirection +type Token + = Bearer String - - Empty: means there were nothing (related to OAuth 2.0) to parse - - OAuthErr: a successfully parsed OAuth 2.0 error - - Missing: means the OAuth provider didn't with all the required parameters for the given grant type. - - Invalid: means the OAuth provider did reply with an invalid parameter for the given grant type. - - FailedToParse: means that the given URL is badly constructed +{-| Use a token to authenticate a request. -} -type ParseErr - = Empty - | OAuthErr Err - | Missing (List String) - | Invalid (List String) - | FailedToParse - +useToken : Token -> List Http.Header -> List Http.Header +useToken token = + (::) (Http.header "Authorization" (tokenToString token)) -{-| Describes an OAuth error as a result of a request failure - - error (_REQUIRED_): - A single ASCII error code. - - errorDescription (_OPTIONAL_) - Human-readable ASCII text providing additional information, used to assist the client developer in - understanding the error that occurred. Values for the `errorDescription` parameter MUST NOT - include characters outside the set `%x20-21 / %x23-5B / %x5D-7E`. - - - errorUri (_OPTIONAL_): - A URI identifying a human-readable web page with information about the error, used to - provide the client developer with additional information about the error. Values for the - `errorUri` parameter MUST conform to the URI-reference syntax and thus MUST NOT include - characters outside the set `%x21 / %x23-5B / %x5D-7E`. - - - state (_REQUIRED if `state` was present in the authorization request_): - The exact value received from the client - --} -type alias Err = - { error : ErrCode - , errorDescription : Maybe String - , errorUri : Maybe String - , state : Maybe String - } +-- +-- Error +-- {-| Describes an OAuth error response [4.1.2.1](https://tools.ietf.org/html/rfc6749#section-4.1.2.1) @@ -300,10 +99,8 @@ type alias Err = a temporary overloading or maintenance of the server. (This error code is needed because a 503 Service Unavailable HTTP status code cannot be returned to the client via an HTTP redirect.) - - Unknown: The server returned an unknown error code. - -} -type ErrCode +type ErrorCode = InvalidRequest | UnauthorizedClient | AccessDenied @@ -311,51 +108,26 @@ type ErrCode | InvalidScope | ServerError | TemporarilyUnavailable - | Unknown - - -{-| Describes the type of access token to use. - - - Bearer: Utilized by simply including the access token string in the request - [rfc6750](https://tools.ietf.org/html/rfc6750) - - - Mac: Not yet supported. - --} -type Token - = Bearer String - + | Custom String -{-| Use a token to authenticate a request. --} -use : Token -> List Http.Header -> List Http.Header -use token = - (::) (Http.header "Authorization" (showToken token)) -{-| Gets the `String` representation of a `ResponseType`. --} -showResponseType : ResponseType -> String -showResponseType r = - case r of - Code -> - "code" - - Token -> - "token" +-- +-- String Utilities +-- -{-| Gets the `String` representation of a `Token`. +{-| Gets the `String` representation of a `Token` to be used in an 'Authorization' header -} -showToken : Token -> String -showToken (Bearer t) = +tokenToString : Token -> String +tokenToString (Bearer t) = "Bearer " ++ t -{-| Gets the `String` representation of an `ErrCode`. +{-| Gets the `String` representation of an `ErrorCode`. -} -showErrCode : ErrCode -> String -showErrCode err = +errorCodeToString : ErrorCode -> String +errorCodeToString err = case err of InvalidRequest -> "invalid_request" @@ -378,15 +150,28 @@ showErrCode err = TemporarilyUnavailable -> "temporarily_unavailable" - Unknown -> - "unknown" + Custom str -> + str -{-| Attempts to parse a `String` into an `ErrCode` code. Will parse to `Unknown` when the string -isn't recognized. --} -errCodeFromString : String -> ErrCode -errCodeFromString str = + +-- +-- (Smart) Constructors +-- + + +tokenFromString : String -> Maybe Token +tokenFromString str = + case ( String.left 6 str, String.dropLeft 7 str ) of + ( "Bearer", t ) -> + Just (Bearer t) + + _ -> + Nothing + + +errorCodeFromString : String -> ErrorCode +errorCodeFromString str = case str of "invalid_request" -> InvalidRequest @@ -410,23 +195,4 @@ errCodeFromString str = TemporarilyUnavailable _ -> - Unknown - - -{-| A json decoder for response error carried by the `Result Http.Error OAuth.ResponseToken` result of -an http call. --} -errDecoder : Json.Decoder Err -errDecoder = - Json.map4 - (\error errorUri errorDescription state -> - { error = error - , errorUri = errorUri - , errorDescription = errorDescription - , state = state - } - ) - (Json.map errCodeFromString <| Json.field "error" Json.string) - (Json.maybe <| Json.field "error_uri" Json.string) - (Json.maybe <| Json.field "error_description" Json.string) - (Json.maybe <| Json.field "state" Json.string) + Custom str diff --git a/src/OAuth/AuthorizationCode.elm b/src/OAuth/AuthorizationCode.elm index a74e0cf..95627ba 100644 --- a/src/OAuth/AuthorizationCode.elm +++ b/src/OAuth/AuthorizationCode.elm @@ -1,6 +1,6 @@ module OAuth.AuthorizationCode exposing - ( authorize, parse - , authenticate, authenticateWithOpts + ( Authorization, AuthorizationResult(..), AuthorizationSuccess, AuthorizationError, parseCode, makeAuthUrl + , Authentication, Credentials, AuthenticationSuccess, AuthenticationError, RequestParts, makeTokenRequest, authenticationErrorDecoder ) {-| The authorization code grant type is used to obtain both access @@ -22,90 +22,196 @@ request. ## Authorize -@docs authorize, parse +@docs Authorization, AuthorizationResult, AuthorizationSuccess, AuthorizationError, parseCode, makeAuthUrl ## Authenticate -@docs authenticate, authenticateWithOpts +@docs Authentication, Credentials, AuthenticationSuccess, AuthenticationError, RequestParts, makeTokenRequest, authenticationErrorDecoder -} -import Browser.Navigation as Navigation -import Http as Http -import Internal as Internal -import OAuth exposing (..) -import OAuth.Decode exposing (..) +import Internal as Internal exposing (..) +import Json.Decode as Json +import OAuth exposing (ErrorCode, Token, errorCodeFromString) import Url exposing (Url) +import Url.Builder as Builder import Url.Parser as Url exposing (()) import Url.Parser.Query as Query -{-| Redirects the resource owner (user) to the resource provider server using the specified -authorization flow. -In this case, use `Code` as a `responseType` +-- +-- Authorize +-- --} -authorize : Authorization -> Cmd msg -authorize = - Internal.authorize + +type alias Authorization = + Internal.Authorization + + +type alias AuthorizationError = + Internal.AuthorizationError ErrorCode -{-| Authenticate the client using the authorization code obtained from the authorization. +{-| The response obtained as a result of an authorization -In this case, use the `AuthorizationCode` constructor. + - code (_REQUIRED_): + The authorization code generated by the authorization server. The authorization code MUST expire + shortly after it is issued to mitigate the risk of leaks. A maximum authorization code lifetime of + 10 minutes is RECOMMENDED. The client MUST NOT use the authorization code more than once. If an + authorization code is used more than once, the authorization server MUST deny the request and + SHOULD revoke (when possible) all tokens previously issued based on that authorization code. The + authorization code is bound to the client identifier and redirection URI. + + - state (_REQUIRED if `state` was present in the authorization request_): + The exact value received from the client -} -authenticate : Authentication -> Http.Request ResponseToken -authenticate = - Internal.authenticate identity +type alias AuthorizationSuccess = + { code : String + , state : Maybe String + } + + +{-| Describes errors coming from attempting to parse a url after an OAuth redirection + - Empty: means there were nothing (related to OAuth 2.0) to parse + - Error: a successfully parsed OAuth 2.0 error + - Success: a successfully parsed the response -{-| Authenticate the client using the authorization code obtained from the authorization, passing -additional custom options. Use with care. +-} +type AuthorizationResult + = Empty + | Error AuthorizationError + | Success AuthorizationSuccess -In this case, use the `AuthorizationCode` constructor. +{-| Redirects the resource owner (user) to the resource provider server using the specified +authorization flow. -} -authenticateWithOpts : AdjustRequest ResponseToken -> Authentication -> Http.Request ResponseToken -authenticateWithOpts fn = - Internal.authenticate fn +makeAuthUrl : Authorization -> Url +makeAuthUrl = + Internal.makeAuthUrl Internal.Code {-| Parse the location looking for a parameters set by the resource provider server after redirecting the resource owner (user). -Fails with a `ParseErr Empty` when there's nothing +Fails with a `AuthorizationResult Empty` when there's nothing -} -parse : Url -> Result ParseErr ResponseCode -parse url_ = +parseCode : Url -> AuthorizationResult +parseCode url_ = let url = { url_ | path = "/" } - - tokenTypeParser = - Url.top - Query.map2 Tuple.pair (Query.string "code") (Query.string "error") - - authorizationCodeParser code = - Url.query <| - Query.map (Internal.parseAuthorizationCode code) (Query.string "state") - - errorParser error = - Url.query <| - Query.map3 (Internal.parseError error) - (Query.string "error_description") - (Query.string "error_url") - (Query.string "state") in - case Url.parse tokenTypeParser url of + case Url.parse (Url.top Query.map2 Tuple.pair codeParser (errorParser errorCodeFromString)) url of Just ( Just code, _ ) -> - Maybe.withDefault (Result.Err FailedToParse) <| Url.parse (authorizationCodeParser code) url + parseUrlQuery url Empty (Query.map Success <| authorizationSuccessParser code) Just ( _, Just error ) -> - Maybe.withDefault (Result.Err FailedToParse) <| Url.parse (errorParser error) url + parseUrlQuery url Empty (Query.map Error <| authorizationErrorParser error) _ -> - Result.Err Empty + Empty + + +authorizationSuccessParser : String -> Query.Parser AuthorizationSuccess +authorizationSuccessParser code = + Query.map (AuthorizationSuccess code) + stateParser + + +codeParser : Query.Parser (Maybe String) +codeParser = + Query.string "code" + + + +-- +-- Authenticate +-- + + +{-| Request configuration for an AuthorizationCode authentication + + let authentication = + { credentials = + -- Only the clientId is required. Specify a secret + -- if a Basic OAuth is required by the resource + -- provider + { clientId = "" + , secret = Nothing + } + -- Authorization code from the authorization result + , code = "" + -- Token endpoint of the resource provider + , url = "" + -- Redirect Uri to your webserver + , redirectUri = "" + } + +-} +type alias Authentication = + { credentials : Credentials + , code : String + , redirectUri : Url + , url : Url + } + + +type alias AuthenticationSuccess = + Internal.AuthenticationSuccess + + +type alias AuthenticationError = + Internal.AuthenticationError ErrorCode + + +type alias RequestParts a = + Internal.RequestParts a + + +{-| Describes at least a `clientId` and if define, a complete set of credentials with the `secret` +-} +type alias Credentials = + { clientId : String + , secret : Maybe String + } + + +authenticationErrorDecoder : Json.Decoder AuthenticationError +authenticationErrorDecoder = + Internal.authenticationErrorDecoder (errorDecoder errorCodeFromString) + + +{-| Builds a the request components required to get a token from an authorization code + + let req : Http.Request AuthenticationSuccess + req = makeTokenRequest authentication |> Http.request + +-} +makeTokenRequest : Authentication -> RequestParts AuthenticationSuccess +makeTokenRequest { credentials, code, url, redirectUri } = + let + body = + [ Builder.string "grant_type" "authorization_code" + , Builder.string "client_id" credentials.clientId + , Builder.string "redirect_uri" (makeRedirectUri redirectUri) + , Builder.string "code" code + ] + |> Builder.toQuery + |> String.dropLeft 1 + + headers = + makeHeaders <| + case credentials.secret of + Nothing -> + Nothing + + Just secret -> + Just { clientId = credentials.clientId, secret = secret } + in + makeRequest url headers body diff --git a/src/OAuth/ClientCredentials.elm b/src/OAuth/ClientCredentials.elm index 58ec6ce..1e8a59a 100644 --- a/src/OAuth/ClientCredentials.elm +++ b/src/OAuth/ClientCredentials.elm @@ -1,8 +1,4 @@ -module OAuth.ClientCredentials - exposing - ( authenticate - , authenticateWithOpts - ) +module OAuth.ClientCredentials exposing (Authentication, Credentials, AuthenticationSuccess, AuthenticationError, RequestParts, makeTokenRequest, authenticationErrorDecoder) {-| The client can request an access token using only its client credentials (or other supported means of authentication) when the client is requesting access to @@ -20,32 +16,83 @@ request. ## Authenticate -@docs authenticate, authenticateWithOpts +@docs Authentication, Credentials, AuthenticationSuccess, AuthenticationError, RequestParts, makeTokenRequest, authenticationErrorDecoder -} -import OAuth exposing (..) -import OAuth.Decode exposing (..) -import Internal as Internal -import Http as Http +import Internal as Internal exposing (..) +import Json.Decode as Json +import OAuth exposing (ErrorCode(..), errorCodeFromString) +import Url exposing (Url) +import Url.Builder as Builder -{-| Authenticate the client using the authorization code obtained from the authorization. +{-| Request configuration for a ClientCredentials authentication -In this case, use the `ClientCredentials` constructor. + let authentication = + { credentials = + -- Token endpoint of the resource provider + , url = "" + -- Scopes requested, can be empty + , scope = ["read:whatever"] + } -} -authenticate : Authentication -> Http.Request ResponseToken -authenticate = - Internal.authenticate identity +type alias Authentication = + { credentials : Credentials + , scope : List String + , url : Url + } -{-| Authenticate the client using the authorization code obtained from the authorization, passing -additional custom options. Use with care. +{-| Describes a couple of client credentials used for Basic authentication -In this case, use the `ClientCredentials` constructor. + { clientId = "" + , secret = "" + } -} -authenticateWithOpts : AdjustRequest ResponseToken -> Authentication -> Http.Request ResponseToken -authenticateWithOpts fn = - Internal.authenticate fn +type alias Credentials = + { clientId : String, secret : String } + + +type alias AuthenticationSuccess = + Internal.AuthenticationSuccess + + +type alias AuthenticationError = + Internal.AuthenticationError ErrorCode + + +type alias RequestParts a = + Internal.RequestParts a + + +authenticationErrorDecoder : Json.Decoder AuthenticationError +authenticationErrorDecoder = + Internal.authenticationErrorDecoder (errorDecoder errorCodeFromString) + + +{-| Builds a the request components required to get a token from client credentials + + let req : Http.Request TokenResponse + req = makeTokenRequest authentication |> Http.request + +-} +makeTokenRequest : Authentication -> RequestParts AuthenticationSuccess +makeTokenRequest { credentials, scope, url } = + let + body = + [ Builder.string "grant_type" "client_credentials" ] + |> urlAddList "scope" scope + |> Builder.toQuery + |> String.dropLeft 1 + + headers = + makeHeaders <| + Just + { clientId = credentials.clientId + , secret = credentials.secret + } + in + makeRequest url headers body diff --git a/src/OAuth/Decode.elm b/src/OAuth/Decode.elm deleted file mode 100644 index 69c4ac0..0000000 --- a/src/OAuth/Decode.elm +++ /dev/null @@ -1,213 +0,0 @@ -module OAuth.Decode exposing - ( RequestParts, AdjustRequest - , responseDecoder, lenientResponseDecoder - , expiresInDecoder, scopeDecoder, lenientScopeDecoder, stateDecoder, accessTokenDecoder, refreshTokenDecoder - , makeToken, makeResponseToken - ) - -{-| This module exposes decoders and helpers to fine tune some requests when necessary. - -This might come in handy for provider that doesn't exactly implement the OAuth 2.0 RFC -(like the API v3 of GitHub). With these utilities, one should hopefully be able to adjust -requests made to the Authorization Server and cope with implementation quirks. - - -## Type Utilities - -@docs RequestParts, AdjustRequest - - -## Json Response Decoders - -@docs responseDecoder, lenientResponseDecoder - - -## Json Field Decoders - -@docs expiresInDecoder, scopeDecoder, lenientScopeDecoder, stateDecoder, accessTokenDecoder, refreshTokenDecoder - - -## Constructors - -@docs makeToken, makeResponseToken - --} - -import Http as Http -import Json.Decode as Json -import OAuth exposing (..) - - -{-| Parts required to build a request. This record is given to `Http.request` in order -to create a new request and may be adjusted at will. --} -type alias RequestParts a = - { method : String - , headers : List Http.Header - , url : String - , body : Http.Body - , expect : Http.Expect a - , timeout : Maybe Float - , withCredentials : Bool - } - - -{-| Alias for the behavior passed to some function in order to adjust Http Request before they get -sent - -For instance, - - adjustRequest : AdjustRequest ResponseToken - adjustRequest req = - { req | headers = [ Http.header "Accept" "application/json" ] :: req.headers } - --} -type alias AdjustRequest a = - RequestParts a -> RequestParts a - - -{-| Json decoder for a response. You may provide a custom response decoder using other decoders -from this module, or some of your own craft. - -For instance, - - myScopeDecoder : Json.Decoder (Maybe (List String)) - myScopeDecoder = - Json.maybe <| - Json.oneOf - [ Json.field "scope" (Json.map (String.split ",") Json.string) ] - - myResponseDecoder : Json.Decoder ResponseToken - myResponseDecoder = - Json.map5 makeResponseToken - accessTokenDecoder - expiresInDecoder - refreshTokenDecoder - myScopeDecoder - stateDecoder - --} -responseDecoder : Json.Decoder ResponseToken -responseDecoder = - Json.map5 makeResponseToken - accessTokenDecoder - expiresInDecoder - refreshTokenDecoder - scopeDecoder - stateDecoder - - -{-| Json decoder for a response, using the 'lenientScopeDecoder' under the hood. That's probably -the decoder you want to use when interacting with GitHub OAuth-2.0 API in combination with 'authenticateWithOpts' - - adjustRequest : AdjustRequest ResponseToken - adjustRequest req = - let - headers = - Http.header "Accept" "application/json" :: req.headers - - expect = - Http.expectJson lenientResponseDecoder - in - { req | headers = headers, expect = expect } - - getToken : String -> Cmd ResponseToken - getToken code = - let - req = - OAuth.AuthorizationCode.authenticateWithOpts adjustRequest <| - {{- [ ... ] -}} - in - Http.send handleResponse req - --} -lenientResponseDecoder : Json.Decoder ResponseToken -lenientResponseDecoder = - Json.map5 makeResponseToken - accessTokenDecoder - expiresInDecoder - refreshTokenDecoder - lenientScopeDecoder - stateDecoder - - -{-| Json decoder for an expire timestamp --} -expiresInDecoder : Json.Decoder (Maybe Int) -expiresInDecoder = - Json.maybe <| Json.field "expires_in" Json.int - - -{-| Json decoder for a scope --} -scopeDecoder : Json.Decoder (Maybe (List String)) -scopeDecoder = - Json.maybe <| Json.field "scope" (Json.list Json.string) - - -{-| Json decoder for a scope, allowing comma- or space-separated scopes --} -lenientScopeDecoder : Json.Decoder (Maybe (List String)) -lenientScopeDecoder = - Json.maybe <| - Json.field "scope" <| - Json.oneOf - [ Json.list Json.string - , Json.map (String.split ",") Json.string - ] - - -{-| Json decoder for a state --} -stateDecoder : Json.Decoder (Maybe String) -stateDecoder = - Json.maybe <| Json.field "state" Json.string - - -{-| Json decoder for an access token --} -accessTokenDecoder : Json.Decoder Token -accessTokenDecoder = - let - mtoken = - Json.map2 makeToken - (Json.field "access_token" Json.string |> Json.map Just) - (Json.field "token_type" Json.string) - - failUnless = - Maybe.map Json.succeed >> Maybe.withDefault (Json.fail "can't decode token") - in - Json.andThen failUnless mtoken - - -{-| Json decoder for a refresh token --} -refreshTokenDecoder : Json.Decoder (Maybe Token) -refreshTokenDecoder = - Json.map2 makeToken - (Json.maybe <| Json.field "refresh_token" Json.string) - (Json.field "token_type" Json.string) - - -{-| Create a ResponseToken record from various parameters --} -makeResponseToken : Token -> Maybe Int -> Maybe Token -> Maybe (List String) -> Maybe String -> ResponseToken -makeResponseToken token expiresIn refreshToken scope state = - { token = token - , expiresIn = expiresIn - , refreshToken = refreshToken - , scope = Maybe.withDefault [] scope - , state = state - } - - -{-| Create a Token from a value and token type. Note that only bearer token are supported --} -makeToken : Maybe String -> String -> Maybe Token -makeToken mtoken tokenType = - case ( mtoken, String.toLower tokenType ) of - ( Just token, "bearer" ) -> - Just <| Bearer token - - _ -> - Nothing diff --git a/src/OAuth/Implicit.elm b/src/OAuth/Implicit.elm index d9843dd..fb51d16 100644 --- a/src/OAuth/Implicit.elm +++ b/src/OAuth/Implicit.elm @@ -1,4 +1,4 @@ -module OAuth.Implicit exposing (authorize, parse) +module OAuth.Implicit exposing (Authorization, AuthorizationResult(..), AuthorizationSuccess, AuthorizationError, makeAuthUrl, parseToken) {-| The implicit grant type is used to obtain access tokens (it does not support the issuance of refresh tokens) and is optimized for public clients known to operate a @@ -16,67 +16,109 @@ request. ## Authorize -@docs authorize, parse +@docs Authorization, AuthorizationResult, AuthorizationSuccess, AuthorizationError, makeAuthUrl, parseToken -} -import Browser.Navigation as Navigation -import Internal as Internal -import OAuth exposing (..) +import Internal exposing (..) +import OAuth exposing (ErrorCode(..), Token, errorCodeFromString) import Url exposing (Protocol(..), Url) -import Url.Builder as Url import Url.Parser as Url exposing (()) import Url.Parser.Query as Query -{-| Redirects the resource owner (user) to the resource provider server using the specified -authorization flow. -In this case, use `Token` as a `responseType` +-- +-- Authorize +-- + + +type alias Authorization = + Internal.Authorization + + +type alias AuthorizationError = + Internal.AuthorizationError ErrorCode + + +{-| The response obtained as a result of an authentication (implicit or not) + + - token (_REQUIRED_): + The access token issued by the authorization server. + + - refreshToken (_OPTIONAL_): + The refresh token, which can be used to obtain new access tokens using the same authorization + grant as described in [Section 6](https://tools.ietf.org/html/rfc6749#section-6). + + - expiresIn (_RECOMMENDED_): + The lifetime in seconds of the access token. For example, the value "3600" denotes that the + access token will expire in one hour from the time the response was generated. If omitted, the + authorization server SHOULD provide the expiration time via other means or document the default + value. + + - scope (_OPTIONAL, if identical to the scope requested; otherwise, REQUIRED_): + The scope of the access token as described by [Section 3.3](https://tools.ietf.org/html/rfc6749#section-3.3). + + - state (_REQUIRED if `state` was present in the authorization request_): + The exact value received from the client -} -authorize : Authorization -> Cmd msg -authorize = - Internal.authorize +type alias AuthorizationSuccess = + { token : Token + , refreshToken : Maybe Token + , expiresIn : Maybe Int + , scope : List String + , state : Maybe String + } + + +{-| Describes errors coming from attempting to parse a url after an OAuth redirection + + - Empty: means there were nothing (related to OAuth 2.0) to parse + - Error: a successfully parsed OAuth 2.0 error + - Success: a successfully parsed the response + +-} +type AuthorizationResult + = Empty + | Error AuthorizationError + | Success AuthorizationSuccess + + +{-| Redirects the resource owner (user) to the resource provider server using the specified +authorization flow. +-} +makeAuthUrl : Authorization -> Url +makeAuthUrl = + Internal.makeAuthUrl Internal.Token {-| Parse the location looking for a parameters set by the resource provider server after redirecting the resource owner (user). -Fails with `ParseErr Empty` when there's nothing +Fails with `ParseResult Empty` when there's nothing or an invalid Url is passed -} -parse : Url -> Result ParseErr ResponseToken -parse url_ = +parseToken : Url -> AuthorizationResult +parseToken url_ = let url = { url_ | path = "/", query = url_.fragment, fragment = Nothing } - - tokenTypeParser = - Url.top - Query.map2 Tuple.pair (Query.string "access_token") (Query.string "error") - - tokenParser accessToken = - Url.query <| - Query.map4 (Internal.parseToken accessToken) - (Query.string "token_type") - (Query.int "expires_in") - (Internal.qsSpaceSeparatedList "scope") - (Query.string "state") - - errorParser error = - Url.query <| - Query.map3 (Internal.parseError error) - (Query.string "error_description") - (Query.string "error_url") - (Query.string "state") in - case Url.parse tokenTypeParser url of - Just ( Just accessToken, _ ) -> - Maybe.withDefault (Result.Err FailedToParse) <| Url.parse (tokenParser accessToken) url + case Url.parse (Url.top Query.map2 Tuple.pair tokenParser (errorParser errorCodeFromString)) url of + Just ( Ok accessToken, _ ) -> + parseUrlQuery url Empty (Query.map Success <| authorizationSuccessParser accessToken) Just ( _, Just error ) -> - Maybe.withDefault (Result.Err FailedToParse) <| Url.parse (errorParser error) url + parseUrlQuery url Empty (Query.map Error <| authorizationErrorParser error) _ -> - Result.Err Empty + Empty + + +authorizationSuccessParser : Token -> Query.Parser AuthorizationSuccess +authorizationSuccessParser accessToken = + Query.map3 (AuthorizationSuccess accessToken Nothing) + expiresInParser + scopeParser + stateParser diff --git a/src/OAuth/Password.elm b/src/OAuth/Password.elm index ce82afd..f5afeb5 100644 --- a/src/OAuth/Password.elm +++ b/src/OAuth/Password.elm @@ -1,8 +1,4 @@ -module OAuth.Password - exposing - ( authenticate - , authenticateWithOpts - ) +module OAuth.Password exposing (Authentication, Credentials, AuthenticationSuccess, AuthenticationError, RequestParts, makeTokenRequest, authenticationErrorDecoder) {-| The resource owner password credentials grant type is suitable in cases where the resource owner has a trust relationship with the @@ -21,32 +17,85 @@ request. ## Authenticate -@docs authenticate, authenticateWithOpts +@docs Authentication, Credentials, AuthenticationSuccess, AuthenticationError, RequestParts, makeTokenRequest, authenticationErrorDecoder -} -import OAuth exposing (..) -import OAuth.Decode exposing (..) -import Internal as Internal -import Http as Http +import Internal as Internal exposing (..) +import Json.Decode as Json +import OAuth exposing (ErrorCode(..), errorCodeFromString) +import Url exposing (Url) +import Url.Builder as Builder + + +{-| Request configuration for a Password authentication + + let authentication = + { credentials = Just + -- Optional, unless required by the resource provider + { clientId = "" + , secret = "" + } + -- Resource owner's password + , password = "" + -- Scopes requested, can be empty + , scope = ["read:whatever"] + -- Token endpoint of the resource provider + , url = "" + -- Resource owner's username + , username = "" + } +-} +type alias Authentication = + { credentials : Maybe Credentials + , password : String + , scope : List String + , url : Url + , username : String + } -{-| Authenticate the client using the authorization code obtained from the authorization. -In this case, use the `Password` constructor. +type alias Credentials = + { clientId : String, secret : String } --} -authenticate : Authentication -> Http.Request ResponseToken -authenticate = - Internal.authenticate identity + +type alias AuthenticationSuccess = + Internal.AuthenticationSuccess + + +type alias AuthenticationError = + Internal.AuthenticationError ErrorCode + + +type alias RequestParts a = + Internal.RequestParts a + + +authenticationErrorDecoder : Json.Decoder AuthenticationError +authenticationErrorDecoder = + Internal.authenticationErrorDecoder (errorDecoder errorCodeFromString) -{-| Authenticate the client using the authorization code obtained from the authorization, passing -additional custom options. Use with care. +{-| Builds a the request components required to get a token from the resource owner (user) credentials -In this case, use the `Password` constructor. + let req : Http.Request TokenResponse + req = makeTokenRequest authentication |> Http.request -} -authenticateWithOpts : AdjustRequest ResponseToken -> Authentication -> Http.Request ResponseToken -authenticateWithOpts fn = - Internal.authenticate fn +makeTokenRequest : Authentication -> RequestParts AuthenticationSuccess +makeTokenRequest { credentials, password, scope, url, username } = + let + body = + [ Builder.string "grant_type" "password" + , Builder.string "username" username + , Builder.string "password" password + ] + |> urlAddList "scope" scope + |> Builder.toQuery + |> String.dropLeft 1 + + headers = + makeHeaders credentials + in + makeRequest url headers body diff --git a/src/OAuth/Refresh.elm b/src/OAuth/Refresh.elm new file mode 100644 index 0000000..d305564 --- /dev/null +++ b/src/OAuth/Refresh.elm @@ -0,0 +1,98 @@ +module OAuth.Refresh exposing (Authentication, Credentials, AuthenticationSuccess, AuthenticationError, RequestParts, makeTokenRequest, authenticationErrorDecoder) + +{-| If the authorization server issued a refresh token to the client, the +client may make a refresh request to the token endpoint to obtain a new access token +(and refresh token) from the authorization server. + +There's only one step in this process: + + - The client authenticates itself directly using the previously obtained refresh token + +After this step, the client owns a fresh `access_token` and possibly, a new `refresh_token`. Both +can be used in subsequent requests. + + +## Authenticate + +@docs Authentication, Credentials, AuthenticationSuccess, AuthenticationError, RequestParts, makeTokenRequest, authenticationErrorDecoder + +-} + +import Internal as Internal exposing (..) +import Json.Decode as Json +import OAuth exposing (ErrorCode(..), Token, errorCodeFromString) +import Url exposing (Url) +import Url.Builder as Builder + + +{-| Request configuration for a Refresh authentication + + let authentication = + -- Optional, unless required by the resource provider + { credentials = Nothing + -- Scopes requested, can be empty + , scope = ["read:whatever"] + -- A refresh token previously delivered + , token = OAuth.Bearer "abcdef1234567890" + -- Token endpoint of the resource provider + , url = "" + } + +-} +type alias Authentication = + { credentials : Maybe Credentials + , token : Token + , scope : List String + , url : Url + } + + +{-| Describes a couple of client credentials used for Basic authentication + + { clientId = "" + , secret = "" + } + +-} +type alias Credentials = + { clientId : String, secret : String } + + +type alias AuthenticationSuccess = + Internal.AuthenticationSuccess + + +type alias AuthenticationError = + Internal.AuthenticationError ErrorCode + + +type alias RequestParts a = + Internal.RequestParts a + + +authenticationErrorDecoder : Json.Decoder AuthenticationError +authenticationErrorDecoder = + Internal.authenticationErrorDecoder (errorDecoder errorCodeFromString) + + +{-| Builds a the request components required to refresh a token + + let req : Http.Request TokenResponse + req = makeTokenRequest reqParts |> Http.request + +-} +makeTokenRequest : Authentication -> RequestParts AuthenticationSuccess +makeTokenRequest { credentials, scope, token, url } = + let + body = + [ Builder.string "grant_type" "refresh_token" + , Builder.string "refresh_token" (extractTokenString token) + ] + |> urlAddList "scope" scope + |> Builder.toQuery + |> String.dropLeft 1 + + headers = + makeHeaders credentials + in + makeRequest url headers body