PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Posting on Bluesky

https://www.purebasic.fr/english/viewtopic.php?t=85168

Page 1 of 1

Posting on Bluesky

Posted: Thu Aug 22, 2024 10:21 am
by Seymour Clufley
This is a small library for using the API for the Bluesky social media platform. I've adapted it from this PHP library and written a few convenience procedures. I only need it for very basic stuff so I have only implemented making posts, with or without images. The text can include HTML hyperlinks and simple URLs. Both will be converted into clickable links. Bluesky can accept images of type JPEG, WEBP, 24-bit PNG, and GIF. However, only the first frame of an animated gif will be shown.

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
EndProcedure
Usage demo:

Code: 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)
I might add more functions in future, if Bluesky implement videos and proper gif handling.
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited