diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2013 Loyful +Copyright (c) 2013-2014 Prowdsponsor All rights reserved. @@ -13,7 +13,7 @@ disclaimer in the documentation and/or other materials provided with the distribution. - * Neither the name of Felipe Lessa , JP Moresmau nor the names of other + * Neither the name of Felipe Lessa, JP Moresmau, Prowdsponsor nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. diff --git a/ig.cabal b/ig.cabal --- a/ig.cabal +++ b/ig.cabal @@ -1,12 +1,12 @@ name: ig -version: 0.2 +version: 0.2.1 synopsis: Bindings to Instagram's API. -homepage: https://github.com/loyful/ig +homepage: https://github.com/prowdsponsor/ig license: BSD3 license-file: LICENSE -author: Felipe Lessa , JP Moresmau -maintainer: Loyful -copyright: (c) 2013 Loyful +author: Felipe Lessa , JP Moresmau +maintainer: Prowdsponsor +copyright: (c) 2013-2014 Prowdsponsor category: Web build-type: Simple cabal-version: >=1.8 @@ -19,49 +19,68 @@ API, this package is being developed on demand. If you need something that has not been implemented yet, please send a pull request or file an issue on GitHub - (). + (). . - A sample Yesod application demonstrating the API can be found at . + A sample Yesod application demonstrating the API can be found at . source-repository head type: git - location: git://github.com/loyful/ig.git + location: git://github.com/prowdsponsor/ig.git flag debug default: False description: Print debugging info. +flag conduit11 + description: Use conduit >= 1.1. + library hs-source-dirs: src ghc-options: -Wall exposed-modules: Instagram +-- other-modules: build-depends: - base >= 4 && < 5 - , bytestring >= 0.9 && < 0.11 - , text == 0.11.* - , transformers >= 0.2 && < 0.4 - , transformers-base - , monad-control - , resourcet - , conduit == 1.0.* - , http-types - , http-conduit == 2.0.* - , attoparsec >= 0.10 && < 0.12 - , attoparsec-conduit == 1.0.* - , aeson >= 0.5 && < 0.8 - , time - , data-default - , lifted-base - , unordered-containers - , crypto-api >= 0.11 && < 0.13 - , cryptohash >= 0.7 - , cryptohash-cryptoapi == 0.1.* - , base16-bytestring >= 0.1 + base >= 4 && < 5 + , bytestring >= 0.9 && < 0.11 + , text >= 0.11 + , transformers >= 0.2 && < 0.4 + , transformers-base + , monad-control + , resourcet + , http-types + , http-conduit >= 2.0 && < 2.2 + , attoparsec >= 0.10 && < 0.12 + , aeson >= 0.5 + , time + , data-default + , lifted-base + , unordered-containers + , crypto-api >= 0.11 && < 0.14 + , cryptohash >= 0.7 + , cryptohash-cryptoapi == 0.1.* + , base16-bytestring >= 0.1 + if flag(conduit11) + build-depends: + conduit == 1.1.* + , conduit-extra == 1.1.* + else + build-depends: + conduit == 1.0.* + , attoparsec-conduit == 1.0.* extensions: OverloadedStrings DeriveDataTypeable - other-modules: + -- -- Copied from fb-0.14.6, may be useful =). + -- EmptyDataDecls + -- GADTs + -- StandaloneDeriving + -- ScopedTypeVariables + -- GeneralizedNewtypeDeriving + -- TypeFamilies + -- FlexibleInstances + -- MultiParamTypeClasses + other-modules: Instagram.Types, Instagram.Monad, Instagram.Auth, diff --git a/src/Instagram/Auth.hs b/src/Instagram/Auth.hs --- a/src/Instagram/Auth.hs +++ b/src/Instagram/Auth.hs @@ -16,13 +16,12 @@ import qualified Data.Text.Encoding as TE import qualified Network.HTTP.Types as HT -import Data.Conduit -- | the URI to redirect the user after she accepts/refuses to authorize the app type RedirectUri = Text -- | get the authorize url to redirect your user to -getUserAccessTokenURL1 :: Monad m => +getUserAccessTokenURL1 :: Monad m => RedirectUri -- ^ the URI to redirect the user after she accepts/refuses to authorize the app -> [Scope] -- ^ the requested scopes (can be empty for Basic) -> InstagramT m Text -- ^ the URL to redirect the user to @@ -37,19 +36,16 @@ buildScopes :: [Scope] -> HT.SimpleQuery buildScopes []=[] buildScopes l =[("scope",BS.intercalate "+" $ map (TE.encodeUtf8 . toLower . pack . show) l)] - + -- | second step of authorization: get the access token once the user has been redirected with a code getUserAccessTokenURL2 :: (MonadBaseControl IO m, MonadResource m) => RedirectUri -- ^ the redirect uri -> Text -- ^ the code sent back to your app -> InstagramT m OAuthToken -- ^ the auth token -getUserAccessTokenURL2 url code= +getUserAccessTokenURL2 url code= addClientInfos buildQuery >>= getPostRequest "/oauth/access_token" >>= getJSONResponse where -- | build query parameters buildQuery :: HT.SimpleQuery buildQuery =[("redirect_uri",TE.encodeUtf8 url),("grant_type","authorization_code"), ("code",TE.encodeUtf8 code)] - - - diff --git a/src/Instagram/Comments.hs b/src/Instagram/Comments.hs --- a/src/Instagram/Comments.hs +++ b/src/Instagram/Comments.hs @@ -10,25 +10,24 @@ import Instagram.Monad import Instagram.Types -import Data.Conduit import qualified Network.HTTP.Types as HT import Data.Text (Text) -- | Get a full list of comments on a media. -getComments :: (MonadBaseControl IO m, MonadResource m) => MediaID +getComments :: (MonadBaseControl IO m, MonadResource m) => MediaID -> Maybe OAuthToken -> InstagramT m (Envelope [Comment]) getComments mid token =getGetEnvelopeM ["/v1/media/",mid,"/comments"] token ([]::HT.Query) -- | Create a comment on a media. -postComment :: (MonadBaseControl IO m, MonadResource m) => MediaID +postComment :: (MonadBaseControl IO m, MonadResource m) => MediaID -> OAuthToken -> Text -> InstagramT m (Envelope NoResult) postComment mid token txt =getPostEnvelope ["/v1/media/",mid,"/comments"] token ["text" ?+ txt] -- | Remove a comment either on the authenticated user's media or authored by the authenticated user. -deleteComment :: (MonadBaseControl IO m, MonadResource m) => MediaID +deleteComment :: (MonadBaseControl IO m, MonadResource m) => MediaID -> CommentID -> OAuthToken -> InstagramT m (Envelope NoResult) diff --git a/src/Instagram/Geographies.hs b/src/Instagram/Geographies.hs --- a/src/Instagram/Geographies.hs +++ b/src/Instagram/Geographies.hs @@ -9,9 +9,8 @@ import Instagram.Monad import Instagram.Types -import qualified Network.HTTP.Types as HT +import qualified Network.HTTP.Types as HT import qualified Data.Text as T (Text) -import Data.Conduit import Data.Default import Data.Typeable import Data.Maybe (isJust) @@ -22,12 +21,12 @@ ,gmpMinId :: Maybe T.Text } deriving (Show,Typeable) - + instance Default GeographyMediaParams where def=GeographyMediaParams Nothing Nothing - + instance HT.QueryLike GeographyMediaParams where - toQuery (GeographyMediaParams cnt minI)=filter (isJust .snd) + toQuery (GeographyMediaParams cnt minI)=filter (isJust .snd) ["count" ?+ cnt ,"min_id" ?+ minI ] diff --git a/src/Instagram/Likes.hs b/src/Instagram/Likes.hs --- a/src/Instagram/Likes.hs +++ b/src/Instagram/Likes.hs @@ -1,5 +1,5 @@ {-# LANGUAGE FlexibleContexts #-} --- | Likes handling +-- | Likes handling -- module Instagram.Likes ( getLikes @@ -10,24 +10,23 @@ import Instagram.Monad import Instagram.Types -import Data.Conduit import qualified Network.HTTP.Types as HT -- | Get a list of users who have liked this media. -getLikes :: (MonadBaseControl IO m, MonadResource m) => MediaID +getLikes :: (MonadBaseControl IO m, MonadResource m) => MediaID -> Maybe OAuthToken -> InstagramT m (Envelope [User]) getLikes mid token =getGetEnvelopeM ["/v1/media/",mid,"/likes"] token ([]::HT.Query) -- | Set a like on this media by the currently authenticated user. -like :: (MonadBaseControl IO m, MonadResource m) => MediaID +like :: (MonadBaseControl IO m, MonadResource m) => MediaID -> OAuthToken -> InstagramT m (Envelope NoResult) like mid token =getPostEnvelope ["/v1/media/",mid,"/likes"] token ([]::HT.Query) -- | Remove a like on this media by the currently authenticated user. -unlike :: (MonadBaseControl IO m, MonadResource m) => MediaID +unlike :: (MonadBaseControl IO m, MonadResource m) => MediaID -> OAuthToken -> InstagramT m (Envelope NoResult) unlike mid token =getDeleteEnvelope ["/v1/media/",mid,"/likes"] token ([]::HT.Query) diff --git a/src/Instagram/Locations.hs b/src/Instagram/Locations.hs --- a/src/Instagram/Locations.hs +++ b/src/Instagram/Locations.hs @@ -12,16 +12,15 @@ import Instagram.Monad import Instagram.Types -import qualified Network.HTTP.Types as HT +import qualified Network.HTTP.Types as HT import Data.Time.Clock.POSIX (POSIXTime) import qualified Data.Text as T (Text) -import Data.Conduit import Data.Typeable import Data.Default import Data.Maybe (isJust) --- | Get information about a location. +-- | Get information about a location. getLocation :: (MonadBaseControl IO m, MonadResource m) => LocationID -> Maybe OAuthToken @@ -37,18 +36,18 @@ lmspMinId :: Maybe T.Text } deriving (Show,Typeable) - + instance Default LocationMediaParams where def=LocationMediaParams Nothing Nothing Nothing Nothing - + instance HT.QueryLike LocationMediaParams where - toQuery (LocationMediaParams maxT minT maxI minI)=filter (isJust .snd) + toQuery (LocationMediaParams maxT minT maxI minI)=filter (isJust .snd) ["max_timestamp" ?+ maxT ,"min_timestamp" ?+ minT ,"max_id" ?+ maxI ,"min_id" ?+ minI ] --- | Get a list of recent media objects from a given location. +-- | Get a list of recent media objects from a given location. getLocationRecentMedia :: (MonadBaseControl IO m, MonadResource m) => LocationID -> Maybe OAuthToken @@ -66,12 +65,12 @@ ,lspFoursquareID :: Maybe T.Text } deriving (Show,Typeable) - + instance Default LocationSearchParams where def=LocationSearchParams Nothing Nothing Nothing Nothing Nothing - + instance HT.QueryLike LocationSearchParams where - toQuery (LocationSearchParams lat long dis fsidV2 fsid )=filter (isJust .snd) + toQuery (LocationSearchParams lat long dis fsidV2 fsid )=filter (isJust .snd) ["lat" ?+ lat ,"lng" ?+ long ,"distance" ?+ dis @@ -79,7 +78,7 @@ ,"foursquare_id" ?+ fsid ] --- | Search for a location by geographic coordinate. +-- | Search for a location by geographic coordinate. searchLocations :: (MonadBaseControl IO m, MonadResource m) => Maybe OAuthToken -> LocationSearchParams diff --git a/src/Instagram/Media.hs b/src/Instagram/Media.hs --- a/src/Instagram/Media.hs +++ b/src/Instagram/Media.hs @@ -11,7 +11,6 @@ import Instagram.Monad import Instagram.Types -import Data.Conduit import qualified Network.HTTP.Types as HT import Data.Default (Default(..)) import Data.Time.Clock.POSIX (POSIXTime) @@ -19,7 +18,7 @@ import Data.Maybe (isJust) -- | Get information about a media object. -getMedia :: (MonadBaseControl IO m, MonadResource m) => MediaID +getMedia :: (MonadBaseControl IO m, MonadResource m) => MediaID -> Maybe OAuthToken -> InstagramT m (Envelope (Maybe Media)) getMedia mid token =getGetEnvelopeM ["/v1/media/",mid] token ([]::HT.Query) @@ -28,7 +27,7 @@ getPopularMedia :: (MonadBaseControl IO m, MonadResource m) => Maybe OAuthToken -> InstagramT m (Envelope [Media]) -getPopularMedia token =getGetEnvelopeM ["/v1/media/popular"] token ([]::HT.Query) +getPopularMedia token =getGetEnvelopeM ["/v1/media/popular"] token ([]::HT.Query) -- | Parameters for call to media search data MediaSearchParams = MediaSearchParams { @@ -39,23 +38,22 @@ ,mspMinTimestamp :: Maybe POSIXTime } deriving (Show,Typeable) - + instance Default MediaSearchParams where def=MediaSearchParams Nothing Nothing Nothing Nothing Nothing - + instance HT.QueryLike MediaSearchParams where - toQuery (MediaSearchParams lat long dis maxT minT )=filter (isJust .snd) + toQuery (MediaSearchParams lat long dis maxT minT )=filter (isJust .snd) ["lat" ?+ lat ,"lng" ?+ long ,"distance" ?+ dis ,"max_timestamp" ?+ maxT ,"min_timestamp" ?+ minT ] - + -- | Search for media in a given area. searchMedia :: (MonadBaseControl IO m, MonadResource m) => Maybe OAuthToken -> MediaSearchParams -> InstagramT m (Envelope [Media]) searchMedia =getGetEnvelopeM ["/v1/media/search"] - diff --git a/src/Instagram/Monad.hs b/src/Instagram/Monad.hs --- a/src/Instagram/Monad.hs +++ b/src/Instagram/Monad.hs @@ -1,6 +1,6 @@ {-# LANGUAGE ScopedTypeVariables, GeneralizedNewtypeDeriving, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, TypeFamilies, - FlexibleContexts, RankNTypes,CPP #-} + FlexibleContexts, RankNTypes, CPP, StandaloneDeriving #-} -- | the instagram monad stack and helper functions module Instagram.Monad ( InstagramT @@ -26,22 +26,25 @@ ,addTokenM ,addClientInfos ,ToHtQuery(..) + + , MonadBaseControl + , R.MonadResource ) where import Instagram.Types -import Control.Applicative +import Control.Applicative import Control.Monad (MonadPlus, liftM) import Control.Monad.Base (MonadBase(..)) import Control.Monad.Fix (MonadFix) -import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad.IO.Class (MonadIO) import Control.Monad.Trans.Class (MonadTrans(lift)) import Control.Monad.Trans.Control ( MonadTransControl(..), MonadBaseControl(..) , ComposeSt, defaultLiftBaseWith , defaultRestoreM ) import Control.Monad.Trans.Reader (ReaderT(..), ask, mapReaderT) +import Data.Default (def) import Data.Typeable (Typeable) -import Data.Default import qualified Control.Monad.Trans.Resource as R import qualified Control.Exception.Lifted as L @@ -59,6 +62,7 @@ import Data.Time.Clock.POSIX (POSIXTime) #if DEBUG +import Control.Monad.IO.Class (liftIO) import Data.Conduit.Binary (sinkHandle) import System.IO (stdout) import Data.Conduit.Util (zipSinks) @@ -67,10 +71,11 @@ -- | the instagram monad transformer -- this encapsulates the data necessary to pass the app credentials, etc newtype InstagramT m a = Is { unIs :: ReaderT IsData m a } - deriving ( Functor, Applicative, Alternative, Monad - , MonadFix, MonadPlus, MonadIO, MonadTrans - , R.MonadThrow, R.MonadActive, R.MonadResource ) - + deriving ( Functor, Applicative, Alternative, Monad, MonadFix + , MonadPlus, MonadIO, MonadTrans, R.MonadThrow ) + +deriving instance R.MonadResource m => R.MonadResource (InstagramT m) + instance MonadBase b m => MonadBase b (InstagramT m) where liftBase = lift . liftBase @@ -83,7 +88,7 @@ newtype StM (InstagramT m) a = StMT {unStMT :: ComposeSt InstagramT m a} liftBaseWith = defaultLiftBaseWith StMT restoreM = defaultRestoreM unStMT - + -- | Run a computation in the 'InstagramT' monad transformer with -- your credentials. runInstagramT :: Credentials -- ^ Your app's credentials. @@ -92,7 +97,7 @@ -> m a -- ^ the result runInstagramT creds manager (Is act) = runReaderT act (IsData creds manager "api.instagram.com") -- potentially we could open to other hosts if there were test endpoints, etc... - + -- | Get the user's credentials. getCreds :: Monad m => InstagramT m Credentials getCreds = isCreds `liftM` Is ask @@ -125,7 +130,7 @@ let qs=HT.renderQuery True $ HT.toQuery query #if DEBUG liftIO $ BSC.putStrLn $ BS.append path qs -#endif +#endif return $ def { H.secure=True , H.host = host @@ -145,7 +150,7 @@ -- | build a URL for a get operation with a single query getQueryURL :: (Monad m,HT.QueryLike q) => ByteString -- ^ the url path - -> q -- ^ the query parameters + -> q -- ^ the query parameters -> InstagramT m ByteString -- ^ the URL getQueryURL path query=do host<-getHost @@ -153,7 +158,7 @@ -- | perform a HTTP request and deal with the JSON result igReq :: forall b (m :: * -> *) wrappedErr . - (MonadBaseControl IO m, C.MonadResource m,FromJSON b,FromJSON wrappedErr) => + (MonadBaseControl IO m, R.MonadResource m,FromJSON b,FromJSON wrappedErr) => H.Request -> (wrappedErr -> IGError) -- ^ extract the error from the JSON -> InstagramT m b @@ -167,15 +172,15 @@ cookies = H.responseCookieJar res ok=isOkay status err=H.StatusCodeException status headers cookies - L.catch (do + L.catch (do #if DEBUG (value,_)<-H.responseBody res C.$$+- zipSinks (sinkParser json) (sinkHandle stdout) liftIO $ BSC.putStrLn "" -#else +#else value<-H.responseBody res C.$$+- sinkParser json #endif if ok - then + then -- parse response as the expected value case fromJSON value of Success ot->return ot @@ -186,11 +191,11 @@ Success ise-> throw $ IGAppException $ extractError ise _ -> throw err -- we can't even parse the error, throw the HTTP error ) (\(_::ParseError)->throw err) -- the error body wasn't even json - + -- | get a JSON response from a request to Instagram -- instagram returns either a result, or an error getJSONResponse :: forall (m :: * -> *) v. - (MonadBaseControl IO m, C.MonadResource m,FromJSON v) => + (MonadBaseControl IO m, R.MonadResource m,FromJSON v) => H.Request -> InstagramT m v @@ -199,14 +204,14 @@ -- | get an envelope from a request to Instagram -- the error is wrapped inside the envelope getJSONEnvelope :: forall (m :: * -> *) v. - (MonadBaseControl IO m, C.MonadResource m,FromJSON v) => + (MonadBaseControl IO m, R.MonadResource m,FromJSON v) => H.Request -> InstagramT m (Envelope v) getJSONEnvelope req=igReq req eeMeta -- | get an envelope from Instagram -getGetEnvelope :: (MonadBaseControl IO m, C.MonadResource m,HT.QueryLike ql,FromJSON v) => +getGetEnvelope :: (MonadBaseControl IO m, R.MonadResource m,HT.QueryLike ql,FromJSON v) => [T.Text] -- ^ the URL components, will be concatenated -> OAuthToken -- ^ the access token -> ql -- ^ the query parameters @@ -214,7 +219,7 @@ getGetEnvelope urlComponents token=getGetEnvelopeM urlComponents (Just token) -- | get an envelope from Instagram, with optional authentication -getGetEnvelopeM :: (MonadBaseControl IO m, C.MonadResource m,HT.QueryLike ql,FromJSON v) => +getGetEnvelopeM :: (MonadBaseControl IO m, R.MonadResource m,HT.QueryLike ql,FromJSON v) => [T.Text] -- ^ the URL components, will be concatenated -> Maybe OAuthToken -- ^ the access token -> ql -- ^ the query parameters @@ -222,7 +227,7 @@ getGetEnvelopeM=getEnvelopeM getGetRequest -- | send a delete and get an envelope from Instagram -getDeleteEnvelope :: (MonadBaseControl IO m, C.MonadResource m,HT.QueryLike ql,FromJSON v) => +getDeleteEnvelope :: (MonadBaseControl IO m, R.MonadResource m,HT.QueryLike ql,FromJSON v) => [T.Text] -- ^ the URL components, will be concatenated -> OAuthToken -- ^ the access token -> ql -- ^ the query parameters @@ -230,7 +235,7 @@ getDeleteEnvelope urlComponents token=getDeleteEnvelopeM urlComponents (Just token) -- | send a delete and get an envelope from Instagram, with optional authentication -getDeleteEnvelopeM :: (MonadBaseControl IO m, C.MonadResource m,HT.QueryLike ql,FromJSON v) => +getDeleteEnvelopeM :: (MonadBaseControl IO m, R.MonadResource m,HT.QueryLike ql,FromJSON v) => [T.Text] -- ^ the URL components, will be concatenated -> Maybe OAuthToken -- ^ the access token -> ql -- ^ the query parameters @@ -238,7 +243,7 @@ getDeleteEnvelopeM=getEnvelopeM getDeleteRequest -- | post a request and get back an envelope from Instagram -getPostEnvelope :: (MonadBaseControl IO m, C.MonadResource m,HT.QueryLike ql,FromJSON v) => +getPostEnvelope :: (MonadBaseControl IO m, R.MonadResource m,HT.QueryLike ql,FromJSON v) => [T.Text] -- ^ the URL components, will be concatenated -> OAuthToken -- ^ the access token -> ql -- ^ the query parameters @@ -246,7 +251,7 @@ getPostEnvelope urlComponents token=getPostEnvelopeM urlComponents (Just token) -- | post a request and get back an envelope from Instagram, with optional authentication -getPostEnvelopeM :: (MonadBaseControl IO m, C.MonadResource m,HT.QueryLike ql,FromJSON v) => +getPostEnvelopeM :: (MonadBaseControl IO m, R.MonadResource m,HT.QueryLike ql,FromJSON v) => [T.Text] -- ^ the URL components, will be concatenated -> Maybe OAuthToken -- ^ the access token -> ql -- ^ the query parameters @@ -254,58 +259,58 @@ getPostEnvelopeM=getEnvelopeM getPostRequest -- | utility function to get an envelop, independently of how the request is built -getEnvelopeM :: (MonadBaseControl IO m, C.MonadResource m,HT.QueryLike ql,FromJSON v) => - (ByteString -> HT.Query -> InstagramT m H.Request) -- ^ the request building method +getEnvelopeM :: (MonadBaseControl IO m, R.MonadResource m,HT.QueryLike ql,FromJSON v) => + (ByteString -> HT.Query -> InstagramT m H.Request) -- ^ the request building method -> [T.Text] -- ^ the URL components, will be concatenated -> Maybe OAuthToken -- ^ the access token -> ql -- ^ the query parameters -> InstagramT m (Envelope v) -- ^ the resulting envelope getEnvelopeM f urlComponents token ql=do let url=TE.encodeUtf8 $ T.concat urlComponents - addTokenM token ql >>= f url >>= getJSONEnvelope - + addTokenM token ql >>= f url >>= getJSONEnvelope + -- | Get the 'H.Manager'. getManager :: Monad m => InstagramT m H.Manager getManager = isManager `liftM` Is ask -- | Run a 'ResourceT' inside a 'InstagramT'. -runResourceInIs :: (C.MonadResource m, MonadBaseControl IO m) => - InstagramT (C.ResourceT m) a +runResourceInIs :: (R.MonadResource m, MonadBaseControl IO m) => + InstagramT (R.ResourceT m) a -> InstagramT m a -runResourceInIs (Is inner) = Is $ ask >>= lift . C.runResourceT . runReaderT inner - +runResourceInIs (Is inner) = Is $ ask >>= lift . R.runResourceT . runReaderT inner + -- | Transform the computation inside a 'InstagramT'. mapInstagramT :: (m a -> n b) -> InstagramT m a -> InstagramT n b -mapInstagramT f = Is . mapReaderT f . unIs - +mapInstagramT f = Is . mapReaderT f . unIs + -- | the data kept through the computations data IsData = IsData { isCreds::Credentials -- ^ app credentials ,isManager::H.Manager -- ^ HTTP connection manager ,isHost:: ByteString -- ^ host name - } + } deriving (Typeable) - + -- | @True@ if the the 'Status' is ok (i.e. @2XX@). isOkay :: HT.Status -> Bool isOkay status = let sc = HT.statusCode status in 200 <= sc && sc < 300 - + -- | add the access token to the query addToken :: HT.QueryLike ql=> OAuthToken -> ql -> HT.Query addToken (OAuthToken{oaAccessToken=(AccessToken t)}) ql=("access_token", Just $ TE.encodeUtf8 t) : HT.toQuery ql -- | add an optional access token to the query -- if we don't have a token, we'll pass the client_id -addTokenM :: (C.MonadResource m, MonadBaseControl IO m,HT.QueryLike ql)=> Maybe OAuthToken -> ql -> InstagramT m HT.Query +addTokenM :: (R.MonadResource m, MonadBaseControl IO m,HT.QueryLike ql)=> Maybe OAuthToken -> ql -> InstagramT m HT.Query addTokenM (Just oat) ql=return $ addToken oat ql addTokenM _ ql= do cid<-liftM clientIDBS getCreds return $ ("client_id",Just cid) : HT.toQuery ql -- | add application client info to the query -addClientInfos :: (C.MonadResource m, MonadBaseControl IO m,HT.QueryLike ql) => +addClientInfos :: (R.MonadResource m, MonadBaseControl IO m,HT.QueryLike ql) => ql -> InstagramT m HT.Query addClientInfos ql= do @@ -313,7 +318,7 @@ csecret<-liftM clientSecretBS getCreds return $ ("client_id",Just cid):("client_secret", Just csecret) : HT.toQuery ql --- | simple class used to hide the serialization of parameters ansd simplify the calling code +-- | simple class used to hide the serialization of parameters ansd simplify the calling code class ToHtQuery a where (?+) :: ByteString -> a -> (ByteString,Maybe ByteString) @@ -325,22 +330,21 @@ instance ToHtQuery Integer where n ?+ d=n ?+ show d - + instance ToHtQuery (Maybe Integer) where n ?+ d=n ?+ fmap show d - + instance ToHtQuery (Maybe POSIXTime) where n ?+ d=n ?+ fmap (show . (round :: POSIXTime -> Integer)) d - + instance ToHtQuery (Maybe T.Text) where n ?+ d=(n,fmap TE.encodeUtf8 d) instance ToHtQuery T.Text where n ?+ d=(n,Just $ TE.encodeUtf8 d) - + instance ToHtQuery (Maybe String) where - n ?+ d=(n,fmap BSC.pack d) + n ?+ d=(n,fmap BSC.pack d) instance ToHtQuery String where - n ?+ d=(n,Just $ BSC.pack d) - + n ?+ d=(n,Just $ BSC.pack d) diff --git a/src/Instagram/RealTime.hs b/src/Instagram/RealTime.hs --- a/src/Instagram/RealTime.hs +++ b/src/Instagram/RealTime.hs @@ -18,9 +18,8 @@ import Data.Text (Text) import Data.Typeable -import qualified Network.HTTP.Types as HT +import qualified Network.HTTP.Types as HT import Data.Maybe (isJust) -import Data.Conduit import Data.Aeson (Value(..)) import qualified Data.ByteString.Base16 as Base16 @@ -31,29 +30,29 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL --- | create a subscription -createSubscription :: (MonadBaseControl IO m, MonadResource m) => +-- | create a subscription +createSubscription :: (MonadBaseControl IO m, MonadResource m) => SubscriptionParams -- ^ the subscription parameters -> InstagramT m (Envelope Subscription) -- ^ the created subscription createSubscription params=do let url="/v1/subscriptions/" - addClientInfos params >>= getPostRequest url >>= getJSONEnvelope + addClientInfos params >>= getPostRequest url >>= getJSONEnvelope -- | list all subscriptions for the application -listSubscriptions :: (MonadBaseControl IO m, MonadResource m) => +listSubscriptions :: (MonadBaseControl IO m, MonadResource m) => InstagramT m (Envelope [Subscription]) -- ^ the ID of the subscription listSubscriptions =do let url="/v1/subscriptions/" - addClientInfos ([]::HT.Query) >>= getGetRequest url >>= getJSONEnvelope + addClientInfos ([]::HT.Query) >>= getGetRequest url >>= getJSONEnvelope -- | delete subscriptions based on criteria -deleteSubscriptions :: (MonadBaseControl IO m, MonadResource m) => +deleteSubscriptions :: (MonadBaseControl IO m, MonadResource m) => DeletionParams -- ^ the parameters for the deletion -> InstagramT m (Envelope Value) -- ^ the ID of the subscription deleteSubscriptions params=do let url="/v1/subscriptions/" - addClientInfos params >>= getDeleteRequest url >>= getJSONEnvelope - + addClientInfos params >>= getDeleteRequest url >>= getJSONEnvelope + -- | parameters for the subscription creation data SubscriptionParams= SubscriptionParams { spRequest :: SubscriptionRequest -- ^ the actual subscription request @@ -63,14 +62,14 @@ } deriving (Read,Show,Eq,Ord,Typeable) --- | to HTTP query +-- | to HTTP query instance HT.QueryLike SubscriptionParams where - toQuery (SubscriptionParams req cb (Aspect asp) tok)=filter (isJust .snd) $ HT.toQuery req ++ + toQuery (SubscriptionParams req cb (Aspect asp) tok)=filter (isJust .snd) $ HT.toQuery req ++ ["aspect" ?+ asp ,"callback_url" ?+ cb ,"verify_token" ?+ tok] --- | details of subscription request +-- | details of subscription request data SubscriptionRequest -- | when a user uploads a picture =UserRequest @@ -87,10 +86,10 @@ grLatitude :: Double ,grLongitude :: Double ,grRadius :: Integer - } + } deriving (Read,Show,Eq,Ord,Typeable) --- | to HTTP query +-- | to HTTP query instance HT.QueryLike SubscriptionRequest where toQuery UserRequest=[("object",Just "user")] toQuery (TagRequest tag)=[("object",Just "tag"),"object_id" ?+ tag] @@ -98,8 +97,8 @@ toQuery (GeographyRequest lat lng rad)=[("object",Just "geography"),"lat" ?+ lat ,"lng" ?+ lng ,"radius" ?+ rad] - --- | deletion parameters + +-- | deletion parameters data DeletionParams -- | delete all subscriptions =DeleteAll @@ -111,13 +110,13 @@ | DeleteUsers -- | delete all tag subscriptions | DeleteTags - -- | delete all location subscriptions + -- | delete all location subscriptions | DeleteLocations - -- | delete all geography subscriptions + -- | delete all geography subscriptions | DeleteGeographies deriving (Read,Show,Eq,Ord,Typeable) --- | to HTTP query +-- | to HTTP query instance HT.QueryLike DeletionParams where toQuery DeleteAll=[("object",Just "all")] toQuery (DeleteOne i)=["id" ?+ i] @@ -125,7 +124,7 @@ toQuery DeleteTags=[("object",Just "tag")] toQuery DeleteLocations=[("object",Just "location")] toQuery DeleteGeographies=[("object",Just "geography")] - + -- | verify the signature with the content, using the secret as the key verifySignature :: Monad m => BS.ByteString -- ^ the signature diff --git a/src/Instagram/Relationships.hs b/src/Instagram/Relationships.hs --- a/src/Instagram/Relationships.hs +++ b/src/Instagram/Relationships.hs @@ -16,30 +16,29 @@ import Data.Typeable (Typeable) import qualified Network.HTTP.Types as HT -import Data.Conduit import Data.Char (toLower) -- | Get the list of users this user follows. -getFollows :: (MonadBaseControl IO m, MonadResource m) => UserID +getFollows :: (MonadBaseControl IO m, MonadResource m) => UserID -> Maybe OAuthToken -> InstagramT m (Envelope [User]) getFollows uid token =getGetEnvelopeM ["/v1/users/",uid,"/follows"] token ([]::HT.Query) -- | Get the list of users this user is followed by. -getFollowedBy :: (MonadBaseControl IO m, MonadResource m) => UserID +getFollowedBy :: (MonadBaseControl IO m, MonadResource m) => UserID -> Maybe OAuthToken -> InstagramT m (Envelope [User]) getFollowedBy uid token =getGetEnvelopeM ["/v1/users/",uid,"/followed-by"] token ([]::HT.Query) -- | List the users who have requested this user's permission to follow. -getRequestedBy :: (MonadBaseControl IO m, MonadResource m) => +getRequestedBy :: (MonadBaseControl IO m, MonadResource m) => OAuthToken -> InstagramT m (Envelope [User]) getRequestedBy token =getGetEnvelope ["/v1/users/self/requested-by"] token ([]::HT.Query) --- | Get information about a relationship to another user. -getRelationship :: (MonadBaseControl IO m, MonadResource m) => UserID +-- | Get information about a relationship to another user. +getRelationship :: (MonadBaseControl IO m, MonadResource m) => UserID -> OAuthToken -> InstagramT m (Envelope Relationship) getRelationship uid token =getGetEnvelope ["/v1/users/",uid,"/relationship"] token ([]::HT.Query) @@ -52,13 +51,13 @@ | Approve | Deny deriving (Show,Read,Eq,Ord,Bounded,Enum,Typeable) - + instance HT.QueryLike RelationShipAction where toQuery a= - ["action" ?+ map toLower (show a)] - + ["action" ?+ map toLower (show a)] + -- | Modify the relationship between the current user and the target user. -setRelationShip :: (MonadBaseControl IO m, MonadResource m) => UserID +setRelationShip :: (MonadBaseControl IO m, MonadResource m) => UserID -> OAuthToken -> RelationShipAction -> InstagramT m (Envelope Relationship) diff --git a/src/Instagram/Tags.hs b/src/Instagram/Tags.hs --- a/src/Instagram/Tags.hs +++ b/src/Instagram/Tags.hs @@ -11,21 +11,20 @@ import Instagram.Monad import Instagram.Types -import qualified Network.HTTP.Types as HT +import qualified Network.HTTP.Types as HT import qualified Data.Text as T (Text) -import Data.Conduit import Data.Typeable import Data.Default import Data.Maybe (isJust) --- | Get information about a tag object. +-- | Get information about a tag object. getTag :: (MonadBaseControl IO m, MonadResource m) => TagName -> Maybe OAuthToken ->InstagramT m (Envelope (Maybe Tag)) getTag name token=getGetEnvelopeM ["/v1/tags/",name] token ([]::HT.Query) - + -- | Get a list of recently tagged media. getRecentTagged :: (MonadBaseControl IO m, MonadResource m) => TagName @@ -34,24 +33,23 @@ ->InstagramT m (Envelope [Media]) getRecentTagged name=getGetEnvelopeM ["/v1/tags/",name,"/media/recent/"] --- | Search for tags by name. +-- | Search for tags by name. searchTags :: (MonadBaseControl IO m, MonadResource m) => TagName -> Maybe OAuthToken ->InstagramT m (Envelope [Tag]) searchTags name token=getGetEnvelopeM ["/v1/tags/search"] token ["q" ?+ name] - --- | parameters for recent tag pagination + +-- | parameters for recent tag pagination data RecentTagParams=RecentTagParams{ rtpMaxID :: Maybe T.Text ,rtpMinID :: Maybe T.Text }deriving (Show,Typeable) - + instance Default RecentTagParams where def=RecentTagParams Nothing Nothing - + instance HT.QueryLike RecentTagParams where - toQuery (RecentTagParams maxI minI)=filter (isJust .snd) + toQuery (RecentTagParams maxI minI)=filter (isJust .snd) ["max_tag_id" ?+ maxI ,"min_tag_id" ?+ minI] - diff --git a/src/Instagram/Users.hs b/src/Instagram/Users.hs --- a/src/Instagram/Users.hs +++ b/src/Instagram/Users.hs @@ -18,21 +18,20 @@ import Data.Time.Clock.POSIX (POSIXTime) import Data.Typeable (Typeable) - + import qualified Network.HTTP.Types as HT import Data.Maybe (isJust) import qualified Data.Text as T (Text) -import Data.Conduit import Data.Default --- | Get basic information about a user. -getUser :: (MonadBaseControl IO m, MonadResource m) => UserID +-- | Get basic information about a user. +getUser :: (MonadBaseControl IO m, MonadResource m) => UserID -> Maybe OAuthToken -> InstagramT m (Envelope (Maybe User)) getUser uid token =getGetEnvelopeM ["/v1/users/",uid] token ([]::HT.Query) - + -- | Parameters for call to self feed data SelfFeedParams = SelfFeedParams { sfpCount :: Maybe Integer, @@ -40,23 +39,23 @@ sfpMinId :: Maybe T.Text } deriving (Show,Typeable) - + instance Default SelfFeedParams where def=SelfFeedParams Nothing Nothing Nothing - + instance HT.QueryLike SelfFeedParams where - toQuery (SelfFeedParams c maxI minI)=filter (isJust .snd) + toQuery (SelfFeedParams c maxI minI)=filter (isJust .snd) ["count" ?+ c ,"max_id" ?+ maxI ,"min_id" ?+ minI] - - --- | See the authenticated user's feed. + + +-- | See the authenticated user's feed. getSelfFeed :: (MonadBaseControl IO m, MonadResource m) => OAuthToken - -> SelfFeedParams + -> SelfFeedParams -> InstagramT m (Envelope [Media]) -getSelfFeed =getGetEnvelope ["/v1/users/self/feed/"] +getSelfFeed =getGetEnvelope ["/v1/users/self/feed/"] -- | Parameters for call to recent media data RecentParams = RecentParams { @@ -67,23 +66,23 @@ rpMinId :: Maybe T.Text } deriving (Show,Typeable) - + instance Default RecentParams where def=RecentParams Nothing Nothing Nothing Nothing Nothing - + instance HT.QueryLike RecentParams where - toQuery (RecentParams c maxT minT maxI minI)=filter (isJust .snd) + toQuery (RecentParams c maxT minT maxI minI)=filter (isJust .snd) ["count" ?+ c ,"max_timestamp" ?+ maxT ,"min_timestamp" ?+ minT ,"max_id" ?+ maxI ,"min_id" ?+ minI] - - --- | Get the most recent media published by a user. -getRecent :: (MonadBaseControl IO m, MonadResource m) => UserID + + +-- | Get the most recent media published by a user. +getRecent :: (MonadBaseControl IO m, MonadResource m) => UserID -> OAuthToken - -> RecentParams + -> RecentParams -> InstagramT m (Envelope [Media]) getRecent uid=getGetEnvelope ["/v1/users/",uid,"/media/recent/"] @@ -93,20 +92,20 @@ slpMaxLikeID :: Maybe T.Text } deriving (Show,Typeable) - + instance Default SelfLikedParams where def=SelfLikedParams Nothing Nothing - + instance HT.QueryLike SelfLikedParams where - toQuery (SelfLikedParams c maxI)=filter (isJust .snd) - ["count" ?+ c - ,"max_like_id" ?+ maxI] + toQuery (SelfLikedParams c maxI)=filter (isJust .snd) + ["count" ?+ c + ,"max_like_id" ?+ maxI] -- | See the authenticated user's list of media they've liked. -getSelfLiked :: (MonadBaseControl IO m, MonadResource m) => OAuthToken +getSelfLiked :: (MonadBaseControl IO m, MonadResource m) => OAuthToken -> SelfLikedParams - -> InstagramT m (Envelope [Media]) -getSelfLiked =getGetEnvelope ["/v1/users/self/media/liked"] + -> InstagramT m (Envelope [Media]) +getSelfLiked =getGetEnvelope ["/v1/users/self/media/liked"] -- | parameters for self liked call data UserSearchParams = UserSearchParams { @@ -114,14 +113,14 @@ uspCount :: Maybe Integer } deriving (Show,Typeable) - + instance HT.QueryLike UserSearchParams where - toQuery (UserSearchParams q c )=filter (isJust .snd) + toQuery (UserSearchParams q c )=filter (isJust .snd) ["count" ?+ c -- does not seem to be taken into account... - ,"q" ?+ q] + ,"q" ?+ q] --- | Search for a user by name. -searchUsers :: (MonadBaseControl IO m, MonadResource m) => Maybe OAuthToken +-- | Search for a user by name. +searchUsers :: (MonadBaseControl IO m, MonadResource m) => Maybe OAuthToken -> UserSearchParams - -> InstagramT m (Envelope [User]) + -> InstagramT m (Envelope [User]) searchUsers =getGetEnvelopeM ["/v1/users/search"]