diff --git a/.gitignore b/.gitignore --- a/.gitignore +++ b/.gitignore @@ -7,12 +7,16 @@ .DS_Store .gdb_history TAGS -# Object files +# Object files, etc *.a *.o *.so *.hi *.p_hi +*.chi +*.chs.h +*.tix +.hpc a.out # autotool autom4te.cache @@ -22,5 +26,8 @@ Main dist/ cabal-dev/ +.cabal-sandbox/ cabal.sandbox.config -.cabal-sandbox +dist-newstyle/ +.ghc.environment.* +.stack-work diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 --- a/.travis.yml +++ /dev/null @@ -1,64 +0,0 @@ -language: haskell - -env: - global: - # OAUTH_CONSUMER_KEY - - secure: "U3hh6wJf87tdZmwLtPyMQ0ci39ouKvTm/JCi0CCz2jaPvWZR+4Tt7aYV5WYqzjSmgfBOqKpXTpwFBcvvWRty8rI1b8OtrlljC1zUcgf/hsz3hfPtv+GKW/ldYnqg7znyeAdxWEF1a4JszKgOJaGMdX7zSpFewgwEq7T4jAlebLA=" - # OAUTH_CONSUMER_SECRET - - secure: "I4BGd16zNQE3WjnwgdT7OM5sIIMtT9DMFPNdnWJPcgYndDovnFAUDoTomaGo0Wue4h64vGWl26f2Nm04i2upJXxkzFFtU5Az6cwUjzkOve1yqrkkyPFTXC8MLQYX3Zz8scQ8h1IJCn0Luu5HsHsool6IFZpiUovLZbDXmY44yH4=" - # OAUTH_ACCESS_TOKEN - - secure: "dW2pYRplxJ7HmJEo3lMgLlzfdOylBvWiV4PJt1j4GMDPJBOu3RM0h3zNkkxDoS9D0wWRkBEH0iN2Bh08v2z7sJtF3f/kgLvPlOy5mNSYcozwMdHJRlJEcXaGULHbZ4p79lVIOdTAhY2WU2QdP7PEv0BiqqVcysnfK0TGkTa+KEc=" - # OAUTH_ACCESS_SECRET - - secure: "I5hzi7sONDn8KJAhmkroHsGNJ2zUxYq2iGamTV9lgMUDH0bwpMx+guzfZr+fGesdlUphM0t+ZCh9YH8BoVJsjZ/db9u/lotg78DKp1QwhrWnISqWj6TIfXrSLPkBwY+xFtxl6Ihsjyl+ileiK5sb0C9mC+zXidgBqEM73miAokY=" - matrix: - - GHCVER=7.4.2 - - GHCVER=7.6.3 - - GHCVER=7.8.3 USE_COVERALLS=1 CABAL_FLAGS="-frun-integrated-test" - - GHCVER=head - -matrix: - allow_failures: - - env: GHCVER=7.4.2 - - env: GHCVER=head - -before_install: - - | - if [ $GHCVER = `ghc --numeric-version` ]; then - echo "use system ghc: `which ghc` `ghc --numeric-version`" - else - travis_retry sudo add-apt-repository -y ppa:hvr/ghc - travis_retry sudo apt-get update - travis_retry sudo apt-get install -y --force-yes cabal-install-1.18 ghc-$GHCVER - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/1.18/bin:$PATH - echo "use ppa:hvr/ghc: `which ghc` `ghc --numeric-version`" - fi - -install: - - export PATH=$HOME/.cabal/bin:$PATH - - which cabal - - travis_retry cabal update - # GHC 7.8.3 exports transformers-0.3.0, but happy and our package installs transformers 0.4 series. - # However, doctest fails when we have multiple version of transformers. - # To prevent this, we restrict transformers version to (< 0.4) - - cabal install happy --constraint="transformers < 0.4" - - cabal install --only-dependencies --enable-tests - - "[ -n \"$USE_COVERALLS\" ] && travis_retry cabal install hpc-coveralls || true" - - ghc-pkg list - -script: - - | - if [ -n "$USE_COVERALLS" ]; then - cabal configure --enable-tests --enable-library-coverage $CABAL_FLAGS - else - cabal configure --enable-tests $CABAL_FLAGS - fi - - cabal build - - | - if [ -n "$USE_COVERALLS" ]; then - run-cabal-test --show-details=always - else - cabal test --show-details=always - fi - -after_script: - - "[ -n \"$USE_COVERALLS\" ] && hpc-coveralls --exclude-dir=tests spec_main || true" diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,98 @@ +## 0.6.1 + +* Export TweetMode (Extended) [#92](https://github.com/himura/twitter-conduit/pull/92) + +## 0.6.0 + +* Support extended tweets [#83](https://github.com/himura/twitter-conduit/pull/83) +* Remove deprecated module `Web.Twitter.Conduit.ParametersDeprecated` [#81](https://github.com/himura/twitter-conduit/pull/81) + +## 0.5.1 + +* Add result_type to searchTweets [#78](https://github.com/himura/twitter-conduit/pull/78). + +## 0.5.0 + +* Support for OverloadedLabels + + `twitter-conduit` now supports the OverloadedLabels extensions for overloaded parameters in `APIRequest` (e.g.: `#count`, `#max_id`). + + We can now write: + + ```haskell + homeTimeline & #count ?~ 200 + ``` + + instead of: + + ```haskell + import qualified Web.Twitter.Conduit.Parameters as P + + homeTimeline & P.count ?~ 200 + ``` + + NOTE: See `Web.Twitter.Conduit.ParametersDeprecated` module if you would like to use classic value lenses. + +* Drop supports conduit < 1.3 and http-conduit < 2.3 [#69](https://github.com/himura/twitter-conduit/pull/69). +* `Web.Twitter.Conduit.Status` is no longer re-exported by Web.Twitter.Conduit in order to avoid name conflictions (e.g. `update`, `lookup`) [#71](https://github.com/himura/twitter-conduit/pull/71). +* Add alias for functions in `Web.Twitter.Conduit.Status` with statuses- prefix [#71](https://github.com/himura/twitter-conduit/pull/71). + (e.g. `Web.Twitter.Conduit.Api.statusesHomeTimeline` for `Web.Twitter.Conduit.Status.homeTimeline`) +* Drop supports network < 2.6 [#74](https://github.com/himura/twitter-conduit/pull/74). +* Support `tweet_mode` parameter [#72](https://github.com/himura/twitter-conduit/pull/72). + +## 0.4.0 + +* Follow direct message API changes [#65](https://github.com/himura/twitter-conduit/pull/65) [#62](https://github.com/himura/twitter-conduit/pull/62) +* Changed WithCursor type [5b9e9d7a](https://github.com/himura/twitter-conduit/commit/5b9e9d7a13d33327fe637cae8e2359a38fce92b5) + * Added type parameter to WithCursor to supports `Text` as the next cursor type. + * Changed {previous,next}Cursor in WithCursor to be optional +* Changed APIRequest type to take HTTP Method [f25fd9b3](https://github.com/himura/twitter-conduit/commit/f25fd9b3b860032f384d01b3457ea896e596366b) + +## 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'` diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,6 +1,8 @@ # twitter-conduit: An Conduit based Twitter API library for Haskell # -[![Build Status](https://travis-ci.org/himura/twitter-conduit.png?branch=master)](https://travis-ci.org/himura/twitter-conduit) +![CI](https://github.com/himura/twitter-conduit/workflows/CI/badge.svg) +[![Hackage](https://img.shields.io/hackage/v/twitter-conduit.svg?style=flat)](https://hackage.haskell.org/package/twitter-conduit) +[![Hackage-Deps](https://img.shields.io/hackage-deps/v/twitter-conduit.svg)](http://packdeps.haskellers.com/feed?needle=twitter-conduit) ## About ## @@ -8,11 +10,6 @@ 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). @@ -22,19 +19,33 @@ ### Build ### -If you would like to use cabal sandbox, prepare sandbox as below: +#### Building with Cabal #### ~~~~ -$ cabal sandbox init +$ cabal v2-build all ~~~~ -and then, +#### Building with Stack #### -~~~~ -$ cabal configure -fbuild-samples -$ cabal build -~~~~ +To build with Stack, you should create top-level `stack.yaml` file first. +An example of `stack.yaml` is like below: +```.yaml +resolver: lts-18.12 +packages: +- . +- sample +extra-deps: +- twitter-types-0.11.0 +- twitter-types-lens-0.11.0 +``` + +then, run stack. + +``` +$ stack build +``` + ### Run ### First, you must obtain consumer key and secret from [Twitter Application Management](https://apps.twitter.com/) page, @@ -62,7 +73,7 @@ and open http://localhost:3000/signIn in your browser. -In both cases, you can obtain OAUTH_ACCESSS_TOKEN and OAUTH_ACCESS_SECRET variables, +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: ~~~~ diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,3 +1,26 @@ -#!/usr/bin/env runhaskell +{-# 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 diff --git a/Warning.hs b/Warning.hs new file mode 100644 --- /dev/null +++ b/Warning.hs @@ -0,0 +1,8 @@ +module 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 diff --git a/Web/Twitter/Conduit.hs b/Web/Twitter/Conduit.hs --- a/Web/Twitter/Conduit.hs +++ b/Web/Twitter/Conduit.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} -- | @@ -10,56 +9,81 @@ -- Portability: portable -- -- A client library for Twitter APIs (see ). +module Web.Twitter.Conduit ( + -- * How to use this library + -- $howto -module Web.Twitter.Conduit - ( - -- * How to use this library - -- $howto + -- ** Authentication + -- $auth - -- * Re-exports - module Web.Twitter.Conduit.Base - , module Web.Twitter.Conduit.Api - , module Web.Twitter.Conduit.Status - , module Web.Twitter.Conduit.Monad - , module Web.Twitter.Conduit.Stream - , module Web.Twitter.Conduit.Request - , module Web.Twitter.Conduit.Parameters + -- ** How to call API + -- $call - , MediaData (..) -#if !MIN_VERSION_twitter_types(0,5,0) - , UploadedMedia - , mediaId - , mediaSize - , mediaImage - , ImageSizeType - , imageWidth - , imageHeight - , imageType -#endif - ) where + -- *** How to specify API parameters + -- $parameter -import Web.Twitter.Conduit.Types -import Web.Twitter.Conduit.Base + -- *** Conduit API: Recursive API call with changing cursor parameter + -- $conduit + + -- * 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.Stream, + module Web.Twitter.Conduit.Types, + + -- * 'Web.Twitter.Conduit.Base' + call, + call', + callWithResponse, + callWithResponse', + sourceWithMaxId, + sourceWithMaxId', + sourceWithCursor, + sourceWithCursor', + sourceWithSearchResult, + sourceWithSearchResult', + + -- * 'Web.Twitter.Conduit.Parameters' + ListParam (..), + MediaData (..), + UserListParam (..), + UserParam (..), + TweetMode (..), + + -- * re-exports + OAuth (..), + Credential (..), + def, + Manager, + newManager, + tlsManagerSettings, +) where + import Web.Twitter.Conduit.Api -import Web.Twitter.Conduit.Status -import Web.Twitter.Conduit.Monad -import Web.Twitter.Conduit.Stream -import Web.Twitter.Conduit.Request +import Web.Twitter.Conduit.Base +import Web.Twitter.Conduit.Cursor import Web.Twitter.Conduit.Parameters +import Web.Twitter.Conduit.Request +import Web.Twitter.Conduit.Response +import Web.Twitter.Conduit.Stream +import Web.Twitter.Conduit.Types --- for haddock +import Data.Default (def) +import Network.HTTP.Conduit (Manager, newManager, tlsManagerSettings) import Web.Authenticate.OAuth + +-- for haddock + +import Control.Lens +import Control.Monad.IO.Class 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.Logger -import Control.Monad.IO.Class -import Control.Lens -#ifdef HLINT {-# ANN module "HLint: ignore Use import/export shortcut" #-} -#endif -- $howto -- @@ -69,18 +93,22 @@ -- and . -- All of following examples import modules as below: -- --- > {-# LANGUAGE OverloadedStrings #-} --- > --- > import Web.Twitter.Conduit --- > import Web.Authenticate.OAuth --- > 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.Logger --- > import Control.Monad.IO.Class --- > import Control.Lens +-- @ +-- {\-# LANGUAGE OverloadedLabels #-\} +-- {\-# 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 +-- @ + +-- $auth +-- -- First, you should obtain consumer token and secret from , -- and prepare 'OAuth' variables as follows: -- @@ -122,17 +150,19 @@ -- -- Or, simply as follows: -- --- > twInfo = setCredential tokens credential def --- --- Every twitter API functions are run in the 'TW' monad. --- By using 'runTW' function, you can perform computation in 'TW' monad. +-- @ +-- twInfo = 'setCredential' tokens credential 'def' +-- @ + +-- $call -- -- Twitter API requests are performed by 'call' function. -- For example, -- could be obtained by: -- -- @ --- timeline <- 'call' 'homeTimeline' +-- mgr \<- 'newManager' 'tlsManagerSettings' +-- timeline \<- 'call' twInfo mgr 'statusesHomeTimeline' -- @ -- -- The response of 'call' function is wrapped by the suitable type of @@ -145,9 +175,48 @@ -- includes 20 tweets, and you can change the number of tweets by the /count/ parameter. -- -- @ --- timeline <- 'call' '$' 'homeTimeline' '&' 'count' '?~' 200 +-- timeline \<- 'call' twInfo mgr '$' 'statusesHomeTimeline' '&' #count '?~' 200 -- @ + +-- $parameter -- +-- The parameters which can be specified for this API, is able to be obtained from type parameters of APIRequest. +-- For example, +-- +-- @ +-- 'statusesHomeTimeline' :: +-- 'APIRequest' 'StatusesHomeTimeline' ['Web.Twitter.Types.Status'] +-- @ +-- +-- - The 2nd type parameter of 'APIRequest' represents acceptable parameters in this API request. +-- - The 3nd type parameter of 'APIRequest' denotes a return type of this API request. +-- +-- The 2nd type parameter of 'statusesHomeTimeline' is 'StatusesHomeTimeline' defined as below: +-- +-- @ +-- type StatusesHomeTimeline = +-- '[ "count" ':= Integer +-- , "since_id" ':= Integer +-- , "max_id" ':= Integer +-- , "trim_user" ':= Bool +-- , "exclude_replies" ':= Bool +-- , "contributor_details" ':= Bool +-- , "include_entities" ':= Bool +-- , "tweet_mode" ':= TweetMode +-- ] +-- @ +-- +-- Each element of list represents the name and type of API parameters. +-- You can specify those parameter with OverloadedLabels extension. +-- In the above example, it shows that 'statusesHomeTimeline' API supports "tweet_mode" parameter with 'TweetMode' type, so +-- you can specify "tweet_mode" parameter as: +-- +-- @ +-- 'statusesHomeTimeline' & #tweet_mode ?~ 'Extended' +-- @ + +-- $conduit +-- -- 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, @@ -155,23 +224,31 @@ -- or use the conduit wrapper 'sourceWithCursor' as below: -- -- @ --- friends <- 'sourceWithCursor' ('friendsList' ('ScreenNameParam' \"thimura\") '&' 'count' '?~' 200) '$$' 'CL.consume' +-- friends \<- +-- 'runConduit' $ +-- 'sourceWithMaxId' 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: +-- For example, you can print 60 tweets from your home timeline, as below: -- -- @ -- main :: IO () --- main = runNoLoggingT . runTW twInfo $ do --- 'sourceWithMaxId' 'homeTimeline' --- $= CL.isolate 60 --- $$ CL.mapM_ $ \status -> liftIO $ do --- T.putStrLn $ T.concat [ T.pack . show $ status ^. statusId --- , \": \" --- , status ^. statusUser . userScreenName --- , \": \" --- , status ^. statusText --- ] +-- main = do +-- mgr \<- 'newManager' 'tlsManagerSettings' +-- 'runConduit' $ 'sourceWithMaxId' twInfo mgr 'homeTimeline' +-- '.|' CL.isolate 60 +-- '.|' CL.mapM_ +-- (\\status -> do +-- T.putStrLn $ +-- T.concat +-- [ T.pack . show $ status ^. statusId +-- , \": \" +-- , status ^. statusUser . userScreenName +-- , \": \" +-- , status ^. statusText +-- ] +-- ) -- @ diff --git a/Web/Twitter/Conduit/Api.hs b/Web/Twitter/Conduit/Api.hs --- a/Web/Twitter/Conduit/Api.hs +++ b/Web/Twitter/Conduit/Api.hs @@ -1,649 +1,1297 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE EmptyDataDecls #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 704 -{-# LANGUAGE ConstraintKinds #-} -#endif - -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 - -- , 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 - -- , listsMembersDestroy - -- , listsMemberships - -- , listsSubscribers - -- , listsSubscribersCreate - -- , listsSubscribersShow - -- , listsSubscribersDestroy - -- , listsSubscribersCreateAll - -- , listsMembersShow - , ListsMembers - , listsMembers - -- , listsMembersCreate - -- , listsDestroy - -- , listsUpdate - -- , listsCreate - -- , listsShow - -- , listsSubscriptions - -- , listsMembersDestroyAll - -- , 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.Types -import Web.Twitter.Conduit.Parameters -import Web.Twitter.Conduit.Parameters.TH -import Web.Twitter.Conduit.Base -import Web.Twitter.Conduit.Request - -import Network.HTTP.Client.MultipartFormData -import qualified Data.Text as T -import qualified Data.Text.Encoding 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\") --- 'liftIO' . '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 [SearchStatus]) -searchTweets q = APIRequestGet (endpoint ++ "search/tweets.json") [("q", T.encodeUtf8 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 [SearchStatus]) -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' '$' '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" - ] - -data DirectMessagesSent --- | Returns query data which asks recent direct messages sent by the authenticating user. --- --- You can perform a query using 'call': --- --- @ --- res <- 'call' '$' '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" - ] - -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' '$' '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", showBS sId)] - -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' '$' '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", showBS 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' '$' '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", T.encodeUtf8 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' '$' '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' '$' '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' '$' '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' '$' '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' '$' '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' '$' '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 follows the user specified in the ID parameter. --- --- You can perform request by using 'call': --- --- @ --- res <- 'call' '$' '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' '$' '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' '$' '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' '$' '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" - ] - -data UsersLookup --- | Returns query data asks user objects. --- --- You can perform request by using 'call': --- --- @ --- res <- 'call' '$' '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' '$' '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' '$' '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' '$' '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", showBS 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' '$' '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", showBS sid)] -deriveHasParamInstances ''FavoritesDestroy - [ "include_entities" - ] - -data ListsMembers --- | Returns query data asks the members of the specified list. --- --- You can perform request by using 'call': --- --- @ --- res <- 'call' '$' '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 - [ "cursor" - , "skip_status" - ] - -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' '$' 'mediaUpload' ('MediaFromFile' \"\/path\/to\/upload\/file1.png\") --- res2 <- 'call' '$' 'mediaUpload' ('MediaRequestBody' \"file2.png\" \"[.. file body ..]\") --- @ --- --- and then collect the resulting media IDs and update your status by calling 'update': --- --- @ --- 'call' '$' '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 +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} + +module Web.Twitter.Conduit.Api ( + -- * Status + StatusesMentionsTimeline, + statusesMentionsTimeline, + StatusesUserTimeline, + statusesUserTimeline, + StatusesHomeTimeline, + statusesHomeTimeline, + StatusesRetweetsOfMe, + statusesRetweetsOfMe, + StatusesRetweetsId, + statusesRetweetsId, + StatusesShowId, + statusesShowId, + StatusesDestroyId, + statusesDestroyId, + StatusesUpdate, + statusesUpdate, + StatusesRetweetId, + statusesRetweetId, + StatusesUpdateWithMedia, + statusesUpdateWithMedia, + StatusesLookup, + statusesLookup, + + -- * 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.Conduit.Base +import Web.Twitter.Conduit.Cursor +import Web.Twitter.Conduit.Parameters +import Web.Twitter.Conduit.Request +import Web.Twitter.Conduit.Request.Internal +import Web.Twitter.Types + +import Data.Aeson +import Data.Default +import qualified Data.Text as T +import Data.Time.Calendar (Day) +import Network.HTTP.Client.MultipartFormData + +-- $setup +-- >>> :set -XOverloadedStrings -XOverloadedLabels +-- >>> import Control.Lens + +-- * Timelines + +-- | Returns query data asks the most recent mentions for the authenticating user. +-- +-- You can perform a query using 'call': +-- +-- @ +-- res <- 'call' 'mentionsTimeline' +-- @ +-- +-- >>> statusesMentionsTimeline +-- APIRequest "GET" "https://api.twitter.com/1.1/statuses/mentions_timeline.json" [] +statusesMentionsTimeline :: APIRequest StatusesMentionsTimeline [Status] +statusesMentionsTimeline = APIRequest "GET" (endpoint ++ "statuses/mentions_timeline.json") def + +type StatusesMentionsTimeline = + '[ "count" ':= Integer + , "since_id" ':= Integer + , "max_id" ':= Integer + , "trim_user" ':= Bool + , "contributor_details" ':= Bool + , "include_entities" ':= Bool + , "tweet_mode" ':= TweetMode + ] + +-- | 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\") +-- @ +-- +-- >>> statusesUserTimeline (ScreenNameParam "thimura") +-- APIRequest "GET" "https://api.twitter.com/1.1/statuses/user_timeline.json" [("screen_name","thimura")] +-- >>> statusesUserTimeline (ScreenNameParam "thimura") & #include_rts ?~ True & #count ?~ 200 +-- APIRequest "GET" "https://api.twitter.com/1.1/statuses/user_timeline.json" [("count","200"),("include_rts","true"),("screen_name","thimura")] +statusesUserTimeline :: UserParam -> APIRequest StatusesUserTimeline [Status] +statusesUserTimeline q = APIRequest "GET" (endpoint ++ "statuses/user_timeline.json") (mkUserParam q) + +type StatusesUserTimeline = + '[ "count" ':= Integer + , "since_id" ':= Integer + , "max_id" ':= Integer + , "trim_user" ':= Bool + , "exclude_replies" ':= Bool + , "contributor_details" ':= Bool + , "include_rts" ':= Bool + , "tweet_mode" ':= TweetMode + ] + +-- | 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' +-- @ +-- +-- >>> statusesHomeTimeline +-- APIRequest "GET" "https://api.twitter.com/1.1/statuses/home_timeline.json" [] +-- >>> statusesHomeTimeline & #count ?~ 200 +-- APIRequest "GET" "https://api.twitter.com/1.1/statuses/home_timeline.json" [("count","200")] +statusesHomeTimeline :: APIRequest StatusesHomeTimeline [Status] +statusesHomeTimeline = APIRequest "GET" (endpoint ++ "statuses/home_timeline.json") def + +type StatusesHomeTimeline = + '[ "count" ':= Integer + , "since_id" ':= Integer + , "max_id" ':= Integer + , "trim_user" ':= Bool + , "exclude_replies" ':= Bool + , "contributor_details" ':= Bool + , "include_entities" ':= Bool + , "tweet_mode" ':= TweetMode + ] + +-- | 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' +-- @ +-- +-- >>> statusesRetweetsOfMe +-- APIRequest "GET" "https://api.twitter.com/1.1/statuses/retweets_of_me.json" [] +-- >>> statusesRetweetsOfMe & #count ?~ 100 +-- APIRequest "GET" "https://api.twitter.com/1.1/statuses/retweets_of_me.json" [("count","100")] +statusesRetweetsOfMe :: APIRequest StatusesRetweetsOfMe [Status] +statusesRetweetsOfMe = APIRequest "GET" (endpoint ++ "statuses/retweets_of_me.json") def + +type StatusesRetweetsOfMe = + '[ "count" ':= Integer + , "since_id" ':= Integer + , "max_id" ':= Integer + , "trim_user" ':= Bool + , "include_entities" ':= Bool + , "include_user_entities" ':= Bool + , "tweet_mode" ':= TweetMode + ] + +-- * Tweets + +-- | 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 +-- @ +-- +-- >>> statusesRetweetsId 1234567890 +-- APIRequest "GET" "https://api.twitter.com/1.1/statuses/retweets/1234567890.json" [] +-- >>> statusesRetweetsId 1234567890 & #count ?~ 100 +-- APIRequest "GET" "https://api.twitter.com/1.1/statuses/retweets/1234567890.json" [("count","100")] +statusesRetweetsId :: StatusId -> APIRequest StatusesRetweetsId [RetweetedStatus] +statusesRetweetsId status_id = APIRequest "GET" uri def + where + uri = endpoint ++ "statuses/retweets/" ++ show status_id ++ ".json" + +type StatusesRetweetsId = + '[ "count" ':= Integer + , "trim_user" ':= Bool + , "tweet_mode" ':= TweetMode + ] + +-- | 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 +-- @ +-- +-- >>> statusesShowId 1234567890 +-- APIRequest "GET" "https://api.twitter.com/1.1/statuses/show/1234567890.json" [] +-- >>> statusesShowId 1234567890 & #include_my_retweet ?~ True +-- APIRequest "GET" "https://api.twitter.com/1.1/statuses/show/1234567890.json" [("include_my_retweet","true")] +statusesShowId :: StatusId -> APIRequest StatusesShowId Status +statusesShowId status_id = APIRequest "GET" uri def + where + uri = endpoint ++ "statuses/show/" ++ show status_id ++ ".json" + +type StatusesShowId = + '[ "trim_user" ':= Bool + , "include_my_retweet" ':= Bool + , "include_entities" ':= Bool + , "include_ext_alt_text" ':= Bool + , "tweet_mode" ':= TweetMode + ] + +-- | 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 +-- @ +-- +-- >>> statusesDestroyId 1234567890 +-- APIRequest "POST" "https://api.twitter.com/1.1/statuses/destroy/1234567890.json" [] +statusesDestroyId :: StatusId -> APIRequest StatusesDestroyId Status +statusesDestroyId status_id = APIRequest "POST" uri def + where + uri = endpoint ++ "statuses/destroy/" ++ show status_id ++ ".json" + +type StatusesDestroyId = + '[ "trim_user" ':= Bool + , "tweet_mode" ':= TweetMode + ] + +-- | 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\" +-- @ +-- +-- >>> statusesUpdate "Hello World" +-- APIRequest "POST" "https://api.twitter.com/1.1/statuses/update.json" [("status","Hello World")] +-- >>> statusesUpdate "Hello World" & #in_reply_to_status_id ?~ 1234567890 +-- APIRequest "POST" "https://api.twitter.com/1.1/statuses/update.json" [("in_reply_to_status_id","1234567890"),("status","Hello World")] +statusesUpdate :: T.Text -> APIRequest StatusesUpdate Status +statusesUpdate status = APIRequest "POST" uri [("status", PVString status)] + where + uri = endpoint ++ "statuses/update.json" + +type StatusesUpdate = + '[ "in_reply_to_status_id" ':= Integer + , -- , "lat_long" + -- , "place_id" + "display_coordinates" ':= Bool + , "trim_user" ':= Bool + , "media_ids" ':= [Integer] + , "tweet_mode" ':= TweetMode + ] + +-- | Returns post data which retweets a tweet, specified by ID. +-- +-- You can perform a search query using 'call': +-- +-- @ +-- res <- 'call' twInfo mgr '$' 'retweetId' 1234567890 +-- @ +-- +-- >>> statusesRetweetId 1234567890 +-- APIRequest "POST" "https://api.twitter.com/1.1/statuses/retweet/1234567890.json" [] +statusesRetweetId :: StatusId -> APIRequest StatusesRetweetId RetweetedStatus +statusesRetweetId status_id = APIRequest "POST" uri def + where + uri = endpoint ++ "statuses/retweet/" ++ show status_id ++ ".json" + +type StatusesRetweetId = + '[ "trim_user" ':= Bool + , "tweet_mode" ':= TweetMode + ] + +-- | 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\") +-- @ +-- +-- >>> statusesUpdateWithMedia "Hello World" (MediaFromFile "/home/fuga/test.jpeg") +-- APIRequestMultipart "POST" "https://api.twitter.com/1.1/statuses/update_with_media.json" [("status","Hello World")] +statusesUpdateWithMedia :: + T.Text -> + MediaData -> + APIRequest StatusesUpdateWithMedia Status +statusesUpdateWithMedia tweet mediaData = + APIRequestMultipart "POST" 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 + +type StatusesUpdateWithMedia = + '[ "possibly_sensitive" ':= Bool + , "in_reply_to_status_id" ':= Integer + , -- , "lat_long" + -- , "place_id" + "display_coordinates" ':= Bool + , "tweet_mode" ':= TweetMode + ] + +-- | 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] +-- @ +-- +-- >>> statusesLookup [10] +-- APIRequest "GET" "https://api.twitter.com/1.1/statuses/lookup.json" [("id","10")] +-- >>> statusesLookup [10, 432656548536401920] +-- APIRequest "GET" "https://api.twitter.com/1.1/statuses/lookup.json" [("id","10,432656548536401920")] +-- >>> statusesLookup [10, 432656548536401920] & #include_entities ?~ True +-- APIRequest "GET" "https://api.twitter.com/1.1/statuses/lookup.json" [("include_entities","true"),("id","10,432656548536401920")] +statusesLookup :: [StatusId] -> APIRequest StatusesLookup [Status] +statusesLookup ids = APIRequest "GET" (endpoint ++ "statuses/lookup.json") [("id", PVIntegerArray ids)] + +type StatusesLookup = + '[ "include_entities" ':= Bool + , "trim_user" ':= Bool + , "map" ':= Bool + , "tweet_mode" ':= TweetMode + ] + +-- | Returns search query. +-- +-- You can perform a search query using 'call': +-- +-- @ +-- res <- 'call' ('searchTweets' \"search text\") +-- 'print' $ res ^. 'searchResultStatuses' +-- @ +-- +-- >>> searchTweets "search text" +-- APIRequest "GET" "https://api.twitter.com/1.1/search/tweets.json" [("q","search text")] +-- >>> searchTweets "search text" & #lang ?~ "ja" & #count ?~ 100 +-- APIRequest "GET" "https://api.twitter.com/1.1/search/tweets.json" [("count","100"),("lang","ja"),("q","search text")] +searchTweets :: + -- | search string + T.Text -> + APIRequest SearchTweets (SearchResult [Status]) +searchTweets q = APIRequest "GET" (endpoint ++ "search/tweets.json") [("q", PVString q)] + +type SearchTweets = + '[ "lang" ':= T.Text + , "locale" ':= T.Text + , "result_type" ':= T.Text + , "count" ':= Integer + , "until" ':= Day + , "since_id" ':= Integer + , "max_id" ':= Integer + , "include_entities" ':= Bool + , "tweet_mode" ':= TweetMode + ] + +-- | Alias of 'searchTweets', for backward compatibility +search :: + -- | search string + T.Text -> + APIRequest SearchTweets (SearchResult [Status]) +search = searchTweets +{-# DEPRECATED search "Please use Web.Twitter.Conduit.searchTweets" #-} + +-- | 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 '?~' 50 +-- @ +-- +-- >>> directMessages +-- APIRequest "GET" "https://api.twitter.com/1.1/direct_messages/events/list.json" [] +-- >>> directMessages & #count ?~ 50 +-- APIRequest "GET" "https://api.twitter.com/1.1/direct_messages/events/list.json" [("count","50")] +directMessages :: APIRequest DirectMessages (WithCursor T.Text EventsCursorKey DirectMessage) +directMessages = APIRequest "GET" (endpoint ++ "direct_messages/events/list.json") def + +type DirectMessages = + '[ "count" ':= Integer + , "include_entities" ':= Bool + , "skip_status" ':= Bool + , "full_text" ':= Bool + , "cursor" ':= T.Text + ] + +-- | 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 +-- APIRequest "GET" "https://api.twitter.com/1.1/direct_messages/sent.json" [] +-- >>> directMessagesSent & #count ?~ 100 +-- APIRequest "GET" "https://api.twitter.com/1.1/direct_messages/sent.json" [("count","100")] +directMessagesSent :: APIRequest DirectMessagesSent [DirectMessage] +directMessagesSent = APIRequest "GET" (endpoint ++ "direct_messages/sent.json") def + +type DirectMessagesSent = + '[ "since_id" ':= Integer + , "max_id" ':= Integer + , "count" ':= Integer + , "include_entities" ':= Bool + , "page" ':= Integer + , "skip_status" ':= Bool + , "full_text" ':= Bool + ] + +-- | 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 +-- APIRequest "GET" "https://api.twitter.com/1.1/direct_messages/show.json" [("id","1234567890")] +directMessagesShow :: StatusId -> APIRequest DirectMessagesShow DirectMessage +directMessagesShow sId = APIRequest "GET" (endpoint ++ "direct_messages/show.json") [("id", PVInteger sId)] + +type DirectMessagesShow = + '[ "full_text" ':= Bool + ] + +-- | 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 +-- APIRequest "DELETE" "https://api.twitter.com/1.1/direct_messages/events/destroy.json" [("id","1234567890")] +directMessagesDestroy :: StatusId -> APIRequest DirectMessagesDestroy NoContent +directMessagesDestroy sId = APIRequest "DELETE" (endpoint ++ "direct_messages/events/destroy.json") [("id", PVInteger sId)] + +type DirectMessagesDestroy = EmptyParams + +newtype DirectMessagesNewResponse = DirectMessagesNewResponse + { directMessageBody :: DirectMessage + } + deriving (Show, Eq) + +instance FromJSON DirectMessagesNewResponse where + parseJSON = withObject "DirectMessagesNewResponse" $ \o -> DirectMessagesNewResponse <$> o .: "event" + +-- | 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 69179963 "Hello thimura! by UserId" +-- APIRequestJSON "POST" "https://api.twitter.com/1.1/direct_messages/events/new.json" [] +directMessagesNew :: RecipientId -> T.Text -> APIRequest DirectMessagesNew DirectMessagesNewResponse +directMessagesNew up msg = + APIRequestJSON "POST" (endpoint ++ "direct_messages/events/new.json") [] body + where + body = + object + [ "event" + .= object + [ "type" .= ("message_create" :: String) + , "message_create" + .= object + [ "target" .= object ["recipient_id" .= up] + , "message_data" .= object ["text" .= msg] + ] + ] + ] + +type DirectMessagesNew = EmptyParams + +type RecipientId = Integer + +-- | 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 +-- APIRequest "GET" "https://api.twitter.com/1.1/friendships/no_retweets/ids.json" [] +friendshipsNoRetweetsIds :: APIRequest FriendshipsNoRetweetsIds [UserId] +friendshipsNoRetweetsIds = APIRequest "GET" (endpoint ++ "friendships/no_retweets/ids.json") [] + +type FriendshipsNoRetweetsIds = EmptyParams + +-- | 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") +-- APIRequest "GET" "https://api.twitter.com/1.1/friends/ids.json" [("screen_name","thimura")] +-- >>> friendsIds (ScreenNameParam "thimura") & #count ?~ 5000 +-- APIRequest "GET" "https://api.twitter.com/1.1/friends/ids.json" [("count","5000"),("screen_name","thimura")] +friendsIds :: UserParam -> APIRequest FriendsIds (WithCursor Integer IdsCursorKey UserId) +friendsIds q = APIRequest "GET" (endpoint ++ "friends/ids.json") (mkUserParam q) + +type FriendsIds = + '[ "count" ':= Integer + , "cursor" ':= Integer + ] + +-- | 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") +-- APIRequest "GET" "https://api.twitter.com/1.1/followers/ids.json" [("screen_name","thimura")] +-- >>> followersIds (ScreenNameParam "thimura") & #count ?~ 5000 +-- APIRequest "GET" "https://api.twitter.com/1.1/followers/ids.json" [("count","5000"),("screen_name","thimura")] +followersIds :: UserParam -> APIRequest FollowersIds (WithCursor Integer IdsCursorKey UserId) +followersIds q = APIRequest "GET" (endpoint ++ "followers/ids.json") (mkUserParam q) + +type FollowersIds = + '[ "count" ':= Integer + , "cursor" ':= Integer + ] + +-- | 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 +-- APIRequest "GET" "https://api.twitter.com/1.1/friendships/incoming.json" [] +friendshipsIncoming :: APIRequest FriendshipsIncoming (WithCursor Integer IdsCursorKey UserId) +friendshipsIncoming = APIRequest "GET" (endpoint ++ "friendships/incoming.json") def + +type FriendshipsIncoming = + '[ "cursor" ':= Integer + ] + +-- | 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 +-- APIRequest "GET" "https://api.twitter.com/1.1/friendships/outgoing.json" [] +friendshipsOutgoing :: APIRequest FriendshipsOutgoing (WithCursor Integer IdsCursorKey UserId) +friendshipsOutgoing = APIRequest "GET" (endpoint ++ "friendships/outgoing.json") def + +type FriendshipsOutgoing = + '[ "cursor" ':= Integer + ] + +-- | 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") +-- APIRequest "POST" "https://api.twitter.com/1.1/friendships/create.json" [("screen_name","thimura")] +-- >>> friendshipsCreate (UserIdParam 69179963) +-- APIRequest "POST" "https://api.twitter.com/1.1/friendships/create.json" [("user_id","69179963")] +friendshipsCreate :: UserParam -> APIRequest FriendshipsCreate User +friendshipsCreate user = APIRequest "POST" (endpoint ++ "friendships/create.json") (mkUserParam user) + +type FriendshipsCreate = + '[ "follow" ':= Bool + ] + +-- | 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") +-- APIRequest "POST" "https://api.twitter.com/1.1/friendships/destroy.json" [("screen_name","thimura")] +-- >>> friendshipsDestroy (UserIdParam 69179963) +-- APIRequest "POST" "https://api.twitter.com/1.1/friendships/destroy.json" [("user_id","69179963")] +friendshipsDestroy :: UserParam -> APIRequest FriendshipsDestroy User +friendshipsDestroy user = APIRequest "POST" (endpoint ++ "friendships/destroy.json") (mkUserParam user) + +type FriendshipsDestroy = EmptyParams + +-- | 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") +-- APIRequest "GET" "https://api.twitter.com/1.1/friends/list.json" [("screen_name","thimura")] +-- >>> friendsList (UserIdParam 69179963) +-- APIRequest "GET" "https://api.twitter.com/1.1/friends/list.json" [("user_id","69179963")] +friendsList :: UserParam -> APIRequest FriendsList (WithCursor Integer UsersCursorKey User) +friendsList q = APIRequest "GET" (endpoint ++ "friends/list.json") (mkUserParam q) + +type FriendsList = + '[ "count" ':= Integer + , "cursor" ':= Integer + , "skip_status" ':= Bool + , "include_user_entities" ':= Bool + ] + +-- | 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") +-- APIRequest "GET" "https://api.twitter.com/1.1/followers/list.json" [("screen_name","thimura")] +-- >>> followersList (UserIdParam 69179963) +-- APIRequest "GET" "https://api.twitter.com/1.1/followers/list.json" [("user_id","69179963")] +followersList :: UserParam -> APIRequest FollowersList (WithCursor Integer UsersCursorKey User) +followersList q = APIRequest "GET" (endpoint ++ "followers/list.json") (mkUserParam q) + +type FollowersList = + '[ "count" ':= Integer + , "cursor" ':= Integer + , "skip_status" ':= Bool + , "include_user_entities" ':= Bool + ] + +-- | Returns query data asks that the credential is valid. +-- +-- You can perform request by using 'call': +-- +-- @ +-- res <- 'call' twInfo mgr '$' 'accountVerifyCredentials' +-- @ +-- +-- >>> accountVerifyCredentials +-- APIRequest "GET" "https://api.twitter.com/1.1/account/verify_credentials.json" [] +accountVerifyCredentials :: APIRequest AccountVerifyCredentials User +accountVerifyCredentials = APIRequest "GET" (endpoint ++ "account/verify_credentials.json") [] + +type AccountVerifyCredentials = + '[ "include_entities" ':= Bool + , "skip_status" ':= Bool + , "include_email" ':= Bool + ] + +-- | 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' & #url ?~ \"http://www.example.com\" +-- @ +-- +-- >>> accountUpdateProfile & #url ?~ "http://www.example.com" +-- APIRequest "POST" "https://api.twitter.com/1.1/account/update_profile.json" [("url","http://www.example.com")] +accountUpdateProfile :: APIRequest AccountUpdateProfile User +accountUpdateProfile = APIRequest "POST" (endpoint ++ "account/update_profile.json") [] + +type AccountUpdateProfile = + '[ "include_entities" ':= Bool + , "skip_status" ':= Bool + , "name" ':= T.Text + , "url" ':= URIString + , "location" ':= T.Text + , "description" ':= T.Text + , "profile_link_color" ':= T.Text + ] + +-- | 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"]) +-- APIRequest "GET" "https://api.twitter.com/1.1/users/lookup.json" [("screen_name","thimura,twitterapi")] +usersLookup :: UserListParam -> APIRequest UsersLookup [User] +usersLookup q = APIRequest "GET" (endpoint ++ "users/lookup.json") (mkUserListParam q) + +type UsersLookup = + '[ "include_entities" ':= Bool + ] + +-- | 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") +-- APIRequest "GET" "https://api.twitter.com/1.1/users/show.json" [("screen_name","thimura")] +usersShow :: UserParam -> APIRequest UsersShow User +usersShow q = APIRequest "GET" (endpoint ++ "users/show.json") (mkUserParam q) + +type UsersShow = + '[ "include_entities" ':= Bool + ] + +-- | 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 +-- APIRequest "GET" "https://api.twitter.com/1.1/favorites/list.json" [] +-- >>> favoritesList (Just (ScreenNameParam "thimura")) +-- APIRequest "GET" "https://api.twitter.com/1.1/favorites/list.json" [("screen_name","thimura")] +-- >>> favoritesList (Just (UserIdParam 69179963)) +-- APIRequest "GET" "https://api.twitter.com/1.1/favorites/list.json" [("user_id","69179963")] +favoritesList :: Maybe UserParam -> APIRequest FavoritesList [Status] +favoritesList mbuser = APIRequest "GET" (endpoint ++ "favorites/list.json") (mkParam mbuser) + where + mkParam Nothing = [] + mkParam (Just usr) = mkUserParam usr + +type FavoritesList = + '[ "count" ':= Integer + , "since_id" ':= Integer + , "max_id" ':= Integer + , "include_entities" ':= Bool + , "tweet_mode" ':= TweetMode + ] + +-- | 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 +-- APIRequest "POST" "https://api.twitter.com/1.1/favorites/create.json" [("id","1234567890")] +favoritesCreate :: StatusId -> APIRequest FavoritesCreate Status +favoritesCreate sid = APIRequest "POST" (endpoint ++ "favorites/create.json") [("id", PVInteger sid)] + +type FavoritesCreate = + '[ "include_entities" ':= Bool + , "tweet_mode" ':= TweetMode + ] + +-- | Returns post data unfavorites the status specified in the ID parameter as the authenticating user. +-- +-- You can perform request by using 'call': +-- +-- @ +-- res <- 'call' twInfo mgr '$' 'favoritesDestroy' 1234567890 +-- @ +-- +-- >>> favoritesDestroy 1234567890 +-- APIRequest "POST" "https://api.twitter.com/1.1/favorites/destroy.json" [("id","1234567890")] +favoritesDestroy :: StatusId -> APIRequest FavoritesDestroy Status +favoritesDestroy sid = APIRequest "POST" (endpoint ++ "favorites/destroy.json") [("id", PVInteger sid)] + +type FavoritesDestroy = + '[ "include_entities" ':= Bool + , "tweet_mode" ':= TweetMode + ] + +-- | 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") +-- APIRequest "GET" "https://api.twitter.com/1.1/lists/statuses.json" [("slug","haskell"),("owner_screen_name","thimura")] +-- >>> listsStatuses (ListIdParam 20849097) +-- APIRequest "GET" "https://api.twitter.com/1.1/lists/statuses.json" [("list_id","20849097")] +listsStatuses :: ListParam -> APIRequest ListsStatuses [Status] +listsStatuses q = APIRequest "GET" (endpoint ++ "lists/statuses.json") (mkListParam q) + +type ListsStatuses = + '[ "since_id" ':= Integer + , "max_id" ':= Integer + , "count" ':= Integer + , "include_entities" ':= Bool + , "include_rts" ':= Bool + , "tweet_mode" ':= TweetMode + ] + +-- | 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") +-- APIRequest "POST" "https://api.twitter.com/1.1/lists/members/destroy.json" [("slug","haskell"),("owner_screen_name","thimura"),("screen_name","thimura")] +-- >>> listsMembersDestroy (ListIdParam 20849097) (UserIdParam 69179963) +-- APIRequest "POST" "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 = APIRequest "POST" (endpoint ++ "lists/members/destroy.json") (mkListParam list ++ mkUserParam user) + +type ListsMembersDestroy = EmptyParams + +-- | 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 +-- APIRequest "GET" "https://api.twitter.com/1.1/lists/memberships.json" [] +-- >>> listsMemberships (Just (ScreenNameParam "thimura")) +-- APIRequest "GET" "https://api.twitter.com/1.1/lists/memberships.json" [("screen_name","thimura")] +-- >>> listsMemberships (Just (UserIdParam 69179963)) +-- APIRequest "GET" "https://api.twitter.com/1.1/lists/memberships.json" [("user_id","69179963")] +listsMemberships :: Maybe UserParam -> APIRequest ListsMemberships (WithCursor Integer ListsCursorKey List) +listsMemberships q = APIRequest "GET" (endpoint ++ "lists/memberships.json") $ maybe [] mkUserParam q + +type ListsMemberships = + '[ "count" ':= Integer + , "cursor" ':= Integer + ] + +-- | 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") +-- APIRequest "GET" "https://api.twitter.com/1.1/lists/subscribers.json" [("slug","haskell"),("owner_screen_name","thimura")] +-- >>> listsSubscribers (ListIdParam 20849097) +-- APIRequest "GET" "https://api.twitter.com/1.1/lists/subscribers.json" [("list_id","20849097")] +listsSubscribers :: ListParam -> APIRequest ListsSubscribers (WithCursor Integer UsersCursorKey User) +listsSubscribers q = APIRequest "GET" (endpoint ++ "lists/subscribers.json") (mkListParam q) + +type ListsSubscribers = + '[ "count" ':= Integer + , "cursor" ':= Integer + , "skip_status" ':= Bool + ] + +-- | 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 +-- APIRequest "GET" "https://api.twitter.com/1.1/lists/subscriptions.json" [] +-- >>> listsSubscriptions (Just (ScreenNameParam "thimura")) +-- APIRequest "GET" "https://api.twitter.com/1.1/lists/subscriptions.json" [("screen_name","thimura")] +-- >>> listsSubscriptions (Just (UserIdParam 69179963)) +-- APIRequest "GET" "https://api.twitter.com/1.1/lists/subscriptions.json" [("user_id","69179963")] +listsSubscriptions :: Maybe UserParam -> APIRequest ListsSubscriptions (WithCursor Integer ListsCursorKey List) +listsSubscriptions q = APIRequest "GET" (endpoint ++ "lists/subscriptions.json") $ maybe [] mkUserParam q + +type ListsSubscriptions = + '[ "count" ':= Integer + , "cursor" ':= Integer + ] + +-- | 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 +-- APIRequest "GET" "https://api.twitter.com/1.1/lists/ownerships.json" [] +-- >>> listsOwnerships (Just (ScreenNameParam "thimura")) +-- APIRequest "GET" "https://api.twitter.com/1.1/lists/ownerships.json" [("screen_name","thimura")] +-- >>> listsOwnerships (Just (UserIdParam 69179963)) +-- APIRequest "GET" "https://api.twitter.com/1.1/lists/ownerships.json" [("user_id","69179963")] +listsOwnerships :: Maybe UserParam -> APIRequest ListsOwnerships (WithCursor Integer ListsCursorKey List) +listsOwnerships q = APIRequest "GET" (endpoint ++ "lists/ownerships.json") $ maybe [] mkUserParam q + +type ListsOwnerships = + '[ "count" ':= Integer + , "cursor" ':= Integer + ] + +-- | 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"]) +-- APIRequest "POST" "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]) +-- APIRequest "POST" "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 = APIRequest "POST" (endpoint ++ "lists/members/create_all.json") (mkListParam list ++ mkUserListParam users) + +type ListsMembersCreateAll = EmptyParams + +-- | 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"]) +-- APIRequest "POST" "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]) +-- APIRequest "POST" "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 = APIRequest "POST" (endpoint ++ "lists/members/destroy_all.json") (mkListParam list ++ mkUserListParam users) + +type ListsMembersDestroyAll = EmptyParams + +-- | 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") +-- APIRequest "GET" "https://api.twitter.com/1.1/lists/members.json" [("slug","haskell"),("owner_screen_name","thimura")] +-- >>> listsMembers (ListIdParam 20849097) +-- APIRequest "GET" "https://api.twitter.com/1.1/lists/members.json" [("list_id","20849097")] +listsMembers :: ListParam -> APIRequest ListsMembers (WithCursor Integer UsersCursorKey User) +listsMembers q = APIRequest "GET" (endpoint ++ "lists/members.json") (mkListParam q) + +type ListsMembers = + '[ "count" ':= Integer + , "cursor" ':= Integer + , "skip_status" ':= Bool + ] + +-- | 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") +-- APIRequest "POST" "https://api.twitter.com/1.1/lists/members/create.json" [("slug","haskell"),("owner_screen_name","thimura"),("screen_name","thimura")] +-- >>> listsMembersCreate (ListIdParam 20849097) (UserIdParam 69179963) +-- APIRequest "POST" "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 = APIRequest "POST" (endpoint ++ "lists/members/create.json") (mkListParam list ++ mkUserParam user) + +type ListsMembersCreate = EmptyParams + +-- | 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") +-- APIRequest "POST" "https://api.twitter.com/1.1/lists/destroy.json" [("slug","haskell"),("owner_screen_name","thimura")] +-- >>> listsDestroy (ListIdParam 20849097) +-- APIRequest "POST" "https://api.twitter.com/1.1/lists/destroy.json" [("list_id","20849097")] +listsDestroy :: ListParam -> APIRequest ListsDestroy List +listsDestroy list = APIRequest "POST" (endpoint ++ "lists/destroy.json") (mkListParam list) + +type ListsDestroy = EmptyParams + +-- | 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") +-- APIRequest "POST" "https://api.twitter.com/1.1/lists/update.json" [("slug","haskell"),("owner_screen_name","thimura"),("description","Haskellers"),("mode","public")] +listsUpdate :: + ListParam -> + -- | is public + Bool -> + -- | description + Maybe T.Text -> + APIRequest ListsUpdate List +listsUpdate list isPublic description = APIRequest "POST" (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" + +type ListsUpdate = EmptyParams + +-- | 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 +-- APIRequest "POST" "https://api.twitter.com/1.1/lists/create.json" [("name","haskell"),("mode","public")] +-- >>> listsCreate "haskell" False Nothing +-- APIRequest "POST" "https://api.twitter.com/1.1/lists/create.json" [("name","haskell"),("mode","private")] +-- >>> listsCreate "haskell" True (Just "Haskellers") +-- APIRequest "POST" "https://api.twitter.com/1.1/lists/create.json" [("description","Haskellers"),("name","haskell"),("mode","public")] +listsCreate :: + -- | list name + T.Text -> + -- | whether public(True) or private(False) + Bool -> + -- | the description to give the list + Maybe T.Text -> + APIRequest ListsCreate List +listsCreate name isPublic description = APIRequest "POST" (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" + +type ListsCreate = EmptyParams + +-- | 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") +-- APIRequest "GET" "https://api.twitter.com/1.1/lists/show.json" [("slug","haskell"),("owner_screen_name","thimura")] +-- >>> listsShow (ListIdParam 20849097) +-- APIRequest "GET" "https://api.twitter.com/1.1/lists/show.json" [("list_id","20849097")] +listsShow :: ListParam -> APIRequest ListsShow List +listsShow q = APIRequest "GET" (endpoint ++ "lists/show.json") (mkListParam q) + +type ListsShow = EmptyParams + +-- | 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\" '&' #media_ids '?~' ['uploadedMediaId' res1, 'uploadedMediaId' res2] +-- @ +-- +-- See: +-- +-- >>> mediaUpload (MediaFromFile "/home/test/test.png") +-- APIRequestMultipart "POST" "https://upload.twitter.com/1.1/media/upload.json" [] +mediaUpload :: + MediaData -> + APIRequest MediaUpload UploadedMedia +mediaUpload mediaData = + APIRequestMultipart "POST" 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 + +type MediaUpload = EmptyParams diff --git a/Web/Twitter/Conduit/Base.hs b/Web/Twitter/Conduit/Base.hs --- a/Web/Twitter/Conduit/Base.hs +++ b/Web/Twitter/Conduit/Base.hs @@ -1,126 +1,149 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} -module Web.Twitter.Conduit.Base - ( api - , getResponse - , call - , call' - , checkResponse - , sourceWithMaxId - , sourceWithMaxId' - , sourceWithCursor - , sourceWithCursor' - , TwitterBaseM - , endpoint - , makeRequest - , sinkJSON - , sinkFromJSON - , showBS - ) where +module Web.Twitter.Conduit.Base ( + ResponseBodyType (..), + NoContent, + getResponse, + call, + call', + callWithResponse, + callWithResponse', + checkResponse, + sourceWithMaxId, + sourceWithMaxId', + sourceWithCursor, + sourceWithCursor', + sourceWithSearchResult, + sourceWithSearchResult', + endpoint, + makeRequest, + sinkJSON, + sinkFromJSON, +) where -import Web.Twitter.Conduit.Monad -import Web.Twitter.Conduit.Types -import Web.Twitter.Conduit.Parameters +import Web.Twitter.Conduit.Cursor import Web.Twitter.Conduit.Request +import Web.Twitter.Conduit.Request.Internal +import Web.Twitter.Conduit.Response +import Web.Twitter.Conduit.Types import Web.Twitter.Types.Lens -import qualified Network.HTTP.Conduit as HTTP -import Network.HTTP.Client.MultipartFormData -import qualified Network.HTTP.Types as HT -import qualified Data.Conduit as C -import qualified Data.Conduit.List as CL - +import Control.Lens +import Control.Monad (void) +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 Data.Coerce +import qualified Data.Conduit as C import qualified Data.Conduit.Attoparsec as CA -import qualified Data.Text as T +import qualified Data.Conduit.List as CL +import qualified Data.Map as M import qualified Data.Text.Encoding as T -import Data.ByteString (ByteString) -import qualified Data.ByteString.Char8 as S8 -import Control.Monad.IO.Class -import Control.Monad.Trans.Class (lift) -import Control.Monad.Trans.Resource (MonadResource, MonadThrow, monadThrow) -import Control.Monad.Logger -import Control.Lens -import Unsafe.Coerce - -type TwitterBaseM m = ( MonadResource m - , MonadLogger m - ) +import GHC.TypeLits (KnownSymbol) +import Network.HTTP.Client.MultipartFormData +import qualified Network.HTTP.Conduit as HTTP +import qualified Network.HTTP.Types as HT +import Web.Authenticate.OAuth (signOAuth) -makeRequest :: (MonadThrow m, MonadIO m) - => APIRequest apiName responseType - -> m HTTP.Request -makeRequest (APIRequestGet u pa) = makeRequest' "GET" u pa -makeRequest (APIRequestPost u pa) = makeRequest' "POST" u pa -makeRequest (APIRequestPostMultipart u param prt) = - formDataBody body =<< makeRequest' "POST" u [] +makeRequest :: + APIRequest apiName responseType -> + IO HTTP.Request +makeRequest (APIRequest m u pa) = makeRequest' m u (makeSimpleQuery pa) +makeRequest (APIRequestMultipart m u param prt) = + formDataBody body =<< makeRequest' m u [] where body = prt ++ partParam - partParam = Prelude.map (uncurry partBS . over _1 T.decodeUtf8) param + partParam = Prelude.map (uncurry partBS . over _1 T.decodeUtf8) (makeSimpleQuery param) +makeRequest (APIRequestJSON m u param body) = do + req <- makeRequest' m u (makeSimpleQuery param) + return $ + req + { HTTP.requestBody = HTTP.RequestBodyLBS $ encode body + , HTTP.requestHeaders = ("Content-Type", "application/json") : HTTP.requestHeaders req + } -makeRequest' :: MonadThrow m - => HT.Method -- ^ HTTP request method (GET or POST) - -> String -- ^ API Resource URL - -> HT.SimpleQuery -- ^ Query - -> m HTTP.Request +makeRequest' :: + -- | HTTP request method (GET or POST) + HT.Method -> + -- | API Resource URL + String -> + -- | Query + HT.SimpleQuery -> + IO HTTP.Request makeRequest' m url query = do - req <- HTTP.parseUrl url - return $ req { HTTP.method = m - , HTTP.queryString = HT.renderSimpleQuery False query - , HTTP.checkStatus = \_ _ _ -> Nothing - } + req <- HTTP.parseRequest url + let addParams = + if m == "POST" + then HTTP.urlEncodedBody query + else \r -> r {HTTP.queryString = HT.renderSimpleQuery False query} + return $ addParams $ req {HTTP.method = m} -{-# DEPRECATED api "use `getResponse =<< makeRequest'`" #-} -api :: TwitterBaseM m - => HT.Method -- ^ HTTP request method (GET or POST) - -> String -- ^ API Resource URL - -> HT.SimpleQuery -- ^ Query - -> TW m (Response (C.ResumableSource (TW m) ByteString)) -api m url query = - getResponse =<< makeRequest' m url query +class ResponseBodyType a where + parseResponseBody :: + Response (C.ConduitM () ByteString (ResourceT IO) ()) -> + ResourceT IO (Response a) -getResponse :: TwitterBaseM m - => HTTP.Request - -> TW m (Response (C.ResumableSource (TW m) ByteString)) -getResponse req = do - proxy <- getProxy - signedReq <- signOAuthTW $ req { HTTP.proxy = proxy } - $(logDebug) $ T.pack $ "Signed Request: " ++ show signedReq - mgr <- getManager +type NoContent = () +instance ResponseBodyType NoContent where + parseResponseBody res = + case responseStatus res of + st | st == HT.status204 -> return $ void res + _ -> do + body <- C.runConduit $ responseBody res C..| sinkJSON + throwM $ TwitterStatusError (responseStatus res) (responseHeaders res) body + +instance {-# OVERLAPPABLE #-} FromJSON a => ResponseBodyType a where + parseResponseBody = getValueOrThrow + +getResponse :: + MonadResource m => + TWInfo -> + HTTP.Manager -> + HTTP.Request -> + m (Response (C.ConduitM () ByteString m ())) +getResponse TWInfo {..} mgr req = do + signedReq <- signOAuth (twOAuth twToken) (twCredential twToken) $ req {HTTP.proxy = twProxy} res <- HTTP.http signedReq mgr - $(logDebug) $ T.pack $ "Response Status: " ++ show (HTTP.responseStatus res) - $(logDebug) $ T.pack $ "Response Header: " ++ show (HTTP.responseHeaders res) return - Response { responseStatus = HTTP.responseStatus res - , responseHeaders = HTTP.responseHeaders res - , responseBody = HTTP.responseBody res - } + Response + { responseStatus = HTTP.responseStatus res + , responseHeaders = HTTP.responseHeaders res + , responseBody = HTTP.responseBody res + } endpoint :: String endpoint = "https://api.twitter.com/1.1/" -getValue :: (MonadLogger m, MonadThrow m) - => Response (C.ResumableSource m ByteString) - -> m (Response Value) +getValue :: + Response (C.ConduitM () ByteString (ResourceT IO) ()) -> + ResourceT IO (Response Value) getValue res = do - value <- responseBody res C.$$+- sinkJSON - return $ res { responseBody = value } + value <- + C.runConduit $ responseBody res C..| sinkJSON + return $ res {responseBody = value} -checkResponse :: Response Value - -> Either TwitterError Value -checkResponse Response{..} = +checkResponse :: + Response Value -> + Either TwitterError Value +checkResponse Response {..} = case responseBody ^? key "errors" of - Just errs -> + 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 @@ -128,121 +151,262 @@ where sci = HT.statusCode responseStatus -getValueOrThrow :: (MonadThrow m, MonadLogger m, FromJSON a) - => Response (C.ResumableSource m ByteString) - -> m a +getValueOrThrow :: + FromJSON a => + Response (C.ConduitM () ByteString (ResourceT IO) ()) -> + ResourceT IO (Response a) getValueOrThrow res = do - val <- getValueOrThrow' res - case fromJSON val of - Success r -> return r - Error err -> monadThrow $ FromJSONError err - -getValueOrThrow' :: (MonadLogger m, MonadThrow m) - => Response (C.ResumableSource m ByteString) - -> m Value -getValueOrThrow' res = do res' <- getValue res case checkResponse res' of - Left err -> monadThrow err - Right v -> return v + Left err -> throwM err + Right _ -> return () + case fromJSON (responseBody res') of + Success r -> return $ res' {responseBody = r} + Error err -> throwM $ FromJSONError err -call :: (TwitterBaseM m, FromJSON responseType) - => APIRequest apiName responseType - -> TW m responseType +-- | 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 :: + ResponseBodyType responseType => + -- | Twitter Setting + TWInfo -> + HTTP.Manager -> + APIRequest apiName responseType -> + IO responseType call = call' -call' :: (TwitterBaseM m, FromJSON value) - => APIRequest apiName responseType - -> TW m value -call' req = do - res <- getResponse =<< makeRequest req - getValueOrThrow res +-- | 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' :: + ResponseBodyType value => + -- | Twitter Setting + TWInfo -> + HTTP.Manager -> + APIRequest apiName responseType -> + IO value +call' info mgr req = responseBody `fmap` callWithResponse' info mgr req -sourceWithMaxId :: ( TwitterBaseM m - , FromJSON responseType - , AsStatus responseType - , HasMaxIdParam (APIRequest apiName [responseType]) - ) - => APIRequest apiName [responseType] - -> C.Source (TW m) responseType -sourceWithMaxId = loop +-- | Perform an 'APIRequest' and then provide the 'Response'. +-- +-- Example: +-- +-- @ +-- res \<- 'callWithResponse' twInfo mgr $ 'accountVerifyCredentials' +-- 'print' $ 'responseStatus' res +-- 'print' $ 'responseHeaders' res +-- 'print' $ 'responseBody' res +-- @ +callWithResponse :: + ResponseBodyType responseType => + -- | Twitter Setting + TWInfo -> + 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' :: + ResponseBodyType value => + TWInfo -> + HTTP.Manager -> + APIRequest apiName responseType -> + IO (Response value) +callWithResponse' info mgr req = + runResourceT $ do + res <- getResponse info mgr =<< liftIO (makeRequest req) + parseResponseBody 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 + , HasParam "max_id" Integer supports + ) => + -- | Twitter Setting + TWInfo -> + HTTP.Manager -> + APIRequest supports [responseType] -> + C.ConduitT () responseType m () +sourceWithMaxId info mgr = loop where loop req = do - res <- lift $ call req + res <- liftIO $ call info mgr req case getMinId res of Just mid -> do CL.sourceList res - loop $ req & maxId ?~ mid - 1 + loop $ req & #max_id ?~ mid - 1 Nothing -> CL.sourceList res getMinId = minimumOf (traverse . status_id) -sourceWithMaxId' :: ( TwitterBaseM m - , HasMaxIdParam (APIRequest apiName [responseType]) - ) - => APIRequest apiName [responseType] - -> C.Source (TW m) Value -sourceWithMaxId' = loop +-- | 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 + , HasParam "max_id" Integer supports + ) => + -- | Twitter Setting + TWInfo -> + HTTP.Manager -> + APIRequest supports [responseType] -> + C.ConduitT () Value m () +sourceWithMaxId' info mgr = loop where loop req = do - res <- lift $ call' req - case getMinId res of + (res :: [Value]) <- liftIO $ call' info mgr req + case minimumOf (traverse . key "id" . _Integer) res of Just mid -> do CL.sourceList res - loop $ req & maxId ?~ mid - 1 + loop $ req & #max_id ?~ mid - 1 Nothing -> CL.sourceList res - getMinId = minimumOf (traverse . key "id" . _Integer) -sourceWithCursor :: ( TwitterBaseM m - , FromJSON responseType - , CursorKey ck - , HasCursorParam (APIRequest apiName (WithCursor ck responseType)) - ) - => APIRequest apiName (WithCursor ck responseType) - -> C.Source (TW m) responseType -sourceWithCursor req = loop (-1) +-- | A wrapper function to perform multiple API request with changing @cursor@ parameter. +-- +-- This function cooperate with instances of 'HasCursorParam'. +sourceWithCursor :: + ( MonadIO m + , FromJSON responseType + , KnownSymbol ck + , HasParam "cursor" Integer supports + ) => + -- | Twitter Setting + TWInfo -> + HTTP.Manager -> + APIRequest supports (WithCursor Integer ck responseType) -> + C.ConduitT () responseType m () +sourceWithCursor info mgr req = loop (Just (-1)) where - loop 0 = CL.sourceNull - loop cur = do - res <- lift $ call $ req & cursor ?~ cur + loop Nothing = CL.sourceNull + loop (Just 0) = CL.sourceNull + loop (Just cur) = do + res <- liftIO $ call info mgr $ req & #cursor ?~ cur CL.sourceList $ contents res loop $ nextCursor res -sourceWithCursor' :: ( TwitterBaseM m - , FromJSON responseType - , CursorKey ck - , HasCursorParam (APIRequest apiName (WithCursor ck responseType)) - ) - => APIRequest apiName (WithCursor ck responseType) - -> C.Source (TW m) Value -sourceWithCursor' req = loop (-1) +-- | 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 + , KnownSymbol ck + , HasParam "cursor" Integer supports + ) => + -- | Twitter Setting + TWInfo -> + HTTP.Manager -> + APIRequest supports (WithCursor Integer ck responseType) -> + C.ConduitT () Value m () +sourceWithCursor' info mgr req = loop (Just (-1)) where - relax :: FromJSON value - => APIRequest apiName (WithCursor ck responseType) - -> APIRequest apiName (WithCursor ck value) - relax = unsafeCoerce - loop 0 = CL.sourceNull - loop cur = do - res <- lift $ call $ relax $ req & cursor ?~ cur + relax :: + APIRequest apiName (WithCursor Integer ck responseType) -> + APIRequest apiName (WithCursor Integer ck Value) + relax = coerce + loop Nothing = CL.sourceNull + loop (Just 0) = CL.sourceNull + loop (Just cur) = do + res <- liftIO $ call info mgr $ relax $ req & #cursor ?~ cur CL.sourceList $ contents res loop $ nextCursor res -sinkJSON :: ( MonadThrow m - , MonadLogger m - ) => C.Consumer ByteString m Value -sinkJSON = do - js <- CA.sinkParser json - $(logDebug) $ T.pack $ "Response JSON: " ++ show js - return js +-- | A wrapper function to perform multiple API request with @SearchResult@. +sourceWithSearchResult :: + ( MonadIO m + , FromJSON responseType + ) => + -- | Twitter Setting + TWInfo -> + HTTP.Manager -> + APIRequest supports (SearchResult [responseType]) -> + m (SearchResult (C.ConduitT () responseType m ())) +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 -sinkFromJSON :: ( FromJSON a - , MonadThrow m - , MonadLogger m - ) => C.Consumer ByteString m a +-- | A wrapper function to perform multiple API request with @SearchResult@. +sourceWithSearchResult' :: + ( MonadIO m + ) => + -- | Twitter Setting + TWInfo -> + HTTP.Manager -> + APIRequest supports (SearchResult [responseType]) -> + m (SearchResult (C.ConduitT () Value m ())) +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 = coerce + 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.ConduitT ByteString o m Value +sinkJSON = CA.sinkParser json + +sinkFromJSON :: + ( FromJSON a + , MonadThrow m + ) => + C.ConduitT ByteString o m a sinkFromJSON = do v <- sinkJSON case fromJSON v of - Error err -> monadThrow $ FromJSONError err + Error err -> throwM $ FromJSONError err Success r -> return r - -showBS :: Show a => a -> ByteString -showBS = S8.pack . show diff --git a/Web/Twitter/Conduit/Cursor.hs b/Web/Twitter/Conduit/Cursor.hs new file mode 100644 --- /dev/null +++ b/Web/Twitter/Conduit/Cursor.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Web.Twitter.Conduit.Cursor ( + IdsCursorKey, + UsersCursorKey, + ListsCursorKey, + EventsCursorKey, + WithCursor (..), +) where + +import Control.DeepSeq (NFData) +import Data.Aeson +import Data.Proxy (Proxy (..)) +import Data.String +import GHC.Generics +import GHC.TypeLits (KnownSymbol, Symbol, symbolVal) + +-- $setup +-- >>> import Data.Text +-- >>> type UserId = Integer + +type IdsCursorKey = "ids" +type UsersCursorKey = "users" +type ListsCursorKey = "lists" +type EventsCursorKey = "events" + +-- | 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 Integer "ids" UserId) +-- >>> nextCursor res +-- Just 1234567890 +-- >>> contents res +-- [1111111111] +-- +-- >>> let Just res = decode "{\"previous_cursor\": 0, \"next_cursor\": 0, \"users\": [1000]}" :: Maybe (WithCursor Integer "users" UserId) +-- >>> nextCursor res +-- Just 0 +-- >>> contents res +-- [1000] +-- +-- >>> let Just res = decode "{\"next_cursor\": \"hogehoge\", \"events\": [1000]}" :: Maybe (WithCursor Text "events" UserId) +-- >>> nextCursor res +-- Just "hogehoge" +-- >>> contents res +-- [1000] +data WithCursor cursorType (cursorKey :: Symbol) wrapped = WithCursor + { previousCursor :: Maybe cursorType + , nextCursor :: Maybe cursorType + , contents :: [wrapped] + } + deriving (Show, Eq, Generic, Generic1, Functor, Foldable, Traversable) + +instance (KnownSymbol cursorKey, FromJSON cursorType) => FromJSON1 (WithCursor cursorType cursorKey) where + liftParseJSON _ lp = + withObject ("WithCursor \"" ++ cursorKeyStr ++ "\"") $ \obj -> + WithCursor <$> obj .:? "previous_cursor" + <*> obj .:? "next_cursor" + <*> (obj .: fromString cursorKeyStr >>= lp) + where + cursorKeyStr = symbolVal (Proxy :: Proxy cursorKey) + +instance (KnownSymbol cursorKey, FromJSON cursorType, FromJSON wrapped) => FromJSON (WithCursor cursorType cursorKey wrapped) where + parseJSON = parseJSON1 + +instance (NFData cursorType, NFData wrapped) => NFData (WithCursor cursorType cursorKey wrapped) diff --git a/Web/Twitter/Conduit/Lens.hs b/Web/Twitter/Conduit/Lens.hs new file mode 100644 --- /dev/null +++ b/Web/Twitter/Conduit/Lens.hs @@ -0,0 +1,55 @@ +{-# 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 (..), +) where + +import Control.Lens +import Data.Text (Text) +import Network.HTTP.Types (ResponseHeaders, Status) +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 cursorType cursorKey wrapped. Lens' (TT.WithCursor cursorType cursorKey wrapped) (Maybe cursorType) +previousCursor afb s = (\b -> s {TT.previousCursor = b}) <$> afb (TT.previousCursor s) + +nextCursor :: forall cursorType cursorKey wrapped. Lens' (TT.WithCursor cursorType cursorKey wrapped) (Maybe cursorType) +nextCursor afb s = (\b -> s {TT.nextCursor = b}) <$> afb (TT.nextCursor s) + +contents :: forall cursorType cursorKey a b. Lens (TT.WithCursor cursorType cursorKey a) (TT.WithCursor cursorType cursorKey b) [a] [b] +contents afb s = (\b -> s {TT.contents = b}) <$> afb (TT.contents s) diff --git a/Web/Twitter/Conduit/Monad.hs b/Web/Twitter/Conduit/Monad.hs deleted file mode 100644 --- a/Web/Twitter/Conduit/Monad.hs +++ /dev/null @@ -1,109 +0,0 @@ -{-# LANGUAGE GADTs #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE CPP #-} - -module Web.Twitter.Conduit.Monad - ( TW - , TWToken (..) - , TWInfo (..) - , setCredential - , runTW - , runTWManager - , getProxy - , getManager - , signOAuthTW - , twitterOAuth - ) - where - -import Web.Authenticate.OAuth -import Network.HTTP.Conduit -import Data.Default -import Control.Monad.IO.Class -import Control.Monad.Trans.Reader -import Control.Monad.Trans.Resource - --- $setup --- >>> :set -XOverloadedStrings - -type TW m = ReaderT TWEnv m - -data TWToken = TWToken - { twOAuth :: OAuth - , twCredential :: Credential - } deriving Show -instance Default TWToken where - def = TWToken twitterOAuth (Credential []) - -data TWInfo = TWInfo - { twToken :: TWToken - , twProxy :: Maybe Proxy - } deriving Show -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 - } - -data TWEnv = TWEnv - { twInfo :: TWInfo - , twManager :: Manager - } - --- | 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 - } - --- | create a new http-conduit manager and run TW monad. --- --- >>> runTW def getProxy --- Nothing --- >>> runTW def $ asks (twCredential . twToken . twInfo) --- Credential {unCredential = []} -runTW :: ( MonadBaseControl IO m - , MonadIO m - ) => TWInfo -> TW (ResourceT m) a -> m a -runTW info st = withManager $ \mgr -> runTWManager info mgr st - -runTWManager :: MonadBaseControl IO m => TWInfo -> Manager -> TW (ResourceT m) a -> ResourceT m a -runTWManager info mgr st = runReaderT st $ TWEnv info mgr - -getProxy ::Monad m => TW m (Maybe Proxy) -getProxy = asks (twProxy . twInfo) - -getManager :: Monad m => TW m Manager -getManager = asks twManager - -signOAuthTW :: MonadIO m - => Request - -> TW m Request -signOAuthTW req = do - TWToken oa cred <- asks (twToken . twInfo) - signOAuth oa cred req diff --git a/Web/Twitter/Conduit/Parameters.hs b/Web/Twitter/Conduit/Parameters.hs --- a/Web/Twitter/Conduit/Parameters.hs +++ b/Web/Twitter/Conduit/Parameters.hs @@ -1,115 +1,78 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} -module Web.Twitter.Conduit.Parameters - ( Parameters (..) - , HasSinceIdParam (..) - , HasCountParam (..) - , HasMaxIdParam (..) - , HasPageParam (..) - , HasCursorParam (..) - , HasTrimUserParam (..) - , HasExcludeRepliesParam (..) - , HasContributorDetailsParam (..) - , HasIncludeEntitiesParam (..) - , HasIncludeUserEntitiesParam (..) - , HasIncludeRtsParam (..) - , HasIncludeMyRetweetParam (..) - , HasInReplyToStatusIdParam (..) - , HasDisplayCoordinatesParam (..) - , HasPossiblySensitiveParam (..) - , HasLangParam (..) - , HasLocaleParam (..) - , HasUntilParam (..) - , HasSkipStatusParam (..) - , HasFollowParam (..) - , HasMapParam (..) - , HasMediaIdsParam (..) - - , UserParam(..) - , UserListParam(..) - , ListParam(..) - , mkUserParam - , mkUserListParam - , mkListParam - ) where +module Web.Twitter.Conduit.Parameters ( + UserParam (..), + UserListParam (..), + ListParam (..), + MediaData (..), + TweetMode (..), + mkUserParam, + mkUserListParam, + mkListParam, +) where -import Prelude as P -import Web.Twitter.Conduit.Parameters.Internal -import Web.Twitter.Conduit.Parameters.TH +import qualified Data.Text as T +import Network.HTTP.Client (RequestBody) +import Web.Twitter.Conduit.Request.Internal (APIQuery, PV (..), ParameterValue (..)) import Web.Twitter.Types -import Data.Time.Calendar (Day) -import Data.Text.Strict.Lens -import Data.Text (Text) -import Control.Lens -import qualified Network.HTTP.Types as HT -import qualified Data.ByteString.Char8 as S8 +-- $setup +-- >>> import Web.Twitter.Conduit.Request.Internal +-- Required parameters + data UserParam = UserIdParam UserId | ScreenNameParam String - deriving (Show, Eq) + deriving (Show, Eq) data UserListParam = UserIdListParam [UserId] | ScreenNameListParam [String] - deriving (Show, Eq) + deriving (Show, Eq) data ListParam = ListIdParam Integer | ListNameParam String - deriving (Show, Eq) - -defineHasParamClass "count" ''Integer 'readShow -defineHasParamClass "since_id" ''Integer 'readShow -defineHasParamClass "max_id" ''Integer 'readShow -defineHasParamClass "page" ''Integer 'readShow -defineHasParamClass "cursor" ''Integer 'readShow -defineHasParamClass "trim_user" ''Bool 'booleanQuery -defineHasParamClass "exclude_replies" ''Bool 'booleanQuery -defineHasParamClass "contributor_details" ''Bool 'booleanQuery -defineHasParamClass "include_entities" ''Bool 'booleanQuery -defineHasParamClass "include_user_entities" ''Bool 'booleanQuery -defineHasParamClass "include_rts" ''Bool 'booleanQuery -defineHasParamClass "include_my_retweet" ''Bool 'booleanQuery -defineHasParamClass "in_reply_to_status_id" ''StatusId 'readShow -defineHasParamClass "display_coordinates" ''Bool 'booleanQuery -defineHasParamClass "possibly_sensitive" ''Bool 'booleanQuery -defineHasParamClass "lang" ''Text 'utf8 -defineHasParamClass "locale" ''Text 'utf8 -defineHasParamClass "until" ''Day 'readShow -defineHasParamClass "skip_status" ''Bool 'booleanQuery -defineHasParamClass "follow" ''Bool 'booleanQuery -defineHasParamClass "map" ''Bool 'booleanQuery -defineHasParamClass' "media_ids" [t|[Integer]|] 'integerArrayQuery + deriving (Show, Eq) +data MediaData + = MediaFromFile FilePath + | MediaRequestBody FilePath RequestBody -- | converts 'UserParam' to 'HT.SimpleQuery'. -- --- >>> mkUserParam $ UserIdParam 123456 +-- >>> makeSimpleQuery . mkUserParam $ UserIdParam 123456 -- [("user_id","123456")] --- >>> mkUserParam $ ScreenNameParam "thimura" +-- >>> makeSimpleQuery . mkUserParam $ ScreenNameParam "thimura" -- [("screen_name","thimura")] -mkUserParam :: UserParam -> HT.SimpleQuery -mkUserParam (UserIdParam uid) = [("user_id", readShow # uid)] -mkUserParam (ScreenNameParam sn) = [("screen_name", S8.pack sn)] +mkUserParam :: UserParam -> APIQuery +mkUserParam (UserIdParam uid) = [("user_id", PVInteger uid)] +mkUserParam (ScreenNameParam sn) = [("screen_name", PVString . T.pack $ sn)] -- | converts 'UserListParam' to 'HT.SimpleQuery'. -- --- >>> mkUserListParam $ UserIdListParam [123456] +-- >>> makeSimpleQuery . mkUserListParam $ UserIdListParam [123456] -- [("user_id","123456")] --- >>> mkUserListParam $ UserIdListParam [123456, 654321] +-- >>> makeSimpleQuery . mkUserListParam $ UserIdListParam [123456, 654321] -- [("user_id","123456,654321")] --- >>> mkUserListParam $ ScreenNameListParam ["thimura", "NikaidouShinku"] +-- >>> makeSimpleQuery . mkUserListParam $ ScreenNameListParam ["thimura", "NikaidouShinku"] -- [("screen_name","thimura,NikaidouShinku")] -mkUserListParam :: UserListParam -> HT.SimpleQuery -mkUserListParam (UserIdListParam uids) = [("user_id", uids ^.. traversed . re readShow & S8.intercalate ",")] -mkUserListParam (ScreenNameListParam sns) = [("screen_name", S8.intercalate "," . P.map S8.pack $ sns)] +mkUserListParam :: UserListParam -> APIQuery +mkUserListParam (UserIdListParam uids) = [("user_id", PVIntegerArray uids)] +mkUserListParam (ScreenNameListParam sns) = [("screen_name", PVStringArray (map T.pack sns))] -- | converts 'ListParam' to 'HT.SimpleQuery'. -- --- >>> mkListParam $ ListIdParam 123123 +-- >>> makeSimpleQuery . mkListParam $ ListIdParam 123123 -- [("list_id","123123")] --- >>> mkListParam $ ListNameParam "thimura/haskell" +-- >>> makeSimpleQuery . mkListParam $ ListNameParam "thimura/haskell" -- [("slug","haskell"),("owner_screen_name","thimura")] -mkListParam :: ListParam -> HT.SimpleQuery -mkListParam (ListIdParam lid) = [("list_id", readShow # lid)] +mkListParam :: ListParam -> APIQuery +mkListParam (ListIdParam lid) = [("list_id", PVInteger lid)] mkListParam (ListNameParam listname) = - [("slug", S8.pack lstName), - ("owner_screen_name", S8.pack screenName)] + [ ("slug", PVString (T.pack lstName)) + , ("owner_screen_name", PVString (T.pack screenName)) + ] where (screenName, ln) = span (/= '/') listname lstName = drop 1 ln +-- Optional parameters + +data TweetMode = Extended deriving (Show, Eq) + +instance ParameterValue TweetMode where + wrap Extended = PVString "extended" + unwrap = const Extended diff --git a/Web/Twitter/Conduit/Parameters/Internal.hs b/Web/Twitter/Conduit/Parameters/Internal.hs deleted file mode 100644 --- a/Web/Twitter/Conduit/Parameters/Internal.hs +++ /dev/null @@ -1,94 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE Rank2Types #-} - -module Web.Twitter.Conduit.Parameters.Internal - ( Parameters(..) - , readShow - , booleanQuery - , integerArrayQuery - , wrappedParam - ) where - -import qualified Network.HTTP.Types as HT -import qualified Data.ByteString as S -import qualified Data.ByteString.Char8 as S8 -import Data.Maybe -import Control.Lens - -class Parameters a where - params :: Lens' a HT.SimpleQuery - --- | This 'Prism' convert from a 'ByteString' to some value based on 'Read' and 'Show' --- --- >>> readShow # 2 --- "2" --- >>> "1024" ^? readShow :: Maybe Integer --- Just 1024 -readShow :: (Read a, Show a) => Prism' S.ByteString a -readShow = prism' (S8.pack . show) (readMaybe . S8.unpack) - where - readMaybe str = case [x | (x, t) <- reads str, ("", "") <- lex t] of - [x] -> Just x - _ -> Nothing - --- | This 'Prism' convert from a 'ByteString' to 'Bool' value. --- --- >>> booleanQuery # True --- "true" --- >>> booleanQuery # False --- "false" --- >>> "true" ^? booleanQuery --- Just True --- >>> "1" ^? booleanQuery --- Just True --- >>> "t" ^? booleanQuery --- Just True --- >>> "test" ^? booleanQuery --- Just False -booleanQuery :: Prism' S.ByteString Bool -booleanQuery = prism' bs sb - where - bs True = "true" - bs False = "false" - sb "true" = Just True - sb "1" = Just True - sb "t" = Just True - sb _ = Just False - --- | This 'Prism' convert from a 'ByteString' to the array of 'Integer' value. --- --- This is not a valid Prism, for example: --- --- @ --- "1, 2" ^? integerArrayQuery == Just [1,2] --- integerArrayQuery # [1,2] != "1, 2" --- @ --- --- >>> integerArrayQuery # [1] --- "1" --- >>> integerArrayQuery # [1,2234,3] --- "1,2234,3" --- >>> "1,2234,3" ^? integerArrayQuery --- Just [1,2234,3] --- >>> "" ^? integerArrayQuery --- Just [] --- >>> "hoge,2" ^? integerArrayQuery --- Nothing -integerArrayQuery :: Prism' S.ByteString [Integer] -integerArrayQuery = prism' bs_arr arr_bs - where - bs_arr xs = S8.intercalate "," $ xs ^.. traversed . re readShow - arr_bs str = chkValid $ map (^? readShow) $ S8.split ',' str - chkValid arr = - if all isJust arr - then Just (catMaybes arr) - else Nothing - -wrappedParam :: Parameters p => S.ByteString -> Prism' S.ByteString a -> Lens' p (Maybe a) -wrappedParam key aSBS = lens getter setter - where - getter = preview $ params . to (lookup key) . _Just . aSBS - setter = flip (over params . replace key) - replace k (Just v) = ((k, aSBS # v):) . dropAssoc k - replace k Nothing = dropAssoc k - dropAssoc k = filter ((/= k) . fst) diff --git a/Web/Twitter/Conduit/Parameters/TH.hs b/Web/Twitter/Conduit/Parameters/TH.hs deleted file mode 100644 --- a/Web/Twitter/Conduit/Parameters/TH.hs +++ /dev/null @@ -1,63 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE Rank2Types #-} -{-# LANGUAGE TemplateHaskell #-} - -module Web.Twitter.Conduit.Parameters.TH where - -import Web.Twitter.Conduit.Parameters.Internal -import Language.Haskell.TH -import Control.Lens -import Data.Char - -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" - -defineHasParamClass :: String -- ^ parameter name - -> Name -- ^ parameter type - -> Name -- ^ a Prism - -> Q [Dec] -defineHasParamClass paramName typeN = - defineHasParamClass' paramName (conT typeN) - -defineHasParamClass' :: String -> TypeQ -> Name -> Q [Dec] -defineHasParamClass' paramName typeQ = - defineHasParamClass'' cNameS fNameS paramName typeQ - where - cNameS = paramNameToClassName paramName - fNameS = snakeToLowerCamel paramName - -defineHasParamClass'' :: String -> String -> String -> TypeQ -> Name -> Q [Dec] -defineHasParamClass'' cNameS fNameS paramName typeQ prismN = do - a <- newName "a" - cName <- newName cNameS - fName <- newName fNameS - let cCxt = cxt [classP ''Parameters [varT a]] - tySig = sigD fName (appT (appT (conT ''Lens') (varT a)) (appT (conT ''Maybe) typeQ)) - valDef = valD (varP fName) (normalB (appE (appE (varE 'wrappedParam) (litE (stringL paramName))) (varE prismN))) [] - 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) diff --git a/Web/Twitter/Conduit/Request.hs b/Web/Twitter/Conduit/Request.hs --- a/Web/Twitter/Conduit/Request.hs +++ b/Web/Twitter/Conduit/Request.hs @@ -1,45 +1,39 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Rank2Types #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE CPP #-} - -module Web.Twitter.Conduit.Request - ( APIRequest(..) - ) where +{-# LANGUAGE TypeFamilies #-} -import Web.Twitter.Conduit.Parameters +module Web.Twitter.Conduit.Request ( + HasParam, + APIRequest (..), +) where +import Data.Aeson +import GHC.TypeLits (Symbol) import Network.HTTP.Client.MultipartFormData import qualified Network.HTTP.Types as HT -import Control.Applicative +import Web.Twitter.Conduit.Request.Internal --- 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 -XOverlappingInstances -XIncoherentInstances +-- >>> :set -XOverloadedStrings -XDataKinds -XTypeOperators -- >>> import Control.Lens --- >>> import Data.Default --- >>> data SampleApi +-- >>> import Web.Twitter.Conduit.Parameters -- >>> 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 +-- >>> type SampleApi = '["count" ':= Integer, "max_id" ':= Integer] +-- >>> let sampleApiRequest :: APIRequest SampleApi [SampleId]; sampleApiRequest = APIRequest "GET" "https://api.twitter.com/sample/api.json" [] -- | 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' +-- type SampleId = 'Integer' +-- sampleApiRequest :: 'APIRequest' SampleApi [SampleId] +-- sampleApiRequest = 'APIRequest' \"GET\" \"https:\/\/api.twitter.com\/sample\/api.json\" [] +-- type SampleApi = '[ "count" ':= Integer +-- , "max_id" ':= Integer +-- ] +-- -- @ -- -- We can obtain request params from @'APIRequest' SampleApi [SampleId]@ : @@ -47,33 +41,41 @@ -- >>> sampleApiRequest ^. params -- [] -- --- And update request parameters. +-- The second type parameter of the APIRequest represents the allowed parameters for the APIRequest. +-- For example, @sampleApiRequest@ has 2 @Integer@ parameters, that is "count" and "max_id". +-- You can update those parameters by label lenses (@#count@ and @#max_id@ respectively) -- --- >>> (sampleApiRequest & count ?~ 100 & maxId ?~ 1234567890) ^. params --- [("max_id","1234567890"),("count","100")] --- >>> (sampleApiRequest & count ?~ 100 & maxId ?~ 1234567890 & count .~ Nothing) ^. params --- [("max_id","1234567890")] -#endif -data APIRequest apiName responseType - = APIRequestGet - { _url :: String - , _params :: HT.SimpleQuery - } - | APIRequestPost - { _url :: String - , _params :: HT.SimpleQuery - } - | APIRequestPostMultipart - { _url :: String - , _params :: HT.SimpleQuery - , _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 +-- >>> (sampleApiRequest & #count ?~ 100 & #max_id ?~ 1234567890) ^. params +-- [("max_id",PVInteger {unPVInteger = 1234567890}),("count",PVInteger {unPVInteger = 100})] +-- >>> (sampleApiRequest & #count ?~ 100 & #max_id ?~ 1234567890 & #count .~ Nothing) ^. params +-- [("max_id",PVInteger {unPVInteger = 1234567890})] +data APIRequest (supports :: [Param Symbol *]) responseType + = APIRequest + { _method :: HT.Method + , _url :: String + , _params :: APIQuery + } + | APIRequestMultipart + { _method :: HT.Method + , _url :: String + , _params :: APIQuery + , _part :: [Part] + } + | APIRequestJSON + { _method :: HT.Method + , _url :: String + , _params :: APIQuery + , _body :: Value + } + +instance Parameters (APIRequest supports responseType) where + type SupportParameters (APIRequest supports responseType) = supports + + params f (APIRequest m u pa) = APIRequest m u <$> f pa + params f (APIRequestMultipart m u pa prt) = + (\p -> APIRequestMultipart m u p prt) <$> f pa + params f (APIRequestJSON m u pa body) = (\p -> APIRequestJSON m u p body) <$> f pa instance Show (APIRequest apiName responseType) where - show (APIRequestGet u p) = "APIRequestGet " ++ show u ++ " " ++ show p - show (APIRequestPost u p) = "APIRequestPost " ++ show u ++ " " ++ show p - show (APIRequestPostMultipart u p _) = "APIRequestPostMultipart " ++ show u ++ " " ++ show p + show (APIRequest m u p) = "APIRequest " ++ show m ++ " " ++ show u ++ " " ++ show (makeSimpleQuery p) + show (APIRequestMultipart m u p _) = "APIRequestMultipart " ++ show m ++ " " ++ show u ++ " " ++ show (makeSimpleQuery p) + show (APIRequestJSON m u p _) = "APIRequestJSON " ++ show m ++ " " ++ show u ++ " " ++ show (makeSimpleQuery p) diff --git a/Web/Twitter/Conduit/Request/Internal.hs b/Web/Twitter/Conduit/Request/Internal.hs new file mode 100644 --- /dev/null +++ b/Web/Twitter/Conduit/Request/Internal.hs @@ -0,0 +1,110 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Web.Twitter.Conduit.Request.Internal where + +import Control.Lens +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as S8 +import Data.Proxy +import Data.Text (Text) +import qualified Data.Text.Encoding as T +import Data.Time.Calendar (Day) +import GHC.OverloadedLabels +import GHC.TypeLits +import qualified Network.HTTP.Types as HT + +data Param label t = label := t + +type EmptyParams = ('[] :: [Param Symbol *]) + +type HasParam (label :: Symbol) (paramType :: *) (params :: [Param Symbol *]) = ParamType label params ~ paramType +type family ParamType (label :: Symbol) (params :: [Param Symbol *]) :: * where + ParamType label ((label ':= paramType) ': ks) = paramType + ParamType label ((label' ':= paramType') ': ks) = ParamType label ks + +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) + +class Parameters req where + type SupportParameters req :: [Param Symbol *] + params :: Lens' req APIQuery + +class ParameterValue a where + wrap :: a -> PV + unwrap :: PV -> a +instance ParameterValue Integer where + wrap = PVInteger + unwrap = unPVInteger +instance ParameterValue Bool where + wrap = PVBool + unwrap = unPVBool +instance ParameterValue Text where + wrap = PVString + unwrap = unPVString +instance ParameterValue [Integer] where + wrap = PVIntegerArray + unwrap = unPVIntegerArray +instance ParameterValue [Text] where + wrap = PVStringArray + unwrap = unPVStringArray +instance ParameterValue Day where + wrap = PVDay + unwrap = unPVDay + +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 + +rawParam :: + (Parameters p, ParameterValue a) => + -- | key + ByteString -> + Lens' p (Maybe a) +rawParam key = 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) + +instance + ( Parameters req + , ParameterValue a + , KnownSymbol label + , HasParam label a (SupportParameters req) + , Functor f + , lens ~ ((Maybe a -> f (Maybe a)) -> req -> f req) + ) => + IsLabel label lens + where + fromLabel = rawParam key + where + key = S8.pack (symbolVal (Proxy :: Proxy label)) diff --git a/Web/Twitter/Conduit/Response.hs b/Web/Twitter/Conduit/Response.hs new file mode 100644 --- /dev/null +++ b/Web/Twitter/Conduit/Response.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE OverloadedStrings #-} + +module Web.Twitter.Conduit.Response ( + Response (..), + TwitterError (..), + TwitterErrorMessage (..), +) where + +import Control.Exception +import Data.Aeson +import Data.Data +import qualified Data.Text as T +import Network.HTTP.Types (ResponseHeaders, Status) + +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 diff --git a/Web/Twitter/Conduit/Status.hs b/Web/Twitter/Conduit/Status.hs --- a/Web/Twitter/Conduit/Status.hs +++ b/Web/Twitter/Conduit/Status.hs @@ -1,315 +1,75 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE EmptyDataDecls #-} -#if __GLASGOW_HASKELL__ >= 704 -{-# LANGUAGE ConstraintKinds #-} -#endif +module Web.Twitter.Conduit.Status ( + -- * Notice + -- $notice -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 + -- * Timelines + mentionsTimeline, + userTimeline, + homeTimeline, + retweetsOfMe, -import Prelude hiding ( lookup ) -import Web.Twitter.Conduit.Base -import Web.Twitter.Conduit.Request -import Web.Twitter.Conduit.Types + -- * Tweets + retweetsId, + showId, + destroyId, + update, + retweetId, + updateWithMedia, + lookup, +) where + +import Data.Text (Text) +import Web.Twitter.Conduit.Api import Web.Twitter.Conduit.Parameters -import Web.Twitter.Conduit.Parameters.TH +import Web.Twitter.Conduit.Request import Web.Twitter.Types -import qualified Data.ByteString as S -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import Network.HTTP.Client.MultipartFormData -import Data.Default - --- $setup --- >>> :set -XOverloadedStrings --- >>> import Control.Lens - --- * Timelines +import Prelude hiding (lookup) -data StatusesMentionsTimeline --- | Returns query data asks the most recent mentions for the authenticating user. --- --- You can perform a query using 'call': --- --- @ --- res <- 'call' 'mentionsTimeline' --- @ +-- $notice -- --- >>> mentionsTimeline --- APIRequestGet "https://api.twitter.com/1.1/statuses/mentions_timeline.json" [] +-- This module provides aliases of statuses API, for backward compatibility. + 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" - ] +mentionsTimeline = statusesMentionsTimeline +{-# DEPRECATED mentionsTimeline "Please use Web.Twitter.Conduit.API.statusesMentionsTimeline" #-} -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" - ] +userTimeline = statusesUserTimeline +{-# DEPRECATED userTimeline "Please use Web.Twitter.Conduit.API.statusesUserTimeline" #-} -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" - ] +homeTimeline = statusesHomeTimeline +{-# DEPRECATED homeTimeline "Please use Web.Twitter.Conduit.API.statusesHomeTimeline" #-} -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 +retweetsOfMe = statusesRetweetsOfMe +{-# DEPRECATED retweetsOfMe "Please use Web.Twitter.Conduit.API.statusesRetweetsOfMe" #-} -data StatusesRetweetsId --- | 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' '$' '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" - ] +retweetsId = statusesRetweetsId +{-# DEPRECATED retweetsId "Please use Web.Twitter.Conduit.API.statusesRetweetsId" #-} -data StatusesShowId --- | Returns query data asks a single Tweet, specified by the id parameter. --- --- You can perform a search query using 'call': --- --- @ --- res <- 'call' '$' '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" - ] +showId = statusesShowId +{-# DEPRECATED showId "Please use Web.Twitter.Conduit.API.statusesShowId" #-} -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' '$' '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" - ] +destroyId = statusesDestroyId +{-# DEPRECATED destroyId "Please use Web.Twitter.Conduit.API.statusesDestroyId" #-} -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' '$' '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", T.encodeUtf8 status)] - where uri = endpoint ++ "statuses/update.json" -deriveHasParamInstances ''StatusesUpdate - [ "in_reply_to_status_id" - -- , "lat_long" - -- , "place_id" - , "display_coordinates" - , "trim_user" - , "media_ids" - ] +update :: Text -> APIRequest StatusesUpdate Status +update = statusesUpdate +{-# DEPRECATED update "Please use Web.Twitter.Conduit.API.statusesUpdate" #-} -data StatusesRetweetId --- | Returns post data which retweets a tweet, specified by ID. --- --- You can perform a search query using 'call': --- --- @ --- res <- 'call' '$' '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" - ] +retweetId = statusesRetweetId +{-# DEPRECATED retweetId "Please use Web.Twitter.Conduit.API.statusesRetweetId" #-} -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' '$' '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", T.encodeUtf8 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" - ] +updateWithMedia :: Text -> MediaData -> APIRequest StatusesUpdateWithMedia Status +updateWithMedia = statusesUpdateWithMedia +{-# DEPRECATED updateWithMedia "Please use Web.Twitter.Conduit.API.statusesUpdateWithMedia" #-} -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' '$' '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", S.intercalate "," . Prelude.map showBS $ ids)] -deriveHasParamInstances ''StatusesLookup - [ "include_entities" - , "trim_user" - , "map" - ] +lookup :: [StatusId] -> APIRequest StatusesLookup [Status] +lookup = statusesLookup +{-# DEPRECATED lookup "Please use Web.Twitter.Conduit.API.statusesLookup" #-} diff --git a/Web/Twitter/Conduit/Stream.hs b/Web/Twitter/Conduit/Stream.hs --- a/Web/Twitter/Conduit/Stream.hs +++ b/Web/Twitter/Conduit/Stream.hs @@ -1,80 +1,123 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE EmptyDataDecls #-} -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE ConstraintKinds #-} -#endif +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} -module Web.Twitter.Conduit.Stream - ( - -- * StreamingAPI - Userstream - , userstream - , StatusesFilter - , statusesFilterByFollow - , statusesFilterByTrack - -- , statusesFilterByLocation - -- , statusesSample - -- , statusesFirehose - -- , sitestream - -- , sitestream' - , stream - , stream' - ) where +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.Conduit.Monad -import Web.Twitter.Types import Web.Twitter.Conduit.Request +import Web.Twitter.Conduit.Request.Internal +import Web.Twitter.Conduit.Response +import Web.Twitter.Conduit.Types +import Web.Twitter.Types +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.List as CL -import qualified Data.Conduit.Internal as CI +import qualified Data.List as L import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import qualified Data.ByteString as S -import Control.Monad.IO.Class -import Data.Aeson - -#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 +import qualified Network.HTTP.Conduit as HTTP -stream :: (TwitterBaseM m, FromJSON responseType) - => APIRequest apiName responseType - -> TW m (C.ResumableSource (TW m) responseType) +stream :: + ( MonadResource m + , FromJSON responseType + , MonadThrow m + ) => + TWInfo -> + HTTP.Manager -> + APIRequest apiName responseType -> + m (C.ConduitM () responseType m ()) stream = stream' -stream' :: (TwitterBaseM m, FromJSON value) - => APIRequest apiName responseType - -> TW m (C.ResumableSource (TW m) value) -stream' req = do - rsrc <- getResponse =<< makeRequest req - responseBody rsrc $=+ CL.sequence sinkFromJSON +stream' :: + ( MonadResource m + , FromJSON value + , MonadThrow m + ) => + TWInfo -> + HTTP.Manager -> + APIRequest apiName responseType -> + m (C.ConduitM () value m ()) +stream' info mgr req = do + rsrc <- getResponse info mgr =<< liftIO (makeRequest req) + return $ responseBody rsrc C..| CL.sequence sinkFromJSONIgnoreSpaces + 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" [] +userstream = APIRequest "GET" "https://userstream.twitter.com/1.1/user.json" [] +type Userstream = + '[ "language" ':= T.Text + , "filter_level" ':= T.Text + , "stall_warnings" ':= Bool + , "replies" ':= T.Text + ] +-- 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]] +-- APIRequest "POST" "https://stream.twitter.com/1.1/statuses/filter.json" [("follow","1,2,3")] +-- >>> statusesFilter [Track ["haskell","functional"]] +-- APIRequest "POST" "https://stream.twitter.com/1.1/statuses/filter.json" [("track","haskell,functional")] +-- >>> statusesFilter [Follow [1,2,3],Track ["haskell","functional"]] +-- APIRequest "POST" "https://stream.twitter.com/1.1/statuses/filter.json" [("follow","1,2,3"),("track","haskell,functional")] +statusesFilter :: [FilterParameter] -> APIRequest StatusesFilter StreamingAPI +statusesFilter fs = APIRequest "POST" statusesFilterEndpoint (L.map paramToQueryItem fs) + +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] +-- APIRequest "POST" "https://stream.twitter.com/1.1/statuses/filter.json" [("follow","1,2,3")] statusesFilterByFollow :: [UserId] -> APIRequest StatusesFilter StreamingAPI -statusesFilterByFollow userIds = - APIRequestPost statusesFilterEndpoint [("follow", S.intercalate "," . map showBS $ userIds)] +statusesFilterByFollow userIds = statusesFilter [Follow userIds] -statusesFilterByTrack :: T.Text -- ^ keyword - -> APIRequest StatusesFilter StreamingAPI -statusesFilterByTrack keyword = - APIRequestPost statusesFilterEndpoint [("track", T.encodeUtf8 keyword)] +-- | Returns statuses/filter.json API query data. +-- +-- >>> statusesFilterByTrack "haskell" +-- APIRequest "POST" "https://stream.twitter.com/1.1/statuses/filter.json" [("track","haskell")] +statusesFilterByTrack :: + -- | keyword + T.Text -> + APIRequest StatusesFilter StreamingAPI +statusesFilterByTrack keyword = statusesFilter [Track [keyword]] + +type StatusesFilter = + '[ "language" ':= T.Text + , "filter_level" ':= T.Text + , "stall_warnings" ':= Bool + ] diff --git a/Web/Twitter/Conduit/Types.hs b/Web/Twitter/Conduit/Types.hs --- a/Web/Twitter/Conduit/Types.hs +++ b/Web/Twitter/Conduit/Types.hs @@ -1,154 +1,64 @@ -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveFoldable #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DeriveTraversable #-} -{-# LANGUAGE EmptyDataDecls #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE CPP #-} -module Web.Twitter.Conduit.Types - ( Response (..) - , TwitterError (..) - , TwitterErrorMessage (..) - , CursorKey (..) - , IdsCursorKey - , UsersCursorKey - , WithCursor (..) - , MediaData (..) -#if !MIN_VERSION_twitter_types(0,5,0) - , UploadedMedia (..) - , ImageSizeType (..) -#endif - ) where - - -import Control.Applicative -import Control.Exception -import Data.Aeson -import Data.Data -import Data.Foldable (Foldable) -import Data.Monoid -import qualified Data.Text as T -import Data.Traversable (Traversable) -import Network.HTTP.Client (RequestBody) -import Network.HTTP.Types (Status, ResponseHeaders) -import Web.Twitter.Types (checkError) - --- $setup --- >>> type UserId = Integer - - -class CursorKey a where - cursorKey :: a -> T.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" - -#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 - -data MediaData = MediaFromFile FilePath - | MediaRequestBody FilePath RequestBody - -#if !MIN_VERSION_twitter_types(0,5,0) -data ImageSizeType = ImageSizeType - { imageWidth :: Int - , imageHeight :: Int - , imageType :: T.Text - } deriving Show -instance FromJSON ImageSizeType where - parseJSON (Object o) = - ImageSizeType <$> o .: "w" - <*> o .: "h" - <*> o .: "image_type" - parseJSON v = fail $ "unknown value: " ++ show v +module Web.Twitter.Conduit.Types ( + TWToken (..), + TWInfo (..), + twitterOAuth, + setCredential, +) where -data UploadedMedia = UploadedMedia - { mediaId :: Integer - , mediaSize :: Integer - , mediaImage :: ImageSizeType - } deriving Show -instance FromJSON UploadedMedia where - parseJSON (Object o) = - UploadedMedia <$> o .: "media_id" - <*> o .: "size" - <*> o .: "image" - parseJSON v = fail $ "unknown value: " ++ show v -#endif +import Data.Default +import Data.Typeable (Typeable) +import Network.HTTP.Conduit +import Web.Authenticate.OAuth -data Response responseType = Response - { responseStatus :: Status - , responseHeaders :: ResponseHeaders - , responseBody :: responseType - } deriving (Show, Eq, Typeable, Functor, Foldable, Traversable) +data TWToken = TWToken + { twOAuth :: OAuth + , twCredential :: Credential + } + deriving (Show, Read, Eq, Typeable) +instance Default TWToken where + def = TWToken twitterOAuth (Credential []) -data TwitterError - = FromJSONError String - | TwitterErrorResponse Status ResponseHeaders [TwitterErrorMessage] - | TwitterStatusError Status ResponseHeaders Value - deriving (Show, Typeable, Eq) +data TWInfo = TWInfo + { twToken :: TWToken + , twProxy :: Maybe Proxy + } + deriving (Show, Read, Eq, Typeable) +instance Default TWInfo where + def = + TWInfo + { twToken = def + , twProxy = Nothing + } -instance Exception TwitterError +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 + } --- | Twitter Error Messages +-- | set OAuth keys and Credentials to TWInfo. -- --- 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 +-- >>> 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 + } diff --git a/Web/Twitter/Conduit/Types/Lens.hs b/Web/Twitter/Conduit/Types/Lens.hs deleted file mode 100644 --- a/Web/Twitter/Conduit/Types/Lens.hs +++ /dev/null @@ -1,37 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE CPP #-} - -module Web.Twitter.Conduit.Types.Lens - ( TT.Response - , responseStatus - , responseBody - , responseHeaders - , TT.WithCursor - , previousCursor - , nextCursor - , contents -#if !MIN_VERSION_twitter_types(0,5,0) - , TT.ImageSizeType - , imageWidth - , imageHeight - , imageType - , TT.UploadedMedia - , mediaId - , mediaSize - , mediaImage -#endif - , TT.TwitterErrorMessage - , twitterErrorMessage - , twitterErrorCode - ) where - -import qualified Web.Twitter.Conduit.Types as TT -import Web.Twitter.Conduit.Types.TH - -makeLenses ''TT.WithCursor -#if !MIN_VERSION_twitter_types(0,5,0) -makeLenses ''TT.ImageSizeType -makeLenses ''TT.UploadedMedia -#endif -makeLenses ''TT.Response -makeLenses ''TT.TwitterErrorMessage diff --git a/Web/Twitter/Conduit/Types/TH.hs b/Web/Twitter/Conduit/Types/TH.hs deleted file mode 100644 --- a/Web/Twitter/Conduit/Types/TH.hs +++ /dev/null @@ -1,18 +0,0 @@ -{-# LANGUAGE CPP #-} - -module Web.Twitter.Conduit.Types.TH - ( makeLenses - ) where - -import Control.Lens hiding (makeLenses) -import Language.Haskell.TH - -#if MIN_VERSION_lens(4,4,0) -makeLenses :: Name -> Q [Dec] -makeLenses = makeLensesWith (lensRules & lensField .~ myFieldToDef) - where - myFieldToDef _ n = [TopName (mkName (nameBase n))] -#else -makeLenses :: Name -> Q [Dec] -makeLenses = makeLensesWith (defaultRules & lensField .~ Just) -#endif diff --git a/sample/Common.hs b/sample/Common.hs deleted file mode 100644 --- a/sample/Common.hs +++ /dev/null @@ -1,62 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE FlexibleContexts #-} - -module Common where - -import Web.Twitter.Conduit - -import Web.Authenticate.OAuth as OA -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 Control.Monad.IO.Class -import Control.Monad.Base -import Control.Monad.Trans.Resource -import System.Environment -import Control.Monad.Logger -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 - -runTwitterFromEnv :: (MonadIO m, MonadBaseControl IO m) => TW (ResourceT m) a -> m a -runTwitterFromEnv task = do - pr <- liftBase getProxyEnv - (oa, cred) <- liftBase getOAuthTokens - let env = (setCredential oa cred def) { twProxy = pr } - runTW env task - -runTwitterFromEnv' :: (MonadIO m, MonadBaseControl IO m) => TW (ResourceT (NoLoggingT m)) a -> m a -runTwitterFromEnv' = runNoLoggingT . runTwitterFromEnv diff --git a/sample/LICENSE b/sample/LICENSE new file mode 100644 --- /dev/null +++ b/sample/LICENSE @@ -0,0 +1,26 @@ +Copyright (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. diff --git a/sample/Setup.hs b/sample/Setup.hs new file mode 100644 --- /dev/null +++ b/sample/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple + +main = defaultMain diff --git a/sample/common/Common.hs b/sample/common/Common.hs new file mode 100644 --- /dev/null +++ b/sample/common/Common.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} + +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} diff --git a/sample/fav.hs b/sample/fav.hs --- a/sample/fav.hs +++ b/sample/fav.hs @@ -2,17 +2,20 @@ module Main where -import Control.Monad.IO.Class -import Web.Twitter.Conduit -import System.Environment import Common +import Web.Twitter.Conduit + import Control.Lens +import System.Environment main :: IO () -main = runTwitterFromEnv' $ do - [statusIdStr] <- liftIO getArgs +main = do + [statusIdStr] <- getArgs + twInfo <- getTWInfoFromEnv + mgr <- newManager tlsManagerSettings let sId = read statusIdStr - targetStatus <- call $ showId sId - liftIO . putStrLn $ "Favorite Tweet: " ++ targetStatus ^. to show - res <- call $ favoritesCreate sId - liftIO $ print res + + targetStatus <- call twInfo mgr $ statusesShowId sId + putStrLn $ "Favorite Tweet: " ++ targetStatus ^. to show + res <- call twInfo mgr $ favoritesCreate sId + print res diff --git a/sample/oauth_callback.hs b/sample/oauth_callback.hs --- a/sample/oauth_callback.hs +++ b/sample/oauth_callback.hs @@ -7,22 +7,19 @@ module Main where -import Web.Scotty -import qualified Network.HTTP.Types as HT -import Web.Twitter.Conduit hiding (text, lookup) -import Web.Authenticate.OAuth (OAuth(..), Credential(..)) -import qualified Web.Authenticate.OAuth as OA -import qualified Network.HTTP.Conduit as HTTP -import qualified Data.Text.Lazy as LT +import Control.Monad.IO.Class import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 +import Data.IORef import qualified Data.Map as M import Data.Maybe -import Data.Monoid -import Data.IORef -import Control.Monad.IO.Class +import qualified Data.Text.Lazy as LT +import qualified Network.HTTP.Types as HT import System.Environment import System.IO.Unsafe +import qualified Web.Authenticate.OAuth as OA +import Web.Scotty +import Web.Twitter.Conduit callback :: String callback = "http://localhost:3000/callback" @@ -33,10 +30,10 @@ consumerSecret <- getEnv "OAUTH_CONSUMER_SECRET" return $ twitterOAuth - { oauthConsumerKey = S8.pack consumerKey - , oauthConsumerSecret = S8.pack consumerSecret - , oauthCallback = Just $ S8.pack callback - } + { oauthConsumerKey = S8.pack consumerKey + , oauthConsumerSecret = S8.pack consumerSecret + , oauthCallback = Just $ S8.pack callback + } type OAuthToken = S.ByteString @@ -46,8 +43,8 @@ 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) + let (res, newm) = M.updateLookupWithKey (\_ _ -> Nothing) k m + in (newm, res) storeCredential :: OAuthToken -> Credential -> IORef (M.Map OAuthToken Credential) -> IO () storeCredential k cred ioref = @@ -56,39 +53,40 @@ main :: IO () main = do tokens <- getTokens + mgr <- newManager tlsManagerSettings putStrLn $ "browse URL: http://localhost:3000/signIn" - scotty 3000 $ app tokens + scotty 3000 $ app tokens mgr makeMessage :: OAuth -> Credential -> S.ByteString makeMessage tokens (Credential cred) = - S8.intercalate "\n" + 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 -> ScottyM () -app tokens = do +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 <- liftIO $ HTTP.withManager $ OA.getAccessToken tokens (OA.insert "oauth_verifier" oauthVerifier cred) + 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 <- liftIO $ HTTP.withManager $ OA.getTemporaryCredential tokens + cred <- OA.getTemporaryCredential tokens mgr case lookup "oauth_token" $ unCredential cred of Just temporaryToken -> do liftIO $ storeCredential temporaryToken cred usersToken diff --git a/sample/oauth_pin.hs b/sample/oauth_pin.hs --- a/sample/oauth_pin.hs +++ b/sample/oauth_pin.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} -- Example: -- $ export OAUTH_CONSUMER_KEY="your consumer key" @@ -8,18 +8,12 @@ module Main where -import Web.Twitter.Conduit hiding (lookup) -import Web.Authenticate.OAuth as OA -import Network.HTTP.Conduit -import qualified Data.Conduit as C import qualified Data.ByteString.Char8 as S8 import Data.Maybe -import Data.Monoid -import Control.Monad.Trans.Control -import Control.Monad.Trans.Resource -import Control.Monad.IO.Class import System.Environment import System.IO (hFlush, stdout) +import Web.Authenticate.OAuth as OA +import Web.Twitter.Conduit getTokens :: IO OAuth getTokens = do @@ -27,22 +21,23 @@ consumerSecret <- getEnv "OAUTH_CONSUMER_SECRET" return $ twitterOAuth - { oauthConsumerKey = S8.pack consumerKey - , oauthConsumerSecret = S8.pack consumerSecret - , oauthCallback = Just "oob" - } + { oauthConsumerKey = S8.pack consumerKey + , oauthConsumerSecret = S8.pack consumerSecret + , oauthCallback = Just "oob" + } -authorize :: (MonadBaseControl IO m, MonadResource m) - => OAuth -- ^ OAuth Consumer key and secret - -> Manager - -> m Credential +authorize :: + -- | OAuth Consumer key and secret + OAuth -> + 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 = liftIO $ do + getPIN url = do putStrLn $ "browse URL: " ++ url putStr "> what was the PIN twitter provided you with? " hFlush stdout @@ -51,7 +46,8 @@ main :: IO () main = do tokens <- getTokens - Credential cred <- liftIO $ withManager $ authorize tokens + mgr <- newManager tlsManagerSettings + Credential cred <- authorize tokens mgr print cred S8.putStrLn . S8.intercalate "\n" $ diff --git a/sample/oslist.hs b/sample/oslist.hs --- a/sample/oslist.hs +++ b/sample/oslist.hs @@ -1,28 +1,31 @@ {-# LANGUAGE OverloadedStrings #-} + module Main where -import qualified Data.Conduit as C +import Common +import Web.Twitter.Conduit + +import Data.Conduit import qualified Data.Conduit.List as CL import qualified Data.Map as M -import Control.Monad.IO.Class import System.Environment -import Web.Twitter.Conduit -import Common - main :: IO () -main = runTwitterFromEnv' $ do - [screenName] <- liftIO getArgs +main = do + [screenName] <- getArgs + twInfo <- getTWInfoFromEnv + mgr <- newManager tlsManagerSettings let sn = ScreenNameParam screenName - folids <- sourceWithCursor (followersIds sn) C.$$ CL.consume - friids <- sourceWithCursor (friendsIds sn) C.$$ CL.consume + folids <- runConduit $ sourceWithCursor twInfo mgr (followersIds sn) .| CL.consume + friids <- runConduit $ sourceWithCursor twInfo mgr (friendsIds sn) .| 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 - liftIO $ putStrLn "one sided:" - liftIO $ print os + putStrLn "one sided:" + print os - liftIO $ putStrLn "both following:" - liftIO $ print bo + putStrLn "both following:" + print bo diff --git a/sample/post.hs b/sample/post.hs --- a/sample/post.hs +++ b/sample/post.hs @@ -1,18 +1,19 @@ {-# LANGUAGE OverloadedStrings #-} + module Main where +import Common +import Web.Twitter.Conduit + import qualified Data.Text as T import qualified Data.Text.IO as T -import Data.Monoid -import Control.Applicative -import Control.Monad.IO.Class -import Web.Twitter.Conduit import System.Environment -import Common main :: IO () -main = runTwitterFromEnv' $ do - status <- T.concat . map T.pack <$> liftIO getArgs - liftIO $ T.putStrLn $ "Post message: " <> status - res <- call $ update status - liftIO $ print res +main = do + status <- T.concat . map T.pack <$> getArgs + T.putStrLn $ "Post message: " <> status + twInfo <- getTWInfoFromEnv + mgr <- newManager tlsManagerSettings + res <- call twInfo mgr $ statusesUpdate status + print res diff --git a/sample/postWithMedia.hs b/sample/postWithMedia.hs --- a/sample/postWithMedia.hs +++ b/sample/postWithMedia.hs @@ -1,15 +1,18 @@ {-# LANGUAGE OverloadedStrings #-} + module Main where -import qualified Data.Text as T -import Control.Monad.IO.Class +import Common import Web.Twitter.Conduit + +import qualified Data.Text as T import System.Environment -import Common main :: IO () -main = runTwitterFromEnv' $ do - [status, filepath] <- liftIO getArgs - liftIO $ putStrLn $ "Post message: " ++ status - res <- call $ updateWithMedia (T.pack status) (MediaFromFile filepath) - liftIO $ print res +main = do + [status, filepath] <- getArgs + putStrLn $ "Post message: " ++ status + twInfo <- getTWInfoFromEnv + mgr <- newManager tlsManagerSettings + res <- call twInfo mgr $ statusesUpdateWithMedia (T.pack status) (MediaFromFile filepath) + print res diff --git a/sample/postWithMultipleMedia.hs b/sample/postWithMultipleMedia.hs --- a/sample/postWithMultipleMedia.hs +++ b/sample/postWithMultipleMedia.hs @@ -1,27 +1,32 @@ +{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} + module Main where -import qualified Data.Text as T +import Common import Web.Twitter.Conduit +import Web.Twitter.Types.Lens + +import Control.Lens +import Control.Monad +import qualified Data.Text as T import System.Environment import System.Exit (exitFailure) import System.IO -import Control.Lens -import Control.Monad.IO.Class -import Control.Monad -import Common main :: IO () -main = runTwitterFromEnv' $ do - (status:filepathList) <- liftIO getArgs - when (length filepathList > 4) $ liftIO $ do +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 - liftIO $ putStrLn $ "Upload media: " ++ filepath - ret <- call $ mediaUpload (MediaFromFile filepath) - liftIO $ putStrLn $ "Upload completed: media_id: " ++ ret ^. mediaId . to show ++ ", filepath: " ++ filepath + putStrLn $ "Upload media: " ++ filepath + ret <- call twInfo mgr $ mediaUpload (MediaFromFile filepath) + putStrLn $ "Upload completed: media_id: " ++ ret ^. uploadedMediaId . to show ++ ", filepath: " ++ filepath return ret - liftIO $ putStrLn $ "Post message: " ++ status - res <- call $ update (T.pack status) & mediaIds ?~ (uploadedMediaList ^.. traversed . mediaId) - liftIO $ print res + putStrLn $ "Post message: " ++ status + res <- call twInfo mgr $ statusesUpdate (T.pack status) & #media_ids ?~ (uploadedMediaList ^.. traversed . uploadedMediaId) + print res diff --git a/sample/search.hs b/sample/search.hs --- a/sample/search.hs +++ b/sample/search.hs @@ -1,20 +1,24 @@ {-# LANGUAGE OverloadedStrings #-} -module Main where -import Control.Monad.IO.Class -import System.Environment +module Main where -import Web.Twitter.Conduit import Common -import qualified Data.Text as T +import Web.Twitter.Conduit +import Web.Twitter.Types.Lens + import Control.Lens +import qualified Data.Text as T +import System.Environment main :: IO () -main = runTwitterFromEnv' $ do - [keyword] <- liftIO getArgs +main = do + [keyword] <- getArgs - res <- call . search $ T.pack keyword + twInfo <- getTWInfoFromEnv + mgr <- newManager tlsManagerSettings + + res <- call twInfo mgr $ search $ T.pack keyword let metadata = res ^. searchResultSearchMetadata - liftIO . putStrLn $ "search completed in: " ++ metadata ^. searchMetadataCompletedIn . to show - liftIO . putStrLn $ "search result max id: " ++ metadata ^. searchMetadataMaxId . to show - liftIO . print $ res ^. searchResultStatuses + putStrLn $ "search completed in: " ++ metadata ^. searchMetadataCompletedIn . to show + putStrLn $ "search result max id: " ++ metadata ^. searchMetadataMaxId . to show + print $ res ^. searchResultStatuses diff --git a/sample/searchSource.hs b/sample/searchSource.hs new file mode 100644 --- /dev/null +++ b/sample/searchSource.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Common +import Web.Twitter.Conduit +import Web.Twitter.Types.Lens + +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 + runConduit $ res ^. searchResultStatuses .| CL.isolate (read num) .| CL.mapM_ print diff --git a/sample/simple.hs b/sample/simple.hs --- a/sample/simple.hs +++ b/sample/simple.hs @@ -1,64 +1,69 @@ -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} module Main where import Web.Twitter.Conduit import Web.Twitter.Types.Lens + import Control.Lens -import Web.Authenticate.OAuth (OAuth(..), Credential(..)) -import qualified Web.Authenticate.OAuth as OA -import Network.HTTP.Conduit -import qualified Data.Conduit as C +import qualified Data.ByteString.Char8 as B8 +import Data.Conduit import qualified Data.Conduit.List as CL import qualified Data.Text as T import qualified Data.Text.IO as T -import qualified Data.ByteString.Char8 as B8 -import Data.Default -import Control.Monad.Logger -import Control.Monad.Trans.Control -import Control.Monad.Trans.Resource -import Control.Monad.IO.Class 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." - } +tokens = + twitterOAuth + { oauthConsumerKey = error "You MUST specify oauthConsumerKey parameter." + , oauthConsumerSecret = error "You MUST specify oauthConsumerSecret parameter." + } -authorize :: (MonadBaseControl IO m, MonadResource m) - => OAuth -- ^ OAuth Consumer key and secret - -> (String -> m String) -- ^ PIN prompt - -> Manager - -> m Credential +authorize :: + -- | OAuth Consumer key and secret + OAuth -> + -- | PIN prompt + (String -> IO String) -> + 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 -withCredential :: (MonadLogger m, MonadBaseControl IO m, MonadIO m) => TW (ResourceT m) a -> m a -withCredential task = do - cred <- liftIO $ withManager $ \mgr -> authorize tokens getPIN mgr - let env = setCredential tokens cred def - runTW env task +getTWInfo :: Manager -> IO TWInfo +getTWInfo mgr = do + Credential cred <- authorize tokens getPIN mgr + let cred' = filter (\(k, _) -> k == "oauth_token" || k == "oauth_token_secret") cred + return $ setCredential tokens (Credential cred') def where - getPIN url = liftIO $ do + getPIN url = do putStrLn $ "browse URL: " ++ url putStr "> what was the PIN twitter provided you with? " hFlush stdout getLine main :: IO () -main = runNoLoggingT . withCredential $ do - liftIO . putStrLn $ "# your home timeline (up to 100 tweets):" - sourceWithMaxId homeTimeline - C.$= CL.isolate 100 - C.$$ CL.mapM_ $ \status -> liftIO $ do - T.putStrLn $ T.concat [ T.pack . show $ status ^. statusId - , ": " - , status ^. statusUser . userScreenName - , ": " - , status ^. statusText - ] +main = do + mgr <- newManager tlsManagerSettings + twInfo <- getTWInfo mgr + putStrLn $ "# your home timeline (up to 800 tweets):" + runConduit $ + sourceWithMaxId twInfo mgr (statusesHomeTimeline & #count ?~ 200) + .| CL.isolate 800 + .| CL.mapM_ + ( \status -> do + T.putStrLn $ + T.concat + [ T.pack . show $ status ^. statusId + , ": " + , status ^. statusUser . userScreenName + , ": " + , status ^. statusText + ] + ) diff --git a/sample/twitter-conduit-sample.cabal b/sample/twitter-conduit-sample.cabal new file mode 100644 --- /dev/null +++ b/sample/twitter-conduit-sample.cabal @@ -0,0 +1,208 @@ +name: 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 >= 2.3.0 + , 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 diff --git a/sample/unfav.hs b/sample/unfav.hs deleted file mode 100644 --- a/sample/unfav.hs +++ /dev/null @@ -1,17 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Main where - -import Control.Monad.IO.Class -import Web.Twitter.Conduit -import System.Environment -import Common -import Control.Lens - -main :: IO () -main = runTwitterFromEnv' $ do - [statusIdStr] <- liftIO getArgs - let sId = read statusIdStr - targetStatus <- call $ showId sId - liftIO . putStrLn $ "Unfavorite Tweet: " ++ targetStatus ^. to show - res <- call $ favoritesDestroy sId - liftIO $ print res diff --git a/sample/userstream.hs b/sample/userstream.hs --- a/sample/userstream.hs +++ b/sample/userstream.hs @@ -1,25 +1,23 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE PatternGuards #-} -import qualified Data.Conduit as C -import qualified Data.Conduit.List as CL -import qualified Data.Text.IO as T -import qualified Data.Text as T -import System.Process +import Common +import Web.Twitter.Conduit +import Web.Twitter.Types.Lens + +import Control.Lens import Control.Monad import Control.Monad.IO.Class -import Control.Applicative -import System.FilePath -import System.Directory +import Control.Monad.Trans.Resource import Data.Conduit import qualified Data.Conduit.Binary as CB -import Network.HTTP.Conduit - -import Web.Twitter.Conduit -import Web.Twitter.Types.Lens -import Common -import Control.Lens +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 @@ -33,35 +31,43 @@ iconPath = ( "icons") <$> confdir >>= ensureDirectoryExist main :: IO () -main = runTwitterFromEnv' $ do - src <- stream userstream - src C.$$+- CL.mapM_ (^! act (liftIO . printTL)) +main = do + twInfo <- getTWInfoFromEnv + mgr <- newManager tlsManagerSettings + runResourceT $ do + src <- stream twInfo mgr userstream + runConduit $ src .| CL.mapM_ (liftIO . printTL) showStatus :: AsStatus s => s -> T.Text -showStatus s = T.concat [ s ^. user . userScreenName - , ":" - , s ^. 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 (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 + | (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 () @@ -69,15 +75,20 @@ 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 :: + -- | screen name + String -> + -- | icon url + String -> + IO String fetchIcon sn url = do ipath <- iconPath let fname = ipath sn ++ "__" ++ takeFileName url exists <- doesFileExist fname - unless exists $ withManager $ \mgr -> do - req <- liftIO $ parseUrl url - body <- http req mgr - responseBody body $$+- CB.sinkFile fname + unless exists $ do + req <- parseRequest url + mgr <- newManager tlsManagerSettings + runResourceT $ do + body <- http req mgr + runConduit $ HTTP.responseBody body .| CB.sinkFile fname return fname diff --git a/tests/ApiSpec.hs b/tests/ApiSpec.hs --- a/tests/ApiSpec.hs +++ b/tests/ApiSpec.hs @@ -1,28 +1,38 @@ -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} module ApiSpec where +import Control.Lens import Data.Conduit import qualified Data.Conduit.List as CL -import Web.Twitter.Conduit (call, sourceWithCursor) +import Data.Time +import Network.HTTP.Conduit +import System.IO.Unsafe +import Test.Hspec +import TestUtils +import Web.Twitter.Conduit (TWInfo, accountVerifyCredentials, call, sourceWithCursor, sourceWithMaxId) import Web.Twitter.Conduit.Api -import Web.Twitter.Conduit.Types.Lens +import Web.Twitter.Conduit.Lens import qualified Web.Twitter.Conduit.Parameters as Param import Web.Twitter.Types.Lens -import Control.Lens -import TestUtils -import Test.Hspec +twInfo :: TWInfo +twInfo = unsafePerformIO getTWInfo -import System.IO.Unsafe +mgr :: Manager +mgr = unsafePerformIO $ newManager tlsManagerSettings +{-# NOINLINE mgr #-} self :: User -self = unsafePerformIO . run . call $ accountVerifyCredentials +self = unsafePerformIO $ call twInfo mgr $ accountVerifyCredentials +{-# NOINLINE self #-} spec :: Spec spec = do unit + #ifdef RUN_INTEGRATED_TEST integrated #endif @@ -32,28 +42,90 @@ integrated :: Spec integrated = do + describe "mentionsTimeline" $ do + it "returns the 20 most recent mentions for user" $ do + res <- call twInfo mgr statusesMentionsTimeline + 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 $ statusesUserTimeline (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 $ + statusesUserTimeline (Param.ScreenNameParam "thimura") + & #count ?~ 100 + & #include_rts ?~ True + res `shouldSatisfy` (anyOf (folded . statusRetweetedStatus . _Just . statusUser . userScreenName) (/= "thimura")) + it "iterate with sourceWithMaxId" $ do + let src = + sourceWithMaxId twInfo mgr $ + statusesUserTimeline (Param.ScreenNameParam "thimura") & #count ?~ 200 + tl <- runConduit $ 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 statusesHomeTimeline + length res `shouldSatisfy` (> 0) + + describe "showId" $ do + it "works for the known tweets" $ do + res <- call twInfo mgr $ statusesShowId 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 $ statusesUpdate "おまえの明日が、今日よりもずっと、楽しい事で溢れているようにと、祈っているよ" + res1 ^. statusUser . userScreenName `shouldBe` self ^. userScreenName + + res2 <- call twInfo mgr $ statusesDestroyId (res1 ^. statusId) + res2 ^. statusId `shouldBe` res1 ^. statusId + + describe "lookup" $ do + it "works for the known tweets" $ do + res <- call twInfo mgr $ statusesLookup [438691466345340928, 477757405942411265] + length res `shouldSatisfy` (== 2) + (res !! 0) ^. statusId `shouldBe` 438691466345340928 + (res !! 1) ^. statusId `shouldBe` 477757405942411265 + + it "handles extended tweets" $ do + res <- call twInfo mgr $ statusesLookup [1128358947772145672] + (res !! 0) ^. statusText `shouldBe` "Through the Twitter Developer Labs program, we'll soon preview new versions of GET /tweets and GET /users, followed\8230 https://t.co/9i4c5bUUCu" + res <- call twInfo mgr $ statusesLookup [1128358947772145672] & #tweet_mode ?~ Param.Extended + (res !! 0) ^. statusText `shouldBe` "Through the Twitter Developer Labs program, we'll soon preview new versions of GET /tweets and GET /users, followed by Tweet streaming, search & metrics. More to come! \128073 https://t.co/rDE48yNiSw https://t.co/oFsvkpnDhS" + describe "friendsIds" $ do it "returns a cursored collection of users IDs" $ do - res <- run . call $ friendsIds (Param.ScreenNameParam "thimura") + res <- call twInfo mgr $ friendsIds (Param.ScreenNameParam "thimura") res ^. contents . to length `shouldSatisfy` (> 0) it "iterate with sourceWithCursor" $ do - friends <- run $ do - let src = sourceWithCursor $ friendsIds (Param.ScreenNameParam "thimura") - src $$ CL.consume + let src = sourceWithCursor twInfo mgr $ friendsIds (Param.ScreenNameParam "thimura") + friends <- runConduit $ src .| CL.consume length friends `shouldSatisfy` (>= 0) describe "listsMembers" $ do it "returns a cursored collection of the member of specified list" $ do - res <- run . call $ listsMembers (Param.ListNameParam "thimura/haskell") + 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 = run . call $ listsMembers (Param.ListNameParam "thimura/haskell_ne") + let action = call twInfo mgr $ listsMembers (Param.ListNameParam "thimura/haskell_ne") action `shouldThrow` anyException it "iterate with sourceWithCursor" $ do - members <- run $ do - let src = sourceWithCursor $ listsMembers (Param.ListNameParam "thimura/haskell") - src $$ CL.consume + let src = sourceWithCursor twInfo mgr $ listsMembers (Param.ListNameParam "thimura/haskell") + members <- runConduit $ src .| CL.consume members ^.. traversed . userScreenName `shouldContain` ["Hackage"] diff --git a/tests/BaseSpec.hs b/tests/BaseSpec.hs new file mode 100644 --- /dev/null +++ b/tests/BaseSpec.hs @@ -0,0 +1,89 @@ +{-# LANGUAGE OverloadedStrings #-} + +module BaseSpec where + +import Web.Twitter.Conduit.Base +import Web.Twitter.Conduit.Response + +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 diff --git a/tests/StatusSpec.hs b/tests/StatusSpec.hs deleted file mode 100644 --- a/tests/StatusSpec.hs +++ /dev/null @@ -1,87 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE CPP #-} - -module StatusSpec where - -import Data.Conduit -import qualified Data.Conduit.List as CL -import Web.Twitter.Conduit (call, accountVerifyCredentials, sourceWithMaxId) -import Web.Twitter.Conduit.Status as Status -import qualified Web.Twitter.Conduit.Parameters as Param -import Web.Twitter.Types.Lens -import Control.Lens -import TestUtils - -import Test.Hspec - -import System.IO.Unsafe - -self :: User -self = unsafePerformIO . run . call $ accountVerifyCredentials - -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 <- run $ call 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 <- run . call $ 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 <- run . call - $ userTimeline (Param.ScreenNameParam "thimura") - & Param.count ?~ 100 & Param.includeRts ?~ True - res `shouldSatisfy` (anyOf (folded . statusRetweetedStatus . _Just . statusUser . userScreenName) (/= "thimura")) - it "iterate with sourceWithMaxId" $ do - tl <- run $ do - let src = sourceWithMaxId $ userTimeline (Param.ScreenNameParam "thimura") & Param.count ?~ 200 - 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 <- run $ call homeTimeline - length res `shouldSatisfy` (> 0) - - describe "showId" $ do - it "works for the known tweets" $ do - res <- run . call $ showId 477833886768959488 - res ^. statusId `shouldBe` 477833886768959488 - res ^. statusText `shouldBe` "真紅かわいいはアレセイア" - res ^. statusCreatedAt `shouldBe` "Sat Jun 14 15:24:10 +0000 2014" - res ^. statusUser . userScreenName `shouldBe` "thimura" - - describe "update & destroyId" $ do - it "posts new tweet and destroy it" $ do - res1 <- run . call $ update "おまえの明日が、今日よりもずっと、楽しい事で溢れているようにと、祈っているよ" - res1 ^. statusUser . userScreenName `shouldBe` self ^. userScreenName - - res2 <- run . call $ destroyId (res1 ^. statusId) - res2 ^. statusId `shouldBe` res1 ^. statusId - - describe "lookup" $ do - it "works for the known tweets" $ do - res <- run . call $ Status.lookup [438691466345340928, 477757405942411265] - length res `shouldSatisfy` (== 2) - (res !! 0) ^. statusId `shouldBe` 438691466345340928 - (res !! 1) ^. statusId `shouldBe` 477757405942411265 diff --git a/tests/TestUtils.hs b/tests/TestUtils.hs --- a/tests/TestUtils.hs +++ b/tests/TestUtils.hs @@ -1,25 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE CPP #-} -module TestUtils (runTwitterFromEnv, run) where - -import Web.Twitter.Conduit +module TestUtils (getTWInfo) where -import Web.Authenticate.OAuth as OA -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 Control.Monad.IO.Class -import Control.Monad.Base -import Control.Monad.Trans.Resource import System.Environment -import Control.Monad.Logger -import Control.Lens +import Web.Twitter.Conduit getOAuthTokens :: IO (OAuth, Credential) getOAuthTokens = do @@ -27,42 +12,21 @@ 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) - ] + 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 - -runTwitterFromEnv :: (MonadIO m, MonadBaseControl IO m) => TW (ResourceT m) a -> m a -runTwitterFromEnv task = do - pr <- liftBase getProxyEnv - (oa, cred) <- liftBase getOAuthTokens - let env = (setCredential oa cred def) { twProxy = pr } - runTW env task - -#ifdef USE_DEBUG_OUTPUT -run :: (MonadIO m, MonadBaseControl IO m) => TW (ResourceT (LoggingT m)) a -> m a -run = runStderrLoggingT . runTwitterFromEnv -#else -run :: (MonadIO m, MonadBaseControl IO m) => TW (ResourceT (NoLoggingT m)) a -> m a -run = runNoLoggingT . runTwitterFromEnv -#endif +getTWInfo :: IO TWInfo +getTWInfo = do + (oa, cred) <- getOAuthTokens + return $ setCredential oa cred def diff --git a/tests/doctests.hs b/tests/doctests.hs --- a/tests/doctests.hs +++ b/tests/doctests.hs @@ -1,19 +1,12 @@ module Main where -import Test.DocTest -import System.Directory -import System.FilePath -import Data.List -import Control.Monad -import Control.Applicative +import Build_doctests (flags, module_sources, pkgs) +import Data.Foldable (traverse_) +import Test.DocTest (doctest) +main :: IO () main = do - -- sources <- findSources "Web" - doctest $ args -- ++ sources + traverse_ putStrLn args -- optionally print arguments + doctest args where - args = [ "-i." - , "-idist/build/autogen" - , "-optP-include" - , "-optPdist/build/autogen/cabal_macros.h" - , "Web/Twitter/Conduit.hs" - ] + args = flags ++ pkgs ++ module_sources diff --git a/tests/hlint.hs b/tests/hlint.hs deleted file mode 100644 --- a/tests/hlint.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Main where - -import Control.Monad -import Language.Haskell.HLint -import System.Environment -import System.Exit - -main :: IO () -main = do - args <- getArgs - hints <- hlint $ ["Web", "--cpp-define=HLINT", "--cpp-ansi", "--cpp-file=dist/build/autogen/cabal_macros.h"] ++ args - unless (null hints) exitFailure diff --git a/twitter-conduit.cabal b/twitter-conduit.cabal --- a/twitter-conduit.cabal +++ b/twitter-conduit.cabal @@ -1,272 +1,138 @@ -name: twitter-conduit -version: 0.0.5.8 -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.8 -build-type: Simple -homepage: https://github.com/himura/twitter-conduit +cabal-version: 1.24 +name: twitter-conduit +version: 0.6.1 +license: BSD3 +license-file: LICENSE +maintainer: Takahiro HIMURA +author: HATTORI Hiroki, Hideyuki Tanaka, Takahiro HIMURA +stability: Experimental +tested-with: ghc ==8.8.4 ghc ==8.10.7 ghc ==9.0.1 +homepage: https://github.com/himura/twitter-conduit +synopsis: + Twitter API package with conduit interface and Streaming API support. 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. + 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. +category: Web, Conduit +build-type: Custom extra-source-files: - .gitignore - .travis.yml - README.md - sample/*.hs + .gitignore + 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 build-samples - description: build samples - default: False + type: git + location: git://github.com/himura/twitter-conduit.git -flag use-debug-output - description: use debug output when running testsuites - default: False +custom-setup + setup-depends: + base, + Cabal >=1.24, + cabal-doctest >=1 && <1.1 flag run-integrated-test - description: use debug output when running testsuites - default: False + description: use debug output when running testsuites + default: False library - ghc-options: -Wall - - build-depends: - base >= 4.5 && < 5 - , transformers >= 0.2.2 - , template-haskell - , lens >= 4.0 && < 4.5 - , authenticate-oauth >= 1.3 - , resourcet >= 1.0 - , conduit >= 1.1 - , conduit-extra >= 1.1 - , monad-logger - , http-types - , http-conduit >= 2.0 && < 2.2 - , http-client >= 0.3 - , aeson >= 0.7.0.5 - , attoparsec >= 0.10 - , data-default >= 0.3 - , bytestring >= 0.9 - , text >= 0.11 - , containers - , time - , twitter-types >= 0.2 - - if flag(lens-aeson) - build-depends: lens-aeson >= 1 - - exposed-modules: - Web.Twitter.Conduit - Web.Twitter.Conduit.Types - Web.Twitter.Conduit.Types.Lens - Web.Twitter.Conduit.Types.TH - Web.Twitter.Conduit.Base - Web.Twitter.Conduit.Api - Web.Twitter.Conduit.Monad - Web.Twitter.Conduit.Stream - Web.Twitter.Conduit.Status - Web.Twitter.Conduit.Request - Web.Twitter.Conduit.Parameters - Web.Twitter.Conduit.Parameters.Internal - Web.Twitter.Conduit.Parameters.TH - - other-modules: - -test-suite hlint - type: exitcode-stdio-1.0 - main-is: hlint.hs - hs-source-dirs: tests - - build-depends: - base - , hlint >= 1.7 - -test-suite doctests - type: exitcode-stdio-1.0 - main-is: doctests.hs - hs-source-dirs: tests - - build-depends: - base - , filepath - , directory - , doctest - -test-suite spec_main - type: exitcode-stdio-1.0 - main-is: spec_main.hs - hs-source-dirs: tests, . - if flag(use-debug-output) - CPP-Options: -DUSE_DEBUG_OUTPUT - - if flag(run-integrated-test) - CPP-Options: -DRUN_INTEGRATED_TEST - - build-depends: - base >= 4.5 && < 5 - , template-haskell - , transformers-base - , transformers - , monad-control - , lens - , bytestring - , time - , text - , aeson - , attoparsec >= 0.10 - , data-default - , resourcet - , conduit - , conduit-extra >= 1.1 - , http-types - , http-conduit - , http-client - , monad-logger - , authenticate-oauth - , case-insensitive - , containers - , hspec - , twitter-types >= 0.4.0 - - 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 - StatusSpec - TestUtils - -executable simple - main-is: simple.hs - hs-source-dirs: sample/ + 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.Request.Internal + Web.Twitter.Conduit.Response + Web.Twitter.Conduit.Cursor + Web.Twitter.Conduit.Parameters - if !flag(build-samples) - buildable: False - else + default-language: Haskell2010 + ghc-options: -Wall build-depends: - base >= 4.5 && < 5 - , transformers-base - , transformers - , monad-control - , lens - , bytestring - , text - , data-default - , resourcet - , conduit - , http-conduit - , monad-logger - , authenticate-oauth - , twitter-conduit - , twitter-types - -executable userstream - main-is: userstream.hs - hs-source-dirs: sample/ + base >=4.12 && <5, + aeson >=0.7.0.5, + attoparsec >=0.10, + authenticate-oauth >=1.3, + bytestring >=0.10.2, + conduit >=1.3, + conduit-extra >=1.3, + containers, + data-default >=0.3, + deepseq, + exceptions >=0.5, + ghc-prim, + http-client >=0.5.0, + http-conduit >=2.3 && <2.4, + http-types, + lens >=4.4, + lens-aeson >=1, + resourcet >=1.0, + text >=0.11, + time, + transformers >=0.2.2, + twitter-types >=0.9, + twitter-types-lens >=0.9 - if !flag(build-samples) - buildable: False - else +test-suite doctests + type: exitcode-stdio-1.0 + main-is: doctests.hs + hs-source-dirs: tests + default-language: Haskell2010 build-depends: - base >= 4.5 && < 5 - , containers - , transformers-base - , transformers - , monad-control - , bytestring - , text - , filepath - , directory - , process - , case-insensitive - , lens - , aeson - , data-default - , resourcet - , conduit - , conduit-extra - , http-conduit - , monad-logger - , authenticate-oauth - , twitter-conduit - , twitter-types - - if flag(network-uri) - build-depends: network-uri >= 2.6 - else - build-depends: network < 2.6 + base, + doctest -executable oauth_callback - main-is: oauth_callback.hs - hs-source-dirs: sample/ +test-suite spec_main + type: exitcode-stdio-1.0 + main-is: spec_main.hs + build-tool-depends: hspec-discover:hspec-discover >=2.3.0 + hs-source-dirs: tests + other-modules: + Spec + ApiSpec + BaseSpec + TestUtils - if !flag(build-samples) - buildable: False - else + default-language: Haskell2010 build-depends: - base >= 4.5 && < 5 - , containers - , transformers-base - , transformers - , monad-control - , bytestring - , text - , resourcet - , conduit - , http-types - , http-conduit - , authenticate-oauth - , twitter-conduit - , scotty >= 0.7 - -executable oauth_pin - main-is: oauth_pin.hs - hs-source-dirs: sample/ + base, + aeson, + attoparsec, + authenticate-oauth, + bytestring, + conduit, + conduit-extra, + containers, + data-default, + hspec, + http-client, + http-conduit, + http-types, + lens, + lens-aeson, + resourcet, + text, + time, + twitter-conduit, + twitter-types, + twitter-types-lens - if !flag(build-samples) - buildable: False - else - build-depends: - base >= 4.5 && < 5 - , containers - , transformers-base - , transformers - , monad-control - , bytestring - , text - , resourcet - , conduit - , http-types - , http-conduit - , authenticate-oauth - , twitter-conduit + if flag(run-integrated-test) + cpp-options: -DRUN_INTEGRATED_TEST