; ============================================================================
; BlueskyAPI Module for PureBasic
; By LastLife based on https://www.purebasic.fr/english/viewtopic.php?p=626397
; ============================================================================

DeclareModule BlueskyAPI
	;- =======================================================================
	;- Constants
	;- =======================================================================
	
	#DEFAULT_API_URI   = "https://bsky.social/xrpc/"
	#IMAGE_SIZE_LIMIT  = 1000000  ; 1MB max for images
	
	;- =======================================================================
	;- Data Structures
	;- =======================================================================
	
	Structure Session
		DID.s           ; Decentralized Identifier
		AccessToken.s	; JWT access token
		RefreshToken.s	; JWT refresh token
		ApiUri.s		; API endpoint URI
	EndStructure
	
	Structure BlobReference
		Link.s
	EndStructure
	
	Structure Blob
		Type.s
		Ref.BlobReference
		MimeType.s
		Size.i
	EndStructure
	
	Structure FacetIndex
		ByteStart.i
		ByteEnd.i
	EndStructure
	
	Structure FacetFeature
		Type.s
		Uri.s
		DID.s
	EndStructure
	
	Structure Facet
		Index.FacetIndex
		Array Features.FacetFeature(0)
	EndStructure
	
	;- =======================================================================
	;- Public Interface
	;- =======================================================================
	
	; Session Management
	Declare.b Initialize(*Session.Session, Handle.s, Password.s, ApiUri.s = #DEFAULT_API_URI)
	Declare.b RefreshSession(*Session.Session)
	
	; Posting
	Declare.s CreatePost(*Session.Session, Text.s, Language.s = "en", ImageBlobRefs.s = "")
	
	; Media Upload
	Declare.s UploadBlob(*Session.Session, *Memory, MemorySize.i, MimeType.s)
	Declare.s UploadImageFile(*Session.Session, FilePath.s)
	
	; Utility
	Declare.s GetPostURL(Handle.s, PostId.s)
	
EndDeclareModule

Module BlueskyAPI
	
	;- =======================================================================
	;- Private Constants
	;- =======================================================================
	
	#CHAR_DQUOTE     = Chr(34)
	#BLOB_DELIMITER  = "|"
	
	;- =======================================================================
	;- URL/JSON Conversion Helpers
	;- =======================================================================
	
	Procedure.s ConvertMapToURLParams(Map Params.s())
		Protected result.s = ""
		Protected isFirst.b = #True
		
		ForEach Params()
			If Not isFirst
				result + "&"
			EndIf
			isFirst = #False
			result + MapKey(Params()) + "=" + Params()
		Next
		
		ProcedureReturn result
	EndProcedure
	
	Procedure.s EscapeJSONString(Text.s)
		Protected result.s = Text
		
		; Backslash must be escaped first!
		result = ReplaceString(result, "\", "\\")
		; Escape double quotes
		result = ReplaceString(result, #CHAR_DQUOTE, "\" + #CHAR_DQUOTE)
		; Escape control characters
		result = ReplaceString(result, #CR$, "\r")
		result = ReplaceString(result, #LF$, "\n")
		result = ReplaceString(result, #TAB$, "\t")
		
		ProcedureReturn result
	EndProcedure
	
	Procedure.s ConvertMapToJSON(Map Params.s())
		Protected json.s = "{ "
		
		ForEach Params()
			Protected key.s = MapKey(Params())
			Protected value.s = Params()
			Protected isRawJSON.b = Bool(Left(value, 1) = "[" Or Left(value, 1) = "{")
			
			json + #CHAR_DQUOTE + key + #CHAR_DQUOTE + ": "
			
			If isRawJSON
				json + value
			Else
				json + #CHAR_DQUOTE + EscapeJSONString(value) + #CHAR_DQUOTE
			EndIf
			
			json + ", "
		Next
		
		json = Left(json, Len(json) - 2) + " }"
		ProcedureReturn json
	EndProcedure
	
	;- =======================================================================
	;- MIME Type Resolution
	;- =======================================================================
	
	Procedure.s GetMimeTypeForExtension(Extension.s)
		Protected ext.s = LCase(RemoveString(Extension, "."))
		
		Select ext
				; Text formats
			Case "txt"  : ProcedureReturn "text/plain"
			Case "json" : ProcedureReturn "application/json"
			Case "xml"  : ProcedureReturn "application/xml"
				
				; Audio formats
			Case "mp3", "ogg", "m4a"
				ProcedureReturn "audio/" + ext
				
				; Image formats
			Case "jpg", "jpeg"
				ProcedureReturn "image/jpeg"
			Case "png", "gif", "webp"
				ProcedureReturn "image/" + ext
			Case "svg"
				ProcedureReturn "image/svg+xml"
				
				; Video formats
			Case "mp4", "webm"
				ProcedureReturn "video/" + ext
		EndSelect
	EndProcedure
	
	;- =======================================================================
	;- HTTP Request Handler
	;- =======================================================================
	
	Procedure.i ExecuteAPIRequest(*Session.Session, RequestType.i, Endpoint.s, Map Args.s(), PostBody.s = "", ContentType.s = "")
		
		Protected url.s = *Session\ApiUri + Endpoint
		Protected NewMap headers.s()
		
		; Configure request based on type
		If RequestType = #PB_HTTP_Get And MapSize(Args())
			url + "?" + ConvertMapToURLParams(Args())
		ElseIf RequestType = #PB_HTTP_Post And ContentType = ""
			ContentType = "application/json"
		EndIf
		
		; Set authorization header if authenticated
		If *Session\AccessToken
			headers("Authorization") = "Bearer " + *Session\AccessToken
		EndIf
		
		; Handle POST body conversion
		If ContentType
			headers("Content-Type") = ContentType
			
			If ContentType = "application/json" And MapSize(Args())
				PostBody = ConvertMapToJSON(Args())
				ClearMap(Args())
			EndIf
		EndIf
		
		; Execute request
		Protected request.i = HTTPRequest(RequestType, url, PostBody, 0, headers())
		
		If request = 0
			ProcedureReturn 0
		EndIf
				
		; Parse JSON response
		Protected *responseData = HTTPMemory(request)
		Protected jsonResult.i = CatchJSON(#PB_Any, *responseData, MemorySize(*responseData))
		
		FinishHTTP(request)
		FreeMemory(*responseData)
		
		ProcedureReturn jsonResult
	EndProcedure
	
	;- =======================================================================
	;- Session Management (Internal)
	;- =======================================================================
	
	Procedure.i RequestNewSession(*Session.Session, Handle.s, Password.s)
		Protected NewMap args.s()
		args("identifier") = Handle
		args("password") = Password
		
		ProcedureReturn ExecuteAPIRequest(*Session, #PB_HTTP_Post, "com.atproto.server.createSession", args())
	EndProcedure
	
	Procedure.i RequestSessionRefresh(*Session.Session, RefreshToken.s)
		Protected originalToken.s = *Session\AccessToken
		*Session\AccessToken = RefreshToken
		
		Protected NewMap args.s()
		Protected json.i = ExecuteAPIRequest(*Session, #PB_HTTP_Post, "com.atproto.server.refreshSession", args())
		
		If json = 0
			*Session\AccessToken = originalToken
		EndIf
		
		ProcedureReturn json
	EndProcedure
	
	Procedure.b ParseSessionFromJSON(*Session.Session, JSON.i)
		If JSON = 0
			ProcedureReturn #False
		EndIf
		
		Protected rootValue = JSONValue(JSON)
		
		If ExamineJSONMembers(rootValue)
			While NextJSONMember(rootValue)
				Protected key.s = JSONMemberKey(rootValue)
				Protected value = JSONMemberValue(rootValue)
				
				Select key
					Case "did"
						*Session\DID = GetJSONString(value)
					Case "accessJwt"
						*Session\AccessToken = GetJSONString(value)
					Case "refreshJwt"
						*Session\RefreshToken = GetJSONString(value)
				EndSelect
			Wend
		EndIf
		
		FreeJSON(JSON)
		ProcedureReturn Bool(*Session\AccessToken <> "")
	EndProcedure
	
	;- =======================================================================
	;- Hyperlink Processing
	;- =======================================================================
	
	; Converts single-quoted href attributes to double-quoted for consistency
	Procedure.s NormalizeHrefQuotes(HTML.s)
		Static regexHandle.i = 0
		
		If regexHandle = 0
			regexHandle = CreateRegularExpression(#PB_Any, "href='(.+?)'")
		EndIf
		
		If ExamineRegularExpression(regexHandle, HTML)
			While NextRegularExpressionMatch(regexHandle)
				Protected pos.i = RegularExpressionMatchPosition(regexHandle)
				Protected len.i = RegularExpressionMatchLength(regexHandle)
				Protected tag.s = Mid(HTML, pos, len)
				
				tag = ReplaceString(tag, "'", #CHAR_DQUOTE)
				HTML = Left(HTML, pos - 1) + tag + Mid(HTML, pos + len)
			Wend
		EndIf
		
		ProcedureReturn HTML
	EndProcedure
	
	; Finds the end position of a URL starting at the given position
	Procedure.i FindURLEndPosition(Text.s, StartPos.i)
		Protected Dim terminators.i(5)
		
		terminators(0) = FindString(Text, ",", StartPos + 1)
		terminators(1) = FindString(Text, #CR$, StartPos + 1)
		terminators(2) = FindString(Text, " ", StartPos + 1)
		terminators(3) = FindString(Text, #CHAR_DQUOTE, StartPos + 1)
		terminators(4) = FindString(Text, "'", StartPos + 1)
		terminators(5) = Len(Text) + 1
		
		SortArray(terminators(), #PB_Sort_Ascending)
		
		Protected i.i
		For i = 0 To ArraySize(terminators())
			If terminators(i) > 0
				ProcedureReturn terminators(i)
			EndIf
		Next
		
		ProcedureReturn -1
	EndProcedure
	
	; Wraps plain URLs in anchor tags
	Procedure.s ConvertPlainURLsToAnchors(Text.s)
		Protected html.s = NormalizeHrefQuotes(Text)
		Protected searchStart.i = 0
		
		Repeat
			Protected urlPos.i = FindString(html, "http", searchStart)
			
			If urlPos = 0
				Break
			EndIf
			
			; Skip URLs already inside anchor tags
			If Mid(html, urlPos - 9, 8) = "<a href="
				searchStart = FindString(html, "</a>", urlPos) + 4
				Continue
			EndIf
			
			Protected urlEnd.i = FindURLEndPosition(html, urlPos)
			If urlEnd = -1
				Break
			EndIf
			
			Protected url.s = Mid(html, urlPos, urlEnd - urlPos)
			Protected anchorTag.s = ~"<a href=\"" + url + ~"\">" + url + "</a>"
			Protected newHTML.s = Left(html, urlPos - 1) + anchorTag
			
			searchStart = Len(newHTML) + 1
			newHTML + Mid(html, urlEnd)
			html = newHTML
		ForEver
		
		ProcedureReturn html
	EndProcedure
	
	; Extracts hyperlinks from HTML and converts them to Bluesky facets
	Procedure.s ExtractFacetsFromHTML(HTML.s, List Facets.Facet())
		Protected processedHTML.s = ConvertPlainURLsToAnchors(HTML)
		Protected plainText.s = ""
		Protected anchorCount.i = CountString(processedHTML, "<a ")
		
		Protected i.i
		For i = 1 To anchorCount + 1
			Protected segment.s = StringField(processedHTML, i, "<a ")
			
			; Handle text before/after anchors
			If FindString(segment, "</a>") = 0
				plainText + segment
				Continue
			EndIf
			
			; Extract URL and display text from anchor
			Protected url.s = StringField(segment, 2, #CHAR_DQUOTE)
			Protected displayText.s = StringField(segment, 2, ">")
			displayText = StringField(displayText, 1, "<")
			Protected remainder.s = StringField(segment, 2, "</a>")
			
			; Create facet for this link
			AddElement(Facets())
			Facets()\Index\ByteStart = StringByteLength(plainText, #PB_UTF8)
			Facets()\Index\ByteEnd = StringByteLength(plainText, #PB_UTF8) + StringByteLength(displayText, #PB_UTF8)
			Facets()\Features(0)\Type = "app.bsky.richtext.facet#link"
			Facets()\Features(0)\Uri = url
			
			plainText + displayText + remainder
		Next
		
		ProcedureReturn plainText
	EndProcedure
	
	;- =======================================================================
	;- Blob Reference Helpers
	;- =======================================================================
	
	Procedure.s EnsureTrailingDelimiter(Text.s)
		If Right(Text, Len(#BLOB_DELIMITER)) <> #BLOB_DELIMITER
			ProcedureReturn Text + #BLOB_DELIMITER
		EndIf
		ProcedureReturn Text
	EndProcedure
	
	; Extracts the blob object JSON from an upload response
	Procedure.s ExtractBlobRefFromResponse(Response.s)
		Protected blobStart.i = FindString(Response, ~"\"blob\"")
		
		If blobStart = 0
			ProcedureReturn ""
		EndIf
		
		; Find opening brace after "blob":
		blobStart = FindString(Response, "{", blobStart + 6)
		If blobStart = 0
			ProcedureReturn ""
		EndIf
		
		; Match braces to find complete blob object
		Protected braceDepth.i = 1
		Protected pos.i = blobStart + 1
		
		While braceDepth > 0 And pos <= Len(Response)
			Protected char.s = Mid(Response, pos, 1)
			
			If char = "{"
				braceDepth + 1
			ElseIf char = "}"
				braceDepth - 1
			EndIf
			
			pos + 1
		Wend
		
		ProcedureReturn Mid(Response, blobStart, pos - blobStart)
	EndProcedure
	
	;- =======================================================================
	;- JSON Building Helpers
	;- =======================================================================
	
	Procedure.s BuildFacetsJSON(List Facets.Facet())
		If ListSize(Facets()) = 0
			ProcedureReturn ""
		EndIf
		
		Protected json.s = "["
		Protected isFirst.b = #True
		
		; The issue is most likely the chair to keyboard interface, but I couldn't get InsertJSONList to work with, so let's build a JSON manually!
		ForEach Facets()
			If Not isFirst
				json + ", "
			EndIf
			isFirst = #False
			
			json + ~"{\"index\": {\"byteStart\": " + Str(Facets()\Index\ByteStart) + ", "
			json + ~"\"byteEnd\": " + Str(Facets()\Index\ByteEnd) + "}, "
			json + ~"\"features\": [{\"$type\": \"" + Facets()\Features(0)\Type + ~"\", "
			json + ~"\"uri\": \"" + Facets()\Features(0)\Uri + ~"\"}]}"
		Next
		
		json + "]"
		ProcedureReturn json
	EndProcedure
	
	Procedure.s BuildImageEmbedJSON(ImageBlobRefs.s)
		Protected refs.s = EnsureTrailingDelimiter(ImageBlobRefs)
		Protected blobCount.i = CountString(refs, #BLOB_DELIMITER)
		Protected imagesArray.s = ""
		
		Protected i.i
		For i = 1 To blobCount
			Protected blobRef.s = StringField(refs, i, #BLOB_DELIMITER)
			
			imagesArray + ~"{ \"alt\":\"\", \"image\":" + blobRef + "}"
			
			If i < blobCount
				imagesArray + ", "
			EndIf
		Next
		
		Protected embedJSON.s = ~"{ \"$type\": \"app.bsky.embed.images\", \"images\": [" + imagesArray + "] }"
		
		ProcedureReturn embedJSON
	EndProcedure
	
	;- =======================================================================
	;- Public Procedures: Session Management
	;- =======================================================================
	
	Procedure.b Initialize(*Session.Session, Handle.s, Password.s, ApiUri.s = #DEFAULT_API_URI)
		*Session\ApiUri = ApiUri
		
		Protected json.i = RequestNewSession(*Session, Handle, Password)
		ProcedureReturn ParseSessionFromJSON(*Session, json)
	EndProcedure
	
	Procedure.b RefreshSession(*Session.Session)
		If *Session\RefreshToken = ""
			ProcedureReturn #False
		EndIf
		
		Protected json.i = RequestSessionRefresh(*Session, *Session\RefreshToken)
		ProcedureReturn ParseSessionFromJSON(*Session, json)
	EndProcedure
	
	;- =======================================================================
	;- Public Procedures: Media Upload
	;- =======================================================================
	
	Procedure.s UploadBlob(*Session.Session, *Memory, MemorySize.i, MimeType.s)
		Protected url.s = *Session\ApiUri + "com.atproto.repo.uploadBlob"
		Protected NewMap headers.s()
		
		headers("Content-Type") = MimeType
		headers("Content-Length") = Str(MemorySize)
		
		If *Session\AccessToken
			headers("Authorization") = "Bearer " + *Session\AccessToken
		EndIf
		
		Protected request.i = HTTPRequestMemory(#PB_HTTP_Post, url, *Memory, MemorySize, 0, headers())
		
		If request = 0
			ProcedureReturn ""
		EndIf
		
		Protected response.s = HTTPInfo(request, #PB_HTTP_Response)
		FinishHTTP(request)
		
		ProcedureReturn ExtractBlobRefFromResponse(response)
	EndProcedure
	
	Procedure.s UploadImageFile(*Session.Session, FilePath.s)
		; Validate file exists
		If FilePath = "" Or FileSize(FilePath) = -1
			ProcedureReturn ""
		EndIf
		
		; Open file
		Protected file.i = ReadFile(#PB_Any, FilePath)
		If file = 0
			ProcedureReturn ""
		EndIf
		
		; Check size limit
		Protected size.i = Lof(file)
		If size > #IMAGE_SIZE_LIMIT
			CloseFile(file)
			ProcedureReturn ""
		EndIf
		
		; Read file into memory
		Protected *memory = AllocateMemory(size)
		ReadData(file, *memory, size)
		CloseFile(file)
		
		; Upload and cleanup
		Protected mimeType.s = GetMimeTypeForExtension(GetExtensionPart(FilePath))
		Protected blobRef.s = UploadBlob(*Session, *memory, size, mimeType)
		
		FreeMemory(*memory)
		ProcedureReturn blobRef
	EndProcedure
	
	;- =======================================================================
	;- Public Procedures: Posting
	;- =======================================================================
	
	Procedure.s CreatePost(*Session.Session, Text.s, Language.s = "en", ImageBlobRefs.s = "")
		; Parse text for hyperlinks and create facets
		Protected NewList facets.Facet()
		Protected plainText.s = ExtractFacetsFromHTML(Text, facets())
		
		; Build record object
		Protected NewMap recordArgs.s()
		recordArgs("text") = plainText
		recordArgs("langs") = ~"[\"" + Language + ~"\"]"
		recordArgs("createdAt") = FormatDate("%yyyy-%mm-%ddT%hh:%ii:%ss.000000Z", Date())
		recordArgs("$type") = "app.bsky.feed.post"
		
		; Add facets if present
		Protected facetsJSON.s = BuildFacetsJSON(facets())
		If facetsJSON <> ""
			recordArgs("facets") = facetsJSON
		EndIf
		
		; Add image embeds if provided
		If ImageBlobRefs <> ""
			recordArgs("embed") = BuildImageEmbedJSON(ImageBlobRefs)
		EndIf
		
		; Build request arguments
		Protected NewMap args.s()
		args("collection") = "app.bsky.feed.post"
		args("repo") = *Session\DID
		args("record") = ConvertMapToJSON(recordArgs())
		
		; Execute request
		Protected json.i = ExecuteAPIRequest(*Session, #PB_HTTP_Post, 
		                                     "com.atproto.repo.createRecord", args())
		
		; Extract post ID from response
		Protected postId.s = ""
		
		If json
			Protected rootValue = JSONValue(json)
			
			If ExamineJSONMembers(rootValue)
				While NextJSONMember(rootValue)
					If JSONMemberKey(rootValue) = "uri"
						Protected uri.s = GetJSONString(JSONMemberValue(rootValue))
						postId = StringField(uri, 5, "/")
						Break
					EndIf
				Wend
			EndIf
			
			FreeJSON(json)
		EndIf
		
		ProcedureReturn postId
	EndProcedure
	
	;- =======================================================================
	;- Public Procedures: Utility
	;- =======================================================================
	
	Procedure.s GetPostURL(Handle.s, PostId.s)
		ProcedureReturn "https://bsky.app/profile/" + Handle + "/post/" + PostId
	EndProcedure
	
EndModule

CompilerIf #PB_Compiler_IsMainFile
	
	#MyHandle = "handle.bsky.social"
	#MyAppPassword = "xxxx-xxxx-xxxx-xxxx"
	
	Define Session.BlueskyAPI::Session
	
	If BlueskyAPI::Initialize(@Session, #MyHandle, #MyAppPassword)
		Debug "Successfully authenticated as: " + Session\Did
		Define PostId.s
		
		; --------------------------------------------------------------------
		; Example 1: Create a simple text post
		; --------------------------------------------------------------------
		PostId.s = BlueskyAPI::CreatePost(@Session, "Hello from PureBasic!")
		If PostId
			Debug "Posted: " + BlueskyAPI::GetPostURL(#MyHandle, PostId)
		EndIf
		
		Delay(1000)
		
		; --------------------------------------------------------------------
		; Example 2: Create a post with hyperlinks
		; (URLs are automatically converted to rich text facets)
		; --------------------------------------------------------------------
		PostId = BlueskyAPI::CreatePost(@Session, "Check out https://lastlife.net/")
		If PostId
			Debug "Posted with link: " + BlueskyAPI::GetPostURL(#MyHandle, PostId)
		EndIf
		
		Delay(1000)
		
		; --------------------------------------------------------------------
		; Example 3: Create and upload images, then post with images, and show
		;			 the post in your browser
		; --------------------------------------------------------------------
		;Create two test images
		Define Dim BlobRefs.s(2)
		Define i.i
		
		For i = 1 To 2
			Define ImageWidth.i = 600
			Define ImageHeight.i = 400
			Define Img.i = CreateImage(#PB_Any, ImageWidth, ImageHeight, 32)
			
			If Img
				StartDrawing(ImageOutput(Img))
				DrawingMode(#PB_2DDrawing_AlphaBlend)
				
				;Draw random colored lines
				Define Color.i = RGBA(Random(255), Random(255), Random(255), 255)
				Define j.i
				For j = 1 To 10
					LineXY(Random(ImageWidth), Random(ImageHeight), Random(ImageWidth), Random(ImageHeight), Color)
				Next
				
				StopDrawing()
				
				;Upload As JPEG
				BlobRefs(i) = BlueskyAPI::UploadImageAsJPEG(@Session, Img, 7)
				FreeImage(Img)
				
				If BlobRefs(i)
					Debug "Image " + Str(i) + " uploaded successfully"
				Else
					Debug "Failed to upload image " + Str(i)
				EndIf
			EndIf
		Next
		
		; Create post with both images
		If BlobRefs(1) And BlobRefs(2)
			Define ImageRefs.s = BlobRefs(1) + "|" + BlobRefs(2)
			PostId = BlueskyAPI::CreatePost(@Session, "Two images created in PureBasic:", "en", ImageRefs)
			
			If PostId
				Define PostURL.s = BlueskyAPI::GetPostURL(#MyHandle, PostId)
				Debug "Posted with images: " + PostURL
				
				; Open the post in the default browser
				RunProgram(PostURL)
			EndIf
		EndIf
		
		Delay(1000)
		
		; --------------------------------------------------------------------
		; Example 4: Refresh the session token
		; --------------------------------------------------------------------
		If BlueskyAPI::RefreshSession(@Session)
			Debug "Session refreshed successfully"
		Else
			Debug "Failed to refresh session"
		EndIf
		
	Else
		Debug "Authentication failed!"
	EndIf
CompilerEndIf
; IDE Options = PureBasic 6.30 beta 5 (Linux - x64)
; CursorPosition = 64
; FirstLine = 21
; Folding = DAAA+
; EnableXP
; DPIAware