1:- module(twitter,
    2         [token/1,
    3          get_bearer_token/5,
    4          make_a_search/4,
    5          get_friends_list/4,
    6          get_user/4,
    7          get_user_following/4,
    8          get_tweet/4]).
    9
   10:- use_module(library(http/thread_httpd)).
   11:- use_module(library(http/http_dispatch)).
   12:- use_module(library(http/http_error)).
   13:- use_module(library(http/html_write)).
   14:- use_module(library(http/http_session)).
   15:- use_module(library(http/js_write)).
   16:- use_module(library(http/http_files)).
   17:- use_module(library(http/json)).
   18:- use_module(library(http/http_open)).
   19:- use_module(library(http/http_json)).
   20:- use_module(library(http/http_parameters)).
   21:- use_module(library(http/http_client)).
   22:- use_module(library(http/http_ssl_plugin)).
   23
   24:- dynamic
   25	token/1.
   26
   27bearer_token_credentials(Key,Secret,B_Token):-
   28        format(atom(B_Token),"~w:~w",[Key,Secret]).
   29
   30get_bearer_token(Key,Secret,JSON,Token,ErrorCode):-
   31	bearer_token_credentials(Key,Secret,B_Token),
   32	base64(B_Token,B_Token64),
   33	format(atom(My_Auth),"Basic ~w",[B_Token64]),
   34	ListofData =[grant_type=client_credentials],
   35        http_open('https://api.twitter.com/oauth2/token', In,
   36                  [ request_header(authorization=My_Auth),status_code(ErrorCode),
   37		    method(post),post(form(ListofData))
   38                  ]),
   39	call_cleanup(json_read_dict(In, JSON),
   40	close(In)),
   41	Token = JSON.access_token,
   42	assertz(token(Token)).
   43
   44
   45make_a_search(My_Search,B_Token64,JSON,ErrorCode):-
   46	Path='/1.1/search/tweets.json',
   47	Search=[q(My_Search)],
   48	get_json(Path, Search, B_Token64, JSON, ErrorCode).
   49
   50get_friends_list(Username, B_Token64, JSON, ErrorCode) :-
   51    % DEPRECATED: Twitter API v1.1 https://developer.twitter.com/en/docs/twitter-api/v1/accounts-and-users/follow-search-get-users/api-reference/get-friends-list
   52    get_friends_list_at_cursor(Username, B_Token64, -1, JSON, ErrorCode).
   53
   54get_friends_list_at_cursor(Username, B_Token64, Cursor, JSON, ErrorCode) :-
   55    Cursor=\=0,
   56    Path='/1.1/friends/list.json',
   57    Search=[screen_name=Username, count=200, cursor=Cursor],
   58    get_json(Path, Search, B_Token64, Json0, ErrorCode0),
   59    (   % succeed for current
   60        JSON = Json0,
   61        ErrorCode = ErrorCode0
   62    ;   % succeed for next
   63        _{next_cursor:NextCursor}:<Json0,
   64        get_friends_list_at_cursor(Username, B_Token64, NextCursor, JSON, ErrorCode)
   65    ).
   66
   67get_user_following(UserId, B_Token64, JSON, ErrorCode) :-
   68    % Twitter API v2 https://developer.twitter.com/en/docs/twitter-api/users/follows/introduction
   69    get_user_following(UserId, [], B_Token64, JSON, ErrorCode).
   70
   71get_user_following(UserId, Options, B_Token64, JSON, ErrorCode) :-
   72    number(UserId),
   73    !,
   74    format(atom(Path), '/2/users/~w/following', [UserId]),
   75    Search=[max_results=1000 | Options],
   76    get_json(Path, Search, B_Token64, Json0, ErrorCode0),
   77    (   % succeed for current
   78        JSON=Json0,
   79        ErrorCode=ErrorCode0
   80    ;   % if there is a pagination token, succeed for next
   81        _{meta:Metadata}:<Json0,
   82        _{next_token:PaginationToken}:<Metadata,
   83        NextOptions=[pagination_token=PaginationToken],
   84        get_user_following(UserId, NextOptions, B_Token64, JSON, ErrorCode)
   85    ).
   86
   87get_tweet(TweetId, B_Token64, JSON, ErrorCode) :-
   88    number(TweetId),
   89    format(atom(Path), '/2/tweets/~w', [TweetId]),
   90    Search=[expansions=author_id],
   91    get_json(Path, Search, B_Token64, JSON, ErrorCode).
   92
   93get_user(UserId, B_Token64, JSON, ErrorCode) :-
   94    number(UserId), !, 
   95    format(atom(Path), '/2/users/~w', [UserId]),
   96	Search=['user.fields'=description],
   97	get_json(Path, Search, B_Token64, JSON, ErrorCode).
   98
   99get_user(Username, B_Token64, JSON, ErrorCode) :-
  100    atom(Username),
  101    uri_encoded(path, Username, EncodedUsername),
  102    format(atom(Path), '/2/users/by/username/~w', [EncodedUsername]),
  103	Search=['user.fields'=description],
  104	get_json(Path, Search, B_Token64, JSON, ErrorCode).
  105
  106
  107get_json(Path, Search, B_Token64, JSON, ErrorCode) :-
  108	URL=[scheme(https), host('api.twitter.com'), path(Path), search(Search)],
  109	Options=[ authorization(bearer(B_Token64)),
  110			status_code(ErrorCode)
  111			],
  112	setup_call_cleanup(http_open(URL, In, Options),
  113					   json_read_dict(In, JSON),
  114					   close(In))