In order to use this, you will need to create an app password on Bluesky (as described here) then use that password as shown in the demo code below.
Bluesky.pbi:
Code: Select all
Global c13.s = Chr(13)
Global c32.s=Chr(32)
Global c34.s = Chr(34)
Global c39.s=Chr(39)
#d1 = "|"
Macro R(t)
MessageRequester("Report",t,0)
EndMacro
Macro StartsWith(main,sub)
(sub<>"" And main<>"" And Left(main,Len(sub))=sub)
EndMacro
Macro EnsureThisEnd(t,endd)
If endd<>""
If Right(t,Len(endd)) <> endd
t+endd
EndIf
EndIf
EndMacro
Procedure.s StringMapToURLParameters(Map arg.s())
t.s = ""
a=0
ForEach arg()
a+1
If a>1
t + "&"
EndIf
t + MapKey(arg())+"="+arg()
Next
ProcedureReturn t
EndProcedure
Procedure.s StringMapToJSONObject(Map arg.s())
t.s = "{ "
ForEach arg()
t + c34+MapKey(arg())+c34+": "
If StartsWith(arg(),"[") Or StartsWith(arg(),"{")
t + arg()
Else
t + c34+arg()+c34
EndIf
t+", "
Next
t = Left(t,Len(t)-2) + " }"
ProcedureReturn t
EndProcedure
Structure BlueskyAPI
accountDid.s
apiKey.s
refreshToken.s
apiUri.s
EndStructure
Structure BlueskyCredentials
handle.s
password.s
EndStructure
Macro BS_PostURL(bshdl,bspid)
"https://bsky.app/profile/"+bshdl+"/post/"+bspid
EndMacro
; Make a request to the Bluesky API
Procedure.i BS_Request(*cnc.BlueskyAPI,reqType.i, request.s, Map arg.s(),postFields.s="",content_type.s="")
u.s = *cnc\apiUri + request
If reqType=#PB_HTTP_Get And MapSize(arg())
u + "?" + StringMapToURLParameters(arg())
Else
If reqType=#PB_HTTP_Post And content_type=""
content_type = "application/json"
EndIf
EndIf
NewMap header.s()
If *cnc\apiKey
header("Authorization") = "Bearer "+*cnc\apiKey
EndIf
If content_type<>""
header("Content-Type") = content_type
If content_type="application/json" And MapSize(arg())
postFields = StringMapToJSONObject(arg())
ClearMap(arg())
EndIf
EndIf
req.i = HTTPRequest(reqType,u,postFields,0,header())
If req
Debug "StatusCode: " + HTTPInfo(req,#PB_HTTP_StatusCode)
Debug "Response: " + HTTPInfo(req,#PB_HTTP_Response)
em.s=HTTPInfo(req,#PB_HTTP_ErrorMessage) : If em : Debug "Error: "+em : EndIf
*ret = HTTPMemory(req)
j.i = CatchJSON(#PB_Any,*ret,MemorySize(*ret))
FinishHTTP(req)
FreeMemory(*ret)
ProcedureReturn j
EndIf
EndProcedure
; Start a new user session using handle and app password
Procedure.i BS_StartNewSession(*cnc.BlueskyAPI,handle.s, password.s)
NewMap arg.s()
arg("identifier") = handle
arg("password") = password
j.i = BS_Request(*cnc,#PB_HTTP_Post, "com.atproto.server.createSession", arg())
;If j\error
;throw new RuntimeException(j\message)
;EndIf
ProcedureReturn j
EndProcedure
; Refresh a user session using an API key
Procedure.i BS_RefreshSession(*cnc.BlueskyAPI,api_key.s)
*cnc\apiKey = api_key
NewMap arg.s()
j.i = BS_Request(*cnc,#PB_HTTP_Post, "com.atproto.server.refreshSession",arg())
;unset(*cnc\apiKey)
;If j\error
;throw new RuntimeException($data->message)
;EndIf
ProcedureReturn j
EndProcedure
; Authorize a user
; If handle and password are provided, a new session will be created. If a refresh token is provided, the session will be refreshed.
Procedure.b BS_Auth(*cnc.BlueskyAPI,handleOrToken.s, password.s="")
If password<>""
;R("START NEW SESSION")
j = BS_StartNewSession(*cnc,handleOrToken,password)
Else
;R("REFRESH SESSION")
j = BS_RefreshSession(*cnc,handleOrToken)
EndIf
ObjectValue = JSONValue(j)
If ExamineJSONMembers(ObjectValue)
While NextJSONMember(ObjectValue)
Select JSONMemberKey(ObjectValue)
Case "did"
*cnc\accountDid = GetJSONString(JSONMemberValue(ObjectValue))
Case "accessJwt"
*cnc\apiKey = GetJSONString(JSONMemberValue(ObjectValue))
Case "refreshJwt"
*cnc\refreshToken = GetJSONString(JSONMemberValue(ObjectValue))
EndSelect
Wend
EndIf
FreeJSON(j)
EndProcedure
Procedure BS_Initialize(*cnc.BlueskyAPI,handle.s,password.s,api_uri.s="https://bsky.social/xrpc/")
*cnc.BlueskyAPI\apiUri = api_uri
BS_Auth(*cnc,handle,password)
EndProcedure
;-------------------------------------------------
#BS_ImageSizeLimit = 1000000
Structure BS_BlobRef
link.s
EndStructure
Structure BS_Blob
type.s
ref.BS_BlobRef
mimeType.s
size.i
EndStructure
Procedure.s BS_UploadBlob(*cnc.BlueskyAPI,*imgMem,mimeType.s)
u.s = *cnc\apiUri + "com.atproto.repo.uploadBlob"
MemLen = MemorySize(*imgMem)
NewMap header.s()
header("Content-Type") = mimeType
If *cnc\apiKey
header("Authorization") = "Bearer "+*cnc\apiKey
EndIf
header("Content-Length") = Str(MemLen)
req = HTTPRequestMemory(#PB_HTTP_Post, u, *imgMem, MemLen, 0, header())
If req
Debug "StatusCode = "+ HTTPInfo(req, #PB_HTTP_StatusCode)
resp.s = HTTPInfo(req, #PB_HTTP_Response)
resp = ReplaceString(resp,"$type","type")
resp = ReplaceString(resp,"$link","link")
j.i = ParseJSON(#PB_Any,resp)
FinishHTTP(req)
EndIf
If j
ObjectValue = JSONValue(j)
If ExamineJSONMembers(ObjectValue)
While NextJSONMember(ObjectValue)
Select JSONMemberKey(ObjectValue)
Case "blob"
value = JSONMemberValue(ObjectValue)
If ExamineJSONMembers(value)
While NextJSONMember(value)
If JSONMemberKey(value) = "ref"
value2 = JSONMemberValue(value)
ExtractJSONStructure(value,@struc.BS_Blob,BS_Blob)
j2 = CreateJSON(#PB_Any)
InsertJSONStructure(JSONValue(j2),@struc,BS_Blob)
blob_ref.s = ComposeJSON(j2)
blob_ref = ReplaceString(blob_ref,"type","$type")
blob_ref = ReplaceString(blob_ref,"link","$link")
FreeJSON(j2)
Break 2
EndIf
Wend
EndIf
EndSelect
Wend
Else
R("CAN'T EXAMINE MAIN")
EndIf
FreeJSON(j)
EndIf
ProcedureReturn blob_ref
EndProcedure
CompilerIf Defined(MimeType,#PB_Procedure)=#False
Procedure.s MimeType(ext.s)
ext = RemoveString(LCase(ext),".")
Select ext
Case "txt"
ProcedureReturn "text/plain"
Case "json"
ProcedureReturn "application/json"
Case "xml"
ProcedureReturn "application/xml"
Case "mp3", "ogg", "m4a"
ProcedureReturn "audio/"+ext
Case "jpg", "jpeg"
ProcedureReturn "image/jpeg"
Case "png", "gif", "webp"
ProcedureReturn "image/"+ext
Case "mp4", "webm"
ProcedureReturn "video/"+ext
Case "svg"
ProcedureReturn "image/svg+xml"
Case "srt"
ProcedureReturn "application/x-subrip"
EndSelect
Debug "Don't know mime type for file extension:"+c13+ext
EndProcedure
CompilerEndIf
Procedure.s BS_UploadImageFile(*cnc.BlueskyAPI,fn.s)
If fn="" Or FileSize(fn)=-1
ProcedureReturn ""
EndIf
f = ReadFile(#PB_Any,fn)
size = Lof(f)
If size>#BS_ImageSizeLimit
CloseFile(f)
Debug "media too large"
ProcedureReturn ""
EndIf
*imgMem = AllocateMemory(size)
ReadData(f,*imgMem,size)
CloseFile(f)
mime.s = MimeType(GetExtensionPart(fn))
blob_ref.s = BS_UploadBlob(*cnc,*imgMem,mime)
FreeMemory(*imgMem)
ProcedureReturn blob_ref
EndProcedure
Procedure.s BS_UploadPBImageAsJPEG(*cnc.BlueskyAPI,img.i,quality.i=7)
If Not IsImage(img)
ProcedureReturn ""
EndIf
UseJPEGImageEncoder()
*imgMem = EncodeImage(img,#PB_ImagePlugin_JPEG,quality)
mime.s = MimeType("jpg")
size = MemorySize(*imgMem)
If size>#BS_ImageSizeLimit
FreeMemory(*imgMem)
Debug "image too large"
ProcedureReturn ""
EndIf
blob_ref.s = BS_UploadBlob(*cnc,*imgMem,mime)
FreeMemory(*imgMem)
ProcedureReturn blob_ref
EndProcedure
Procedure.s BS_UploadPBImageAsPNG(*cnc.BlueskyAPI,img.i,depth=24)
If Not IsImage(img)
ProcedureReturn ""
EndIf
; BS doesn't support 32-bit
If depth=32
depth=24
EndIf
UsePNGImageEncoder()
*imgMem = EncodeImage(img,#PB_ImagePlugin_PNG,0,depth)
mime.s = MimeType("png")
size = MemorySize(*imgMem)
If size>#BS_ImageSizeLimit
FreeMemory(*imgMem)
Debug "image too large"
ProcedureReturn ""
EndIf
blob_ref.s = BS_UploadBlob(*cnc,*imgMem,mime)
FreeMemory(*imgMem)
ProcedureReturn blob_ref
EndProcedure
Structure BS_FacetIndex
byteStart.i
byteEnd.i
EndStructure
Structure BS_FacetFeatures
type.s
uri.s
did.s
EndStructure
Structure BS_Facet
index.BS_FacetIndex
Array features.BS_FacetFeatures(0)
EndStructure
Procedure.s ConformAllHyperlinks(h.s)
Static r.i
If Not r
r = CreateRegularExpression(#PB_Any,"href='(.+?)'")
EndIf
If ExamineRegularExpression(r,h)
While NextRegularExpressionMatch(r)
detect1 = RegularExpressionMatchPosition(r)
detect2 = RegularExpressionMatchLength(r)
tag.s = Mid(h,detect1,detect2)
tag = ReplaceString(tag,c39,c34)
h = Left(h,detect1-1)+tag+Mid(h,detect1+detect2,Len(h))
Wend
EndIf
ProcedureReturn h
EndProcedure
Procedure.s MakeURLsIntoHyperlinks(h.s)
h = ConformAllHyperlinks(h)
Dim cand_detect2.i(5)
Repeat
detect1 = FindString(h,"http",start)
If Not detect1 : Break : EndIf
If Mid(h,detect1-9,8)="<a href="
start = FindString(h,"</a>",detect1)+4
Continue
EndIf
;cand_detect2(0) = FindString(h,".",detect1+1)
cand_detect2(0) = FindString(h,",",detect1+1)
cand_detect2(1) = FindString(h,c13,detect1+1)
cand_detect2(2) = FindString(h,c32,detect1+1)
cand_detect2(3) = FindString(h,c34,detect1+1)
cand_detect2(4) = FindString(h,c39,detect1+1)
cand_detect2(5) = Len(h)+1
SortArray(cand_detect2(),#PB_Sort_Ascending)
detect2 = -1
For a = 1 To ArraySize(cand_detect2())
If cand_detect2(a)>0
detect2 = cand_detect2(a)
Break
EndIf
Next a
If detect2=-1 : Break : EndIf
u.s = Mid(h,detect1,detect2-detect1)
nh.s = Left(h,detect1-1)+"<a href="+c34+u+c34+">"+u+"</a>"
start = Len(nh)+1
nh + Mid(h,detect2,Len(h))
h = nh
ForEver
ProcedureReturn h
EndProcedure
Procedure.s ParseHyperlinks(h.s,List facet.BS_Facet())
h = MakeURLsIntoHyperlinks(h)
pt.s = ""
anchors = CountString(h,"<a ")
For a = 1 To anchors+1
this_one.s = StringField(h,a,"<a ")
If FindString(this_one,"</a>")=0
pt + this_one
Continue
EndIf
u.s = StringField(this_one,2,c34)
alias.s = StringField(this_one,2,">")
alias = StringField(alias,1,"<")
excess.s = StringField(this_one,2,"</a>")
AddElement(facet())
facet()\index\byteStart = Len(pt)
facet()\index\byteEnd = Len(pt)+Len(alias)
facet()\features(0)\type = "app.bsky.richtext.facet#link"
facet()\features(0)\uri = u
pt+alias+excess
Next a
ProcedureReturn pt
EndProcedure
Procedure.s BS_Post(*cnc.BlueskyAPI,txt.s,img_blobref_arr.s="")
NewList facet.BS_Facet()
plainTxt.s = ParseHyperlinks(txt,facet())
NewMap record_arg.s()
record_arg("text") = plainTxt
record_arg("langs") = "["+c34+"en"+c34+"]"
record_arg("createdAt") = FormatDate("%yyyy-%mm-%ddT%hh:%mm:%ss.000000Z",Date())
record_arg("$type") = "app.bsky.feed.post"
fj = CreateJSON(#PB_Any)
InsertJSONList(JSONValue(fj),facet())
record_arg("facets") = ComposeJSON(fj)
FreeJSON(fj)
record_arg("facets") = ReplaceString(record_arg("facets"),c34+"type"+c34+":",c34+"$type"+c34+":")
If img_blobref_arr<>""
EnsureThisEnd(img_blobref_arr,#d1)
blobs = CountString(img_blobref_arr,#d1)
t.s = ""
For b = 1 To blobs
blob_ref.s = StringField(img_blobref_arr,b,#d1)
t + "{ ¬alt¬:¬¬, ¬image¬:"+blob_ref+"}"
If b<blobs : t+", " : EndIf
Next b
record_arg("embed") = "{ ¬$type¬: ¬app.bsky.embed.images¬, ¬images¬: [" +t+ "] }"
record_arg("embed") = ReplaceString(record_arg("embed"),"¬",c34)
EndIf
NewMap arg.s()
arg("collection") = "app.bsky.feed.post"
arg("repo") = *cnc\accountDid
arg("record") = StringMapToJSONObject(record_arg())
j.i = BS_Request(*cnc,#PB_HTTP_Post, "com.atproto.repo.createRecord", arg())
If j
ObjectValue = JSONValue(j)
If ExamineJSONMembers(ObjectValue)
While NextJSONMember(ObjectValue)
If JSONMemberKey(ObjectValue) = "uri"
ur.s = GetJSONString(JSONMemberValue(ObjectValue))
id.s = StringField(ur,5,"/")
Break
EndIf
Wend
EndIf
FreeJSON(j)
EndIf
ProcedureReturn id
EndProcedureCode: Select all
XIncludeFile "Bluesky.pbi"
#MyBSHandle = "myblueskyhandle.bsky.social"
#MyBSAppPassword = "enbr-39rh-mlc4-kzva"
BS_Initialize(@bsky.BlueskyAPI,#MyBSHandle,#MyBSAppPassword)
Dim blob_ref.s(2)
For b = 1 To 2
iw=600
ih=400
img = CreateImage(#PB_Any,iw,ih,32)
StartDrawing(ImageOutput(img))
DrawingMode(#PB_2DDrawing_AlphaBlend)
clr = RGBA(Random(255),Random(255),Random(255),255)
For a = 1 To 10
LineXY(Random(iw),Random(ih),Random(iw),Random(ih),clr)
Next a
StopDrawing()
Select b
Case 1
; upload this image directly
blob_ref(b) = BS_UploadPBImageAsJPEG(@bsky,img)
Case 2
; save this image to a file and upload the file
jpgfn.s = ; enter a viable JPEG filename here
UseJPEGImageEncoder()
SaveImage(img,jpgfn,#PB_ImagePlugin_JPEG)
blob_ref(b) = BS_UploadImageFile(@bsky,jpgfn)
EndSelect
FreeImage(img)
Next b
txt.s = "Two images created in PB:"
mid.s = BS_Post(@bsky,txt,blob_ref(1)+#d1+blob_ref(2))
u.s = BS_PostURL(#MyBSHandle,mid)
RunProgram(u)
