twitter-conduit-0.3.0/.travis/0000755000000000000000000000000013312637147014442 5ustar0000000000000000twitter-conduit-0.3.0/Web/0000755000000000000000000000000013312637147013571 5ustar0000000000000000twitter-conduit-0.3.0/Web/Twitter/0000755000000000000000000000000013312637147015233 5ustar0000000000000000twitter-conduit-0.3.0/Web/Twitter/Conduit/0000755000000000000000000000000013312637147016640 5ustar0000000000000000twitter-conduit-0.3.0/Web/Twitter/Conduit/Parameters/0000755000000000000000000000000013312637147020743 5ustar0000000000000000twitter-conduit-0.3.0/sample/0000755000000000000000000000000013312640427014330 5ustar0000000000000000twitter-conduit-0.3.0/sample/common/0000755000000000000000000000000013312637147015625 5ustar0000000000000000twitter-conduit-0.3.0/tests/0000755000000000000000000000000013312637147014216 5ustar0000000000000000twitter-conduit-0.3.0/Web/Twitter/Conduit.hs0000644000000000000000000002742413312637147017205 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} -- | -- Module: Web.Twitter.Conduit -- Copyright: (c) 2014 Takahiro Himura -- License: BSD -- Maintainer: Takahiro Himura -- Stability: experimental -- Portability: portable -- -- A client library for Twitter APIs (see ). module Web.Twitter.Conduit ( -- * How to use this library -- $howto -- * Re-exports module Web.Twitter.Conduit.Api , module Web.Twitter.Conduit.Cursor , module Web.Twitter.Conduit.Request , module Web.Twitter.Conduit.Response , module Web.Twitter.Conduit.Status , module Web.Twitter.Conduit.Stream , module Web.Twitter.Conduit.Types -- * 'Web.Twitter.Conduit.Base' , call , call' , callWithResponse , callWithResponse' , sourceWithMaxId , sourceWithMaxId' , sourceWithCursor , sourceWithCursor' , sourceWithSearchResult , sourceWithSearchResult' -- * 'Web.Twitter.Conduit.Parameters' , Parameters.ListParam(..) , Parameters.MediaData(..) , Parameters.UserListParam(..) , Parameters.UserParam(..) -- * re-exports , OAuth (..) , Credential (..) , def , Manager , newManager , tlsManagerSettings -- * deprecated , contributorDetails , count , cursor , displayCoordinates , excludeReplies , filterLevel , follow , inReplyToStatusId , includeEntities , includeMyRetweet , includeRts , includeUserEntities , lang , language , locale , map , maxId , mediaIds , page , possiblySensitive , replies , sinceId , skipStatus , stallWarnings , trimUser , until ) where import Web.Twitter.Conduit.Api import Web.Twitter.Conduit.Base import Web.Twitter.Conduit.Cursor import qualified Web.Twitter.Conduit.Parameters as Parameters import Web.Twitter.Conduit.Request import Web.Twitter.Conduit.Response import Web.Twitter.Conduit.Status import Web.Twitter.Conduit.Stream import Web.Twitter.Conduit.Types import Web.Twitter.Types import Data.Default (def) import Data.Time.Calendar (Day) import Network.HTTP.Conduit (Manager, newManager, tlsManagerSettings) import Web.Authenticate.OAuth import Prelude hiding (map, until) -- for haddock import Data.Conduit import qualified Data.Conduit.List as CL import qualified Data.Text as T import qualified Data.Text.IO as T import Control.Monad.IO.Class import Control.Lens #ifdef HLINT {-# ANN module "HLint: ignore Use import/export shortcut" #-} #endif -- $howto -- -- The main module of twitter-conduit is "Web.Twitter.Conduit". -- This library cooperate with , -- , -- and . -- All of following examples import modules as below: -- -- > {-# LANGUAGE OverloadedStrings #-} -- > -- > import Web.Twitter.Conduit -- > import Web.Twitter.Types.Lens -- > import Data.Conduit -- > import qualified Data.Conduit.List as CL -- > import qualified Data.Text as T -- > import qualified Data.Text.IO as T -- > import Control.Monad.IO.Class -- > import Control.Lens -- -- First, you should obtain consumer token and secret from , -- and prepare 'OAuth' variables as follows: -- -- @ -- tokens :: 'OAuth' -- tokens = 'twitterOAuth' -- { 'oauthConsumerKey' = \"YOUR CONSUMER KEY\" -- , 'oauthConsumerSecret' = \"YOUR CONSUMER SECRET\" -- } -- @ -- -- Second, you should obtain access token and secret. -- You can find examples obtaining those tokens in -- , -- for instance, -- , and -- . -- If you need more information, see . -- -- You should set an access token to 'Credential' variable: -- -- @ -- credential :: 'Credential' -- credential = 'Credential' -- [ (\"oauth_token\", \"YOUR ACCESS TOKEN\") -- , (\"oauth_token_secret\", \"YOUR ACCESS TOKEN SECRET\") -- ] -- @ -- -- You should also set up the 'TWToken' and 'TWInfo' variables as below: -- -- @ -- twInfo :: 'TWInfo' -- twInfo = 'def' -- { 'twToken' = 'def' { 'twOAuth' = tokens, 'twCredential' = credential } -- , 'twProxy' = Nothing -- } -- @ -- -- Or, simply as follows: -- -- > twInfo = setCredential tokens credential def -- -- Twitter API requests are performed by 'call' function. -- For example, -- could be obtained by: -- -- @ -- mgr \<- 'newManager' 'tlsManagerSettings' -- timeline \<- 'call' twInfo mgr 'homeTimeline' -- @ -- -- The response of 'call' function is wrapped by the suitable type of -- . -- In this case, /timeline/ has a type of ['Status']. -- If you need /raw/ JSON Value which is parsed by , -- use 'call'' to obtain it. -- -- By default, the response of -- includes 20 tweets, and you can change the number of tweets by the /count/ parameter. -- -- @ -- timeline \<- 'call' twInfo mgr '$' 'homeTimeline' '&' 'count' '?~' 200 -- @ -- -- If you need more statuses, you can obtain those with multiple API requests. -- This library provides the wrapper for multiple requests with conduit interfaces. -- For example, if you intend to fetch the all friends information, -- you may perform multiple API requests with changing cursor parameter, -- or use the conduit wrapper 'sourceWithCursor' as below: -- -- @ -- friends \<- 'sourceWithCursor' twInfo mgr ('friendsList' ('ScreenNameParam' \"thimura\") '&' 'count' '?~' 200) '$$' 'CL.consume' -- @ -- -- Statuses APIs, for instance, 'homeTimeline', are also wrapped by 'sourceWithMaxId'. -- -- For example, you can print 1000 tweets from your home timeline, as below: -- -- @ -- main :: IO () -- main = do -- mgr \<- 'newManager' 'tlsManagerSettings' -- 'sourceWithMaxId' twInfo mgr 'homeTimeline' -- $= CL.isolate 60 -- $$ CL.mapM_ $ \\status -> liftIO $ do -- T.putStrLn $ T.concat [ T.pack . show $ status ^. statusId -- , \": \" -- , status ^. statusUser . userScreenName -- , \": \" -- , status ^. statusText -- ] -- @ contributorDetails :: Parameters.HasContributorDetailsParam a => Lens' a (Maybe Bool) contributorDetails = Parameters.contributorDetails {-# DEPRECATED contributorDetails "Please use Web.Twitter.Conduit.Parameters.contributorDetails" #-} count :: Parameters.HasCountParam a => Lens' a (Maybe Integer) count = Parameters.count {-# DEPRECATED count "Please use Web.Twitter.Conduit.Parameters.count" #-} cursor :: Parameters.HasCursorParam a => Lens' a (Maybe Integer) cursor = Parameters.cursor {-# DEPRECATED cursor "Please use Web.Twitter.Conduit.Parameters.cursor" #-} displayCoordinates :: Parameters.HasDisplayCoordinatesParam a => Lens' a (Maybe Bool) displayCoordinates = Parameters.displayCoordinates {-# DEPRECATED displayCoordinates "Please use Web.Twitter.Conduit.Parameters.displayCoordinates" #-} excludeReplies :: Parameters.HasExcludeRepliesParam a => Lens' a (Maybe Bool) excludeReplies = Parameters.excludeReplies {-# DEPRECATED excludeReplies "Please use Web.Twitter.Conduit.Parameters.excludeReplies" #-} filterLevel :: Parameters.HasFilterLevelParam a => Lens' a (Maybe T.Text) filterLevel = Parameters.filterLevel {-# DEPRECATED filterLevel "Please use Web.Twitter.Conduit.Parameters.filterLevel" #-} follow :: Parameters.HasFollowParam a => Lens' a (Maybe Bool) follow = Parameters.follow {-# DEPRECATED follow "Please use Web.Twitter.Conduit.Parameters.follow" #-} inReplyToStatusId :: Parameters.HasInReplyToStatusIdParam a => Lens' a (Maybe Integer) inReplyToStatusId = Parameters.inReplyToStatusId {-# DEPRECATED inReplyToStatusId "Please use Web.Twitter.Conduit.Parameters.inReplyToStatusId" #-} includeEntities :: Parameters.HasIncludeEntitiesParam a => Lens' a (Maybe Bool) includeEntities = Parameters.includeEntities {-# DEPRECATED includeEntities "Please use Web.Twitter.Conduit.Parameters.includeEntities" #-} includeMyRetweet :: Parameters.HasIncludeMyRetweetParam a => Lens' a (Maybe Bool) includeMyRetweet = Parameters.includeMyRetweet {-# DEPRECATED includeMyRetweet "Please use Web.Twitter.Conduit.Parameters.includeMyRetweet" #-} includeRts :: Parameters.HasIncludeRtsParam a => Lens' a (Maybe Bool) includeRts = Parameters.includeRts {-# DEPRECATED includeRts "Please use Web.Twitter.Conduit.Parameters.includeRts" #-} includeUserEntities :: Parameters.HasIncludeUserEntitiesParam a => Lens' a (Maybe Bool) includeUserEntities = Parameters.includeUserEntities {-# DEPRECATED includeUserEntities "Please use Web.Twitter.Conduit.Parameters.includeUserEntities" #-} lang :: Parameters.HasLangParam a => Lens' a (Maybe T.Text) lang = Parameters.lang {-# DEPRECATED lang "Please use Web.Twitter.Conduit.Parameters.lang" #-} language :: Parameters.HasLanguageParam a => Lens' a (Maybe T.Text) language = Parameters.language {-# DEPRECATED language "Please use Web.Twitter.Conduit.Parameters.language" #-} locale :: Parameters.HasLocaleParam a => Lens' a (Maybe T.Text) locale = Parameters.locale {-# DEPRECATED locale "Please use Web.Twitter.Conduit.Parameters.locale" #-} map :: Parameters.HasMapParam a => Lens' a (Maybe Bool) map = Parameters.map {-# DEPRECATED map "Please use Web.Twitter.Conduit.Parameters.map" #-} maxId :: Parameters.HasMaxIdParam a => Lens' a (Maybe Integer) maxId = Parameters.maxId {-# DEPRECATED maxId "Please use Web.Twitter.Conduit.Parameters.maxId" #-} mediaIds :: Parameters.HasMediaIdsParam a => Lens' a (Maybe [Integer]) mediaIds = Parameters.mediaIds {-# DEPRECATED mediaIds "Please use Web.Twitter.Conduit.Parameters.mediaIds" #-} page :: Parameters.HasPageParam a => Lens' a (Maybe Integer) page = Parameters.page {-# DEPRECATED page "Please use Web.Twitter.Conduit.Parameters.page" #-} possiblySensitive :: Parameters.HasPossiblySensitiveParam a => Lens' a (Maybe Bool) possiblySensitive = Parameters.possiblySensitive {-# DEPRECATED possiblySensitive "Please use Web.Twitter.Conduit.Parameters.possiblySensitive" #-} replies :: Parameters.HasRepliesParam a => Lens' a (Maybe T.Text) replies = Parameters.replies {-# DEPRECATED replies "Please use Web.Twitter.Conduit.Parameters.replies" #-} sinceId :: Parameters.HasSinceIdParam a => Lens' a (Maybe Integer) sinceId = Parameters.sinceId {-# DEPRECATED sinceId "Please use Web.Twitter.Conduit.Parameters.sinceId" #-} skipStatus :: Parameters.HasSkipStatusParam a => Lens' a (Maybe Bool) skipStatus = Parameters.skipStatus {-# DEPRECATED skipStatus "Please use Web.Twitter.Conduit.Parameters.skipStatus" #-} stallWarnings :: Parameters.HasStallWarningsParam a => Lens' a (Maybe Bool) stallWarnings = Parameters.stallWarnings {-# DEPRECATED stallWarnings "Please use Web.Twitter.Conduit.Parameters.stallWarnings" #-} trimUser :: Parameters.HasTrimUserParam a => Lens' a (Maybe Bool) trimUser = Parameters.trimUser {-# DEPRECATED trimUser "Please use Web.Twitter.Conduit.Parameters.trimUser" #-} until :: Parameters.HasUntilParam a => Lens' a (Maybe Day) until = Parameters.until {-# DEPRECATED until "Please use Web.Twitter.Conduit.Parameters.until" #-} twitter-conduit-0.3.0/Web/Twitter/Conduit/Lens.hs0000644000000000000000000000442513312637147020102 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE RankNTypes #-} module Web.Twitter.Conduit.Lens ( -- * 'TT.Response' TT.Response , responseStatus , responseBody , responseHeaders -- * 'TT.TwitterErrorMessage' , TT.TwitterErrorMessage , twitterErrorMessage , twitterErrorCode -- * 'TT.WithCursor' , TT.WithCursor , previousCursor , nextCursor , contents -- * Re-exports , TT.TwitterError(..) , TT.CursorKey (..) , TT.IdsCursorKey , TT.UsersCursorKey , TT.ListsCursorKey ) where #if __GLASGOW_HASKELL__ < 710 import Control.Applicative #endif import Control.Lens import Data.Text (Text) import Network.HTTP.Types (Status, ResponseHeaders) import qualified Web.Twitter.Conduit.Cursor as TT import qualified Web.Twitter.Conduit.Response as TT -- * Lenses for 'TT.Response' responseStatus :: forall responseType. Lens' (TT.Response responseType) Status responseStatus afb s = (\b -> s { TT.responseStatus = b }) <$> afb (TT.responseStatus s) responseHeaders :: forall responseType. Lens' (TT.Response responseType) ResponseHeaders responseHeaders afb s = (\b -> s {TT.responseHeaders = b }) <$> afb (TT.responseHeaders s) responseBody :: forall a b. Lens (TT.Response a) (TT.Response b) a b responseBody afb s = (\b -> s { TT.responseBody = b }) <$> afb (TT.responseBody s) -- * Lenses for 'TT.TwitterErrorMessage' twitterErrorCode :: Lens' TT.TwitterErrorMessage Int twitterErrorCode afb s = (\b -> s { TT.twitterErrorCode = b }) <$> afb (TT.twitterErrorCode s) twitterErrorMessage :: Lens' TT.TwitterErrorMessage Text twitterErrorMessage afb s = (\b -> s { TT.twitterErrorMessage = b }) <$> afb (TT.twitterErrorMessage s) -- * Lenses for 'TT.WithCursor' previousCursor :: forall cursorKey wrapped. Lens' (TT.WithCursor cursorKey wrapped) Integer previousCursor afb s = (\b -> s { TT.previousCursor = b }) <$> afb (TT.previousCursor s) nextCursor :: forall cursorKey wrapped. Lens' (TT.WithCursor cursorKey wrapped) Integer nextCursor afb s = (\b -> s { TT.nextCursor = b }) <$> afb (TT.nextCursor s) contents :: forall cursorKey a b. Lens (TT.WithCursor cursorKey a) (TT.WithCursor cursorKey b) [a] [b] contents afb s = (\b -> s { TT.contents = b }) <$> afb (TT.contents s) twitter-conduit-0.3.0/Web/Twitter/Conduit/Types.hs0000644000000000000000000000357113312637147020306 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} module Web.Twitter.Conduit.Types ( TWToken (..) , TWInfo (..) , twitterOAuth , setCredential ) where import Data.Default import Data.Typeable (Typeable) import Web.Authenticate.OAuth import Network.HTTP.Conduit data TWToken = TWToken { twOAuth :: OAuth , twCredential :: Credential } deriving (Show, Read, Eq, Typeable) instance Default TWToken where def = TWToken twitterOAuth (Credential []) data TWInfo = TWInfo { twToken :: TWToken , twProxy :: Maybe Proxy } deriving (Show, Read, Eq, Typeable) instance Default TWInfo where def = TWInfo { twToken = def , twProxy = Nothing } twitterOAuth :: OAuth twitterOAuth = def { oauthServerName = "twitter" , oauthRequestUri = "https://api.twitter.com/oauth/request_token" , oauthAccessTokenUri = "https://api.twitter.com/oauth/access_token" , oauthAuthorizeUri = "https://api.twitter.com/oauth/authorize" , oauthConsumerKey = error "You MUST specify oauthConsumerKey parameter." , oauthConsumerSecret = error "You MUST specify oauthConsumerSecret parameter." , oauthSignatureMethod = HMACSHA1 , oauthCallback = Nothing } -- | set OAuth keys and Credentials to TWInfo. -- -- >>> let proxy = Proxy "localhost" 8080 -- >>> let twinfo = def { twProxy = Just proxy } -- >>> let oauth = twitterOAuth { oauthConsumerKey = "consumer_key", oauthConsumerSecret = "consumer_secret" } -- >>> let credential = Credential [("oauth_token","...")] -- >>> let twinfo2 = setCredential oauth credential twinfo -- >>> oauthConsumerKey . twOAuth . twToken $ twinfo2 -- "consumer_key" -- >>> twProxy twinfo2 == Just proxy -- True setCredential :: OAuth -> Credential -> TWInfo -> TWInfo setCredential oa cred env = TWInfo { twToken = TWToken oa cred , twProxy = twProxy env } twitter-conduit-0.3.0/Web/Twitter/Conduit/Api.hs0000644000000000000000000010550313312637147017711 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE CPP #-} module Web.Twitter.Conduit.Api ( -- * Search SearchTweets , searchTweets , search -- * Direct Messages , DirectMessages , directMessages , DirectMessagesSent , directMessagesSent , DirectMessagesShow , directMessagesShow , DirectMessagesDestroy , directMessagesDestroy , DirectMessagesNew , directMessagesNew -- * Friends & Followers , FriendshipsNoRetweetsIds , friendshipsNoRetweetsIds , FriendsIds , friendsIds , FollowersIds , followersIds , FriendshipsIncoming , friendshipsIncoming , FriendshipsOutgoing , friendshipsOutgoing , FriendshipsCreate , friendshipsCreate , FriendshipsDestroy , friendshipsDestroy -- , friendshipsUpdate -- , friendshipsShow , FriendsList , friendsList , FollowersList , followersList -- , friendshipsLookup -- * Users -- , accountSettings , AccountVerifyCredentials , accountVerifyCredentials -- , accountSettingsUpdate -- , accountUpdateDeliveryDevice , AccountUpdateProfile , accountUpdateProfile -- , accountUpdateProfileBackgroundImage -- , accountUpdateProfileColors -- , accoutUpdateProfileImage -- , blocksList -- , blocksIds -- , blocksCreate -- , blocksDestroy , UsersLookup , usersLookup , UsersShow , usersShow -- , usersSearch -- , usersContributees -- , usersContributors -- , accuntRemoveProfileBanner -- , accuntUpdateProfileBanner -- , usersProfileBanner -- , mutesUsersCreate -- , mutesUsersDestroy -- , mutesUsersIds -- , mutesUsersList -- * Suggested Users -- , usersSuggestionsSlug -- , usersSuggestions -- , usersSuggestionsSlugMembers -- * Favorites , FavoritesList , favoritesList , FavoritesDestroy , favoritesDestroy , FavoritesCreate , favoritesCreate -- * Lists -- , listsList , ListsStatuses , listsStatuses , ListsMembersDestroy , listsMembersDestroy , ListsMemberships , listsMemberships , ListsSubscribers , listsSubscribers -- , listsSubscribersCreate -- , listsSubscribersShow -- , listsSubscribersDestroy , ListsMembersCreateAll , listsMembersCreateAll -- , listsMembersShow , ListsMembers , listsMembers , ListsMembersCreate , listsMembersCreate , ListsDestroy , listsDestroy , ListsUpdate , listsUpdate , ListsCreate , listsCreate , ListsShow , listsShow , ListsSubscriptions , listsSubscriptions , ListsMembersDestroyAll , listsMembersDestroyAll , ListsOwnerships , listsOwnerships -- * Saved Searches -- savedSearchesList -- savedSearchesShowId -- savedSearchesCreate -- savedSearchesDestroyId -- * Places & Geo -- geoIdPlaceId -- geoReverseGeocode -- geoSearch -- geoSimilarPlaces -- geoPlace -- * media , MediaUpload , mediaUpload ) where import Web.Twitter.Types import Web.Twitter.Conduit.Parameters hiding (description, name) import Web.Twitter.Conduit.Parameters.TH import Web.Twitter.Conduit.Base import Web.Twitter.Conduit.Request import Web.Twitter.Conduit.Cursor import Network.HTTP.Client.MultipartFormData import qualified Data.Text as T import Data.Default -- $setup -- >>> :set -XOverloadedStrings -- >>> import Control.Lens data SearchTweets -- | Returns search query. -- -- You can perform a search query using 'call': -- -- @ -- res <- 'call' ('searchTweets' \"search text\") -- 'print' $ res ^. 'searchResultStatuses' -- @ -- -- >>> searchTweets "search text" -- APIRequestGet "https://api.twitter.com/1.1/search/tweets.json" [("q","search text")] -- >>> searchTweets "search text" & lang ?~ "ja" & count ?~ 100 -- APIRequestGet "https://api.twitter.com/1.1/search/tweets.json" [("count","100"),("lang","ja"),("q","search text")] searchTweets :: T.Text -- ^ search string -> APIRequest SearchTweets (SearchResult [Status]) searchTweets q = APIRequestGet (endpoint ++ "search/tweets.json") [("q", PVString q)] deriveHasParamInstances ''SearchTweets [ "lang" , "locale" -- , "result_type" , "count" , "until" , "since_id" , "max_id" , "include_entities" -- , "callback" (needless) ] -- | Alias of 'searchTweets', for backward compatibility search :: T.Text -- ^ search string -> APIRequest SearchTweets (SearchResult [Status]) search = searchTweets data DirectMessages -- | Returns query data which asks recent direct messages sent to the authenticating user. -- -- You can perform a query using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'directMessages' '&' 'count' '?~' 100 -- @ -- -- >>> directMessages -- APIRequestGet "https://api.twitter.com/1.1/direct_messages.json" [] -- >>> directMessages & count ?~ 100 -- APIRequestGet "https://api.twitter.com/1.1/direct_messages.json" [("count","100")] directMessages :: APIRequest DirectMessages [DirectMessage] directMessages = APIRequestGet (endpoint ++ "direct_messages.json") def deriveHasParamInstances ''DirectMessages [ "since_id" , "max_id" , "count" , "include_entities" , "skip_status" , "full_text" ] data DirectMessagesSent -- | Returns query data which asks recent direct messages sent by the authenticating user. -- -- You can perform a query using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'directMessagesSent' '&' 'count' '?~' 100 -- @ -- -- >>> directMessagesSent -- APIRequestGet "https://api.twitter.com/1.1/direct_messages/sent.json" [] -- >>> directMessagesSent & count ?~ 100 -- APIRequestGet "https://api.twitter.com/1.1/direct_messages/sent.json" [("count","100")] directMessagesSent :: APIRequest DirectMessagesSent [DirectMessage] directMessagesSent = APIRequestGet (endpoint ++ "direct_messages/sent.json") def deriveHasParamInstances ''DirectMessagesSent [ "since_id" , "max_id" , "count" , "include_entities" , "page" , "skip_status" , "full_text" ] data DirectMessagesShow -- | Returns query data which asks a single direct message, specified by an id parameter. -- -- You can perform a query using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'directMessagesShow' 1234567890 -- @ -- -- >>> directMessagesShow 1234567890 -- APIRequestGet "https://api.twitter.com/1.1/direct_messages/show.json" [("id","1234567890")] directMessagesShow :: StatusId -> APIRequest DirectMessagesShow DirectMessage directMessagesShow sId = APIRequestGet (endpoint ++ "direct_messages/show.json") [("id", PVInteger sId)] deriveHasParamInstances ''DirectMessagesShow [ "full_text" ] data DirectMessagesDestroy -- | Returns post data which destroys the direct message specified in the required ID parameter. -- -- You can perform a query using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'directMessagesDestroy' 1234567890 -- @ -- -- >>> directMessagesDestroy 1234567890 -- APIRequestPost "https://api.twitter.com/1.1/direct_messages/destroy.json" [("id","1234567890")] directMessagesDestroy :: StatusId -> APIRequest DirectMessagesDestroy DirectMessage directMessagesDestroy sId = APIRequestPost (endpoint ++ "direct_messages/destroy.json") [("id", PVInteger sId)] deriveHasParamInstances ''DirectMessagesDestroy [ "include_entities" ] data DirectMessagesNew -- | Returns post data which sends a new direct message to the specified user from the authenticating user. -- -- You can perform a post using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'directMessagesNew' (ScreenNameParam \"thimura\") \"Hello DM\" -- @ -- -- >>> directMessagesNew (ScreenNameParam "thimura") "Hello DM" -- APIRequestPost "https://api.twitter.com/1.1/direct_messages/new.json" [("text","Hello DM"),("screen_name","thimura")] -- >>> directMessagesNew (UserIdParam 69179963) "Hello thimura! by UserId" -- APIRequestPost "https://api.twitter.com/1.1/direct_messages/new.json" [("text","Hello thimura! by UserId"),("user_id","69179963")] directMessagesNew :: UserParam -> T.Text -> APIRequest DirectMessagesNew DirectMessage directMessagesNew q msg = APIRequestPost (endpoint ++ "direct_messages/new.json") (("text", PVString msg):mkUserParam q) data FriendshipsNoRetweetsIds -- | Returns a collection of user_ids that the currently authenticated user does not want to receive retweets from. -- -- You can perform a request using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'friendshipsNoRetweetsIds' -- @ -- -- >>> friendshipsNoRetweetsIds -- APIRequestGet "https://api.twitter.com/1.1/friendships/no_retweets/ids.json" [] friendshipsNoRetweetsIds :: APIRequest FriendshipsNoRetweetsIds [UserId] friendshipsNoRetweetsIds = APIRequestGet (endpoint ++ "friendships/no_retweets/ids.json") [] data FriendsIds -- | Returns query data which asks a collection of user IDs for every user the specified user is following. -- -- You can perform a query using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'friendsIds' ('ScreenNameParam' \"thimura\") -- @ -- -- Or, you can iterate with 'sourceWithCursor': -- -- @ -- 'sourceWithCursor' ('friendsIds' ('ScreenNameParam' \"thimura\")) $$ CL.consume -- @ -- -- >>> friendsIds (ScreenNameParam "thimura") -- APIRequestGet "https://api.twitter.com/1.1/friends/ids.json" [("screen_name","thimura")] -- >>> friendsIds (ScreenNameParam "thimura") & count ?~ 5000 -- APIRequestGet "https://api.twitter.com/1.1/friends/ids.json" [("count","5000"),("screen_name","thimura")] friendsIds :: UserParam -> APIRequest FriendsIds (WithCursor IdsCursorKey UserId) friendsIds q = APIRequestGet (endpoint ++ "friends/ids.json") (mkUserParam q) deriveHasParamInstances ''FriendsIds [ "cursor" -- , "stringify_ids" -- (needless) , "count" ] data FollowersIds -- | Returns query data which asks a collection of user IDs for every user following the specified user. -- -- You can perform a query using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'followersIds' ('ScreenNameParam' \"thimura\") -- @ -- -- Or, you can iterate with 'sourceWithCursor': -- -- @ -- 'sourceWithCursor' ('followersIds' ('ScreenNameParam' \"thimura\")) $$ CL.consume -- @ -- -- >>> followersIds (ScreenNameParam "thimura") -- APIRequestGet "https://api.twitter.com/1.1/followers/ids.json" [("screen_name","thimura")] -- >>> followersIds (ScreenNameParam "thimura") & count ?~ 5000 -- APIRequestGet "https://api.twitter.com/1.1/followers/ids.json" [("count","5000"),("screen_name","thimura")] followersIds :: UserParam -> APIRequest FollowersIds (WithCursor IdsCursorKey UserId) followersIds q = APIRequestGet (endpoint ++ "followers/ids.json") (mkUserParam q) deriveHasParamInstances ''FollowersIds [ "cursor" -- , "stringify_ids" -- (needless) , "count" ] data FriendshipsIncoming -- | Returns a collection of numeric IDs for every user who has a pending request to follow the authenticating user. -- -- You can perform a request by using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'friendshipsIncoming' -- @ -- -- Or, you can iterate with 'sourceWithCursor': -- -- @ -- 'sourceWithCursor' 'friendshipsIncoming' $$ CL.consume -- @ -- -- >>> friendshipsIncoming -- APIRequestGet "https://api.twitter.com/1.1/friendships/incoming.json" [] friendshipsIncoming :: APIRequest FriendshipsIncoming (WithCursor IdsCursorKey UserId) friendshipsIncoming = APIRequestGet (endpoint ++ "friendships/incoming.json") def deriveHasParamInstances ''FriendshipsIncoming [ "cursor" -- , "stringify_ids" -- (needless) ] data FriendshipsOutgoing -- | Returns a collection of numeric IDs for every protected user for whom the authenticating user has a pending follow request. -- -- You can perform a request by using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'friendshipsOutgoing' -- @ -- -- Or, you can iterate with 'sourceWithCursor': -- -- @ -- 'sourceWithCursor' 'friendshipsOutgoing' $$ CL.consume -- @ -- -- >>> friendshipsOutgoing -- APIRequestGet "https://api.twitter.com/1.1/friendships/outgoing.json" [] friendshipsOutgoing :: APIRequest FriendshipsOutgoing (WithCursor IdsCursorKey UserId) friendshipsOutgoing = APIRequestGet (endpoint ++ "friendships/outgoing.json") def deriveHasParamInstances ''FriendshipsOutgoing [ "cursor" -- , "stringify_ids" -- (needless) ] data FriendshipsCreate -- | Returns post data which follows the user specified in the ID parameter. -- -- You can perform request by using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'friendshipsCreate' ('ScreenNameParam' \"thimura\") -- @ -- -- >>> friendshipsCreate (ScreenNameParam "thimura") -- APIRequestPost "https://api.twitter.com/1.1/friendships/create.json" [("screen_name","thimura")] -- >>> friendshipsCreate (UserIdParam 69179963) -- APIRequestPost "https://api.twitter.com/1.1/friendships/create.json" [("user_id","69179963")] friendshipsCreate :: UserParam -> APIRequest FriendshipsCreate User friendshipsCreate user = APIRequestPost (endpoint ++ "friendships/create.json") (mkUserParam user) deriveHasParamInstances ''FriendshipsCreate [ "follow" ] data FriendshipsDestroy -- | Returns post data which unfollows the user specified in the ID parameter. -- -- You can perform request by using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'friendshipsDestroy' ('ScreenNameParam' \"thimura\") -- @ -- -- >>> friendshipsDestroy (ScreenNameParam "thimura") -- APIRequestPost "https://api.twitter.com/1.1/friendships/destroy.json" [("screen_name","thimura")] -- >>> friendshipsDestroy (UserIdParam 69179963) -- APIRequestPost "https://api.twitter.com/1.1/friendships/destroy.json" [("user_id","69179963")] friendshipsDestroy :: UserParam -> APIRequest FriendshipsDestroy User friendshipsDestroy user = APIRequestPost (endpoint ++ "friendships/destroy.json") (mkUserParam user) data FriendsList -- | Returns query data which asks a cursored collection of user objects for every user the specified users is following. -- -- You can perform request by using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'friendsList' ('ScreenNameParam' \"thimura\") -- @ -- -- Or, you can iterate with 'sourceWithCursor': -- -- @ -- 'sourceWithCursor' ('friendsList' ('ScreenNameParam' \"thimura\")) $$ CL.consume -- @ -- -- >>> friendsList (ScreenNameParam "thimura") -- APIRequestGet "https://api.twitter.com/1.1/friends/list.json" [("screen_name","thimura")] -- >>> friendsList (UserIdParam 69179963) -- APIRequestGet "https://api.twitter.com/1.1/friends/list.json" [("user_id","69179963")] friendsList :: UserParam -> APIRequest FriendsList (WithCursor UsersCursorKey User) friendsList q = APIRequestGet (endpoint ++ "friends/list.json") (mkUserParam q) deriveHasParamInstances ''FriendsList [ "cursor" , "count" , "skip_status" , "include_user_entities" ] data FollowersList -- | Returns query data which asks a cursored collection of user objects for users following the specified user. -- -- You can perform request by using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'followersList' ('ScreenNameParam' \"thimura\") -- @ -- -- Or, you can iterate with 'sourceWithCursor': -- -- @ -- 'sourceWithCursor' ('followersList' ('ScreenNameParam' \"thimura\")) $$ CL.consume -- @ -- -- >>> followersList (ScreenNameParam "thimura") -- APIRequestGet "https://api.twitter.com/1.1/followers/list.json" [("screen_name","thimura")] -- >>> followersList (UserIdParam 69179963) -- APIRequestGet "https://api.twitter.com/1.1/followers/list.json" [("user_id","69179963")] followersList :: UserParam -> APIRequest FollowersList (WithCursor UsersCursorKey User) followersList q = APIRequestGet (endpoint ++ "followers/list.json") (mkUserParam q) deriveHasParamInstances ''FollowersList [ "cursor" , "count" , "skip_status" , "include_user_entities" ] data AccountVerifyCredentials -- | Returns query data asks that the credential is valid. -- -- You can perform request by using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'accountVerifyCredentials' -- @ -- -- >>> accountVerifyCredentials -- APIRequestGet "https://api.twitter.com/1.1/account/verify_credentials.json" [] accountVerifyCredentials :: APIRequest AccountVerifyCredentials User accountVerifyCredentials = APIRequestGet (endpoint ++ "account/verify_credentials.json") [] deriveHasParamInstances ''AccountVerifyCredentials [ "include_entities" , "skip_status" , "include_email" ] data AccountUpdateProfile -- | Returns user object with updated fields. -- Note that while no specific parameter is required, you need to provide at least one parameter before executing the query. -- -- You can perform request by using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'accountUpdateProfile' & 'Web.Twitter.Conduit.Parameters.url' ?~ \"http://www.example.com\" -- @ -- -- >>> accountUpdateProfile & url ?~ "http://www.example.com" -- APIRequestPost "https://api.twitter.com/1.1/account/update_profile.json" [("url","http://www.example.com")] accountUpdateProfile :: APIRequest AccountUpdateProfile User accountUpdateProfile = APIRequestPost (endpoint ++ "account/update_profile.json") [] deriveHasParamInstances ''AccountUpdateProfile [ "include_entities" , "skip_status" , "name" , "url" , "location" , "description" , "profile_link_color" ] data UsersLookup -- | Returns query data asks user objects. -- -- You can perform request by using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'usersLookup' ('ScreenNameListParam' [\"thimura\", \"twitterapi\"]) -- @ -- -- >>> usersLookup (ScreenNameListParam ["thimura", "twitterapi"]) -- APIRequestGet "https://api.twitter.com/1.1/users/lookup.json" [("screen_name","thimura,twitterapi")] usersLookup :: UserListParam -> APIRequest UsersLookup [User] usersLookup q = APIRequestGet (endpoint ++ "users/lookup.json") (mkUserListParam q) deriveHasParamInstances ''UsersLookup [ "include_entities" ] data UsersShow -- | Returns query data asks the user specified by user id or screen name parameter. -- -- You can perform request by using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'usersShow' ('ScreenNameParam' \"thimura\") -- @ -- -- >>> usersShow (ScreenNameParam "thimura") -- APIRequestGet "https://api.twitter.com/1.1/users/show.json" [("screen_name","thimura")] usersShow :: UserParam -> APIRequest UsersShow User usersShow q = APIRequestGet (endpoint ++ "users/show.json") (mkUserParam q) deriveHasParamInstances ''UsersShow [ "include_entities" ] data FavoritesList -- | Returns the 20 most recent Tweets favorited by the specified user. -- -- You can perform request by using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'favoritesList' (ScreenNameParam \"thimura\") -- @ -- -- >>> favoritesList Nothing -- APIRequestGet "https://api.twitter.com/1.1/favorites/list.json" [] -- >>> favoritesList (Just (ScreenNameParam "thimura")) -- APIRequestGet "https://api.twitter.com/1.1/favorites/list.json" [("screen_name","thimura")] -- >>> favoritesList (Just (UserIdParam 69179963)) -- APIRequestGet "https://api.twitter.com/1.1/favorites/list.json" [("user_id","69179963")] favoritesList :: Maybe UserParam -> APIRequest FavoritesList [Status] favoritesList mbuser = APIRequestGet (endpoint ++ "favorites/list.json") (mkParam mbuser) where mkParam Nothing = [] mkParam (Just usr) = mkUserParam usr deriveHasParamInstances ''FavoritesList [ "count" , "since_id" , "max_id" , "include_entities" ] data FavoritesCreate -- | Returns post data which favorites the status specified in the ID parameter as the authenticating user. -- -- You can perform request by using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'favoritesCreate' 1234567890 -- @ -- -- >>> favoritesCreate 1234567890 -- APIRequestPost "https://api.twitter.com/1.1/favorites/create.json" [("id","1234567890")] favoritesCreate :: StatusId -> APIRequest FavoritesCreate Status favoritesCreate sid = APIRequestPost (endpoint ++ "favorites/create.json") [("id", PVInteger sid)] deriveHasParamInstances ''FavoritesCreate [ "include_entities" ] data FavoritesDestroy -- | Returns post data unfavorites the status specified in the ID paramter as the authenticating user. -- -- You can perform request by using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'favoritesDestroy' 1234567890 -- @ -- -- >>> favoritesDestroy 1234567890 -- APIRequestPost "https://api.twitter.com/1.1/favorites/destroy.json" [("id","1234567890")] favoritesDestroy :: StatusId -> APIRequest FavoritesDestroy Status favoritesDestroy sid = APIRequestPost (endpoint ++ "favorites/destroy.json") [("id", PVInteger sid)] deriveHasParamInstances ''FavoritesDestroy [ "include_entities" ] data ListsStatuses -- | Returns the query parameter which fetches a timeline of tweets authored by members of the specified list. -- -- You can perform request by using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'listsStatuses' ('ListNameParam' "thimura/haskell") -- @ -- -- If you need more statuses, you can obtain those by using 'sourceWithMaxId': -- @ -- res <- sourceWithMaxId ('listsStatuses' ('ListNameParam' "thimura/haskell") & count ?~ 200) $$ CL.take 1000 -- @ -- -- >>> listsStatuses (ListNameParam "thimura/haskell") -- APIRequestGet "https://api.twitter.com/1.1/lists/statuses.json" [("slug","haskell"),("owner_screen_name","thimura")] -- >>> listsStatuses (ListIdParam 20849097) -- APIRequestGet "https://api.twitter.com/1.1/lists/statuses.json" [("list_id","20849097")] listsStatuses :: ListParam -> APIRequest ListsStatuses [Status] listsStatuses q = APIRequestGet (endpoint ++ "lists/statuses.json") (mkListParam q) deriveHasParamInstances ''ListsStatuses [ "since_id" , "max_id" , "count" , "include_entities" , "include_rts" ] data ListsMembersDestroy -- | Returns the post parameter which removes the specified member from the list. -- -- You can perform request by using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'listsMembersDestroy' ('ListNameParam' "thimura/haskell") ('ScreenNameParam' "thimura") -- @ -- -- >>> listsMembersDestroy (ListNameParam "thimura/haskell") (ScreenNameParam "thimura") -- APIRequestPost "https://api.twitter.com/1.1/lists/members/destroy.json" [("slug","haskell"),("owner_screen_name","thimura"),("screen_name","thimura")] -- >>> listsMembersDestroy (ListIdParam 20849097) (UserIdParam 69179963) -- APIRequestPost "https://api.twitter.com/1.1/lists/members/destroy.json" [("list_id","20849097"),("user_id","69179963")] listsMembersDestroy :: ListParam -> UserParam -> APIRequest ListsMembersDestroy List listsMembersDestroy list user = APIRequestPost (endpoint ++ "lists/members/destroy.json") (mkListParam list ++ mkUserParam user) data ListsMemberships -- | Returns the request parameters which asks the lists the specified user has been added to. -- If 'UserParam' are not provided, the memberships for the authenticating user are returned. -- -- You can perform request by using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'listsMemberships' ('ListNameParam' "thimura/haskell") -- @ -- -- >>> listsMemberships Nothing -- APIRequestGet "https://api.twitter.com/1.1/lists/memberships.json" [] -- >>> listsMemberships (Just (ScreenNameParam "thimura")) -- APIRequestGet "https://api.twitter.com/1.1/lists/memberships.json" [("screen_name","thimura")] -- >>> listsMemberships (Just (UserIdParam 69179963)) -- APIRequestGet "https://api.twitter.com/1.1/lists/memberships.json" [("user_id","69179963")] listsMemberships :: Maybe UserParam -> APIRequest ListsMemberships (WithCursor ListsCursorKey List) listsMemberships q = APIRequestGet (endpoint ++ "lists/memberships.json") $ maybe [] mkUserParam q deriveHasParamInstances ''ListsMemberships [ "cursor" , "count" ] data ListsSubscribers -- | Returns the request parameter which asks the subscribers of the specified list. -- -- You can perform request by using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'listsSubscribers' ('ListNameParam' "thimura/haskell") -- @ -- -- >>> listsSubscribers (ListNameParam "thimura/haskell") -- APIRequestGet "https://api.twitter.com/1.1/lists/subscribers.json" [("slug","haskell"),("owner_screen_name","thimura")] -- >>> listsSubscribers (ListIdParam 20849097) -- APIRequestGet "https://api.twitter.com/1.1/lists/subscribers.json" [("list_id","20849097")] listsSubscribers :: ListParam -> APIRequest ListsSubscribers (WithCursor UsersCursorKey User) listsSubscribers q = APIRequestGet (endpoint ++ "lists/subscribers.json") (mkListParam q) deriveHasParamInstances ''ListsSubscribers [ "cursor" , "count" , "skip_status" ] data ListsSubscriptions -- | Returns the request parameter which obtains a collection of the lists the specified user is subscribed to. -- -- You can perform request by using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'listsSubscriptions' ('ListNameParam' "thimura/haskell") -- @ -- -- >>> listsSubscriptions Nothing -- APIRequestGet "https://api.twitter.com/1.1/lists/subscriptions.json" [] -- >>> listsSubscriptions (Just (ScreenNameParam "thimura")) -- APIRequestGet "https://api.twitter.com/1.1/lists/subscriptions.json" [("screen_name","thimura")] -- >>> listsSubscriptions (Just (UserIdParam 69179963)) -- APIRequestGet "https://api.twitter.com/1.1/lists/subscriptions.json" [("user_id","69179963")] listsSubscriptions :: Maybe UserParam -> APIRequest ListsSubscriptions (WithCursor ListsCursorKey List) listsSubscriptions q = APIRequestGet (endpoint ++ "lists/subscriptions.json") $ maybe [] mkUserParam q deriveHasParamInstances ''ListsSubscriptions [ "cursor" , "count" ] data ListsOwnerships -- | Returns the request parameter which asks the lists owned by the specified Twitter user. -- -- You can perform request by using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'listsOwnerships' ('ListNameParam' "thimura/haskell") -- @ -- -- >>> listsOwnerships Nothing -- APIRequestGet "https://api.twitter.com/1.1/lists/ownerships.json" [] -- >>> listsOwnerships (Just (ScreenNameParam "thimura")) -- APIRequestGet "https://api.twitter.com/1.1/lists/ownerships.json" [("screen_name","thimura")] -- >>> listsOwnerships (Just (UserIdParam 69179963)) -- APIRequestGet "https://api.twitter.com/1.1/lists/ownerships.json" [("user_id","69179963")] listsOwnerships :: Maybe UserParam -> APIRequest ListsOwnerships (WithCursor ListsCursorKey List) listsOwnerships q = APIRequestGet (endpoint ++ "lists/ownerships.json") $ maybe [] mkUserParam q deriveHasParamInstances ''ListsOwnerships [ "cursor" , "count" ] data ListsMembersCreateAll -- | Adds multiple members to a list. -- -- You can perform request by using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'listsMembersCreateAll' ('ListNameParam' "thimura/haskell") ('ScreenNameListParam' [\"thimura\", \"twitterapi\"]) -- @ -- -- >>> listsMembersCreateAll (ListNameParam "thimura/haskell") (ScreenNameListParam ["thimura", "twitterapi"]) -- APIRequestPost "https://api.twitter.com/1.1/lists/members/create_all.json" [("slug","haskell"),("owner_screen_name","thimura"),("screen_name","thimura,twitterapi")] -- >>> listsMembersCreateAll (ListIdParam 20849097) (UserIdListParam [69179963, 6253282]) -- APIRequestPost "https://api.twitter.com/1.1/lists/members/create_all.json" [("list_id","20849097"),("user_id","69179963,6253282")] listsMembersCreateAll :: ListParam -> UserListParam -> APIRequest ListsMembersCreateAll List listsMembersCreateAll list users = APIRequestPost (endpoint ++ "lists/members/create_all.json") (mkListParam list ++ mkUserListParam users) data ListsMembersDestroyAll -- | Adds multiple members to a list. -- -- You can perform request by using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'listsMembersDestroyAll' ('ListNameParam' "thimura/haskell") ('ScreenNameListParam' [\"thimura\", \"twitterapi\"]) -- @ -- -- >>> listsMembersDestroyAll (ListNameParam "thimura/haskell") (ScreenNameListParam ["thimura", "twitterapi"]) -- APIRequestPost "https://api.twitter.com/1.1/lists/members/destroy_all.json" [("slug","haskell"),("owner_screen_name","thimura"),("screen_name","thimura,twitterapi")] -- >>> listsMembersDestroyAll (ListIdParam 20849097) (UserIdListParam [69179963, 6253282]) -- APIRequestPost "https://api.twitter.com/1.1/lists/members/destroy_all.json" [("list_id","20849097"),("user_id","69179963,6253282")] listsMembersDestroyAll :: ListParam -> UserListParam -> APIRequest ListsMembersDestroyAll List listsMembersDestroyAll list users = APIRequestPost (endpoint ++ "lists/members/destroy_all.json") (mkListParam list ++ mkUserListParam users) data ListsMembers -- | Returns query data asks the members of the specified list. -- -- You can perform request by using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'listsMembers' ('ListNameParam' "thimura/haskell") -- @ -- -- >>> listsMembers (ListNameParam "thimura/haskell") -- APIRequestGet "https://api.twitter.com/1.1/lists/members.json" [("slug","haskell"),("owner_screen_name","thimura")] -- >>> listsMembers (ListIdParam 20849097) -- APIRequestGet "https://api.twitter.com/1.1/lists/members.json" [("list_id","20849097")] listsMembers :: ListParam -> APIRequest ListsMembers (WithCursor UsersCursorKey User) listsMembers q = APIRequestGet (endpoint ++ "lists/members.json") (mkListParam q) deriveHasParamInstances ''ListsMembers [ "count" , "cursor" , "skip_status" ] data ListsMembersCreate -- | Returns the post parameter which adds a member to a list. -- -- You can perform request by using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'listsMembersCreate' ('ListNameParam' "thimura/haskell") ('ScreenNameParam' "thimura") -- @ -- -- >>> listsMembersCreate (ListNameParam "thimura/haskell") (ScreenNameParam "thimura") -- APIRequestPost "https://api.twitter.com/1.1/lists/members/create.json" [("slug","haskell"),("owner_screen_name","thimura"),("screen_name","thimura")] -- >>> listsMembersCreate (ListIdParam 20849097) (UserIdParam 69179963) -- APIRequestPost "https://api.twitter.com/1.1/lists/members/create.json" [("list_id","20849097"),("user_id","69179963")] listsMembersCreate :: ListParam -> UserParam -> APIRequest ListsMembersCreate List listsMembersCreate list user = APIRequestPost (endpoint ++ "lists/members/create.json") (mkListParam list ++ mkUserParam user) data ListsDestroy -- | Returns the post parameter which deletes the specified list. -- -- You can perform request by using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'listsDestroy' ('ListNameParam' "thimura/haskell") -- @ -- -- >>> listsDestroy (ListNameParam "thimura/haskell") -- APIRequestPost "https://api.twitter.com/1.1/lists/destroy.json" [("slug","haskell"),("owner_screen_name","thimura")] -- >>> listsDestroy (ListIdParam 20849097) -- APIRequestPost "https://api.twitter.com/1.1/lists/destroy.json" [("list_id","20849097")] listsDestroy :: ListParam -> APIRequest ListsDestroy List listsDestroy list = APIRequestPost (endpoint ++ "lists/destroy.json") (mkListParam list) data ListsUpdate -- | Returns the post parameter which updates the specified list. -- -- You can perform request by using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'listsUpdate' ('ListNameParam' "thimura/haskell") True (Just "Haskellers") -- @ -- -- >>> listsUpdate (ListNameParam "thimura/haskell") True (Just "Haskellers") -- APIRequestPost "https://api.twitter.com/1.1/lists/update.json" [("slug","haskell"),("owner_screen_name","thimura"),("description","Haskellers"),("mode","public")] listsUpdate :: ListParam -> Bool -- ^ is public -> Maybe T.Text -- ^ description -> APIRequest ListsUpdate List listsUpdate list isPublic description = APIRequestPost (endpoint ++ "lists/update.json") (mkListParam list ++ p') where p = [("mode", PVString . mode $ isPublic)] p' = maybe id (\d -> (("description", PVString d):)) description p mode True = "public" mode False = "private" data ListsCreate -- | Returns the post parameter which creates a new list for the authenticated user. -- -- You can perform request by using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'listsCreate' ('ListNameParam' "thimura/haskell") -- @ -- -- >>> listsCreate "haskell" True Nothing -- APIRequestPost "https://api.twitter.com/1.1/lists/create.json" [("name","haskell"),("mode","public")] -- >>> listsCreate "haskell" False Nothing -- APIRequestPost "https://api.twitter.com/1.1/lists/create.json" [("name","haskell"),("mode","private")] -- >>> listsCreate "haskell" True (Just "Haskellers") -- APIRequestPost "https://api.twitter.com/1.1/lists/create.json" [("description","Haskellers"),("name","haskell"),("mode","public")] listsCreate :: T.Text -- ^ list name -> Bool -- ^ whether public(True) or private(False) -> Maybe T.Text -- ^ the description to give the list -> APIRequest ListsCreate List listsCreate name isPublic description = APIRequestPost (endpoint ++ "lists/create.json") p' where p = [("name", PVString name), ("mode", PVString . mode $ isPublic)] p' = maybe id (\d -> (("description", PVString d):)) description p mode True = "public" mode False = "private" data ListsShow -- | Returns the request parameter which asks the specified list. -- -- You can perform request by using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'listsShow' ('ListNameParam' "thimura/haskell") -- @ -- -- >>> listsShow (ListNameParam "thimura/haskell") -- APIRequestGet "https://api.twitter.com/1.1/lists/show.json" [("slug","haskell"),("owner_screen_name","thimura")] -- >>> listsShow (ListIdParam 20849097) -- APIRequestGet "https://api.twitter.com/1.1/lists/show.json" [("list_id","20849097")] listsShow :: ListParam -> APIRequest ListsShow List listsShow q = APIRequestGet (endpoint ++ "lists/show.json") (mkListParam q) data MediaUpload -- | Upload media and returns the media data. -- -- You can update your status with multiple media by calling 'mediaUpload' and 'update' successively. -- -- First, you should upload media with 'mediaUpload': -- -- @ -- res1 <- 'call' twInfo mgr '$' 'mediaUpload' ('MediaFromFile' \"\/path\/to\/upload\/file1.png\") -- res2 <- 'call' twInfo mgr '$' 'mediaUpload' ('MediaRequestBody' \"file2.png\" \"[.. file body ..]\") -- @ -- -- and then collect the resulting media IDs and update your status by calling 'update': -- -- @ -- 'call' twInfo mgr '$' 'update' \"Hello World\" '&' 'mediaIds' '?~' ['mediaId' res1, 'mediaId' res2] -- @ -- -- See: -- -- >>> mediaUpload (MediaFromFile "/home/test/test.png") -- APIRequestPostMultipart "https://upload.twitter.com/1.1/media/upload.json" [] mediaUpload :: MediaData -> APIRequest MediaUpload UploadedMedia mediaUpload mediaData = APIRequestPostMultipart uri [] [mediaBody mediaData] where uri = "https://upload.twitter.com/1.1/media/upload.json" mediaBody (MediaFromFile fp) = partFileSource "media" fp mediaBody (MediaRequestBody filename filebody) = partFileRequestBody "media" filename filebody twitter-conduit-0.3.0/Web/Twitter/Conduit/Stream.hs0000644000000000000000000001156113312637147020433 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleInstances #-} module Web.Twitter.Conduit.Stream ( -- * StreamingAPI Userstream , userstream , StatusesFilter , FilterParameter (..) , statusesFilter , statusesFilterByFollow , statusesFilterByTrack -- , statusesFilterByLocation -- , statusesSample -- , statusesFirehose -- , sitestream -- , sitestream' , stream , stream' ) where import Web.Twitter.Conduit.Types import Web.Twitter.Conduit.Base import Web.Twitter.Types import Web.Twitter.Conduit.Parameters import Web.Twitter.Conduit.Parameters.TH import Web.Twitter.Conduit.Request import Web.Twitter.Conduit.Response import Control.Monad.Catch import Control.Monad.IO.Class import Control.Monad.Trans.Resource (MonadResource) import Data.Aeson import qualified Data.ByteString.Char8 as S8 import Data.Char import qualified Data.Conduit as C import qualified Data.Conduit.Internal as CI import qualified Data.Conduit.List as CL import qualified Data.List as L import qualified Data.Text as T import qualified Network.HTTP.Conduit as HTTP #if MIN_VERSION_conduit(1,3,0) #else #if MIN_VERSION_conduit(1,0,16) ($=+) :: MonadIO m => CI.ResumableSource m a -> CI.Conduit a m o -> m (CI.ResumableSource m o) ($=+) = (return .) . (C.$=+) #else rsrc $=+ cndt = do (src, finalizer) <- C.unwrapResumable rsrc return $ CI.ResumableSource (src C.$= cndt) finalizer #endif #endif stream :: ( MonadResource m , FromJSON responseType #if MIN_VERSION_conduit(1,3,0) , MonadThrow m #endif ) => TWInfo -> HTTP.Manager -> APIRequest apiName responseType #if MIN_VERSION_http_conduit(2,3,0) -> m (C.ConduitM () responseType m ()) #else -> m (C.ResumableSource m responseType) #endif stream = stream' stream' :: ( MonadResource m , FromJSON value #if MIN_VERSION_conduit(1,3,0) , MonadThrow m #endif ) => TWInfo -> HTTP.Manager -> APIRequest apiName responseType #if MIN_VERSION_http_conduit(2,3,0) -> m (C.ConduitM () value m ()) #else -> m (C.ResumableSource m value) #endif stream' info mgr req = do rsrc <- getResponse info mgr =<< liftIO (makeRequest req) #if MIN_VERSION_http_conduit(2,3,0) return $ responseBody rsrc C..| CL.sequence sinkFromJSONIgnoreSpaces #else responseBody rsrc $=+ CL.sequence sinkFromJSONIgnoreSpaces #endif where sinkFromJSONIgnoreSpaces = CL.filter (not . S8.all isSpace) C.=$ sinkFromJSON data Userstream userstream :: APIRequest Userstream StreamingAPI userstream = APIRequestGet "https://userstream.twitter.com/1.1/user.json" [] deriveHasParamInstances ''Userstream [ "language" , "filter_level" , "stall_warnings" , "replies" ] -- https://dev.twitter.com/streaming/overview/request-parameters data FilterParameter = Follow [UserId] | Track [T.Text] -- | Returns statuses/filter.json API query data. -- -- >>> statusesFilter [Follow [1,2,3]] -- APIRequestPost "https://stream.twitter.com/1.1/statuses/filter.json" [("follow","1,2,3")] -- >>> statusesFilter [Track ["haskell","functional"]] -- APIRequestPost "https://stream.twitter.com/1.1/statuses/filter.json" [("track","haskell,functional")] -- >>> statusesFilter [Follow [1,2,3],Track ["haskell","functional"]] -- APIRequestPost "https://stream.twitter.com/1.1/statuses/filter.json" [("follow","1,2,3"),("track","haskell,functional")] statusesFilter :: [FilterParameter] -> APIRequest StatusesFilter StreamingAPI statusesFilter = APIRequestPost statusesFilterEndpoint . L.map paramToQueryItem paramToQueryItem :: FilterParameter -> APIQueryItem paramToQueryItem (Follow userIds) = ("follow", PVIntegerArray userIds) paramToQueryItem (Track texts) = ("track", PVStringArray texts) statusesFilterEndpoint :: String statusesFilterEndpoint = "https://stream.twitter.com/1.1/statuses/filter.json" data StatusesFilter -- | Returns statuses/filter.json API query data. -- -- >>> statusesFilterByFollow [1,2,3] -- APIRequestPost "https://stream.twitter.com/1.1/statuses/filter.json" [("follow","1,2,3")] statusesFilterByFollow :: [UserId] -> APIRequest StatusesFilter StreamingAPI statusesFilterByFollow userIds = statusesFilter [Follow userIds] -- | Returns statuses/filter.json API query data. -- -- >>> statusesFilterByTrack "haskell" -- APIRequestPost "https://stream.twitter.com/1.1/statuses/filter.json" [("track","haskell")] statusesFilterByTrack :: T.Text -- ^ keyword -> APIRequest StatusesFilter StreamingAPI statusesFilterByTrack keyword = statusesFilter [Track [keyword]] deriveHasParamInstances ''StatusesFilter [ "language" , "filter_level" , "stall_warnings" ] twitter-conduit-0.3.0/Web/Twitter/Conduit/Status.hs0000644000000000000000000002417713312637147020472 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE EmptyDataDecls #-} module Web.Twitter.Conduit.Status ( -- * Timelines StatusesMentionsTimeline , mentionsTimeline , StatusesUserTimeline , userTimeline , StatusesHomeTimeline , homeTimeline , StatusesRetweetsOfMe , retweetsOfMe -- * Tweets , StatusesRetweetsId , retweetsId , StatusesShowId , showId , StatusesDestroyId , destroyId , StatusesUpdate , update , StatusesRetweetId , retweetId , MediaData (..) , StatusesUpdateWithMedia , updateWithMedia -- , oembed -- , retweetersIds , StatusesLookup , lookup ) where import Prelude hiding ( lookup ) import Web.Twitter.Conduit.Base import Web.Twitter.Conduit.Request import Web.Twitter.Conduit.Parameters import Web.Twitter.Conduit.Parameters.TH import Web.Twitter.Types import qualified Data.Text as T import Network.HTTP.Client.MultipartFormData import Data.Default -- $setup -- >>> :set -XOverloadedStrings -- >>> import Control.Lens -- * Timelines data StatusesMentionsTimeline -- | Returns query data asks the most recent mentions for the authenticating user. -- -- You can perform a query using 'call': -- -- @ -- res <- 'call' 'mentionsTimeline' -- @ -- -- >>> mentionsTimeline -- APIRequestGet "https://api.twitter.com/1.1/statuses/mentions_timeline.json" [] mentionsTimeline :: APIRequest StatusesMentionsTimeline [Status] mentionsTimeline = APIRequestGet (endpoint ++ "statuses/mentions_timeline.json") def deriveHasParamInstances ''StatusesMentionsTimeline [ "count" , "since_id" , "max_id" , "trim_user" , "contributor_details" , "include_entities" ] data StatusesUserTimeline -- | Returns query data asks a collection of the most recent Tweets posted by the user indicated by the screen_name or user_id parameters. -- -- You can perform a search query using 'call': -- -- @ -- res <- 'call' $ 'userTimeline' ('ScreenNameParam' \"thimura\") -- @ -- -- >>> userTimeline (ScreenNameParam "thimura") -- APIRequestGet "https://api.twitter.com/1.1/statuses/user_timeline.json" [("screen_name","thimura")] -- >>> userTimeline (ScreenNameParam "thimura") & includeRts ?~ True & count ?~ 200 -- APIRequestGet "https://api.twitter.com/1.1/statuses/user_timeline.json" [("count","200"),("include_rts","true"),("screen_name","thimura")] userTimeline :: UserParam -> APIRequest StatusesUserTimeline [Status] userTimeline q = APIRequestGet (endpoint ++ "statuses/user_timeline.json") (mkUserParam q) deriveHasParamInstances ''StatusesUserTimeline [ "count" , "since_id" , "max_id" , "trim_user" , "exclude_replies" , "contributor_details" , "include_rts" ] data StatusesHomeTimeline -- | Returns query data asks a collection of the most recentTweets and retweets posted by the authenticating user and the users they follow. -- -- You can perform a search query using 'call': -- -- @ -- res <- 'call' 'homeTimeline' -- @ -- -- >>> homeTimeline -- APIRequestGet "https://api.twitter.com/1.1/statuses/home_timeline.json" [] -- >>> homeTimeline & count ?~ 200 -- APIRequestGet "https://api.twitter.com/1.1/statuses/home_timeline.json" [("count","200")] homeTimeline :: APIRequest StatusesHomeTimeline [Status] homeTimeline = APIRequestGet (endpoint ++ "statuses/home_timeline.json") def deriveHasParamInstances ''StatusesHomeTimeline [ "count" , "since_id" , "max_id" , "trim_user" , "exclude_replies" , "contributor_details" , "include_entities" ] data StatusesRetweetsOfMe -- | Returns query data asks the most recent tweets authored by the authenticating user that have been retweeted by others. -- -- You can perform a search query using 'call': -- -- @ -- res <- 'call' 'retweetsOfMe' -- @ -- -- >>> retweetsOfMe -- APIRequestGet "https://api.twitter.com/1.1/statuses/retweets_of_me.json" [] -- >>> retweetsOfMe & count ?~ 100 -- APIRequestGet "https://api.twitter.com/1.1/statuses/retweets_of_me.json" [("count","100")] retweetsOfMe :: APIRequest StatusesRetweetsOfMe [Status] retweetsOfMe = APIRequestGet (endpoint ++ "statuses/retweets_of_me.json") def deriveHasParamInstances ''StatusesRetweetsOfMe [ "count" , "since_id" , "max_id" , "trim_user" , "include_entities" , "include_user_entities" ] -- * Tweets data StatusesRetweetsId -- | Returns query data that asks for the most recent retweets of the specified tweet -- -- You can perform a search query using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'retweetsId' 1234567890 -- @ -- -- >>> retweetsId 1234567890 -- APIRequestGet "https://api.twitter.com/1.1/statuses/retweets/1234567890.json" [] -- >>> retweetsId 1234567890 & count ?~ 100 -- APIRequestGet "https://api.twitter.com/1.1/statuses/retweets/1234567890.json" [("count","100")] retweetsId :: StatusId -> APIRequest StatusesRetweetsId [RetweetedStatus] retweetsId status_id = APIRequestGet uri def where uri = endpoint ++ "statuses/retweets/" ++ show status_id ++ ".json" deriveHasParamInstances ''StatusesRetweetsId [ "count" , "trim_user" ] data StatusesShowId -- | Returns query data asks a single Tweet, specified by the id parameter. -- -- You can perform a search query using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'showId' 1234567890 -- @ -- -- >>> showId 1234567890 -- APIRequestGet "https://api.twitter.com/1.1/statuses/show/1234567890.json" [] -- >>> showId 1234567890 & includeMyRetweet ?~ True -- APIRequestGet "https://api.twitter.com/1.1/statuses/show/1234567890.json" [("include_my_retweet","true")] showId :: StatusId -> APIRequest StatusesShowId Status showId status_id = APIRequestGet uri def where uri = endpoint ++ "statuses/show/" ++ show status_id ++ ".json" deriveHasParamInstances ''StatusesShowId [ "trim_user" , "include_my_retweet" , "include_entities" , "include_ext_alt_text" ] data StatusesDestroyId -- | Returns post data which destroys the status specified by the require ID parameter. -- -- You can perform a search query using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'destroyId' 1234567890 -- @ -- -- >>> destroyId 1234567890 -- APIRequestPost "https://api.twitter.com/1.1/statuses/destroy/1234567890.json" [] destroyId :: StatusId -> APIRequest StatusesDestroyId Status destroyId status_id = APIRequestPost uri def where uri = endpoint ++ "statuses/destroy/" ++ show status_id ++ ".json" deriveHasParamInstances ''StatusesDestroyId [ "trim_user" ] data StatusesUpdate -- | Returns post data which updates the authenticating user's current status. -- To upload an image to accompany the tweet, use 'updateWithMedia'. -- -- You can perform a search query using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'update' \"Hello World\" -- @ -- -- >>> update "Hello World" -- APIRequestPost "https://api.twitter.com/1.1/statuses/update.json" [("status","Hello World")] -- >>> update "Hello World" & inReplyToStatusId ?~ 1234567890 -- APIRequestPost "https://api.twitter.com/1.1/statuses/update.json" [("in_reply_to_status_id","1234567890"),("status","Hello World")] update :: T.Text -> APIRequest StatusesUpdate Status update status = APIRequestPost uri [("status", PVString status)] where uri = endpoint ++ "statuses/update.json" deriveHasParamInstances ''StatusesUpdate [ "in_reply_to_status_id" -- , "lat_long" -- , "place_id" , "display_coordinates" , "trim_user" , "media_ids" ] data StatusesRetweetId -- | Returns post data which retweets a tweet, specified by ID. -- -- You can perform a search query using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'retweetId' 1234567890 -- @ -- -- >>> retweetId 1234567890 -- APIRequestPost "https://api.twitter.com/1.1/statuses/retweet/1234567890.json" [] retweetId :: StatusId -> APIRequest StatusesRetweetId RetweetedStatus retweetId status_id = APIRequestPost uri def where uri = endpoint ++ "statuses/retweet/" ++ show status_id ++ ".json" deriveHasParamInstances ''StatusesRetweetId [ "trim_user" ] data StatusesUpdateWithMedia -- | Returns post data which updates the authenticating user's current status and attaches media for upload. -- -- You can perform a search query using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'updateWithMedia' \"Hello World\" ('MediaFromFile' \"/home/thimura/test.jpeg\") -- @ -- -- >>> updateWithMedia "Hello World" (MediaFromFile "/home/fuga/test.jpeg") -- APIRequestPostMultipart "https://api.twitter.com/1.1/statuses/update_with_media.json" [("status","Hello World")] updateWithMedia :: T.Text -> MediaData -> APIRequest StatusesUpdateWithMedia Status updateWithMedia tweet mediaData = APIRequestPostMultipart uri [("status", PVString tweet)] [mediaBody mediaData] where uri = endpoint ++ "statuses/update_with_media.json" mediaBody (MediaFromFile fp) = partFileSource "media[]" fp mediaBody (MediaRequestBody filename filebody) = partFileRequestBody "media[]" filename filebody deriveHasParamInstances ''StatusesUpdateWithMedia [ "possibly_sensitive" , "in_reply_to_status_id" -- , "lat_long" -- , "place_id" , "display_coordinates" ] data StatusesLookup -- | Returns fully-hydrated tweet objects for up to 100 tweets per request, as specified by comma-separated values passed to the id parameter. -- -- You can perform a request using 'call': -- -- @ -- res <- 'call' twInfo mgr '$' 'lookup' [20, 432656548536401920] -- @ -- -- >>> lookup [10] -- APIRequestGet "https://api.twitter.com/1.1/statuses/lookup.json" [("id","10")] -- >>> lookup [10, 432656548536401920] -- APIRequestGet "https://api.twitter.com/1.1/statuses/lookup.json" [("id","10,432656548536401920")] -- >>> lookup [10, 432656548536401920] & includeEntities ?~ True -- APIRequestGet "https://api.twitter.com/1.1/statuses/lookup.json" [("include_entities","true"),("id","10,432656548536401920")] lookup :: [StatusId] -> APIRequest StatusesLookup [Status] lookup ids = APIRequestGet (endpoint ++ "statuses/lookup.json") [("id", PVIntegerArray ids)] deriveHasParamInstances ''StatusesLookup [ "include_entities" , "trim_user" , "map" ] twitter-conduit-0.3.0/Web/Twitter/Conduit/Base.hs0000644000000000000000000003275413312637147020061 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RecordWildCards #-} module Web.Twitter.Conduit.Base ( getResponse , call , call' , callWithResponse , callWithResponse' , checkResponse , sourceWithMaxId , sourceWithMaxId' , sourceWithCursor , sourceWithCursor' , sourceWithSearchResult , sourceWithSearchResult' , endpoint , makeRequest , sinkJSON , sinkFromJSON ) where import Web.Twitter.Conduit.Cursor import Web.Twitter.Conduit.Parameters hiding (url) import Web.Twitter.Conduit.Request import Web.Twitter.Conduit.Response import Web.Twitter.Conduit.Types import Web.Twitter.Types.Lens import Control.Lens import Control.Monad.Base import Control.Monad.Catch (MonadThrow (..)) import Control.Monad.IO.Class import Control.Monad.Trans.Resource (MonadResource, ResourceT, runResourceT) import Data.Aeson import Data.Aeson.Lens import Data.ByteString (ByteString) import qualified Data.Conduit as C import qualified Data.Conduit.Attoparsec as CA import qualified Data.Conduit.List as CL import qualified Data.Map as M import Data.Monoid import qualified Data.Text.Encoding as T import Network.HTTP.Client.MultipartFormData import qualified Network.HTTP.Conduit as HTTP import qualified Network.HTTP.Types as HT import Unsafe.Coerce import Web.Authenticate.OAuth (signOAuth) makeRequest :: APIRequest apiName responseType -> IO HTTP.Request makeRequest (APIRequestGet u pa) = makeRequest' "GET" u (makeSimpleQuery pa) makeRequest (APIRequestPost u pa) = makeRequest' "POST" u (makeSimpleQuery pa) makeRequest (APIRequestPostMultipart u param prt) = formDataBody body =<< makeRequest' "POST" u [] where body = prt ++ partParam partParam = Prelude.map (uncurry partBS . over _1 T.decodeUtf8) (makeSimpleQuery param) makeRequest' :: HT.Method -- ^ HTTP request method (GET or POST) -> String -- ^ API Resource URL -> HT.SimpleQuery -- ^ Query -> IO HTTP.Request makeRequest' m url query = do #if MIN_VERSION_http_client(0,4,30) req <- HTTP.parseRequest url #else req <- HTTP.parseUrl url #endif let addParams = if m == "POST" then HTTP.urlEncodedBody query else \r -> r { HTTP.queryString = HT.renderSimpleQuery False query } return $ addParams $ req { HTTP.method = m #if !MIN_VERSION_http_client(0,4,30) , HTTP.checkStatus = \_ _ _ -> Nothing #endif } getResponse :: MonadResource m => TWInfo -> HTTP.Manager -> HTTP.Request #if MIN_VERSION_http_conduit(2,3,0) -> m (Response (C.ConduitM () ByteString m ())) #else -> m (Response (C.ResumableSource m ByteString)) #endif getResponse TWInfo{..} mgr req = do signedReq <- signOAuth (twOAuth twToken) (twCredential twToken) $ req { HTTP.proxy = twProxy } res <- HTTP.http signedReq mgr return Response { responseStatus = HTTP.responseStatus res , responseHeaders = HTTP.responseHeaders res , responseBody = HTTP.responseBody res } endpoint :: String endpoint = "https://api.twitter.com/1.1/" getValue :: #if MIN_VERSION_http_conduit(2,3,0) Response (C.ConduitM () ByteString (ResourceT IO) ()) #else Response (C.ResumableSource (ResourceT IO) ByteString) #endif -> ResourceT IO (Response Value) getValue res = do value <- #if MIN_VERSION_http_conduit(2,3,0) C.runConduit $ responseBody res C..| sinkJSON #else responseBody res C.$$+- sinkJSON #endif return $ res { responseBody = value } checkResponse :: Response Value -> Either TwitterError Value checkResponse Response{..} = case responseBody ^? key "errors" of Just errs@(Array _) -> case fromJSON errs of Success errList -> Left $ TwitterErrorResponse responseStatus responseHeaders errList Error msg -> Left $ FromJSONError msg Just err -> Left $ TwitterUnknownErrorResponse responseStatus responseHeaders err Nothing -> if sci < 200 || sci > 400 then Left $ TwitterStatusError responseStatus responseHeaders responseBody else Right responseBody where sci = HT.statusCode responseStatus getValueOrThrow :: FromJSON a #if MIN_VERSION_http_conduit(2,3,0) => Response (C.ConduitM () ByteString (ResourceT IO) ()) #else => Response (C.ResumableSource (ResourceT IO) ByteString) #endif -> ResourceT IO (Response a) getValueOrThrow res = do res' <- getValue res case checkResponse res' of Left err -> throwM err Right _ -> return () case fromJSON (responseBody res') of Success r -> return $ res' { responseBody = r } Error err -> throwM $ FromJSONError err -- | Perform an 'APIRequest' and then provide the response which is mapped to a suitable type of -- . -- -- Example: -- -- @ -- user <- 'call' twInfo mgr $ 'accountVerifyCredentials' -- print user -- @ -- -- If you need raw JSON value which is parsed by , -- use 'call'' to obtain it. call :: FromJSON responseType => TWInfo -- ^ Twitter Setting -> HTTP.Manager -> APIRequest apiName responseType -> IO responseType call = call' -- | Perform an 'APIRequest' and then provide the response. -- The response of this function is not restrict to @responseType@, -- so you can choose an arbitrarily type of FromJSON instances. call' :: FromJSON value => TWInfo -- ^ Twitter Setting -> HTTP.Manager -> APIRequest apiName responseType -> IO value call' info mgr req = responseBody `fmap` callWithResponse' info mgr req -- | Perform an 'APIRequest' and then provide the 'Response'. -- -- Example: -- -- @ -- res \<- 'callWithResponse' twInfo mgr $ 'accountVerifyCredentials' -- 'print' $ 'responseStatus' res -- 'print' $ 'responseHeaders' res -- 'print' $ 'responseBody' res -- @ callWithResponse :: FromJSON responseType => TWInfo -- ^ Twitter Setting -> HTTP.Manager -> APIRequest apiName responseType -> IO (Response responseType) callWithResponse = callWithResponse' -- | Perform an 'APIRequest' and then provide the 'Response'. -- The response of this function is not restrict to @responseType@, -- so you can choose an arbitrarily type of FromJSON instances. -- -- Example: -- -- @ -- res \<- 'callWithResponse'' twInfo mgr $ 'accountVerifyCredentials' -- 'print' $ 'responseStatus' res -- 'print' $ 'responseHeaders' res -- 'print' $ 'responseBody' (res :: Value) -- @ callWithResponse' :: FromJSON value => TWInfo -> HTTP.Manager -> APIRequest apiName responseType -> IO (Response value) callWithResponse' info mgr req = runResourceT $ do res <- getResponse info mgr =<< liftIO (makeRequest req) getValueOrThrow res -- | A wrapper function to perform multiple API request with changing @max_id@ parameter. -- -- This function cooperate with instances of 'HasMaxIdParam'. sourceWithMaxId :: ( MonadIO m , FromJSON responseType , AsStatus responseType , HasMaxIdParam (APIRequest apiName [responseType]) ) => TWInfo -- ^ Twitter Setting -> HTTP.Manager -> APIRequest apiName [responseType] -> C.Source m responseType sourceWithMaxId info mgr = loop where loop req = do res <- liftIO $ call info mgr req case getMinId res of Just mid -> do CL.sourceList res loop $ req & maxId ?~ mid - 1 Nothing -> CL.sourceList res getMinId = minimumOf (traverse . status_id) -- | A wrapper function to perform multiple API request with changing @max_id@ parameter. -- The response of this function is not restrict to @responseType@, -- so you can choose an arbitrarily type of FromJSON instances. -- -- This function cooperate with instances of 'HasMaxIdParam'. sourceWithMaxId' :: ( MonadIO m , HasMaxIdParam (APIRequest apiName [responseType]) ) => TWInfo -- ^ Twitter Setting -> HTTP.Manager -> APIRequest apiName [responseType] -> C.Source m Value sourceWithMaxId' info mgr = loop where loop req = do res <- liftIO $ call' info mgr req case getMinId res of Just mid -> do CL.sourceList res loop $ req & maxId ?~ mid - 1 Nothing -> CL.sourceList res getMinId = minimumOf (traverse . key "id" . _Integer) -- | A wrapper function to perform multiple API request with changing @cursor@ parameter. -- -- This function cooperate with instances of 'HasCursorParam'. sourceWithCursor :: ( MonadIO m , FromJSON responseType , CursorKey ck , HasCursorParam (APIRequest apiName (WithCursor ck responseType)) ) => TWInfo -- ^ Twitter Setting -> HTTP.Manager -> APIRequest apiName (WithCursor ck responseType) -> C.Source m responseType sourceWithCursor info mgr req = loop (-1) where loop 0 = CL.sourceNull loop cur = do res <- liftIO $ call info mgr $ req & cursor ?~ cur CL.sourceList $ contents res loop $ nextCursor res -- | A wrapper function to perform multiple API request with changing @cursor@ parameter. -- The response of this function is not restrict to @responseType@, -- so you can choose an arbitrarily type of FromJSON instances. -- -- This function cooperate with instances of 'HasCursorParam'. sourceWithCursor' :: ( MonadIO m , CursorKey ck , HasCursorParam (APIRequest apiName (WithCursor ck responseType)) ) => TWInfo -- ^ Twitter Setting -> HTTP.Manager -> APIRequest apiName (WithCursor ck responseType) -> C.Source m Value sourceWithCursor' info mgr req = loop (-1) where relax :: APIRequest apiName (WithCursor ck responseType) -> APIRequest apiName (WithCursor ck Value) relax = unsafeCoerce loop 0 = CL.sourceNull loop cur = do res <- liftIO $ call info mgr $ relax $ req & cursor ?~ cur CL.sourceList $ contents res loop $ nextCursor res -- | A wrapper function to perform multiple API request with @SearchResult@. sourceWithSearchResult :: ( MonadIO m , FromJSON responseType ) => TWInfo -- ^ Twitter Setting -> HTTP.Manager -> APIRequest apiName (SearchResult [responseType]) -> m (SearchResult (C.Source m responseType)) sourceWithSearchResult info mgr req = do res <- liftIO $ call info mgr req let body = CL.sourceList (res ^. searchResultStatuses) <> loop (res ^. searchResultSearchMetadata . searchMetadataNextResults) return $ res & searchResultStatuses .~ body where origQueryMap = req ^. params . to M.fromList loop Nothing = CL.sourceNull loop (Just nextResultsStr) = do let nextResults = nextResultsStr & HT.parseSimpleQuery . T.encodeUtf8 & traversed . _2 %~ (PVString . T.decodeUtf8) nextParams = M.toList $ M.union (M.fromList nextResults) origQueryMap res <- liftIO $ call info mgr $ req & params .~ nextParams CL.sourceList (res ^. searchResultStatuses) loop $ res ^. searchResultSearchMetadata . searchMetadataNextResults -- | A wrapper function to perform multiple API request with @SearchResult@. sourceWithSearchResult' :: ( MonadIO m ) => TWInfo -- ^ Twitter Setting -> HTTP.Manager -> APIRequest apiName (SearchResult [responseType]) -> m (SearchResult (C.Source m Value)) sourceWithSearchResult' info mgr req = do res <- liftIO $ call info mgr $ relax req let body = CL.sourceList (res ^. searchResultStatuses) <> loop (res ^. searchResultSearchMetadata . searchMetadataNextResults) return $ res & searchResultStatuses .~ body where origQueryMap = req ^. params . to M.fromList relax :: APIRequest apiName (SearchResult [responseType]) -> APIRequest apiName (SearchResult [Value]) relax = unsafeCoerce loop Nothing = CL.sourceNull loop (Just nextResultsStr) = do let nextResults = nextResultsStr & HT.parseSimpleQuery . T.encodeUtf8 & traversed . _2 %~ (PVString . T.decodeUtf8) nextParams = M.toList $ M.union (M.fromList nextResults) origQueryMap res <- liftIO $ call info mgr $ relax $ req & params .~ nextParams CL.sourceList (res ^. searchResultStatuses) loop $ res ^. searchResultSearchMetadata . searchMetadataNextResults sinkJSON :: ( MonadThrow m ) => C.Consumer ByteString m Value sinkJSON = CA.sinkParser json sinkFromJSON :: ( FromJSON a , MonadThrow m ) => C.Consumer ByteString m a sinkFromJSON = do v <- sinkJSON case fromJSON v of Error err -> throwM $ FromJSONError err Success r -> return r twitter-conduit-0.3.0/Web/Twitter/Conduit/Request.hs0000644000000000000000000001062413312637147020627 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE CPP #-} module Web.Twitter.Conduit.Request ( Parameters(..) , APIRequest(..) , APIQuery , APIQueryItem , PV(..) , makeSimpleQuery , paramValueBS ) where #if __GLASGOW_HASKELL__ < 710 import Control.Applicative #endif import Control.Lens import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as S8 import Data.Text (Text) import qualified Data.Text.Encoding as T import Data.Time.Calendar (Day) import Network.HTTP.Client.MultipartFormData import qualified Network.HTTP.Types as HT class Parameters a where params :: Lens' a APIQuery -- In GHC 7.4.2, the following test fails with Overlapping instances error. -- It may be caused by #5820 "defining instance in GHCi leads to duplicated instances". -- So, we bypass below tests when GHC version older than 7.6. -- see details: https://ghc.haskell.org/trac/ghc/ticket/5820 #if __GLASGOW_HASKELL__ >= 706 -- $setup -- >>> :set -XOverloadedStrings -XRank2Types -XEmptyDataDecls -XFlexibleInstances -- >>> import Control.Lens -- >>> import Data.Default -- >>> import Web.Twitter.Conduit.Parameters -- >>> data SampleApi -- >>> type SampleId = Integer -- >>> instance HasCountParam (APIRequest SampleApi [SampleId]) -- >>> instance HasMaxIdParam (APIRequest SampleApi [SampleId]) -- >>> let sampleApiRequest :: APIRequest SampleApi [SampleId]; sampleApiRequest = APIRequestGet "https://api.twitter.com/sample/api.json" def -- | API request. You should use specific builder functions instead of building this directly. -- -- For example, if there were a @SampleApi@ type and a builder function which named @sampleApiRequest@. -- In addition, @'APIRequest' SampleApi [SampleId]@ is a instance of both of 'HasCountParam' and 'HasMaxIdParam'. -- -- @ -- data 'SampleApi' -- type 'SampleId' = 'Integer' -- instance 'HasCountParam' ('APIRequest' 'SampleApi' ['SampleId']) -- instance 'HasMaxIdParam' ('APIRequest' 'SampleApi' ['SampleId']) -- 'sampleApiRequest' :: 'APIRequest' 'SampleApi' ['SampleId'] -- 'sampleApiRequest' = 'APIRequestGet' \"https:\/\/api.twitter.com\/sample\/api.json\" 'def' -- @ -- -- We can obtain request params from @'APIRequest' SampleApi [SampleId]@ : -- -- >>> sampleApiRequest ^. params -- [] -- -- And update request parameters. -- -- >>> (sampleApiRequest & count ?~ 100 & maxId ?~ 1234567890) ^. params -- [("max_id",PVInteger {unPVInteger = 1234567890}),("count",PVInteger {unPVInteger = 100})] -- >>> (sampleApiRequest & count ?~ 100 & maxId ?~ 1234567890 & count .~ Nothing) ^. params -- [("max_id",PVInteger {unPVInteger = 1234567890})] #endif data APIRequest apiName responseType = APIRequestGet { _url :: String , _params :: APIQuery } | APIRequestPost { _url :: String , _params :: APIQuery } | APIRequestPostMultipart { _url :: String , _params :: APIQuery , _part :: [Part] } instance Parameters (APIRequest apiName responseType) where params f (APIRequestGet u pa) = APIRequestGet u <$> f pa params f (APIRequestPost u pa) = APIRequestPost u <$> f pa params f (APIRequestPostMultipart u pa prt) = (\p -> APIRequestPostMultipart u p prt) <$> f pa instance Show (APIRequest apiName responseType) where show (APIRequestGet u p) = "APIRequestGet " ++ show u ++ " " ++ show (makeSimpleQuery p) show (APIRequestPost u p) = "APIRequestPost " ++ show u ++ " " ++ show (makeSimpleQuery p) show (APIRequestPostMultipart u p _) = "APIRequestPostMultipart " ++ show u ++ " " ++ show (makeSimpleQuery p) type APIQuery = [APIQueryItem] type APIQueryItem = (ByteString, PV) data PV = PVInteger { unPVInteger :: Integer } | PVBool { unPVBool :: Bool } | PVString { unPVString :: Text } | PVIntegerArray { unPVIntegerArray :: [Integer] } | PVStringArray { unPVStringArray :: [Text] } | PVDay { unPVDay :: Day } deriving (Show, Eq) makeSimpleQuery :: APIQuery -> HT.SimpleQuery makeSimpleQuery = traversed . _2 %~ paramValueBS paramValueBS :: PV -> ByteString paramValueBS (PVInteger i) = S8.pack . show $ i paramValueBS (PVBool True) = "true" paramValueBS (PVBool False) = "false" paramValueBS (PVString txt) = T.encodeUtf8 txt paramValueBS (PVIntegerArray iarr) = S8.intercalate "," $ map (S8.pack . show) iarr paramValueBS (PVStringArray iarr) = S8.intercalate "," $ map T.encodeUtf8 iarr paramValueBS (PVDay day) = S8.pack . show $ day twitter-conduit-0.3.0/Web/Twitter/Conduit/Response.hs0000644000000000000000000000376513312637147021005 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE OverloadedStrings #-} module Web.Twitter.Conduit.Response ( Response (..) , TwitterError (..) , TwitterErrorMessage (..) ) where #if __GLASGOW_HASKELL__ < 710 import Control.Applicative import Data.Foldable (Foldable) import Data.Traversable (Traversable) #endif import Control.Exception import Data.Aeson import Data.Data import qualified Data.Text as T import Network.HTTP.Types (Status, ResponseHeaders, Status, ResponseHeaders) data Response responseType = Response { responseStatus :: Status , responseHeaders :: ResponseHeaders , responseBody :: responseType } deriving (Show, Eq, Typeable, Functor, Foldable, Traversable) data TwitterError = FromJSONError String | TwitterErrorResponse Status ResponseHeaders [TwitterErrorMessage] | TwitterUnknownErrorResponse Status ResponseHeaders Value | TwitterStatusError Status ResponseHeaders Value deriving (Show, Typeable, Eq) instance Exception TwitterError -- | Twitter Error Messages -- -- see detail: data TwitterErrorMessage = TwitterErrorMessage { twitterErrorCode :: Int , twitterErrorMessage :: T.Text } deriving (Show, Data, Typeable) instance Eq TwitterErrorMessage where TwitterErrorMessage { twitterErrorCode = a } == TwitterErrorMessage { twitterErrorCode = b } = a == b instance Ord TwitterErrorMessage where compare TwitterErrorMessage { twitterErrorCode = a } TwitterErrorMessage { twitterErrorCode = b } = a `compare` b instance Enum TwitterErrorMessage where fromEnum = twitterErrorCode toEnum a = TwitterErrorMessage a T.empty instance FromJSON TwitterErrorMessage where parseJSON (Object o) = TwitterErrorMessage <$> o .: "code" <*> o .: "message" parseJSON v = fail $ "unexpected: " ++ show v twitter-conduit-0.3.0/Web/Twitter/Conduit/Cursor.hs0000644000000000000000000000412313312637147020451 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE CPP #-} module Web.Twitter.Conduit.Cursor ( CursorKey (..) , IdsCursorKey , UsersCursorKey , ListsCursorKey , WithCursor (..) ) where #if __GLASGOW_HASKELL__ < 710 import Control.Applicative import Data.Monoid #endif import Data.Aeson import Data.Text (Text) import Web.Twitter.Types (checkError) -- $setup -- >>> type UserId = Integer class CursorKey a where cursorKey :: a -> Text -- | Phantom type to specify the key which point out the content in the response. data IdsCursorKey instance CursorKey IdsCursorKey where cursorKey = const "ids" -- | Phantom type to specify the key which point out the content in the response. data UsersCursorKey instance CursorKey UsersCursorKey where cursorKey = const "users" -- | Phantom type to specify the key which point out the content in the response. data ListsCursorKey instance CursorKey ListsCursorKey where cursorKey = const "lists" #if __GLASGOW_HASKELL__ >= 706 -- | A wrapper for API responses which have "next_cursor" field. -- -- The first type parameter of 'WithCursor' specifies the field name of contents. -- -- >>> let Just res = decode "{\"previous_cursor\": 0, \"next_cursor\": 1234567890, \"ids\": [1111111111]}" :: Maybe (WithCursor IdsCursorKey UserId) -- >>> nextCursor res -- 1234567890 -- >>> contents res -- [1111111111] -- -- >>> let Just res = decode "{\"previous_cursor\": 0, \"next_cursor\": 0, \"users\": [1000]}" :: Maybe (WithCursor UsersCursorKey UserId) -- >>> nextCursor res -- 0 -- >>> contents res -- [1000] #endif data WithCursor cursorKey wrapped = WithCursor { previousCursor :: Integer , nextCursor :: Integer , contents :: [wrapped] } deriving Show instance (FromJSON wrapped, CursorKey c) => FromJSON (WithCursor c wrapped) where parseJSON (Object o) = checkError o >> WithCursor <$> o .: "previous_cursor" <*> o .: "next_cursor" <*> o .: cursorKey (undefined :: c) parseJSON _ = mempty twitter-conduit-0.3.0/Web/Twitter/Conduit/Parameters.hs0000644000000000000000000001173513312637147021306 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module Web.Twitter.Conduit.Parameters ( Parameters(..) , PV(..) , APIQuery , APIQueryItem , makeSimpleQuery , HasSinceIdParam (..) , HasCountParam (..) , HasMaxIdParam (..) , HasPageParam (..) , HasCursorParam (..) , HasTrimUserParam (..) , HasExcludeRepliesParam (..) , HasContributorDetailsParam (..) , HasIncludeEntitiesParam (..) , HasIncludeEmailParam (..) , HasIncludeExtAltTextParam (..) , HasIncludeUserEntitiesParam (..) , HasIncludeRtsParam (..) , HasIncludeMyRetweetParam (..) , HasInReplyToStatusIdParam (..) , HasDisplayCoordinatesParam (..) , HasPossiblySensitiveParam (..) , HasLangParam (..) , HasLanguageParam (..) , HasLocaleParam (..) , HasFilterLevelParam (..) , HasStallWarningsParam (..) , HasRepliesParam (..) , HasUntilParam (..) , HasSkipStatusParam (..) , HasFollowParam (..) , HasMapParam (..) , HasMediaIdsParam (..) , HasDescriptionParam (..) , HasNameParam (..) , HasProfileLinkColorParam (..) , HasLocationParam (..) , HasUrlParam (..) , HasFullTextParam (..) , HasWithParam (..) , UserParam(..) , UserListParam(..) , ListParam(..) , MediaData(..) , mkUserParam , mkUserListParam , mkListParam ) where import qualified Data.Text as T import Network.HTTP.Client (RequestBody) import Web.Twitter.Conduit.Parameters.TH import Web.Twitter.Conduit.Request import Web.Twitter.Types data UserParam = UserIdParam UserId | ScreenNameParam String deriving (Show, Eq) data UserListParam = UserIdListParam [UserId] | ScreenNameListParam [String] deriving (Show, Eq) data ListParam = ListIdParam Integer | ListNameParam String deriving (Show, Eq) data MediaData = MediaFromFile FilePath | MediaRequestBody FilePath RequestBody defineHasParamClassInteger "count" defineHasParamClassInteger "since_id" defineHasParamClassInteger "max_id" defineHasParamClassInteger "page" defineHasParamClassInteger "cursor" defineHasParamClassBool "trim_user" defineHasParamClassBool "exclude_replies" defineHasParamClassBool "contributor_details" defineHasParamClassBool "include_entities" defineHasParamClassBool "include_email" defineHasParamClassBool "include_user_entities" defineHasParamClassBool "include_rts" defineHasParamClassBool "include_my_retweet" defineHasParamClassBool "include_ext_alt_text" defineHasParamClassInteger "in_reply_to_status_id" defineHasParamClassBool "display_coordinates" defineHasParamClassBool "possibly_sensitive" defineHasParamClassString "lang" defineHasParamClassString "language" defineHasParamClassString "locale" defineHasParamClassString "filter_level" defineHasParamClassBool "stall_warnings" defineHasParamClassString "replies" defineHasParamClassDay "until" defineHasParamClassBool "skip_status" defineHasParamClassBool "follow" defineHasParamClassBool "map" defineHasParamClassIntegerArray "media_ids" defineHasParamClassString "description" defineHasParamClassString "name" defineHasParamClassString "profile_link_color" defineHasParamClassString "location" defineHasParamClassURI "url" defineHasParamClassBool "full_text" defineHasParamClassString "with" -- | converts 'UserParam' to 'HT.SimpleQuery'. -- -- >>> makeSimpleQuery . mkUserParam $ UserIdParam 123456 -- [("user_id","123456")] -- >>> makeSimpleQuery . mkUserParam $ ScreenNameParam "thimura" -- [("screen_name","thimura")] mkUserParam :: UserParam -> APIQuery mkUserParam (UserIdParam uid) = [("user_id", PVInteger uid)] mkUserParam (ScreenNameParam sn) = [("screen_name", PVString . T.pack $ sn)] -- | converts 'UserListParam' to 'HT.SimpleQuery'. -- -- >>> makeSimpleQuery . mkUserListParam $ UserIdListParam [123456] -- [("user_id","123456")] -- >>> makeSimpleQuery . mkUserListParam $ UserIdListParam [123456, 654321] -- [("user_id","123456,654321")] -- >>> makeSimpleQuery . mkUserListParam $ ScreenNameListParam ["thimura", "NikaidouShinku"] -- [("screen_name","thimura,NikaidouShinku")] mkUserListParam :: UserListParam -> APIQuery mkUserListParam (UserIdListParam uids) = [("user_id", PVIntegerArray uids)] mkUserListParam (ScreenNameListParam sns) = [("screen_name", PVStringArray (Prelude.map T.pack sns))] -- | converts 'ListParam' to 'HT.SimpleQuery'. -- -- >>> makeSimpleQuery . mkListParam $ ListIdParam 123123 -- [("list_id","123123")] -- >>> makeSimpleQuery . mkListParam $ ListNameParam "thimura/haskell" -- [("slug","haskell"),("owner_screen_name","thimura")] mkListParam :: ListParam -> APIQuery mkListParam (ListIdParam lid) = [("list_id", PVInteger lid)] mkListParam (ListNameParam listname) = [("slug", PVString (T.pack lstName)), ("owner_screen_name", PVString (T.pack screenName))] where (screenName, ln) = span (/= '/') listname lstName = drop 1 ln twitter-conduit-0.3.0/Web/Twitter/Conduit/Parameters/TH.hs0000644000000000000000000001030113312637147021605 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TemplateHaskell #-} module Web.Twitter.Conduit.Parameters.TH ( defineHasParamClass , defineHasParamClass' , defineHasParamClassBool , defineHasParamClassDay , defineHasParamClassInteger , defineHasParamClassIntegerArray , defineHasParamClassString , defineHasParamClassStringArray , defineHasParamClassURI , deriveHasParamInstances ) where import Web.Twitter.Conduit.Request import Language.Haskell.TH import Control.Lens import qualified Data.ByteString as S import Data.Char import Data.Text (Text) import Data.Time.Calendar (Day) import Web.Twitter.Types snakeToLowerCamel :: String -> String snakeToLowerCamel [] = [] snakeToLowerCamel "_" = [] snakeToLowerCamel ('_':x:xs) = toUpper x : snakeToLowerCamel xs snakeToLowerCamel str = f ++ snakeToLowerCamel next where (f, next) = span (/= '_') str snakeToUpperCamel :: String -> String snakeToUpperCamel = upcase . snakeToLowerCamel where upcase [] = [] upcase (x:xs) = toUpper x : xs paramNameToClassName :: String -> String paramNameToClassName paramName = "Has" ++ snakeToUpperCamel paramName ++ "Param" wrappedParam :: Parameters p => S.ByteString -> (a -> PV) -> (PV -> a) -> Lens' p (Maybe a) wrappedParam key wrap unwrap = lens getter setter where getter = preview $ params . to (lookup key) . _Just . to unwrap setter = flip (over params . replace key) replace k (Just v) = ((k, wrap v):) . dropAssoc k replace k Nothing = dropAssoc k dropAssoc k = filter ((/= k) . fst) defineHasParamClass :: Name -- wrap function -> Name -- unwrap function -> TypeQ -- wrapped type -> String -- ^ parameter name -> Q [Dec] defineHasParamClass wrap unwrap typ paramName = defineHasParamClass' cNameS fNameS wrap unwrap typ paramName where cNameS = paramNameToClassName paramName fNameS = snakeToLowerCamel paramName defineHasParamClass' :: String -> String -> Name -> Name -> TypeQ -> String -> Q [Dec] defineHasParamClass' cNameS fNameS wrap unwrap typ paramName = do a <- newName "a" cName <- newName cNameS fName <- newName fNameS #if MIN_VERSION_template_haskell(2, 10, 0) let cCxt = cxt [conT ''Parameters `appT` varT a] #else let cCxt = cxt [classP ''Parameters [varT a]] #endif let tySig = sigD fName (appT (appT (conT ''Lens') (varT a)) (appT (conT ''Maybe) typ)) valDef = valD (varP fName) (normalB (appE (appE (appE (varE 'wrappedParam) (litE (stringL paramName))) (conE wrap)) (varE unwrap))) [] dec <- classD cCxt cName [PlainTV a] [] [tySig, valDef] return [dec] deriveHasParamInstances :: Name -- ^ target data type name -> [String] -- ^ parameter name -> Q [Dec] deriveHasParamInstances typName paramNameList = mapM mkInstance cNameStrList where cNameStrList = map paramNameToClassName paramNameList mkInstance cn = instanceD (return []) (appT (conT (mkName cn)) targetType) [] targetType = do a <- newName "a" appT (appT (conT (mkName "APIRequest")) (conT typName)) (varT a) defineHasParamClassInteger :: String -> Q [Dec] defineHasParamClassInteger = defineHasParamClass 'PVInteger 'unPVInteger [t|Integer|] defineHasParamClassBool :: String -> Q [Dec] defineHasParamClassBool = defineHasParamClass 'PVBool 'unPVBool [t|Bool|] defineHasParamClassString :: String -> Q [Dec] defineHasParamClassString = defineHasParamClass 'PVString 'unPVString [t|Text|] defineHasParamClassURI :: String -> Q [Dec] defineHasParamClassURI = defineHasParamClass 'PVString 'unPVString [t|URIString|] defineHasParamClassIntegerArray :: String -> Q [Dec] defineHasParamClassIntegerArray = defineHasParamClass 'PVIntegerArray 'unPVIntegerArray [t|[Integer]|] defineHasParamClassStringArray :: String -> Q [Dec] defineHasParamClassStringArray = defineHasParamClass 'PVStringArray 'unPVStringArray [t|[Text]|] defineHasParamClassDay :: String -> Q [Dec] defineHasParamClassDay = defineHasParamClass 'PVDay 'unPVDay [t|Day|] twitter-conduit-0.3.0/tests/spec_main.hs0000644000000000000000000000006113312637147016505 0ustar0000000000000000import Spec import Test.Hspec main = hspec spec twitter-conduit-0.3.0/tests/Spec.hs0000644000000000000000000000007413312637147015445 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --no-main #-} twitter-conduit-0.3.0/tests/ApiSpec.hs0000644000000000000000000000370013312637147016076 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} module ApiSpec where import Control.Lens import Data.Conduit import qualified Data.Conduit.List as CL import Network.HTTP.Conduit import System.IO.Unsafe import TestUtils import Web.Twitter.Conduit (call, sourceWithCursor, TWInfo) import Web.Twitter.Conduit.Api import Web.Twitter.Conduit.Lens import qualified Web.Twitter.Conduit.Parameters as Param import Web.Twitter.Types.Lens import Test.Hspec twInfo :: TWInfo twInfo = unsafePerformIO getTWInfo mgr :: Manager mgr = unsafePerformIO $ newManager tlsManagerSettings {-# NOINLINE mgr #-} spec :: Spec spec = do unit #ifdef RUN_INTEGRATED_TEST integrated #endif unit :: Spec unit = return () integrated :: Spec integrated = do describe "friendsIds" $ do it "returns a cursored collection of users IDs" $ do res <- call twInfo mgr $ friendsIds (Param.ScreenNameParam "thimura") res ^. contents . to length `shouldSatisfy` (> 0) it "iterate with sourceWithCursor" $ do let src = sourceWithCursor twInfo mgr $ friendsIds (Param.ScreenNameParam "thimura") friends <- src $$ CL.consume length friends `shouldSatisfy` (>= 0) describe "listsMembers" $ do it "returns a cursored collection of the member of specified list" $ do res <- call twInfo mgr $ listsMembers (Param.ListNameParam "thimura/haskell") res ^. contents . to length `shouldSatisfy` (>= 0) it "should raise error when specified list does not exists" $ do let action = call twInfo mgr $ listsMembers (Param.ListNameParam "thimura/haskell_ne") action `shouldThrow` anyException it "iterate with sourceWithCursor" $ do let src = sourceWithCursor twInfo mgr $ listsMembers (Param.ListNameParam "thimura/haskell") members <- src $$ CL.consume members ^.. traversed . userScreenName `shouldContain` ["Hackage"] twitter-conduit-0.3.0/tests/BaseSpec.hs0000644000000000000000000000715313312637147016245 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module BaseSpec where import Web.Twitter.Conduit.Response import Web.Twitter.Conduit.Base import Control.Applicative import Control.Lens import Data.Aeson import Data.Aeson.Lens import Data.Conduit import qualified Data.Conduit.Attoparsec as CA import Data.Maybe import qualified Data.Text as T import qualified Network.HTTP.Types as HT import Test.Hspec spec :: Spec spec = do unit unit :: Spec unit = do describe "checkResponse" $ do describe "when the response has \"errors\" key" $ do let errorMessage = fromJust . decode $ "{\"errors\":[{\"message\":\"Sorry, that page does not exist\",\"code\":34}]}" response = Response HT.status404 [] errorMessage result = checkResponse response it "returns TwitterErrorResponse" $ do case result of Left res@(TwitterErrorResponse _ _ msgs) -> do res `shouldBe` TwitterErrorResponse HT.status404 [] [TwitterErrorMessage 34 ""] twitterErrorMessage (head msgs) `shouldBe` "Sorry, that page does not exist" _ -> expectationFailure $ "Unexpected " ++ show result describe "when the response does not has \"errors\" key but have error status code" $ do let errorMessage = fromJust . decode $ "{}" response = Response HT.status404 [] errorMessage result = checkResponse response it "returns TwitterStatusError" $ do case result of Left (TwitterStatusError st hdr body) -> do st `shouldBe` HT.status404 hdr `shouldBe` [] body `shouldBe` errorMessage _ -> expectationFailure $ "Unexpected " ++ show result describe "sinkJSON" $ do describe "when valid JSON input" $ do let input = "{\"test\": \"input\", \"status\": 200 }" it "can consume the input from Source and returns JSON Value" $ do res <- yield input $$ sinkJSON res ^. key "test" . _String `shouldBe` "input" res ^? key "status" . _Integer `shouldBe` Just 200 describe "when invalid JSON input" $ do let input = "{]" it "should raise Data.Conduit.Attoparsec.ParseError" $ do let parseErrorException (CA.ParseError {}) = True parseErrorException _ = False action = yield input $$ sinkJSON action `shouldThrow` parseErrorException describe "sinkFromJSON" $ do describe "when valid JSON input" $ do let input = "{\"test\": \"input\", \"status\": 200 }" it "can consume the input from Source and returns a value which type is the specified one" $ do res <- yield input $$ sinkFromJSON res `shouldBe` TestJSON "input" 200 describe "when the JSON value does not have expected format" $ do let input = "{\"status\": 200}" it "should raise FromJSONError" $ do let fromJSONException (FromJSONError {}) = True fromJSONException _ = False action :: IO TestJSON action = yield input $$ sinkFromJSON action `shouldThrow` fromJSONException data TestJSON = TestJSON { testField :: T.Text , testStatus :: Int } deriving (Show, Eq) instance FromJSON TestJSON where parseJSON (Object o) = TestJSON <$> o .: "test" <*> o .: "status" parseJSON v = fail $ "Unexpected: " ++ show v twitter-conduit-0.3.0/tests/StatusSpec.hs0000644000000000000000000000763213312637147016660 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} module StatusSpec where import Control.Lens import Data.Conduit import qualified Data.Conduit.List as CL import Data.Time import Network.HTTP.Conduit import System.IO.Unsafe import Web.Twitter.Conduit (call, accountVerifyCredentials, sourceWithMaxId, TWInfo) import qualified Web.Twitter.Conduit.Parameters as Param import Web.Twitter.Conduit.Status as Status import Web.Twitter.Types.Lens import TestUtils import Test.Hspec twInfo :: TWInfo twInfo = unsafePerformIO getTWInfo mgr :: Manager mgr = unsafePerformIO $ newManager tlsManagerSettings {-# NOINLINE mgr #-} self :: User self = unsafePerformIO $ call twInfo mgr $ accountVerifyCredentials {-# NOINLINE self #-} spec :: Spec spec = do unit #ifdef RUN_INTEGRATED_TEST integrated #endif unit :: Spec unit = return () integrated :: Spec integrated = do describe "mentionsTimeline" $ do it "returns the 20 most resent mentions for user" $ do res <- call twInfo mgr mentionsTimeline length res `shouldSatisfy` (> 0) let mentionsScreenName = res ^.. traversed . statusEntities . _Just . enUserMentions . traversed . entityBody . userEntityUserScreenName mentionsScreenName `shouldSatisfy` allOf folded (== (self ^. userScreenName)) length mentionsScreenName `shouldSatisfy` (== length res) describe "userTimeline" $ do it "returns the 20 most recent tweets posted by the user indicated by ScreenNameParam" $ do res <- call twInfo mgr $ userTimeline (Param.ScreenNameParam "thimura") length res `shouldSatisfy` (== 20) res `shouldSatisfy` (allOf folded (^. statusUser . userScreenName . to (== "thimura"))) it "returns the recent tweets which include RTs when specified include_rts option" $ do res <- call twInfo mgr $ userTimeline (Param.ScreenNameParam "thimura") & Param.count ?~ 100 & Param.includeRts ?~ True res `shouldSatisfy` (anyOf (folded . statusRetweetedStatus . _Just . statusUser . userScreenName) (/= "thimura")) it "iterate with sourceWithMaxId" $ do let src = sourceWithMaxId twInfo mgr $ userTimeline (Param.ScreenNameParam "thimura") & Param.count ?~ 200 tl <- src $$ CL.isolate 600 =$ CL.consume length tl `shouldSatisfy` (== 600) let ids = tl ^.. traversed . statusId zip ids (tail ids) `shouldSatisfy` all (\(a, b) -> a > b) describe "homeTimeline" $ do it "returns the most recent tweets in home timeline" $ do res <- call twInfo mgr homeTimeline length res `shouldSatisfy` (> 0) describe "showId" $ do it "works for the known tweets" $ do res <- call twInfo mgr $ showId 477833886768959488 res ^. statusId `shouldBe` 477833886768959488 res ^. statusText `shouldBe` "真紅かわいいはアレセイア" res ^. statusCreatedAt `shouldBe` UTCTime (fromGregorian 2014 6 14) (secondsToDiffTime 55450) res ^. statusUser . userScreenName `shouldBe` "thimura" describe "update & destroyId" $ do it "posts new tweet and destroy it" $ do res1 <- call twInfo mgr $ update "おまえの明日が、今日よりもずっと、楽しい事で溢れているようにと、祈っているよ" res1 ^. statusUser . userScreenName `shouldBe` self ^. userScreenName res2 <- call twInfo mgr $ destroyId (res1 ^. statusId) res2 ^. statusId `shouldBe` res1 ^. statusId describe "lookup" $ do it "works for the known tweets" $ do res <- call twInfo mgr $ Status.lookup [438691466345340928, 477757405942411265] length res `shouldSatisfy` (== 2) (res !! 0) ^. statusId `shouldBe` 438691466345340928 (res !! 1) ^. statusId `shouldBe` 477757405942411265 twitter-conduit-0.3.0/tests/TestUtils.hs0000644000000000000000000000331113312637147016510 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE CPP #-} module TestUtils (getTWInfo) where import Web.Twitter.Conduit import qualified Network.URI as URI import Network.HTTP.Conduit import qualified Data.Map as M import qualified Data.ByteString.Char8 as S8 import qualified Data.CaseInsensitive as CI import Control.Applicative import System.Environment import Control.Lens getOAuthTokens :: IO (OAuth, Credential) getOAuthTokens = do consumerKey <- getEnv' "OAUTH_CONSUMER_KEY" consumerSecret <- getEnv' "OAUTH_CONSUMER_SECRET" accessToken <- getEnv' "OAUTH_ACCESS_TOKEN" accessSecret <- getEnv' "OAUTH_ACCESS_SECRET" let oauth = twitterOAuth { oauthConsumerKey = consumerKey , oauthConsumerSecret = consumerSecret } cred = Credential [ ("oauth_token", accessToken) , ("oauth_token_secret", accessSecret) ] return (oauth, cred) where getEnv' = (S8.pack <$>) . getEnv getProxyEnv :: IO (Maybe Proxy) getProxyEnv = do env <- M.fromList . over (mapped . _1) CI.mk <$> getEnvironment let u = M.lookup "https_proxy" env <|> M.lookup "http_proxy" env <|> M.lookup "proxy" env >>= URI.parseURI >>= URI.uriAuthority return $ Proxy <$> (S8.pack . URI.uriRegName <$> u) <*> (parsePort . URI.uriPort <$> u) where parsePort :: String -> Int parsePort [] = 8080 parsePort (':':xs) = read xs parsePort xs = error $ "port number parse failed " ++ xs getTWInfo :: IO TWInfo getTWInfo = do pr <- getProxyEnv (oa, cred) <- getOAuthTokens return $ (setCredential oa cred def) { twProxy = pr } twitter-conduit-0.3.0/tests/doctests.hs0000644000000000000000000000043513312637147016404 0ustar0000000000000000module Main where import Build_doctests (flags, pkgs, module_sources) import Data.Foldable (traverse_) import Test.DocTest (doctest) main :: IO () main = do traverse_ putStrLn args -- optionally print arguments doctest args where args = flags ++ pkgs ++ module_sources twitter-conduit-0.3.0/tests/hlint.hs0000644000000000000000000000104513312637147015670 0ustar0000000000000000module Main where import Control.Monad import Data.Maybe import Language.Haskell.HLint import System.Environment import System.Exit main :: IO () main = do args <- getArgs cabalMacros <- getCabalMacrosPath hints <- hlint $ ["Web", "--cpp-define=HLINT", "--cpp-ansi", "--cpp-file=" ++ cabalMacros] ++ args unless (null hints) exitFailure getCabalMacrosPath :: IO FilePath getCabalMacrosPath = do env <- getEnvironment let dist = fromMaybe "dist" $ lookup "HASKELL_DIST_DIR" env return $ dist ++ "/build/autogen/cabal_macros.h" twitter-conduit-0.3.0/LICENSE0000644000000000000000000000246013312637147014063 0ustar0000000000000000Copyright (c)2011-2014, Takahiro Himura All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. twitter-conduit-0.3.0/Setup.hs0000644000000000000000000000114713312637147014513 0ustar0000000000000000{-# LANGUAGE CPP #-} module Main (main) where #ifndef MIN_VERSION_cabal_doctest #define MIN_VERSION_cabal_doctest(x,y,z) 0 #endif #if MIN_VERSION_cabal_doctest(1,0,0) import Distribution.Extra.Doctest ( defaultMainWithDoctests ) main :: IO () main = defaultMainWithDoctests "doctests" #else #ifdef MIN_VERSION_Cabal -- If the macro is defined, we have new cabal-install, -- but for some reason we don't have cabal-doctest in package-db -- -- Probably we are running cabal sdist, when otherwise using new-build -- workflow import Warning () #endif import Distribution.Simple main :: IO () main = defaultMain #endif twitter-conduit-0.3.0/twitter-conduit.cabal0000644000000000000000000001033613312637147017210 0ustar0000000000000000name: twitter-conduit version: 0.3.0 license: BSD3 license-file: LICENSE author: HATTORI Hiroki, Hideyuki Tanaka, Takahiro HIMURA maintainer: Takahiro HIMURA synopsis: Twitter API package with conduit interface and Streaming API support. category: Web, Conduit stability: Experimental cabal-version: >= 1.10 build-type: Custom homepage: https://github.com/himura/twitter-conduit tested-with: GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3 description: This package provides bindings to Twitter's APIs (see ). . This package uses the http-conduit package for accessing the Twitter API (see ). This package also depends on the twitter-types package (see ). . You can find basic examples in the directory. . This package is under development. If you find something that has not been implemented yet, please send a pull request or open an issue on GitHub. extra-source-files: .gitignore .travis.yml .travis/*.sh README.md ChangeLog.md Warning.hs sample/LICENSE sample/twitter-conduit-sample.cabal sample/*.hs sample/common/*.hs tests/*.hs source-repository head type: git location: git://github.com/himura/twitter-conduit.git flag network-uri description: Get Network.URI from the network-uri package default: True flag lens-aeson description: Get Data.Aeson.Lens from the lens-aeson package default: True flag run-integrated-test description: use debug output when running testsuites default: False library ghc-options: -Wall build-depends: base >= 4.5 && < 5 , transformers >= 0.2.2 , transformers-base , template-haskell , exceptions >= 0.5 , authenticate-oauth >= 1.3 , resourcet >= 1.0 , conduit >= 1.1 , conduit-extra >= 1.1 , http-types , http-conduit >= 2.0 && < 2.4 , http-client >= 0.3.0 , aeson >= 0.7.0.5 , attoparsec >= 0.10 , data-default >= 0.3 , bytestring >= 0.10.2 , text >= 0.11 , containers , time , twitter-types >= 0.6 , twitter-types-lens >= 0.6 if flag(lens-aeson) build-depends: lens-aeson >= 1 , lens >= 4.4 else build-depends: lens >= 4.0 && < 4.4 exposed-modules: Web.Twitter.Conduit Web.Twitter.Conduit.Lens Web.Twitter.Conduit.Types Web.Twitter.Conduit.Api Web.Twitter.Conduit.Stream Web.Twitter.Conduit.Status Web.Twitter.Conduit.Base Web.Twitter.Conduit.Request Web.Twitter.Conduit.Response Web.Twitter.Conduit.Cursor Web.Twitter.Conduit.Parameters Web.Twitter.Conduit.Parameters.TH default-language: Haskell2010 test-suite hlint type: exitcode-stdio-1.0 main-is: hlint.hs hs-source-dirs: tests build-depends: base , hlint >= 1.7 default-language: Haskell2010 test-suite doctests type: exitcode-stdio-1.0 main-is: doctests.hs hs-source-dirs: tests build-depends: base , doctest default-language: Haskell2010 test-suite spec_main type: exitcode-stdio-1.0 main-is: spec_main.hs hs-source-dirs: tests if flag(run-integrated-test) CPP-Options: -DRUN_INTEGRATED_TEST build-tool-depends: hspec-discover:hspec-discover >= 2.3.0 && < 2.5 build-depends: base >= 4.5 && < 5 , template-haskell , lens , bytestring , time , text , aeson , attoparsec >= 0.10 , data-default , resourcet , conduit , conduit-extra >= 1.1 , http-types , http-conduit , http-client , authenticate-oauth , case-insensitive , containers , hspec , twitter-types >= 0.6 , twitter-types-lens >= 0.6 , twitter-conduit if flag(network-uri) build-depends: network-uri >= 2.6 else build-depends: network < 2.6 if flag(lens-aeson) build-depends: lens-aeson >= 1 other-modules: Spec ApiSpec BaseSpec StatusSpec TestUtils default-language: Haskell2010 custom-setup setup-depends: base >= 4.5 && <5, Cabal >= 1.24, cabal-doctest >= 1 && < 1.1 twitter-conduit-0.3.0/.gitignore0000644000000000000000000000035713312637147015051 0ustar0000000000000000# General \#*# .*~ *~ .#* *.swp .DS_Store .gdb_history TAGS # Object files *.a *.o *.so *.hi *.p_hi a.out # autotool autom4te.cache stamp-h1 # misc *.sqlite Main dist/ cabal-dev/ cabal.sandbox.config .cabal-sandbox .stack-work/ stack.yaml twitter-conduit-0.3.0/.travis.yml0000644000000000000000000001025413312637147015167 0ustar0000000000000000# This Travis job script has been generated by a script via # # make_travis_yml_2.hs 'twitter-conduit.cabal' # # For more information, see https://github.com/hvr/multi-ghc-travis # language: c sudo: false git: submodules: false # whether to recursively clone submodules cache: directories: - $HOME/.cabal/packages - $HOME/.cabal/store before_cache: - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log # remove files that are regenerated by 'cabal update' - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.* - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx matrix: include: - compiler: "ghc-7.8.4" # env: TEST=--disable-tests BENCH=--disable-benchmarks addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.8.4], sources: [hvr-ghc]}} - compiler: "ghc-7.10.3" # env: TEST=--disable-tests BENCH=--disable-benchmarks addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.10.3], sources: [hvr-ghc]}} - compiler: "ghc-8.0.2" # env: TEST=--disable-tests BENCH=--disable-benchmarks addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.0.2], sources: [hvr-ghc]}} - compiler: "ghc-8.2.2" # env: TEST=--disable-tests BENCH=--disable-benchmarks addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.2], sources: [hvr-ghc]}} - compiler: "ghc-8.4.3" # env: TEST=--disable-tests BENCH=--disable-benchmarks addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.4.3], sources: [hvr-ghc]}} before_install: - HC=${CC} - HCPKG=${HC/ghc/ghc-pkg} - unset CC - PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$PATH - PKGNAME='twitter-conduit' install: - cabal --version - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" - BENCH=${BENCH---enable-benchmarks} - TEST=${TEST---enable-tests} - HADDOCK=${HADDOCK-true} - INSTALLED=${INSTALLED-true} - travis_retry cabal update -v - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config - rm -fv cabal.project.local - "echo 'packages: .' > cabal.project" - rm -f cabal.project.freeze - cabal new-build -w ${HC} ${TEST} ${BENCH} --dep -j2 all - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --dep -j2 all # Here starts the actual work to be performed for the package under test; # any command which exits with a non-zero exit code causes the build to fail. script: - if [ -f configure.ac ]; then autoreconf -i; fi - rm -rf .ghc.environment.* dist/ - cabal sdist # test that a source-distribution can be generated - cd dist/ - SRCTAR=(${PKGNAME}-*.tar.gz) - SRC_BASENAME="${SRCTAR/%.tar.gz}" - tar -xvf "./$SRC_BASENAME.tar.gz" - cd "$SRC_BASENAME/" ## from here on, CWD is inside the extracted source-tarball - rm -fv cabal.project.local - "echo 'packages: .' > cabal.project" # this builds all libraries and executables (without tests/benchmarks) - rm -f cabal.project.freeze - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all # this builds all libraries and executables (including tests/benchmarks) # - rm -rf ./dist-newstyle # Build with installed constraints for packages in global-db - if $INSTALLED; then ${HCPKG} list --global --simple-output --names-only | sed -r 's/([a-zA-Z0-9-]+*) */--constraint=\1 installed;/g' | sed 's/;$/;all/' | xargs -d ';' cabal new-build -w ${HC} --disable-tests --disable-benchmarks; else echo "Not building with installed constraints"; fi # build & run tests, build benchmarks - cabal new-build -w ${HC} ${TEST} ${BENCH} all - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} all; fi # haddock - rm -rf ./dist-newstyle - if $HADDOCK; then cabal new-haddock -w ${HC} --disable-tests --disable-benchmarks all; else echo "Skipping haddock generation";fi # EOF notifications: slack: secure: HUt3eZH5IBJXlgH1/ob+iMqaQRSloqT3VY0rMLmD7gOMpUFm3a5/XYejqD+hd7EYQRa/Z1YCpmIBe3RYGPt6TnNGvIFdcJFFO7lOs7Ooxp03yB5kAMw9eACv/FNJPd2aIjYdKGbSab4XY4s9wW0GewYv0FHrNFWj81Rhl8C4fGg= twitter-conduit-0.3.0/.travis/check-sdist.sh0000755000000000000000000000100013312637147017171 0ustar0000000000000000#!/bin/bash BASEDIR="$PWD" TARGET="$1" DIST="$(stack path | awk '/^dist-dir/ {print $2}')" stack sdist if [ ! -f ${DIST%/}/${TARGET}-*.tar.gz ]; then echo "NG: missing archive" exit 1 fi cd "$DIST" srctgz=(${TARGET}*.tar.gz) srctgz="${srctgz[0]}" pkgname="${srctgz%.tar.gz}" tar xvzf "${srctgz}" cd "$BASEDIR" NG=$(git ls-tree -r HEAD | while read perm blob hash name; do [ -e "$DIST/$pkgname/$name" ] || echo "$name"; done) if [ -n "$NG" ]; then echo "Missing files:" echo $NG exit 1 fi twitter-conduit-0.3.0/README.md0000644000000000000000000000466013312637147014341 0ustar0000000000000000# twitter-conduit: An Conduit based Twitter API library for Haskell # [![Travis](https://img.shields.io/travis/himura/twitter-conduit/master.svg)](https://travis-ci.org/himura/twitter-conduit) [![Hackage-Deps](https://img.shields.io/hackage-deps/v/twitter-conduit.svg)](http://packdeps.haskellers.com/feed?needle=twitter-conduit) ## About ## This is an conduit based Twitter API library for Haskell, including Streaming API supports. Documentation is available in [hackage](http://hackage.haskell.org/package/twitter-conduit). ## Usage ## $ cabal update $ cabal install twitter-conduit ## Quick Start ## For a runnable example, see [sample/simple.hs](https://github.com/himura/twitter-conduit/blob/master/sample/simple.hs). You can find other various examples in [sample](https://github.com/himura/twitter-conduit/tree/master/sample/) directory. ## Run Samples ## ### Build ### If you would like to use cabal sandbox, prepare sandbox as below: ~~~~ $ cabal sandbox init ~~~~ and then, ~~~~ $ cabal install --only-dependencies -fbuild-samples $ cabal configure -fbuild-samples $ cabal build ~~~~ ### Run ### First, you must obtain consumer key and secret from [Twitter Application Management](https://apps.twitter.com/) page, and you have to set those values to environment variables as shown below: ~~~~ $ export OAUTH_CONSUMER_KEY="YOUR APPLICATION CONSUMER KEY" $ export OAUTH_CONSUMER_SECRET="YOUR APPLICATION CONSUMER SECRET" ~~~~ Before you run examples, you must prepare OAuth access token and secret. You can obtain access token and secret by using either PIN or web callback. If you would like to use the PIN method, you run simply as below, and follow instructions: ~~~~ $ cabal run oauth_pin ~~~~ On the other hand, If you would like to use the callback method, do as follows: ~~~~ $ cabal run oauth_callback ~~~~ and open http://localhost:3000/signIn in your browser. In both cases, you can obtain `OAUTH_ACCESS_TOKEN` and `OAUTH_ACCESS_SECRET` variables, then you should set those values to environment variables as shown below: ~~~~ $ export OAUTH_ACCESS_TOKEN="YOUR ACCESS TOKEN" $ export OAUTH_ACCESS_SECRET="YOUR ACCESS SECRET" ~~~~ Finally, you can access Twitter UserStream as follows: ~~~~ $ cabal run userstream ~~~~ ## Examples ## TODO ## Authors and Credits ## `twitter-conduit` initially was written by Takahiro Himura. We would like to thank everyone who supported and contributed to the development of this library. twitter-conduit-0.3.0/ChangeLog.md0000644000000000000000000000367413312637147015237 0ustar0000000000000000## 0.3.0 * Upgrade http-conduit dependencies to: http-conduit >= 2.0 && < 2.4 [#59](https://github.com/himura/twitter-conduit/pull/59) ## 0.2.2 * Upgrade http-conduit and http-client dependencies to: http-conduit >= 2.1.8 && http-client >= 0.4.30 [#51](https://github.com/himura/twitter-conduit/pull/51) * Added `include_email` parameter to `AccountVerifyCredentials` [#49](https://github.com/himura/twitter-conduit/pull/49) * Added `extAltText` parameter to `showId` [#50](https://github.com/himura/twitter-conduit/pull/50) ## 0.2.1 * Added `fullText` parameter to direct message calls [#47](https://github.com/himura/twitter-conduit/pull/47) * Replaced `SearchStatus` with `Status` type [#46](https://github.com/himura/twitter-conduit/pull/46) * Added `accountUpdateProfile` [#45](https://github.com/himura/twitter-conduit/pull/45) * Added `listsMembersCreateAll` and `listsMembersDestroyAll` * Parameter lenses in `Web.Twitter.Conduit` re-exported from `Web.Twitter.Conduit.Parameters` are deprecated ## 0.2.0 * Changed the signature of functions defined in Web.Twitter.Conduit.Base, because Manager of http-conduit 2.0 and later does not need MonadResource. [#43](https://github.com/himura/twitter-conduit/issues/43) * Removed `TwitterBaseM` * Removed `TW` monad * Re-exported `OAuth (..)` and `Credential (..)` from authenticate-oauth * Re-exported `def` from data-default * Re-exported `Manager`, `newManager` and `tlsManagerSettings` from http-conduit ## 0.1.3 * Make TWToken and TWInfo an instance of Read and Typeable [#42](https://github.com/himura/twitter-conduit/issues/42) ## 0.1.2 * Streaming API: Support multiple filters [#41](https://github.com/himura/twitter-conduit/issues/41) * Include parameters in body for POST requests [#40](https://github.com/himura/twitter-conduit/issues/40) ## 0.1.1.1 * Fix warnings on GHC 7.10 * Fix doctest when twitter-feed package exists ## 0.1.1 * Add `sourceWithSearchResult` and `sourceWithSearchResult'` twitter-conduit-0.3.0/Warning.hs0000644000000000000000000000040013312637147015007 0ustar0000000000000000module Warning {-# WARNING ["You are configuring this package without cabal-doctest installed.", "The doctests test-suite will not work as a result.", "To fix this, install cabal-doctest before configuring."] #-} () where twitter-conduit-0.3.0/sample/LICENSE0000644000000000000000000000246013312637147015344 0ustar0000000000000000Copyright (c)2011-2014, Takahiro Himura All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. twitter-conduit-0.3.0/sample/twitter-conduit-sample.cabal0000644000000000000000000001011513312637147021743 0ustar0000000000000000name: twitter-conduit-sample version: 0.1 license: BSD3 license-file: LICENSE author: Takahiro HIMURA maintainer: Takahiro HIMURA synopsis: Twitter API package with conduit interface and Streaming API support. category: Web, Conduit stability: Experimental cabal-version: >= 1.10 build-type: Simple homepage: https://github.com/himura/twitter-conduit flag network-uri description: Get Network.URI from the network-uri package default: True library ghc-options: -Wall hs-source-dirs: common build-depends: base >= 4.5 && < 5 , bytestring , case-insensitive , conduit , conduit-extra , containers , directory , filepath , http-conduit , lens , process , resourcet , text , transformers , twitter-conduit , twitter-types-lens if flag(network-uri) build-depends: network-uri >= 2.6 else build-depends: network < 2.6 default-language: Haskell2010 exposed-modules: Common executable fav main-is: fav.hs hs-source-dirs: . build-depends: base >= 4.5 && < 5 , lens , twitter-conduit , twitter-conduit-sample default-language: Haskell2010 ghc-options: -Wall executable oauth_callback main-is: oauth_callback.hs hs-source-dirs: . build-depends: base >= 4.5 && < 5 , authenticate-oauth , bytestring , containers , http-types , scotty >= 0.7 , text , transformers , twitter-conduit default-language: Haskell2010 ghc-options: -Wall executable oauth_pin main-is: oauth_pin.hs hs-source-dirs: . build-depends: base >= 4.5 && < 5 , authenticate-oauth , bytestring , text , twitter-conduit default-language: Haskell2010 ghc-options: -Wall executable oslist main-is: oslist.hs hs-source-dirs: . build-depends: base >= 4.5 && < 5 , conduit , containers , twitter-conduit , twitter-conduit-sample default-language: Haskell2010 ghc-options: -Wall executable post main-is: post.hs hs-source-dirs: . build-depends: base >= 4.5 && < 5 , text , twitter-conduit , twitter-conduit-sample default-language: Haskell2010 ghc-options: -Wall executable postWithMedia main-is: postWithMedia.hs hs-source-dirs: . build-depends: base >= 4.5 && < 5 , text , twitter-conduit , twitter-conduit-sample default-language: Haskell2010 ghc-options: -Wall executable postWithMultipleMedia main-is: postWithMultipleMedia.hs hs-source-dirs: . build-depends: base >= 4.5 && < 5 , lens , text , twitter-conduit , twitter-conduit-sample , twitter-types-lens default-language: Haskell2010 ghc-options: -Wall executable search main-is: search.hs hs-source-dirs: . build-depends: base >= 4.5 && < 5 , lens , text , twitter-conduit , twitter-conduit-sample , twitter-types-lens default-language: Haskell2010 ghc-options: -Wall executable searchSource main-is: searchSource.hs hs-source-dirs: . build-depends: base >= 4.5 && < 5 , conduit , lens , text , twitter-conduit , twitter-conduit-sample , twitter-types-lens default-language: Haskell2010 ghc-options: -Wall executable simple main-is: simple.hs hs-source-dirs: . build-depends: base >= 4.5 && < 5 , authenticate-oauth , bytestring , conduit , lens , resourcet , text , twitter-conduit , twitter-types-lens default-language: Haskell2010 ghc-options: -Wall executable userstream main-is: userstream.hs hs-source-dirs: . build-depends: base >= 4.5 && < 5 , conduit , conduit-extra , directory , filepath , http-conduit , lens , process , resourcet , text , transformers , twitter-conduit , twitter-conduit-sample , twitter-types-lens default-language: Haskell2010 ghc-options: -Wall twitter-conduit-0.3.0/sample/post.hs0000644000000000000000000000075613312637147015666 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Main where import Web.Twitter.Conduit hiding (map) import Common import Control.Applicative import Data.Monoid import qualified Data.Text as T import qualified Data.Text.IO as T import System.Environment main :: IO () main = do status <- T.concat . map T.pack <$> getArgs T.putStrLn $ "Post message: " <> status twInfo <- getTWInfoFromEnv mgr <- newManager tlsManagerSettings res <- call twInfo mgr $ update status print res twitter-conduit-0.3.0/sample/oauth_callback.hs0000644000000000000000000000660713312637147017636 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- Example: -- $ export OAUTH_CONSUMER_KEY="your consumer key" -- $ export OAUTH_CONSUMER_SECRET="your consumer secret" -- $ runhaskell oauth_callback.hs module Main where import Web.Scotty import qualified Network.HTTP.Types as HT import Web.Twitter.Conduit hiding (lookup,url) import qualified Web.Authenticate.OAuth as OA import qualified Data.Text.Lazy as LT import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 import qualified Data.Map as M import Data.Maybe import Data.Monoid import Data.IORef import Control.Monad.IO.Class import System.Environment import System.IO.Unsafe callback :: String callback = "http://localhost:3000/callback" getTokens :: IO OAuth getTokens = do consumerKey <- getEnv "OAUTH_CONSUMER_KEY" consumerSecret <- getEnv "OAUTH_CONSUMER_SECRET" return $ twitterOAuth { oauthConsumerKey = S8.pack consumerKey , oauthConsumerSecret = S8.pack consumerSecret , oauthCallback = Just $ S8.pack callback } type OAuthToken = S.ByteString usersToken :: IORef (M.Map OAuthToken Credential) usersToken = unsafePerformIO $ newIORef M.empty takeCredential :: OAuthToken -> IORef (M.Map OAuthToken Credential) -> IO (Maybe Credential) takeCredential k ioref = atomicModifyIORef ioref $ \m -> let (res, newm) = M.updateLookupWithKey (\_ _ -> Nothing) k m in (newm, res) storeCredential :: OAuthToken -> Credential -> IORef (M.Map OAuthToken Credential) -> IO () storeCredential k cred ioref = atomicModifyIORef ioref $ \m -> (M.insert k cred m, ()) main :: IO () main = do tokens <- getTokens mgr <- newManager tlsManagerSettings putStrLn $ "browse URL: http://localhost:3000/signIn" scotty 3000 $ app tokens mgr makeMessage :: OAuth -> Credential -> S.ByteString makeMessage tokens (Credential cred) = S8.intercalate "\n" [ "export OAUTH_CONSUMER_KEY=\"" <> oauthConsumerKey tokens <> "\"" , "export OAUTH_CONSUMER_SECRET=\"" <> oauthConsumerSecret tokens <> "\"" , "export OAUTH_ACCESS_TOKEN=\"" <> fromMaybe "" (lookup "oauth_token" cred) <> "\"" , "export OAUTH_ACCESS_SECRET=\"" <> fromMaybe "" (lookup "oauth_token_secret" cred) <> "\"" ] app :: OAuth -> Manager -> ScottyM () app tokens mgr = do get "/callback" $ do temporaryToken <- param "oauth_token" oauthVerifier <- param "oauth_verifier" mcred <- liftIO $ takeCredential temporaryToken usersToken case mcred of Just cred -> do accessTokens <- OA.getAccessToken tokens (OA.insert "oauth_verifier" oauthVerifier cred) mgr liftIO $ print accessTokens let message = makeMessage tokens accessTokens liftIO . S8.putStrLn $ message text . LT.pack . S8.unpack $ message Nothing -> do status HT.status404 text "temporary token is not found" get "/signIn" $ do cred <- OA.getTemporaryCredential tokens mgr case lookup "oauth_token" $ unCredential cred of Just temporaryToken -> do liftIO $ storeCredential temporaryToken cred usersToken let url = OA.authorizeUrl tokens cred redirect $ LT.pack url Nothing -> do status HT.status500 text "Failed to obtain the temporary token." twitter-conduit-0.3.0/sample/search.hs0000644000000000000000000000121113312637147016131 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Main where import Web.Twitter.Conduit import Web.Twitter.Types.Lens import Common import Control.Lens import qualified Data.Text as T import System.Environment main :: IO () main = do [keyword] <- getArgs twInfo <- getTWInfoFromEnv mgr <- newManager tlsManagerSettings res <- call twInfo mgr $ search $ T.pack keyword let metadata = res ^. searchResultSearchMetadata putStrLn $ "search completed in: " ++ metadata ^. searchMetadataCompletedIn . to show putStrLn $ "search result max id: " ++ metadata ^. searchMetadataMaxId . to show print $ res ^. searchResultStatuses twitter-conduit-0.3.0/sample/postWithMedia.hs0000644000000000000000000000065313312637147017456 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Main where import Web.Twitter.Conduit import Common import qualified Data.Text as T import System.Environment main :: IO () main = do [status, filepath] <- getArgs putStrLn $ "Post message: " ++ status twInfo <- getTWInfoFromEnv mgr <- newManager tlsManagerSettings res <- call twInfo mgr $ updateWithMedia (T.pack status) (MediaFromFile filepath) print res twitter-conduit-0.3.0/sample/Setup.hs0000644000000000000000000000005613312637147015772 0ustar0000000000000000import Distribution.Simple main = defaultMain twitter-conduit-0.3.0/sample/simple.hs0000644000000000000000000000367513312637147016175 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-} module Main where import Web.Twitter.Conduit import qualified Web.Twitter.Conduit.Parameters as P import Web.Twitter.Types.Lens import Control.Lens import qualified Data.ByteString.Char8 as B8 import qualified Data.Conduit as C import qualified Data.Conduit.List as CL import qualified Data.Text as T import qualified Data.Text.IO as T import System.IO (hFlush, stdout) import qualified Web.Authenticate.OAuth as OA tokens :: OAuth tokens = twitterOAuth { oauthConsumerKey = error "You MUST specify oauthConsumerKey parameter." , oauthConsumerSecret = error "You MUST specify oauthConsumerSecret parameter." } authorize :: OAuth -- ^ OAuth Consumer key and secret -> (String -> IO String) -- ^ PIN prompt -> Manager -> IO Credential authorize oauth getPIN mgr = do cred <- OA.getTemporaryCredential oauth mgr let url = OA.authorizeUrl oauth cred pin <- getPIN url OA.getAccessToken oauth (OA.insert "oauth_verifier" (B8.pack pin) cred) mgr getTWInfo :: Manager -> IO TWInfo getTWInfo mgr = do cred <- authorize tokens getPIN mgr return $ setCredential tokens cred def where getPIN url = do putStrLn $ "browse URL: " ++ url putStr "> what was the PIN twitter provided you with? " hFlush stdout getLine main :: IO () main = do mgr <- newManager tlsManagerSettings twInfo <- getTWInfo mgr putStrLn $ "# your home timeline (up to 800 tweets):" sourceWithMaxId twInfo mgr (homeTimeline & P.count ?~ 200) C.$= CL.isolate 800 C.$$ CL.mapM_ $ \status -> do T.putStrLn $ T.concat [ T.pack . show $ status ^. statusId , ": " , status ^. statusUser . userScreenName , ": " , status ^. statusText ] twitter-conduit-0.3.0/sample/oauth_pin.hs0000644000000000000000000000344413312637147016664 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-} -- Example: -- $ export OAUTH_CONSUMER_KEY="your consumer key" -- $ export OAUTH_CONSUMER_SECRET="your consumer secret" -- $ runhaskell oauth_pin.hs module Main where import Web.Twitter.Conduit hiding (lookup,url) import Web.Authenticate.OAuth as OA import qualified Data.ByteString.Char8 as S8 import Data.Maybe import Data.Monoid import System.Environment import System.IO (hFlush, stdout) getTokens :: IO OAuth getTokens = do consumerKey <- getEnv "OAUTH_CONSUMER_KEY" consumerSecret <- getEnv "OAUTH_CONSUMER_SECRET" return $ twitterOAuth { oauthConsumerKey = S8.pack consumerKey , oauthConsumerSecret = S8.pack consumerSecret , oauthCallback = Just "oob" } authorize :: OAuth -- ^ OAuth Consumer key and secret -> Manager -> IO Credential authorize oauth mgr = do cred <- OA.getTemporaryCredential oauth mgr let url = OA.authorizeUrl oauth cred pin <- getPIN url OA.getAccessToken oauth (OA.insert "oauth_verifier" pin cred) mgr where getPIN url = do putStrLn $ "browse URL: " ++ url putStr "> what was the PIN twitter provided you with? " hFlush stdout S8.getLine main :: IO () main = do tokens <- getTokens mgr <- newManager tlsManagerSettings Credential cred <- authorize tokens mgr print cred S8.putStrLn . S8.intercalate "\n" $ [ "export OAUTH_CONSUMER_KEY=\"" <> oauthConsumerKey tokens <> "\"" , "export OAUTH_CONSUMER_SECRET=\"" <> oauthConsumerSecret tokens <> "\"" , "export OAUTH_ACCESS_TOKEN=\"" <> fromMaybe "" (lookup "oauth_token" cred) <> "\"" , "export OAUTH_ACCESS_SECRET=\"" <> fromMaybe "" (lookup "oauth_token_secret" cred) <> "\"" ] twitter-conduit-0.3.0/sample/oslist.hs0000644000000000000000000000146213312637147016211 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Main where import Web.Twitter.Conduit hiding (map) import Common import qualified Data.Conduit as C import qualified Data.Conduit.List as CL import qualified Data.Map as M import System.Environment main :: IO () main = do [screenName] <- getArgs twInfo <- getTWInfoFromEnv mgr <- newManager tlsManagerSettings let sn = ScreenNameParam screenName folids <- sourceWithCursor twInfo mgr (followersIds sn) C.$$ CL.consume friids <- sourceWithCursor twInfo mgr (friendsIds sn) C.$$ CL.consume let folmap = M.fromList $ map (flip (,) True) folids os = filter (\uid -> M.notMember uid folmap) friids bo = filter (\usr -> M.member usr folmap) friids putStrLn "one sided:" print os putStrLn "both following:" print bo twitter-conduit-0.3.0/sample/fav.hs0000644000000000000000000000073213312637147015447 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Main where import Web.Twitter.Conduit import Common import Control.Lens import System.Environment main :: IO () main = do [statusIdStr] <- getArgs twInfo <- getTWInfoFromEnv mgr <- newManager tlsManagerSettings let sId = read statusIdStr targetStatus <- call twInfo mgr $ showId sId putStrLn $ "Favorite Tweet: " ++ targetStatus ^. to show res <- call twInfo mgr $ favoritesCreate sId print res twitter-conduit-0.3.0/sample/searchSource.hs0000644000000000000000000000140613312637147017320 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Main where import Web.Twitter.Conduit import Web.Twitter.Types.Lens import Common import Control.Lens import Data.Conduit import qualified Data.Conduit.List as CL import qualified Data.Text as T import System.Environment main :: IO () main = do [num, keyword] <- getArgs twInfo <- getTWInfoFromEnv mgr <- newManager tlsManagerSettings res <- sourceWithSearchResult twInfo mgr $ searchTweets $ T.pack keyword let metadata = res ^. searchResultSearchMetadata putStrLn $ "search completed in: " ++ metadata ^. searchMetadataCompletedIn . to show putStrLn $ "search result max id: " ++ metadata ^. searchMetadataMaxId . to show res ^. searchResultStatuses $$ CL.isolate (read num) =$ CL.mapM_ print twitter-conduit-0.3.0/sample/userstream.hs0000644000000000000000000000652213312637147017070 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternGuards #-} import Web.Twitter.Conduit import Web.Twitter.Types.Lens import Common import Control.Applicative import Control.Lens import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.Resource import Data.Conduit import qualified Data.Conduit as C import qualified Data.Conduit.Binary as CB import qualified Data.Conduit.List as CL import qualified Data.Text as T import qualified Data.Text.IO as T import Network.HTTP.Conduit as HTTP import System.Directory import System.FilePath import System.Process ensureDirectoryExist :: FilePath -> IO FilePath ensureDirectoryExist dir = do createDirectoryIfMissing True dir return dir confdir :: IO FilePath confdir = fmap ( ".twitter-conduit") getHomeDirectory >>= ensureDirectoryExist iconPath :: IO FilePath iconPath = ( "icons") <$> confdir >>= ensureDirectoryExist main :: IO () main = do twInfo <- getTWInfoFromEnv mgr <- newManager tlsManagerSettings runResourceT $ do src <- stream twInfo mgr userstream #if MIN_VERSION_http_conduit(2,3,0) C.runConduit $ src C..| CL.mapM_ (liftIO . printTL) #else src C.$$+- CL.mapM_ (liftIO . printTL) #endif showStatus :: AsStatus s => s -> T.Text showStatus s = T.concat [ s ^. user . userScreenName , ":" , s ^. text ] printTL :: StreamingAPI -> IO () printTL (SStatus s) = T.putStrLn . showStatus $ s printTL (SRetweetedStatus s) = T.putStrLn $ T.concat [ s ^. user . userScreenName , ": RT @" , showStatus (s ^. rsRetweetedStatus) ] printTL (SEvent event) | (event^.evEvent) == "favorite" || (event^.evEvent) == "unfavorite", Just (ETStatus st) <- event ^. evTargetObject = do let (fromUser, fromIcon) = evUserInfo (event^.evSource) (toUser, _toIcon) = evUserInfo (event^.evTarget) evUserInfo (ETUser u) = (u ^. userScreenName, u ^. userProfileImageURL) evUserInfo _ = ("", Nothing) header = T.concat [ event ^. evEvent, "[", fromUser, " -> ", toUser, "]"] T.putStrLn $ T.concat [ header, " :: ", showStatus st ] icon <- case fromIcon of Just iconUrl -> Just <$> fetchIcon (T.unpack fromUser) (T.unpack iconUrl) Nothing -> return Nothing notifySend header (showStatus st) icon printTL s = print s notifySend :: T.Text -> T.Text -> Maybe FilePath -> IO () notifySend header content icon = do let ic = maybe [] (\i -> ["-i", i]) icon void $ rawSystem "notify-send" $ [T.unpack header, T.unpack content] ++ ic fetchIcon :: String -- ^ screen name -> String -- ^ icon url -> IO String fetchIcon sn url = do ipath <- iconPath let fname = ipath sn ++ "__" ++ takeFileName url exists <- doesFileExist fname unless exists $ do req <- parseUrl url mgr <- newManager tlsManagerSettings runResourceT $ do body <- http req mgr #if MIN_VERSION_http_conduit(2,3,0) C.runConduit $ HTTP.responseBody body C..| CB.sinkFile fname #else HTTP.responseBody body $$+- CB.sinkFile fname #endif return fname twitter-conduit-0.3.0/sample/postWithMultipleMedia.hs0000644000000000000000000000220113312637147021161 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Main where import Web.Twitter.Conduit import qualified Web.Twitter.Conduit.Parameters as P import Web.Twitter.Types.Lens import Common import Control.Lens import Control.Monad import qualified Data.Text as T import System.Environment import System.Exit (exitFailure) import System.IO main :: IO () main = do (status:filepathList) <- getArgs when (length filepathList > 4) $ do hPutStrLn stderr $ "You can upload upto 4 images in a single tweet, but we got " ++ show (length filepathList) ++ " images. abort." exitFailure twInfo <- getTWInfoFromEnv mgr <- newManager tlsManagerSettings uploadedMediaList <- forM filepathList $ \filepath -> do putStrLn $ "Upload media: " ++ filepath ret <- call twInfo mgr $ mediaUpload (MediaFromFile filepath) putStrLn $ "Upload completed: media_id: " ++ ret ^. uploadedMediaId . to show ++ ", filepath: " ++ filepath return ret putStrLn $ "Post message: " ++ status res <- call twInfo mgr $ update (T.pack status) & P.mediaIds ?~ (uploadedMediaList ^.. traversed . uploadedMediaId) print res twitter-conduit-0.3.0/sample/common/Common.hs0000644000000000000000000000326313312637147017415 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} module Common where import Web.Twitter.Conduit import Control.Applicative import Control.Lens import qualified Data.ByteString.Char8 as S8 import qualified Data.CaseInsensitive as CI import qualified Data.Map as M import Network.HTTP.Conduit import qualified Network.URI as URI import System.Environment getOAuthTokens :: IO (OAuth, Credential) getOAuthTokens = do consumerKey <- getEnv' "OAUTH_CONSUMER_KEY" consumerSecret <- getEnv' "OAUTH_CONSUMER_SECRET" accessToken <- getEnv' "OAUTH_ACCESS_TOKEN" accessSecret <- getEnv' "OAUTH_ACCESS_SECRET" let oauth = twitterOAuth { oauthConsumerKey = consumerKey , oauthConsumerSecret = consumerSecret } cred = Credential [ ("oauth_token", accessToken) , ("oauth_token_secret", accessSecret) ] return (oauth, cred) where getEnv' = (S8.pack <$>) . getEnv getProxyEnv :: IO (Maybe Proxy) getProxyEnv = do env <- M.fromList . over (mapped . _1) CI.mk <$> getEnvironment let u = M.lookup "https_proxy" env <|> M.lookup "http_proxy" env <|> M.lookup "proxy" env >>= URI.parseURI >>= URI.uriAuthority return $ Proxy <$> (S8.pack . URI.uriRegName <$> u) <*> (parsePort . URI.uriPort <$> u) where parsePort :: String -> Int parsePort [] = 8080 parsePort (':':xs) = read xs parsePort xs = error $ "port number parse failed " ++ xs getTWInfoFromEnv :: IO TWInfo getTWInfoFromEnv = do pr <- getProxyEnv (oa, cred) <- getOAuthTokens return $ (setCredential oa cred def) { twProxy = pr }