I looked at that.I looked at this a while back. Unless you are expecting a lot of users I would use https://auth0.com as a server. The free tier supports 7000 users.
'Auth Filter class
Sub Class_Globals
End Sub
Public Sub Initialize
End Sub
'Return True to allow the request to proceed.
Public Sub Filter(req As ServletRequest, resp As ServletResponse) As Boolean
Dim Token As String = req.GetHeader("api_key")
resp.ContentType = "application/json"
If Token <> "" And Token <> "demo-api-key" Then
Dim jjwt As ABJJWT
Dim TokenJJWT As ABJJWTToken = jjwt.CheckToken(Token, "SECRET-KEY",0)
If TokenJJWT = Null Then
resp.SendError(401,"Unauthorized")
Return False
End If
Dim spl() As String = Regex.Split(";", TokenJJWT.Audience)
If spl.Length = 2 Then
req.GetSession.SetAttribute("OTID", spl(0))
req.GetSession.SetAttribute("Demo", False)
req.GetSession.SetAttribute("Dev", spl(1))
Else
resp.SendError(401,"Unauthorized")
Return False
End If
Else
If Token = "demo-api-key" Then
req.GetSession.SetAttribute("OTID", 0)
req.GetSession.SetAttribute("Demo", True)
req.GetSession.SetAttribute("Dev", "DEMO")
Else
resp.SendError(401,"Unauthorized")
Return False
End If
End If
resp.SetHeader("Access-Control-Allow-Origin","*")
resp.SetHeader("Access-Control-Allow-Methods" ,"GET, POST, UPDATE, DELETE, OPTIONS")
resp.SetHeader("Access-Control-Allow-Headers", "Access-Control-Allow-Headers, Origin, Accept, X-Requested-With, Content-Type, Access-Control-Request-Method, Access-Control-Request-Headers, Authorization")
Return True
End Sub
'Handler class
Sub Class_Globals
End Sub
Public Sub Initialize
End Sub
Sub Handle(req As ServletRequest, resp As ServletResponse)
Dim IsDemo As Boolean = req.GetSession.GetAttribute2("Demo", True)
Dim Response As String
Dim OTID As Int = req.GetSession.GetAttribute2("OTID", 0)
Dim Dev As String = req.GetSession.GetAttribute2("Dev", "Demo")
Select Case req.Method
Case "DELETE" ' Deletes
If req.RequestURI.Length + 1 <= "/v1/group/".Length Then
resp.SendError(404, "Group not found")
Return
End If
Dim paramId As String = req.RequestURI.SubString("/v1/group/".Length)
If paramId = "" Then
resp.SendError(404, "Group not found")
Return
Else
Dim Code As String = "GROUP_DELETE"
Dim grp As RecGroup = DBMApp.GroupFromRecord(paramId, OTID)
If grp = Null Then
resp.SendError(404, "Group not found")
Return
Else
If IsActiveType(grp.grpGrpTypID) = False Then
resp.SendError(404, "Group not found")
Return
End If
End If
grp.grpGrpTypID = SetToType(grp.grpGrpTypID, "130", "")
Dim sysrlID As Int = DBMApp.InsertLog(7, OTID, 0, paramId, 0, Code, Dev, "Delete group API", 0, grp.ToJSON(True))
Dim SQL As SQL = DBM.GetSQL
Dim NumRegistrations As Int = DBM.SQLSelectSingleResult(SQL, "SELECT COUNT(regId) AS OTID FROM tRegistration WHERE regGrpID=" & paramId, Null)
If NumRegistrations > 0 Then
resp.SendError(409, $"{"errorCode": "1001", "errorMessage": ${NumRegistrations} "registration(s) found using this group"}"$)
resp.ContentType = "application/json"
Return
End If
' actual delete
Try
SQL.BeginTransaction
DBMApp.UPDATESTATUSGroup(SQL, paramId, grp.IdenID, grp.grpGrpTypID, SetToType(grp.grpGrpTypID, "130", "8"), Null, 0, Code, sysrlID)
SQL.TransactionSuccessful
Catch
Log(LastException)
SQL.Rollback
End Try
DBM.CloseSQL(SQL)
End If
Case "GET" ' Find Group by ID
If req.RequestURI.Length + 1 <= "/v1/group/".Length Then
resp.SendError(404, "Group not found")
Return
End If
Dim paramId As String = req.RequestURI.SubString("/v1/group/".Length)
If paramId = "" Then
resp.SendError(404, "Group not found")
Return
Else
If IsDemo Then
Dim mGroup As modelGroup
mGroup.Initialize
mGroup.ParentId = 0
mGroup.Id = 10
mGroup.typeId = 400110
mGroup.Code = "Demo Code"
mGroup.Description = "Demo Description"
mGroup.Comment = "Demo comment"
mGroup.Barcode = "Demo Barcode"
mGroup.Number = 0
Response = mGroup.ToJson
Else
Dim SQL As SQL = DBM.GetSQL
Dim SQL_str As String = $"SELECT grpParentID, grpID, grpGrpTypId, grpCode, grpDescription, grpComment, grpNumber01, idenCode FROM tGroup INNER JOIN tIdentification ON tGroup.grpID = tIdentification.idenGrpID WHERE tGroup.OTID=${OTID} AND tGroup.grpID=?"$
Dim Variables As List
Variables.Initialize
Variables.Add(paramId)
Dim res As List = DBM.SQLSelect(SQL, SQL_str, Variables)
DBM.CloseSQL(SQL)
If res.Size = 0 Then
resp.SendError(404, "Group not found")
Return
Else
Dim m As Map = res.Get(0)
Dim mGroup As modelGroup
mGroup.Initialize
mGroup.ParentId = m.Get("grpparentid")
mGroup.Id = m.Get("grpid")
mGroup.typeId = m.Get("grpgrptypid")
mGroup.Code = m.Get("grpcode")
mGroup.Description = m.Get("grpdescription")
mGroup.Comment = m.Get("grpcomment")
mGroup.Barcode = m.Get("idencode")
mGroup.Number = m.Get("grpnumber01")
If IsActiveType(mGroup.Typeid) = False Then
resp.SendError(404, "Group not found")
Return
End If
Response = mGroup.ToJson
End If
End If
End If
Case "POST" ' Add a new group to the store
Dim bodyJson As String
Dim body As TextReader
Dim group As modelGroup
body.Initialize(req.InputStream)
bodyJson = body.ReadAll
If bodyJson.StartsWith("{") Then
group.Initialize
group.FromJson(bodyJson)
End If
If group.IsInitialized = False Then
resp.SendError(409, $"{"errorCode": "1002", "errorMessage": "Json body is not a group object"}"$)
resp.ContentType = "application/json"
Return
Else
If group.Check(True) = False Then
resp.SendError(409, $"{"errorCode": "1003", "errorMessage": "Invalid values or missing required fields"}"$)
resp.ContentType = "application/json"
Return
End If
If IsDemo Then
' nothing do do, 200 OK is fine
Else
If DBM.ActiveExists(group.Code, "SELECT grpGrpTypID FROM tGroup WHERE grpCode=? AND OTID=?", Array As Object(group.Code, OTID)) = False Then
resp.SendError(409, $"{"errorCode": "1005", "errorMessage": "Code already exists"}"$)
resp.ContentType = "application/json"
Return
End If
If DBM.ActiveExists(group.Barcode, "SELECT idenIdenTypID FROM tIdentification WHERE idenCode=? AND OTID=?", Array As Object(group.Barcode, OTID)) = False Then
resp.SendError(409, $"{"errorCode": "1006", "errorMessage": "Barcode already in use"}"$)
resp.ContentType = "application/json"
Return
End If
Dim grp As RecGroup
grp.Initialize
grp.OTID = OTID
grp.grpParentID = group.ParentId
grp.DescriptionParent = ""
grp.grpGrpTypID = group.Typeid
grp.grpCode = group.Code
grp.grpDescription = group.Description
grp.BarCode = group.Barcode
grp.grpComment = group.Comment
grp.grpNumber01 = group.Number
grp.grpOTLastModifiedLoginID = 0
grp.grpOTCreationTag = "GROUP_CREATE"
grp.grpID = DBMApp.INSERTGroup(grp, Null, True, "8" & group.Typeid, Dev)
If grp.grpID = 0 Then
' error
End If
Response = $"{"id": ${grp.grpID}}"$
End If
End If
Case "PUT" ' Update a group
Dim bodyJson As String
Dim body As TextReader
Dim group As modelGroup
body.Initialize(req.InputStream)
bodyJson = body.ReadAll
If bodyJson.StartsWith("{") Then
group.Initialize
group.FromJson(bodyJson)
End If
If group.IsInitialized = False Then
resp.SendError(409, $"{"errorCode": "1002", "errorMessage": "Json body is not a group object"}"$)
resp.ContentType = "application/json"
Return
Else
If group.Check(True) = False Then
resp.SendError(409, $"{"errorCode": "1003", "errorMessage": "Invalid values or missing required fields"}"$)
resp.ContentType = "application/json"
Return
End If
If IsDemo Then
' nothing do do, 200 OK is fine
Else
If DBM.ActiveExists(group.Code, "SELECT grpGrpTypID FROM tGroup WHERE grpCode=? AND OTID=? AND grpId<>?", Array As Object(group.Code, OTID, group.Id)) = False Then
resp.SendError(409, $"{"errorCode": "1005", "errorMessage": "Code already exists"}"$)
resp.ContentType = "application/json"
Return
End If
If DBM.ActiveExists(group.Barcode, "SELECT idenIdenTypID FROM tIdentification WHERE idenCode=? AND OTID=? AND idenGrpID<>?", Array As Object(group.Barcode, OTID, group.Id)) = False Then
resp.SendError(409, $"{"errorCode": "1006", "errorMessage": "Barcode already in use"}"$)
resp.ContentType = "application/json"
Return
End If
Dim grp As RecGroup
grp.Initialize
grp.OTID = OTID
grp.grpParentID = group.ParentId
grp.DescriptionParent = ""
grp.grpGrpTypID = group.Typeid
grp.grpCode = group.Code
grp.grpDescription = group.Description
grp.BarCode = group.Barcode
grp.grpComment = group.Comment
grp.grpNumber01 = group.Number
grp.grpOTLastModifiedLoginID = 0
grp.grpOTCreationTag = "GROUP_UPDATE"
grp.grpID = group.Id
If DBMApp.UPDATEGroup(grp, Null, Dev) = False Then
' error
End If
End If
End If
Case Else
resp.SendError(400, "Bad Request")
Return
End Select
If Response <> "" Then
resp.write(Response)
End If
End Sub
Sub SetToType(origType As Int, target As String, Prefix As String) As Int
Dim s As String = origType
If s.EndsWith(target) Then
Return Prefix & origType
End If
s = s.SubString2(0,s.Length - 3) & target
Dim sInt As Int = s
Return Prefix & sInt
End Sub
Sub IsActiveType(origType As Int) As Boolean
Dim s As String = origType
Return s.EndsWith("110")
End Sub
I think the free version doesn't support connecting to a remote (such as my B4J app) to mange the users. I think it used to work on the free plan, but now you need to pay. I will need to look into it in more detail, as I only had a quick look.
Still rather to have oAuth2 running on my B4J server and not connecting to a remote oAuth service.
We use cookies and similar technologies for the following purposes:
Do you accept cookies and these technologies?
We use cookies and similar technologies for the following purposes:
Do you accept cookies and these technologies?