module Web.Hastodon.API
( mkHastodonClient
, getAccountById
, getCurrentAccount
, getFollowers
, getFollowersWithOption
, getFollowing
, getFollowingWithOption
, getAccountStatuses
, getAccountStatusesWithOption
, postFollow
, postUnfollow
, postBlock
, postUnblock
, postMute
, postMuteWithOption
, postUnmute
, getRelationships
, getSearchedAccounts
, getSearchedAccountsWithOption
, postApps
, getBlocks
, getBlocksWithOption
, getFavorites
, getFavoritesWithOption
, getFollowRequests
, getFollowRequestsWithOption
, postAuthorizeRequest
, postRejectRequest
, getInstance
, postMediaFile
, getMutes
, getMutesWithOption
, getNotifications
, getNotificationsWithOption
, getNotificationById
, postNotificationsClear
, getReports
, getSearchedResults
, getSearchedResultsWithOption
, getStatus
, getCard
, getContext
, getRebloggedBy
, getRebloggedByWithOption
, getFavoritedBy
, getFavoritedByWithOption
, postStatus
, postStatusWithOption
, postStatusWithMediaIds
, postReblog
, postUnreblog
, postFavorite
, postUnfavorite
, getHomeTimeline
, getHomeTimelineWithOption
, getPublicTimeline
, getPublicTimelineWithOption
, getTaggedTimeline
, getTaggedTimelineWithOption
) where
import Control.Applicative
import Data.Aeson
import qualified Data.ByteString.Char8 as Char8
import qualified Data.ByteString.Lazy.Char8 as LChar8
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.String.Utils
import Network.HTTP.Simple
import Network.HTTP.Client.MultipartFormData
import Network.Mime
import Web.Hastodon.Types
import Web.Hastodon.Util
import Web.Hastodon.Option
pAccountById = "/api/v1/accounts/:id"
pCurrentAccounts = "/api/v1/accounts/verify_credentials"
pFollowers = "/api/v1/accounts/:id/followers"
pFollowing = "/api/v1/accounts/:id/following"
pAccountStatuses = "/api/v1/accounts/:id/statuses"
pFollow = "/api/v1/accounts/:id/follow"
pUnfollow = "/api/v1/accounts/:id/unfollow"
pBlock = "/api/v1/accounts/:id/block"
pUnblock = "/api/v1/accounts/:id/unblock"
pMute = "/api/v1/accounts/:id/mute"
pUnmute = "/api/v1/accounts/:id/unmute"
pRelationships = "/api/v1/accounts/relationships"
pSearchAccounts = "/api/v1/accounts/search"
pApps = "/api/v1/apps"
pBlocks = "/api/v1/blocks"
pFavorites = "/api/v1/favourites"
pFollowRequests = "/api/v1/follow_requests"
pAuthorizeRequest = "/api/v1/follow_requests/:id/authorize"
pRejectRequest = "/api/v1/follow_requests/:id/reject"
pInstance = "/api/v1/instance"
pMedia = "/api/v1/media"
pMutes = "/api/v1/mutes"
pNotifications = "/api/v1/notifications"
pNotificationById = "/api/v1/notifications/:id"
pNotificationClear = "/api/v1/notifications/clear"
pReports = "/api/v1/reports"
pSearch = "/api/v1/search"
pStatus = "/api/v1/statuses/:id"
pContext = "/api/v1/statuses/:id/context"
pCard = "/api/v1/statuses/:id/card"
pRebloggedBy = "/api/v1/statuses/:id/reblogged_by"
pFavoritedBy = "/api/v1/statuses/:id/favourited_by"
pStatuses = "/api/v1/statuses"
pDeleteStatus = "/api/v1/statuses/:id"
pHomeTimeline = "/api/v1/timelines/home"
pPublicTimeline = "/api/v1/timelines/public"
pReblog = "/api/v1/statuses/:id/reblog"
pUnreblog = "/api/v1/statuses/:id/unreblog"
pFavorite = "/api/v1/statuses/:id/favourite"
pUnfavorite = "/api/v1/statuses/:id/unfavourite"
pTaggedTimeline = "/api/v1/timelines/tag/:hashtag"
getOAuthToken :: String -> String -> String -> String -> String -> IO (Either JSONException OAuthResponse)
getOAuthToken clientId clientSecret username password host = do
initReq <- parseRequest $ "https://" ++ host ++ "/oauth/token"
let reqBody = [(Char8.pack "client_id", utf8ToChar8 clientId),
(Char8.pack "client_secret", utf8ToChar8 clientSecret),
(Char8.pack "username", utf8ToChar8 username),
(Char8.pack "password", utf8ToChar8 password),
(Char8.pack "grant_type", Char8.pack "password"),
(Char8.pack "scope", Char8.pack "read write follow")]
let req = setRequestBodyURLEncoded reqBody $ initReq
res <- httpJSONEither req
return $ (getResponseBody res :: Either JSONException OAuthResponse)
getHastodonResponseBody :: String -> HastodonClient -> IO LChar8.ByteString
getHastodonResponseBody path client = do
req <- mkHastodonRequest path client
res <- httpLBS req
return $ getResponseBody res
getHastodonResponseJSONWithOption opt path client =
mkHastodonRequestWithQuery opt path client >>= httpJSONEither
getHastodonResponseJSON path client = mkHastodonRequest path client >>= httpJSONEither
postAndGetHastodonResult path body client = do
initReq <- mkHastodonRequest path client
let req = setRequestBodyURLEncoded body $ initReq
res <- httpNoBody req
return $ (getResponseStatusCode res) == 200
postAndGetHastodonResponseJSON path body client = do
initReq <- mkHastodonRequest path client
let req = setRequestBodyURLEncoded body $ initReq
httpJSONEither req
mkHastodonClient :: String -> String -> String -> String -> String -> IO (Maybe HastodonClient)
mkHastodonClient clientId clientSecret username password host = do
oauthRes <- getOAuthToken clientId clientSecret username password host
case oauthRes of
Left err -> return $ Nothing
Right oauthData -> return $ Just $ HastodonClient host (accessToken oauthData)
getAccountById :: HastodonClient -> AccountId -> IO (Either JSONException Account)
getAccountById client id = do
res <- getHastodonResponseJSON (replace ":id" (show id) pAccountById) client
return (getResponseBody res :: Either JSONException Account)
getCurrentAccount :: HastodonClient -> IO (Either JSONException Account)
getCurrentAccount client = do
res <- getHastodonResponseJSON pCurrentAccounts client
return (getResponseBody res :: Either JSONException Account)
getFollowers :: HastodonClient -> AccountId -> IO (Either JSONException [Account])
getFollowers client = getFollowersWithOption client mempty
getFollowersWithOption :: HastodonClient -> RangeOption -> AccountId -> IO (Either JSONException [Account])
getFollowersWithOption client opt id = do
res <- getHastodonResponseJSONWithOption
(optionAsQuery opt)
(replace ":id" (show id) pFollowers)
client
return (getResponseBody res :: Either JSONException [Account])
getFollowing :: HastodonClient -> AccountId -> IO (Either JSONException [Account])
getFollowing client = getFollowingWithOption client mempty
getFollowingWithOption :: HastodonClient -> RangeOption -> AccountId -> IO (Either JSONException [Account])
getFollowingWithOption client opt id = do
res <- getHastodonResponseJSONWithOption
(optionAsQuery opt)
(replace ":id" (show id) pFollowing)
client
return (getResponseBody res :: Either JSONException [Account])
getAccountStatusesWithOption :: HastodonClient -> GetAccountStatusesOption -> AccountId -> IO (Either JSONException [Status])
getAccountStatusesWithOption client opt id = do
res <- getHastodonResponseJSONWithOption
(optionAsQuery opt)
(replace ":id" (show id) pAccountStatuses)
client
return (getResponseBody res :: Either JSONException [Status])
getAccountStatuses :: HastodonClient -> AccountId -> IO (Either JSONException [Status])
getAccountStatuses client = getAccountStatusesWithOption client mempty
getRelationships :: HastodonClient -> [AccountId] -> IO (Either JSONException [Relationship])
getRelationships client ids = do
let intIds = map (show) ids
let params = foldl (\x y -> x ++ (if x == "" then "?" else "&") ++ "id%5b%5d=" ++ y) "" intIds
res <- getHastodonResponseJSON (pRelationships ++ params) client
return (getResponseBody res :: Either JSONException [Relationship])
getSearchedAccountsWithOption ::
HastodonClient -> AccountSearchOption -> String -> IO (Either JSONException [Account])
getSearchedAccountsWithOption client opt query = do
res <- getHastodonResponseJSONWithOption (optionAsQuery opt) (pSearchAccounts ++ "?q=" ++ query) client
return (getResponseBody res :: Either JSONException [Account])
getSearchedAccounts :: HastodonClient -> String -> IO (Either JSONException [Account])
getSearchedAccounts client = getSearchedAccountsWithOption client mempty
postFollow :: HastodonClient -> AccountId -> IO (Either JSONException Relationship)
postFollow client id = do
res <- postAndGetHastodonResponseJSON (replace ":id" (show id) pFollow) [] client
return (getResponseBody res :: Either JSONException Relationship)
postUnfollow :: HastodonClient -> AccountId -> IO (Either JSONException Relationship)
postUnfollow client id = do
res <- postAndGetHastodonResponseJSON (replace ":id" (show id) pUnfollow) [] client
return (getResponseBody res :: Either JSONException Relationship)
postBlock :: HastodonClient -> AccountId -> IO (Either JSONException Relationship)
postBlock client id = do
res <- postAndGetHastodonResponseJSON (replace ":id" (show id) pBlock) [] client
return (getResponseBody res :: Either JSONException Relationship)
postUnblock :: HastodonClient -> AccountId -> IO (Either JSONException Relationship)
postUnblock client id = do
res <- postAndGetHastodonResponseJSON (replace ":id" (show id) pUnblock) [] client
return (getResponseBody res :: Either JSONException Relationship)
postMuteWithOption ::
HastodonClient -> PostMuteOption -> AccountId -> IO (Either JSONException Relationship)
postMuteWithOption client opt id = do
let prms = optionAsForm opt
res <- postAndGetHastodonResponseJSON (replace ":id" (show id) pMute) prms client
return (getResponseBody res :: Either JSONException Relationship)
postMute :: HastodonClient -> AccountId -> IO (Either JSONException Relationship)
postMute client = postMuteWithOption client mempty
postUnmute :: HastodonClient -> AccountId -> IO (Either JSONException Relationship)
postUnmute client id = do
res <- postAndGetHastodonResponseJSON (replace ":id" (show id) pUnmute) [] client
return (getResponseBody res :: Either JSONException Relationship)
postApps :: String -> String -> IO (Either JSONException OAuthClient)
postApps host clientName = do
let reqBody = [(Char8.pack "client_name", utf8ToChar8 clientName),
(Char8.pack "redirect_uris", Char8.pack "urn:ietf:wg:oauth:2.0:oob"),
(Char8.pack "scopes", Char8.pack "read write follow")]
initReq <- parseRequest $ "https://" ++ host ++ pApps
let req = setRequestBodyURLEncoded reqBody $ initReq
res <- httpJSONEither req
return (getResponseBody res :: Either JSONException OAuthClient)
getBlocksWithOption :: HastodonClient -> RangeOption -> IO (Either JSONException [Account])
getBlocksWithOption client opt = do
res <- getHastodonResponseJSONWithOption (optionAsQuery opt) pBlocks client
return (getResponseBody res :: Either JSONException [Account])
getBlocks :: HastodonClient -> IO (Either JSONException [Account])
getBlocks client = getBlocksWithOption client mempty
getFavoritesWithOption :: HastodonClient -> RangeOption -> IO (Either JSONException [Status])
getFavoritesWithOption client opt = do
res <- getHastodonResponseJSONWithOption (optionAsQuery opt) pFavorites client
return (getResponseBody res :: Either JSONException [Status])
getFavorites :: HastodonClient -> IO (Either JSONException [Status])
getFavorites client = getFavoritesWithOption client mempty
getFollowRequestsWithOption :: HastodonClient -> RangeOption -> IO (Either JSONException [Account])
getFollowRequestsWithOption client opt = do
res <- getHastodonResponseJSONWithOption (optionAsQuery opt) pFollowRequests client
return (getResponseBody res :: Either JSONException [Account])
getFollowRequests :: HastodonClient -> IO (Either JSONException [Account])
getFollowRequests client = getFollowRequestsWithOption client mempty
postAuthorizeRequest :: HastodonClient -> AccountId -> IO Bool
postAuthorizeRequest client id = postAndGetHastodonResult (replace ":id" (show id) pAuthorizeRequest) [] client
postRejectRequest :: HastodonClient -> AccountId -> IO Bool
postRejectRequest client id = postAndGetHastodonResult (replace ":id" (show id) pRejectRequest) [] client
getInstance :: HastodonClient -> IO (Either JSONException Instance)
getInstance client = do
res <- getHastodonResponseJSON pInstance client
return (getResponseBody res :: Either JSONException Instance)
postMediaFile :: HastodonClient -> String -> String -> IO (Either JSONException Attachment)
postMediaFile client filename description = do
initReq <- mkHastodonRequest pMedia client
let file = partFileSource (T.pack "file") filename
let mimetype = defaultMimeLookup (T.pack filename)
req <- formDataBody [file { partContentType = Just mimetype },
partBS (T.pack "description") (utf8ToChar8 description)
] initReq
res <- httpJSONEither req
return (getResponseBody res :: Either JSONException Attachment)
getMutesWithOption :: HastodonClient -> RangeOption -> IO (Either JSONException [Account])
getMutesWithOption client opt = do
res <- getHastodonResponseJSONWithOption (optionAsQuery opt) pMutes client
return (getResponseBody res :: Either JSONException [Account])
getMutes :: HastodonClient -> IO (Either JSONException [Account])
getMutes client = getMutesWithOption client mempty
getNotifications :: HastodonClient -> IO (Either JSONException [Notification])
getNotifications client = getNotificationsWithOption client mempty
getNotificationsWithOption :: HastodonClient -> GetNotificationsOption -> IO (Either JSONException [Notification])
getNotificationsWithOption client opt = do
res <- getHastodonResponseJSONWithOption (optionAsQuery opt) pNotifications client
return (getResponseBody res :: Either JSONException [Notification])
getNotificationById :: HastodonClient -> NotificationId -> IO (Either JSONException Notification)
getNotificationById client id = do
res <- getHastodonResponseJSON (replace ":id" (show id) pNotificationById) client
return (getResponseBody res :: Either JSONException Notification)
postNotificationsClear :: HastodonClient -> IO Bool
postNotificationsClear = postAndGetHastodonResult pNotificationClear []
getReports :: HastodonClient -> IO (Either JSONException [Report])
getReports client = do
res <- getHastodonResponseJSON pReports client
return (getResponseBody res :: Either JSONException [Report])
getSearchedResults :: HastodonClient -> String -> IO (Either JSONException [Results])
getSearchedResults client = getSearchedResultsWithOption client mempty
getSearchedResultsWithOption ::
HastodonClient -> StatusSearchOption -> String -> IO (Either JSONException [Results])
getSearchedResultsWithOption client opt query = do
res <- getHastodonResponseJSONWithOption (optionAsQuery opt) (pSearch ++ "?q=" ++ query) client
return (getResponseBody res :: Either JSONException [Results])
getStatus :: HastodonClient -> StatusId -> IO (Either JSONException Status)
getStatus client id = do
res <- getHastodonResponseJSON (replace ":id" (show id) pStatus) client
return (getResponseBody res :: Either JSONException Status)
getCard :: HastodonClient -> StatusId -> IO (Either JSONException Card)
getCard client id = do
res <- getHastodonResponseJSON (replace ":id" (show id) pCard) client
return (getResponseBody res :: Either JSONException Card)
getContext :: HastodonClient -> StatusId -> IO (Either JSONException Context)
getContext client id = do
res <- getHastodonResponseJSON (replace ":id" (show id) pContext) client
return (getResponseBody res :: Either JSONException Context)
getRebloggedByWithOption :: HastodonClient -> RangeOption -> StatusId -> IO (Either JSONException [Account])
getRebloggedByWithOption client opt id = do
res <- getHastodonResponseJSONWithOption (optionAsQuery opt) (replace ":id" (show id) pRebloggedBy) client
return (getResponseBody res :: Either JSONException [Account])
getRebloggedBy :: HastodonClient -> StatusId -> IO (Either JSONException [Account])
getRebloggedBy client = getRebloggedByWithOption client mempty
getFavoritedByWithOption :: HastodonClient -> RangeOption -> StatusId -> IO (Either JSONException [Account])
getFavoritedByWithOption client opt id = do
res <- getHastodonResponseJSONWithOption (optionAsQuery opt) (replace ":id" (show id) pFavoritedBy) client
return (getResponseBody res :: Either JSONException [Account])
getFavoritedBy :: HastodonClient -> StatusId -> IO (Either JSONException [Account])
getFavoritedBy client = getFavoritedByWithOption client mempty
postStatus :: HastodonClient -> String -> IO (Either JSONException Status)
postStatus client = postStatusWithOption client mempty
postStatusWithOption ::
HastodonClient -> PostStatusOption -> String -> IO (Either JSONException Status)
postStatusWithOption client opt status = do
let prms = [(Char8.pack "status", utf8ToChar8 status)] ++ optionAsForm opt
res <- postAndGetHastodonResponseJSON pStatuses prms client
return (getResponseBody res :: Either JSONException Status)
postStatusWithMediaIds :: HastodonClient -> String -> [MediaId] -> IO (Either JSONException Status)
postStatusWithMediaIds client status mediaIds = do
let unpackedMediaIds = [(Char8.pack "media_ids[]", (utf8ToChar8 . unMediaId) media) | media <- mediaIds]
let body = (Char8.pack "status",utf8ToChar8 status):unpackedMediaIds
res <- postAndGetHastodonResponseJSON pStatuses body client
return (getResponseBody res :: Either JSONException Status)
postReblog :: HastodonClient -> StatusId -> IO (Either JSONException Status)
postReblog client id = do
res <- postAndGetHastodonResponseJSON (replace ":id" (show id) pReblog) [] client
return (getResponseBody res :: Either JSONException Status)
postUnreblog :: HastodonClient -> StatusId -> IO (Either JSONException Status)
postUnreblog client id = do
res <- postAndGetHastodonResponseJSON (replace ":id" (show id) pUnreblog) [] client
return (getResponseBody res :: Either JSONException Status)
postFavorite :: HastodonClient -> StatusId -> IO (Either JSONException Status)
postFavorite client id = do
res <- postAndGetHastodonResponseJSON (replace ":id" (show id) pFavorite) [] client
return (getResponseBody res :: Either JSONException Status)
postUnfavorite :: HastodonClient -> StatusId -> IO (Either JSONException Status)
postUnfavorite client id = do
res <- postAndGetHastodonResponseJSON (replace ":id" (show id) pUnfavorite) [] client
return (getResponseBody res :: Either JSONException Status)
getHomeTimeline :: HastodonClient -> IO (Either JSONException [Status])
getHomeTimeline client = getHomeTimelineWithOption client mempty
getHomeTimelineWithOption :: HastodonClient -> TimelineOption -> IO (Either JSONException [Status])
getHomeTimelineWithOption client opt = do
res <- getHastodonResponseJSONWithOption (optionAsQuery opt) pHomeTimeline client
return (getResponseBody res :: Either JSONException [Status])
getPublicTimeline :: HastodonClient -> IO (Either JSONException [Status])
getPublicTimeline client = getPublicTimelineWithOption client mempty
getPublicTimelineWithOption :: HastodonClient -> TimelineOption -> IO (Either JSONException [Status])
getPublicTimelineWithOption client opt = do
res <- getHastodonResponseJSONWithOption (optionAsQuery opt) pPublicTimeline client
return (getResponseBody res :: Either JSONException [Status])
getTaggedTimeline :: HastodonClient -> String -> IO (Either JSONException [Status])
getTaggedTimeline client hashtag = do
res <- getHastodonResponseJSON (replace ":hashtag" hashtag pTaggedTimeline) client
return (getResponseBody res :: Either JSONException [Status])
getTaggedTimelineWithOption ::
HastodonClient -> TimelineOption -> String -> IO (Either JSONException [Status])
getTaggedTimelineWithOption client opt hashtag = do
res <- getHastodonResponseJSONWithOption
(optionAsQuery opt)
(replace ":hashtag" hashtag pTaggedTimeline)
client
return (getResponseBody res :: Either JSONException [Status])