cWinOAuth2.pkg

// Class: cOAuth2
//
// The server-side aspect of the OAuth 2.0 class
//
// Includes a class and object (c/oStructHandler_tGrantToken) generated by
// Sture's VDF XRay to handle turning a received JSON grant into a VDF struct
// variable that we can work with. NOTE: No longer the case in v1.1.
//
// Revision:
//      2022/06/05  (MJP, UIG)
//          Version 1.1
//          Improved JavaScript side to make it a more compliant framework component.
//          Added Logout and RefreshToken methods
//          Replace Sture's JSON handling with cJsonObject - makes it all nicer!
//          Tidied up overall.
//
//      2015/07/15  (MJP, UIG) 
//          Initial version: 1.0
//

Use cHttpTransferREST.pkg
Use OAuthLoginDialog.dg
Use cJsonObject.pkg
Use WinUuid.pkg

Struct stOAuthParam
    String sParam
    String sValue
End_Struct

Struct stGrantToken
    String  expires_in
    String  token_type
    String  scope
    String  expires_on
    String  not_before
    String  resource
    String  access_token
    String  refresh_token
    String  id_token
    String  ext_expires_on
End_Struct

Class cOAuth2 is a cObject
    
    Procedure Construct_Object
        Forward Send Construct_Object

        Property Boolean wpbLoggedIn        False
        Property String  wpsOAuth2Url       ""
        Property String  wpsOAuth2LogoutUrl
        Property String  wpsClientIDName    "client_id"
        Property String  wpsClientID        ""
        Property String  wpsRedirUrlName    "redirect_uri"
        Property String  wpsRedirectUrl     ""
        Property String  wpsLogoutRedirName "post_logout_redirect_uri"
        Property String  wpsRespTypeName    "response_type"
        Property String  wpsResponseType    "token"
        Property String  wpsStateName       "state"
        Property Integer wpiPollInterval    500
        Property String  wpsErrorCode       ""
        Property String  wpsErrorDesc       ""
        Property String  wpsAuthCode        ""
        Property Integer wpiExpiresIn       0
        Property String  wpsRedirectedTo    ""
        Property String  wpsAccessToken     ""
        Property String  wpsAuthCdName      "code"
        Property String  wpsExpiresName     "expires_in"
        Property String  wpsRetStateName    "state"
        Property String  wpsErrCodeName     "error"
        Property String  wpsErrDescName     "error_description"
        Property stOAuthParam[] wpatParams
        Property stGrantToken wptGrant
        Property String   wpsGrantDetail     ""
        Property DateTime wpdtGrantReceived
        Property String   psClientSecret     ""
        Property String   psTokenHost        ""
        Property String   psTokenPath        ""
        Property Boolean  pbAutoLogin        False
        Property Boolean  pbUseGrantAsAT     False
        Property Boolean  pbValidateToken    False
        Property Boolean  pbValidateCode     False
        Property String   psValidateHost     ""
        Property String   psValidatePath     ""
        Property Boolean  pbUrlDecodeCode    False
        Property Boolean  pbUrlEncodeReDir   False
        Property String   psGrantDetail      ""
        Property String   wpsState           ""
                
        Object oHttp is a cHttpTransferREST
        End_Object
        
    End_Procedure
    
    Procedure AddParam String sParam String sValue
        stOAuthParam[] tParams
        stOAuthParam   tParam
        Integer i
        
        Get wpatParams           to tParams
        Move sParam to tParam.sParam
        
        Move (SearchArray(tParam, tParams)) to i
        
        If (i = -1) Begin
            Move (SizeOfArray(tParams)) to i
            Move sParam                 to tParams[i].sParam
        End

        Move sValue to tParams[i].sValue
        Set wpatParams to tParams
    End_Procedure
    
    Procedure ClearParams
        stOAuthParam[] tEmpty
        
        Set wpatParams to tEmpty
    End_Procedure
    
    Procedure OnBeforeLogin
    End_Procedure
    
    Function LoginURL Returns String
        String         sUUID sURL
        stOAuthParam[] atParams
        Integer        i iLast
        
        Move (RandomHexUUID())  to sUUID
        
        Set    wpsState         to sUUID
        
        Move (wpsOAuth2Url(Self) + "?" + ;
              wpsClientIDName(Self) + "=" + ;
              wpsClientID(Self) + "&" + ;
              wpsRedirUrlName(Self) + "=" + ;
              wpsRedirectUrl(Self) + "&" + ;
              wpsRespTypeName(Self) + "=" + ;
              wpsResponseType(Self) + "&" + ;
              wpsStateName(Self) + "=" + sUUID) to sURL

        Get wpatParams to atParams
        Move (SizeOfArray(atParams) - 1) to iLast
        
        For i from 0 to iLast
            Move (sURL + "&" + ;
                  atParams[i].sParam + "=" + ;
                  atParams[i].sValue) to sURL
        Loop
        
        Function_Return sURL
    End_Function
    
    Function LogoutURL Returns String
        String sURL
        
        Move (wpsOAuth2LogoutUrl(Self) + "?" + ;
              wpsLogoutRedirName(Self) + "=" + ;
              wpsRedirectUrl(Self)) to sURL
              
        Function_Return sURL
    End_Function
    
    Procedure Login
        String sState
        
        Send OnBeforeLogin

        Set psCode      of oOAuthLoginDialog to ""
        Set psRedirURL  of oOAuthLoginDialog to (wpsRedirectUrl(Self))
        Set psURL       of oOAuthLoginDialog to (LoginURL(Self))
        Set pbLoggingIn of oOAuthLoginDialog to True
        Set psState     of oOAuthLoginDialog to (wpsState(Self))
        Send Popup      of oOAuthLoginDialog
        Get psState     of oOAuthLoginDialog to sState
        
        If (sState <> wpsState(Self)) Begin
            // ToDo: set error codes
            
            Send LoginFail
            Procedure_Return
        End
        
        Set wpsAuthCode     to (psCode(oOAuthLoginDialog(Self)))
        Set wpsAccessToken  to ""

        If (pbLoggedIn(oOAuthLoginDialog(Self))) ;
            Send LoginDone
        Else ;
            Send LoginFail
        
        Set wpbLoggedIn     to (wpsAccessToken(Self) <> "")
    End_Procedure
    
    Procedure Logout
        String sState
        
        Set psURL       of oOAuthLoginDialog to (LogoutURL(Self))
        Set pbLoggingIn of oOAuthLoginDialog to False
        Send Popup      of oOAuthLoginDialog
        Send LogoutDone
    End_Procedure
    
    Procedure OnLoad
        Forward Send OnLoad
        
        If (pbAutoLogin(Self)) Begin
            Send Login
        End
        
    End_Procedure
    
    Function GrantLeft Returns Integer
        DateTime dtNow dtReceived
        Integer  iExpires iPassed iLeft
        TimeSpan tsPassed
        String   sDT
        
        Move (CurrentDateTime())            to dtNow
        Get wpdtGrantReceived               to dtReceived
        Move (dtNow - dtReceived)           to tsPassed
        Move (SpanTotalSeconds(tsPassed))   to iPassed        
        Get wpiExpiresIn                    to iExpires
        Function_Return (iExpires - iPassed)
    End_Function
    
    // These two events (OnLogin and OnLoginFail) are designed for overriding in
    // the developer's own code - there is no need to Forward Send them.
    Procedure OnLogin
    End_Procedure

    Procedure OnLoginFail
    End_Procedure

    Procedure LoginDone
        String         sCode sToken sID sReDir sSecret sPath sBody sResp sHost sScope
        Integer        iOK i iMax iPos iStat iIdx
        Boolean        bOK
        Handle         hoJson
        UChar[]        ucaResp
        stGrantToken   tResp
        stOAuthParam[] atParams
        stOAuthParam   tParam
        
        Set wpsErrorCode to ""
        Set wpsErrorDesc to ""
        
        Get wpsAuthCode to sCode
        
        If (sCode = "") Begin  // We don't HAVE an auth code - return blank
            Set wpsErrorCode to "NO-CODE"
            Set wpsErrorDesc to "No code returned from call to OAuth 2.0 end-point"
            Set wpbLoggedIn  to False
            Send OnLoginFail
            Procedure_Return
        End
        
        Get wpsClientID     to sID
        Get wpsRedirectUrl  to sReDir
        Get psClientSecret  to sSecret
        Get psTokenPath     to sPath
        Get psTokenHost     to sHost
        
        Send Reset          of oHttp
        Set psRemoteHost    of oHTTP    to sHost
            
        Get AddHeader   of oHttp "Content-type" "application/x-www-form-urlencoded" to iOK
        
        Get wpatParams to atParams
        Move "scope" to tParam.sParam        
        Move (SearchArray(tParam, atParams)) to iIdx        
        If (iIdx <> -1) ;
            Move atParams[iIdx].sValue to sScope
            
        Move (             "client_id=" + sID)              to sBody
        If (sScope <> "") ;
            Move (sBody + "&scope=" + sScope)               to sBody
        Move (sBody +     "&code=" + sCode)                 to sBody
        Move (sBody +     "&redirect_uri=" + sReDir)        to sBody
        Move (sBody +     "&grant_type=authorization_code") to sBody
        Move (sBody +     "&client_secret=" + sSecret)      to sBody
                
        Get HttpVerbAddrRequest of oHttp sPath (AddressOf(sBody)) (Length(sBody)) False "POST" to iOK

        If iOK Begin
            Get ResponseStatusCode of oHttp to iStat
            
            If ((iStat >= 200) and (iStat < 300)) Begin
                Get pucaData of oHttp to ucaResp
                Get Create (RefClass(cJsonObject)) to hoJson
                Set pbRequireAllMembers of hoJson to False
                Get ParseUtf8 of hoJson ucaResp to bOK
                
                If bOK Begin
                
                    If (HasMember(hoJson, "error")) Begin
                        Set wpsErrorCode to (MemberValue(hoJson, "error"))
                        If (HasMember(hoJson, "error_description")) ;
                            Set wpsErrDescName to (MemberValue(hoJson, "error_description"))
                        Set wpbLoggedIn              to False
                        Send OnLoginFail
                    End
                    Else Begin
                        Get JsonToDataType of hoJson to tResp
                        Move tResp.access_token      to sToken
                        Set wpsAccessToken           to tResp.access_token
                        Set wptGrant                 to tResp
                        Set wpiExpiresIn             to (Integer(tResp.expires_in))
                        Set wpdtGrantReceived        to (CurrentDateTime())
                        Set peWhiteSpace of hoJson   to jpWhitespace_Pretty
                        Set wpsGrantDetail           to (Stringify(hoJson))
                        Set wpbLoggedIn              to True
                        Send OnLogin
                    End
                    
                End
                Else Begin
                    Get psData of oHttp to sResp
                    Set wpsErrorCode    to "JSON-PARSEFAIL"
                    Set wpsErrorDesc    to sResp
                    Set wpbLoggedIn     to False
                    Send OnLoginFail
                End
                
                Send Destroy of hoJson
            End
            Else Begin
                Set wpsErrorCode to "GRANT-HTTPFAIL"
                Set wpsErrorDesc to ("HTTP Error" * String(iStat) * "in response to request for access token grant")
                Set wpbLoggedIn  to False
                Send OnLoginFail
            End
            
        End
        Else Begin
            Set wpsErrorCode to "GRANT-HTTPFAIL"
            Set wpsErrorDesc to ("No response from HTTP call to grant token endpoint https://" + psTokenHost(Self) + "/" + sPath)
            Set wpbLoggedIn  to False
            Send OnLoginFail
        End
        
    End_Procedure
    
    Procedure RefreshToken
        String         sBody sID sToken sReDir sSecret sResp sPath sHost sScope
        Integer        iOK iStat iIdx
        Boolean        bOK
        Handle         hoJson
        UChar[]        ucaResp
        stGrantToken   tGrant tResp
        stOAuthParam[] atParams
        stOAuthParam   tParam
        
        Set wpsErrorCode to ""
        Set wpsErrorDesc to ""
        
        Get wptGrant             to tGrant
        Move tGrant.refresh_token   to sToken
        
        If (sToken = "") Begin
            Set wpsErrorCode to "NO-REFRESH"
            Set wpsErrorDesc to "Current grant does not contain a refresh token"
            Send OnLoginFail
            Procedure_Return
        End
        
        Get wpsClientID         to sID
        Get wpsRedirectUrl      to sReDir
        Get    psClientSecret   to sSecret
        Get    psTokenPath      to sPath
        Get    psTokenHost      to sHost
        
        Get wpatParams to atParams
        Move "scope" to tParam.sParam        
        Move (SearchArray(tParam, atParams)) to iIdx        
        If (iIdx <> -1) ;
            Move atParams[iIdx].sValue to sScope
            
        Move (             "client_id=" + sID)          to sBody
        Move (sBody +     "&grant_type=refresh_token")  to sBody
        If (sScope <> "") ;
            Move (sBody + "&scope=" + sScope)           to sBody
        Move (sBody +     "&refresh_token=" + sToken)   to sBody
        Move (sBody +     "&redirect_uri=" + sReDir)    to sBody
        Move (sBody +     "&client_secret=" + sSecret)  to sBody
        
        Send Reset          of oHttp
        Set psRemoteHost    of oHTTP to sHost
        Get AddHeader       of oHttp "Content-type" "application/x-www-form-urlencoded" to iOK
        
        Get HttpVerbAddrRequest of oHttp sPath (AddressOf(sBody)) (Length(sBody)) False "POST" to iOK

        If iOK Begin
            Get ResponseStatusCode of oHttp to iStat
            
            If ((iStat >= 200) and (iStat < 300)) Begin
                Get pucaData of oHttp to ucaResp
                Get Create (RefClass(cJsonObject)) to hoJson
                Set pbRequireAllMembers of hoJson to False
                Get ParseUtf8 of hoJson ucaResp to bOK
                
                If bOK Begin
                
                    If (HasMember(hoJson, "error")) Begin
                        Set wpsErrorCode to (MemberValue(hoJson, "error"))
                        If (HasMember(hoJson, "error_description")) ;
                            Set wpsErrDescName to (MemberValue(hoJson, "error_description"))
                        Send OnLoginFail
                    End
                    Else Begin
                        Get JsonToDataType of hoJson    to tResp
                        Move tResp.access_token         to sToken
                        Set wpsAccessToken           to tResp.access_token
                        Set wptGrant                 to tResp
                        Set wpiExpiresIn             to (Integer(tResp.expires_in))
                        Set wpdtGrantReceived        to (CurrentDateTime())
                        Set peWhiteSpace of hoJson      to jpWhitespace_Pretty
                        Set wpsGrantDetail           to (Stringify(hoJson))
                        Send OnLogin
                    End
                    
                End
                Else Begin
                    Get psData of oHttp to sResp
                    Set wpsErrorCode to "JSON-PARSEFAIL"
                    Set wpsErrorDesc to sResp
                    Send OnLoginFail
                End
                
                Send Destroy of hoJson
            End
            Else Begin
                Set wpsErrorCode to "GRANT-HTTPFAIL"
                Set wpsErrorDesc to ("HTTP Error" * String(iStat) * "in response to request for refresh token grant")
                Send OnLoginFail
            End
            
        End
        Else Begin
            Set wpsErrorCode to "GRANT-HTTPFAIL"
            Set wpsErrorDesc to ("No response from HTTP call to refresh token endpoint https://" + psTokenHost(Self) + "/" + sPath)
            Send OnLoginFail
        End
        
    End_Procedure
    
    Procedure LoginFail
        Send OnLoginFail
    End_Procedure
    
    Procedure OnLogout
    End_Procedure
    
    Procedure LogoutDone
        stGrantToken   tGrant
        
        Set psGrantDetail   to ""
        Set wpsAuthCode     to ""
        Set wpsAccessToken  to ""
        Set wptGrant        to tGrant
        Set wpiExpiresIn    to 0
        Set wpbLoggedIn     to False
        Send OnLogout
    End_Procedure
    
End_Class