packages feed

ig (empty) → 0.1

raw patch · 16 files changed

+1907/−0 lines, 16 filesdep +aesondep +attoparsecdep +attoparsec-conduitsetup-changed

Dependencies added: aeson, attoparsec, attoparsec-conduit, base, base16-bytestring, bytestring, conduit, crypto-api, cryptohash, cryptohash-cryptoapi, data-default, http-conduit, http-types, lifted-base, monad-control, resourcet, text, time, transformers, transformers-base, unordered-containers

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013 Loyful++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.++    * Neither the name of Felipe Lessa <felipe.lessa@loyful.com>, JP Moresmau <jpmoresmau@gmail.com> nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ ig.cabal view
@@ -0,0 +1,88 @@+name:                ig+version:             0.1+synopsis:            Bindings to Instagram's API.+homepage:            https://github.com/loyful/ig+license:             BSD3+license-file:        LICENSE+author:              Felipe Lessa <felipe.lessa@loyful.com>, JP Moresmau <jpmoresmau@gmail.com>+maintainer:          Loyful <opensource@loyful.com>+copyright:           (c) 2013 Loyful+category:            Web+build-type:          Simple+cabal-version:       >=1.8++description:+  This package exports bindings to Instagram's APIs (see+  <http://instagram.com/developer/>).+  .+  While we would like to have a complete binding to Instagram's+  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+  (<https://github.com/loyful/ig/issues>).+  .+  A sample Yesod application demonstrating the API can be found at <https://github.com/loyful/ig-testapp>.++source-repository head+  type: git+  location: git://github.com/loyful/ig.git++flag debug+  default: False+  description: Print debugging info.++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         == 1.9.*+     , attoparsec           == 0.10.*+     , attoparsec-conduit   == 1.0.*+     , aeson                >= 0.5     && < 0.7,+     time,+     data-default,+     lifted-base,+     unordered-containers+    , crypto-api >= 0.11 && < 0.13+    , cryptohash >= 0.7+    , cryptohash-cryptoapi == 0.1.*+    , base16-bytestring    >= 0.1+  extensions:+    OverloadedStrings+    DeriveDataTypeable+    -- -- 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,+                  Instagram.Users,+                  Instagram.RealTime,+                  Instagram.Tags,+                  Instagram.Relationships,+                  Instagram.Media,+                  Instagram.Comments,+                  Instagram.Likes,+                  Instagram.Locations,+                  Instagram.Geographies+  if flag(debug)+    cpp-options: -DDEBUG
+ src/Instagram.hs view
@@ -0,0 +1,136 @@+-- | the public API for Instagram access+module Instagram+  (+  -- generic types and functions+  InstagramT+  ,runInstagramT+  ,runResourceInIs+  ,IGException++  -- authentication+  ,RedirectUri+  ,getUserAccessTokenURL1+  ,getUserAccessTokenURL2+  ,Credentials(..)+  ,OAuthToken(..)+  ,AccessToken(..) -- we open this type so that the api client can just use the token data outside of your type (as a simple Text)+  ,User(..)+  ,Scope(..)+  +  -- data+  ,Envelope(..)+  ,Pagination(..)+  ,Media(..)+  ,Position(..)+  ,UserPosition(..)+  ,Location(..)+  ,ImageData(..)+  ,Images(..)+  ,Comment(..)+  ,Collection(..)+  ,NoResult+  +  -- user+  ,UserID+  ,getUser+  ,SelfFeedParams(..)+  ,getSelfFeed+  ,RecentParams(..)+  ,getRecent+  ,SelfLikedParams(..)+  ,getSelfLiked+  ,UserSearchParams(..)+  ,searchUsers+  +  -- real time+  ,Aspect -- do not export constructor since only media is supported+  ,media+  ,CallbackUrl+  ,Subscription(..)+  ,createSubscription+  ,listSubscriptions+  ,deleteSubscriptions+  ,SubscriptionRequest(..)+  ,SubscriptionParams(..)+  ,DeletionParams(..)+  ,Update(..)+  ,verifySignature+    +  -- Tags+  ,Tag(..)+  ,TagName+  ,getTag+  ,RecentTagParams(..)+  ,getRecentTagged+  ,searchTags+  +  -- relationships+   ,OutgoingStatus(..)+  ,IncomingStatus(..)+  ,Relationship(..)+  ,getFollows+  ,getFollowedBy+  ,getRequestedBy+  ,getRelationship+  ,setRelationShip+  ,RelationShipAction(..)+  +  -- media+  ,MediaID+  ,getMedia+  ,getPopularMedia+  ,MediaSearchParams(..)+  ,searchMedia+  +  -- comments+  ,CommentID+  ,getComments+  ,postComment+  ,deleteComment+  +  -- likes+  ,getLikes+  ,like+  ,unlike+  +  -- locations+  ,LocationID+  ,getLocation+  ,LocationMediaParams(..)+  ,getLocationRecentMedia+  ,LocationSearchParams(..)+  ,searchLocations+  +  -- geographies+  ,GeographyID+  ,GeographyMediaParams(..)+  ,getGeographyRecentMedia++  ) where++import Instagram.Auth+import Instagram.Comments+import Instagram.Geographies+import Instagram.Likes+import Instagram.Locations+import Instagram.Media+import Instagram.Monad+import Instagram.RealTime+import Instagram.Relationships+import Instagram.Tags+import Instagram.Types+import Instagram.Users+++-- debugging+--import Data.Aeson+--import qualified Data.ByteString.Lazy as BS+--+--parse :: IO()+--parse = do+--  t<-BS.readFile "env1.json"+--  let d=eitherDecode t+--  print (d::Either String (Envelope [Media]))+--  return()+  +
+ src/Instagram/Auth.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE FlexibleContexts #-}+-- | handle the authorization mecanism for Instagram+-- <http://instagram.com/developer/authentication/#>+module Instagram.Auth (+  RedirectUri,+  getUserAccessTokenURL1,+  getUserAccessTokenURL2+) where++import Instagram.Monad+import Instagram.Types++import Data.Text hiding (map)+import Control.Monad (liftM)+import qualified Data.ByteString as BS (ByteString,intercalate)+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 => +  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+getUserAccessTokenURL1 url scopes=  do+  cid<-liftM clientIDBS getCreds+  bsurl<-getQueryURL "/oauth/authorize/" $ buildQuery cid ++ buildScopes scopes+  return $ TE.decodeUtf8 bsurl+  where+    -- | build the query with client id and redirect URI+    buildQuery :: BS.ByteString -> HT.SimpleQuery+    buildQuery cid=[("client_id",cid),("redirect_uri",TE.encodeUtf8 url),("response_type","code")]+    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= +  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)]+     +     +
+ src/Instagram/Comments.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE FlexibleContexts #-}+-- | comments handling+-- <http://instagram.com/developer/endpoints/comments/#>+module Instagram.Comments (+  getComments+  ,postComment+  ,deleteComment+)where++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 +  -> 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 +  -> 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 +  -> CommentID+  -> OAuthToken+  -> InstagramT m (Envelope NoResult)+deleteComment mid cid token =getDeleteEnvelope ["/v1/media/",mid,"/comments/",cid] token ([]::HT.Query)
+ src/Instagram/Geographies.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE FlexibleContexts #-}+-- | geographies handling+-- <http://instagram.com/developer/endpoints/geographies/#>+module Instagram.Geographies (+  GeographyMediaParams(..)+  ,getGeographyRecentMedia+)where++import Instagram.Monad+import Instagram.Types++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)++-- | Parameters for call to recent media in geography search+data GeographyMediaParams = GeographyMediaParams {+    gmpCount :: Maybe Integer+    ,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) +    ["count" ?+ cnt+    ,"min_id" ?+ minI   ]++-- | Get very recent media from a geography subscription that you created+getGeographyRecentMedia :: (MonadBaseControl IO m, MonadResource m) =>+  GeographyID+  -> GeographyMediaParams+  ->InstagramT m (Envelope [Media])+getGeographyRecentMedia gid = getGetEnvelopeM ["/v1/geographies/", gid,"/media/recent"] Nothing
+ src/Instagram/Likes.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE FlexibleContexts #-}+-- | Likes handling +-- <http://instagram.com/developer/endpoints/likes/#>+module Instagram.Likes (+  getLikes+  ,like+  ,unlike+)where++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 +  -> 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 +  -> 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 +  -> OAuthToken+  -> InstagramT m (Envelope NoResult)+unlike mid token =getDeleteEnvelope ["/v1/media/",mid,"/likes"] token ([]::HT.Query)
+ src/Instagram/Locations.hs view
@@ -0,0 +1,87 @@+{-# LANGUAGE FlexibleContexts #-}+-- | locations handling+-- <http://instagram.com/developer/endpoints/locations/#>+module Instagram.Locations (+  getLocation+  ,LocationMediaParams(..)+  ,getLocationRecentMedia+  ,LocationSearchParams(..)+  ,searchLocations+) where++import Instagram.Monad+import Instagram.Types++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. +getLocation :: (MonadBaseControl IO m, MonadResource m) =>+  LocationID+  -> Maybe OAuthToken+  ->InstagramT m (Envelope (Maybe Location))+getLocation lid token=getGetEnvelopeM ["/v1/locations/",lid] token ([]::HT.Query)+++-- | Parameters for call to recent media in location search+data LocationMediaParams = LocationMediaParams {+    lmspMaxTimestamp :: Maybe POSIXTime,+    lmspMinTimestamp :: Maybe POSIXTime,+    lmspMaxID :: Maybe T.Text,+    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) +    ["max_timestamp" ?+ maxT+    ,"min_timestamp" ?+ minT+    ,"max_id" ?+ maxI+    ,"min_id" ?+ minI   ]++-- | Get a list of recent media objects from a given location. +getLocationRecentMedia ::  (MonadBaseControl IO m, MonadResource m) =>+  LocationID+  -> Maybe OAuthToken+  -> LocationMediaParams+  ->InstagramT m (Envelope [Media])+getLocationRecentMedia lid = getGetEnvelopeM ["/v1/locations/", lid,"/media/recent"]+++-- | Parameters for call to media search+data LocationSearchParams = LocationSearchParams {+    lspLatitude ::  Maybe Double+    ,lspLongitude ::  Maybe Double+    ,lspDistance ::  Maybe Integer+    ,lspFoursquareIDv2 :: Maybe T.Text+    ,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) +    ["lat" ?+ lat+    ,"lng" ?+ long+    ,"distance" ?+ dis+    ,"foursquare_v2_id" ?+ fsidV2+    ,"foursquare_id" ?+ fsid+   ]++-- | Search for a location by geographic coordinate. +searchLocations ::  (MonadBaseControl IO m, MonadResource m) =>+   Maybe OAuthToken+  -> LocationSearchParams+  ->InstagramT m (Envelope [Location])+searchLocations = getGetEnvelopeM ["/v1/locations/search"]
+ src/Instagram/Media.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE FlexibleContexts #-}+-- | media handling+-- <http://instagram.com/developer/endpoints/media/#>+module Instagram.Media (+  getMedia+  ,getPopularMedia+  ,MediaSearchParams(..)+  ,searchMedia+)where++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)+import Data.Typeable (Typeable)+import Data.Maybe (isJust)++-- | Get information about a media object.+getMedia ::     (MonadBaseControl IO m, MonadResource m) => MediaID +  -> Maybe OAuthToken+  -> InstagramT m (Envelope (Maybe Media))+getMedia mid token  =getGetEnvelopeM ["/v1/media/",mid] token ([]::HT.Query)++-- | Get a list of what media is most popular at the moment.+getPopularMedia ::     (MonadBaseControl IO m, MonadResource m) =>+  Maybe OAuthToken+  -> InstagramT m (Envelope [Media])+getPopularMedia token  =getGetEnvelopeM ["/v1/media/popular"] token ([]::HT.Query)  ++-- | Parameters for call to media search+data MediaSearchParams = MediaSearchParams {+    mspLatitude ::  Maybe Double+    ,mspLongitude ::  Maybe Double+    ,mspDistance ::  Maybe Integer+    ,mspMaxTimestamp :: Maybe POSIXTime+    ,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) +    ["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"]+
+ src/Instagram/Monad.hs view
@@ -0,0 +1,345 @@+{-# LANGUAGE ScopedTypeVariables, GeneralizedNewtypeDeriving, FlexibleInstances,+  MultiParamTypeClasses, UndecidableInstances, TypeFamilies,+  FlexibleContexts, RankNTypes,CPP #-}+-- | the instagram monad stack and helper functions+module Instagram.Monad (+  InstagramT+  ,runInstagramT+  ,getCreds+  ,getHost+  ,getPostRequest+  ,getGetRequest+  ,getDeleteRequest+  ,getQueryURL+  ,getJSONResponse+  ,getJSONEnvelope+  ,getGetEnvelope+  ,getGetEnvelopeM+  ,getPostEnvelope+  ,getPostEnvelopeM+  ,getDeleteEnvelope+  ,getDeleteEnvelopeM+  ,getManager+  ,runResourceInIs+  ,mapInstagramT+  ,addToken+  ,addTokenM+  ,addClientInfos+  ,ToHtQuery(..)+  ) where++import Instagram.Types++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.Trans.Class (MonadTrans(lift))+import Control.Monad.Trans.Control ( MonadTransControl(..), MonadBaseControl(..)+                                   , ComposeSt, defaultLiftBaseWith+                                   , defaultRestoreM )+import Control.Monad.Trans.Reader (ReaderT(..), ask, mapReaderT)+import Data.Typeable (Typeable)+import qualified Control.Monad.Trans.Resource as R+import qualified Control.Exception.Lifted as L++import qualified Data.Conduit as C+import qualified Network.HTTP.Conduit as H+import qualified Network.HTTP.Types as HT+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC+import Data.Aeson (json,fromJSON,Result(..),FromJSON)+import Data.Conduit.Attoparsec (sinkParser, ParseError)+import Control.Exception.Base (throw)+import qualified Data.Text.Encoding as TE+import qualified Data.Text as T (Text,concat)+import Data.Time.Clock.POSIX (POSIXTime)++#if DEBUG+import Data.Conduit.Binary (sinkHandle)+import System.IO (stdout)+import Data.Conduit.Util (zipSinks)+#endif++-- | 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 )+             +instance MonadBase b m => MonadBase b (InstagramT m) where+    liftBase = lift . liftBase++instance MonadTransControl InstagramT where+    newtype StT InstagramT a = FbStT { unFbStT :: StT (ReaderT IsData) a }+    liftWith f = Is $ liftWith (\run -> f (liftM FbStT . run . unIs))+    restoreT = Is . restoreT . liftM unFbStT++instance MonadBaseControl b m => MonadBaseControl b (InstagramT m) where+    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.+             -> H.Manager -- ^ Connection manager (see 'H.withManager').+             -> InstagramT m a -- ^ the action to run+             -> 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++-- | Get the instagram host+getHost :: Monad m => InstagramT m ByteString+getHost = isHost `liftM` Is ask++-- | build a post request to Instagram+getPostRequest :: (Monad m,HT.QueryLike q) => ByteString -- ^ the url path+  -> q -- ^ the query parameters+  -> InstagramT m (H.Request a) -- ^ the properly configured request+getPostRequest path query=do+  host<-getHost+  return $ H.def {+                     H.secure=True+                     , H.host = host+                     , H.port = 443+                     , H.path = path+                     , H.method=HT.methodPost+                     , H.requestBody=H.RequestBodyBS $ HT.renderQuery False $ HT.toQuery query+                }++-- | build a get request to Instagram+getGetRequest :: (Monad m,MonadIO m,HT.QueryLike q) => ByteString -- ^ the url path+  -> q -- ^ the query parameters+  -> InstagramT m (H.Request a) -- ^ the properly configured request+getGetRequest path query=do+  host<-getHost+  let qs=HT.renderQuery True $ HT.toQuery query+#if DEBUG+  liftIO $ BSC.putStrLn $ BS.append path qs+#endif  +  return $ H.def {+                     H.secure=True+                     , H.host = host+                     , H.port = 443+                     , H.path = path+                     , H.method=HT.methodGet+                     , H.queryString=qs+                }++-- | build a delete request  to Instagram+getDeleteRequest :: (Monad m,MonadIO m,HT.QueryLike q) => ByteString -- ^ the url path+  -> q -- ^ the query parameters+  -> InstagramT m (H.Request a) -- ^ the properly configured request+getDeleteRequest path query=do+  get<-getGetRequest path query+  return $ get {H.method=HT.methodDelete}++-- | 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 +  -> InstagramT m ByteString  -- ^ the URL+getQueryURL path query=do+  host<-getHost+  return $ BS.concat ["https://",host,path,HT.renderQuery True  $ HT.toQuery query]++-- | 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) =>+                    H.Request (InstagramT m)+                    -> (wrappedErr -> IGError) -- ^ extract the error from the JSON+                    -> InstagramT m b+igReq req extractError=do+   -- we check the status ourselves+  let req' = req { H.checkStatus = \_ _ _ -> Nothing }+  mgr<-getManager+  res<-H.http req' mgr+  let status = H.responseStatus res+      headers = H.responseHeaders res+      cookies = H.responseCookieJar res+      ok=isOkay status+      err=H.StatusCodeException status headers cookies+  L.catch (do    +#if DEBUG+    (value,_)<-H.responseBody res C.$$+- zipSinks (sinkParser json) (sinkHandle stdout)+    liftIO $ BSC.putStrLn ""+#else  +    value<-H.responseBody res C.$$+- sinkParser json+#endif+    if ok+      then +          -- parse response as the expected value+          case fromJSON value of+            Success ot->return ot+            Error jerr->throw $ JSONException jerr -- got an ok response we couldn't parse+      else+          -- parse response as an error+          case fromJSON value of+            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) =>+                                 H.Request (InstagramT m)+                                 -> InstagramT+                                      m v+getJSONResponse req=igReq req id++-- | 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) =>+                                 H.Request (InstagramT m)+                                 -> 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) =>+  [T.Text] -- ^ the URL components, will be concatenated+  -> OAuthToken -- ^ the access token+  -> ql -- ^ the query parameters+  -> InstagramT m (Envelope v) -- ^ the resulting envelope+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) =>+  [T.Text]  -- ^ the URL components, will be concatenated+  -> Maybe OAuthToken -- ^ the access token+  -> ql -- ^ the query parameters+  -> InstagramT m (Envelope v) -- ^ the resulting envelope+getGetEnvelopeM=getEnvelopeM getGetRequest++-- | send a delete and get an envelope from Instagram+getDeleteEnvelope :: (MonadBaseControl IO m, C.MonadResource m,HT.QueryLike ql,FromJSON v) =>+  [T.Text] -- ^ the URL components, will be concatenated+  -> OAuthToken -- ^ the access token+  -> ql -- ^ the query parameters+  -> InstagramT m (Envelope v) -- ^ the resulting envelope+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) =>+  [T.Text]  -- ^ the URL components, will be concatenated+  -> Maybe OAuthToken -- ^ the access token+  -> ql -- ^ the query parameters+  -> InstagramT m (Envelope v) -- ^ the resulting envelope+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) =>+  [T.Text] -- ^ the URL components, will be concatenated+  -> OAuthToken -- ^ the access token+  -> ql -- ^ the query parameters+  -> InstagramT m (Envelope v) -- ^ the resulting envelope+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) =>+  [T.Text]  -- ^ the URL components, will be concatenated+  -> Maybe OAuthToken -- ^ the access token+  -> ql -- ^ the query parameters+  -> InstagramT m (Envelope v) -- ^ the resulting envelope+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 (InstagramT m))) -- ^ 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  +      +-- | 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+                -> InstagramT m a+runResourceInIs (Is inner) = Is $ ask >>= lift . C.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    +    +-- | 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 (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) =>+    ql ->+    InstagramT m HT.Query+addClientInfos ql= do+  cid<-liftM clientIDBS getCreds+  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  +class ToHtQuery a where+  (?+) :: ByteString -> a -> (ByteString,Maybe ByteString)++instance ToHtQuery Double where+  n ?+ d=n ?+ show d++instance ToHtQuery (Maybe Double) where+  n ?+ d=n ?+ fmap show d++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)  ++instance ToHtQuery String where+  n ?+ d=(n,Just $ BSC.pack d)    +
+ src/Instagram/RealTime.hs view
@@ -0,0 +1,140 @@+{-# LANGUAGE FlexibleContexts #-}+-- | Real time subscription management+-- <http://instagram.com/developer/realtime/#>+module Instagram.RealTime (+  createSubscription+  ,listSubscriptions+  ,deleteSubscriptions+  ,SubscriptionRequest(..)+  ,SubscriptionParams(..)+  ,DeletionParams(..)+  ,verifySignature+)++where++import Instagram.Monad+import Instagram.Types++import Data.Text (Text)+import Data.Typeable+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+import qualified Crypto.Classes as Crypto+import qualified Crypto.HMAC as Crypto+import Crypto.Hash.CryptoAPI (SHA1)+import Control.Monad (liftM)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL++-- | 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  ++-- | list all subscriptions for the application+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  ++-- | delete subscriptions based on criteria+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  + +-- | parameters for the subscription creation+data SubscriptionParams= SubscriptionParams {+  spRequest :: SubscriptionRequest -- ^ the actual subscription request+  ,spCallback :: CallbackUrl -- ^ the url Instagram will post notifications to+  ,spAspect :: Aspect  -- ^ the subscription aspect+  ,spVerifyToken :: Maybe Text -- ^ the verification token+  }+  deriving (Read,Show,Eq,Ord,Typeable)++-- | to HTTP query  +instance HT.QueryLike SubscriptionParams where+  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  +data SubscriptionRequest+  -- | when a user uploads a picture+  =UserRequest+  -- | when a picture is tagged with the given tag+  | TagRequest {+    trTag ::Text+    }+  -- | when a picture is tagged with a specific location+  | LocationRequest {+    lrID :: Text+     }+  -- | when a picture is tagged with a location inside the given region+  | GeographyRequest {+    grLatitude :: Double+    ,grLongitude :: Double+    ,grRadius :: Integer+    }  +    deriving (Read,Show,Eq,Ord,Typeable)++-- | to HTTP query    +instance HT.QueryLike SubscriptionRequest where+  toQuery UserRequest=[("object",Just "user")]+  toQuery (TagRequest tag)=[("object",Just "tag"),"object_id" ?+ tag]+  toQuery (LocationRequest i)=[("object",Just "location"),"object_id" ?+ i]+  toQuery (GeographyRequest lat lng rad)=[("object",Just "geography"),"lat" ?+ lat+    ,"lng" ?+ lng+    ,"radius" ?+ rad]+ +-- | deletion parameters +data DeletionParams+  -- | delete all subscriptions+  =DeleteAll+  -- | delete one subscription, given its ID+  | DeleteOne {+    doID :: Text+    }+  -- | delete all user subscriptions+  | DeleteUsers+  -- | delete all tag subscriptions+  | DeleteTags+  -- | delete all location subscriptions  +  | DeleteLocations+  -- | delete all geography subscriptions  +  | DeleteGeographies+   deriving (Read,Show,Eq,Ord,Typeable)++-- | to HTTP query    +instance HT.QueryLike DeletionParams where+  toQuery DeleteAll=[("object",Just "all")]+  toQuery (DeleteOne i)=["id" ?+ i]+  toQuery DeleteUsers=[("object",Just "user")]+  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+                              -> BSL.ByteString -- ^ the content+                              -> InstagramT m Bool+verifySignature sig content=do+  csecret<-liftM clientSecretBS getCreds+  let key :: Crypto.MacKey ctx SHA1+      key = Crypto.MacKey csecret -- secret is the key+      hash = Crypto.hmac key content+      expected = Base16.encode (Crypto.encode hash)+  return $! sig `Crypto.constTimeEq` expected
+ src/Instagram/Relationships.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE FlexibleContexts #-}+-- | relationship handling+-- <http://instagram.com/developer/endpoints/relationships/#>+module Instagram.Relationships (+  getFollows+  ,getFollowedBy+  ,getRequestedBy+  ,getRelationship+  ,setRelationShip+  ,RelationShipAction(..)+)where++import Instagram.Monad+import Instagram.Types++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 +  -> 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 +  -> 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) =>  +   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 +  -> OAuthToken+  -> InstagramT m (Envelope Relationship)+getRelationship uid token  =getGetEnvelope ["/v1/users/",uid,"/relationship"] token ([]::HT.Query)++-- | relationship action+data RelationShipAction =  Follow+  | Unfollow+  | Block+  | Unblock+  | Approve+  | Deny+  deriving (Show,Read,Eq,Ord,Bounded,Enum,Typeable)+  +instance HT.QueryLike RelationShipAction where+  toQuery a=+    ["action" ?+ map toLower (show a)] +  +-- | Modify the relationship between the current user and the target user.+setRelationShip :: (MonadBaseControl IO m, MonadResource m) => UserID +  -> OAuthToken+  -> RelationShipAction+  -> InstagramT m (Envelope Relationship)+setRelationShip uid=getPostEnvelope ["/v1/users/",uid,"/relationship"]
+ src/Instagram/Tags.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE FlexibleContexts #-}+-- | tag operations+-- <http://instagram.com/developer/endpoints/tags/#>+module Instagram.Tags (+  getTag+  ,RecentTagParams(..)+  ,getRecentTagged+  ,searchTags+)where++import Instagram.Monad+import Instagram.Types++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. +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+  -> Maybe OAuthToken+  -> RecentTagParams+  ->InstagramT m (Envelope [Media])+getRecentTagged name=getGetEnvelopeM ["/v1/tags/",name,"/media/recent/"]++-- | 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   +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) +    ["max_tag_id" ?+ maxI+    ,"min_tag_id" ?+ minI]+
+ src/Instagram/Types.hs view
@@ -0,0 +1,607 @@+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, ScopedTypeVariables #-}+-- | Types definitions+module Instagram.Types (+  Credentials(..)+  ,clientIDBS+  ,clientSecretBS+  ,OAuthToken(..)+  ,AccessToken(..)+  ,UserID+  ,User(..)+  ,Scope(..)+  ,IGException(..)+  ,Envelope(..)+  ,ErrEnvelope(..)+  ,IGError+  ,Pagination(..)+  ,MediaID+  ,Media(..)+  ,Position(..)+  ,UserPosition(..)+  ,LocationID+  ,Location(..)+  ,ImageData(..)+  ,Images(..)+  ,CommentID+  ,Comment(..)+  ,Collection(..)+  ,Aspect(..)+  ,media+  ,CallbackUrl+  ,Subscription(..)+  ,Update(..)+  ,TagName+  ,Tag(..)+  ,OutgoingStatus(..)+  ,IncomingStatus(..)+  ,Relationship(..)+  ,NoResult+  ,GeographyID+)where++import Control.Applicative+import Data.Text+import Data.Typeable (Typeable)+import Data.ByteString (ByteString)++import Data.Aeson+++import qualified Data.Text.Encoding as TE+import Control.Exception.Base (Exception)+import Data.Time.Clock.POSIX (POSIXTime)+import qualified Data.Text as T (pack)+import Data.Aeson.Types (Parser)+import qualified Data.HashMap.Strict as HM (lookup)++-- | the app credentials+data Credentials = Credentials {+  cClientID :: Text -- ^ client id+  ,cClientSecret :: Text -- ^ client secret+  }+  deriving (Show,Read,Eq,Ord,Typeable)+      +-- | get client id in ByteString form+clientIDBS :: Credentials -> ByteString+clientIDBS=TE.encodeUtf8 . cClientID++-- | get client secret in ByteString form+clientSecretBS :: Credentials -> ByteString+clientSecretBS=TE.encodeUtf8 . cClientSecret+      +-- | the oauth token returned after authentication+data OAuthToken = OAuthToken {+  oaAccessToken :: AccessToken -- ^ the access token+  ,oaUser :: User -- ^ the user structure returned+  }+  deriving (Show,Read,Eq,Ord,Typeable)++-- | to json as per Instagram format+instance ToJSON OAuthToken  where+    toJSON oa=object ["access_token" .= oaAccessToken oa, "user" .= oaUser oa] ++-- | from json as per Instagram format        +instance FromJSON OAuthToken where+    parseJSON (Object v) =OAuthToken <$>+                         v .: "access_token" <*>+                         v .: "user" +    parseJSON _= fail "OAuthToken"++-- | the access token is simply a Text+newtype AccessToken=AccessToken Text+    deriving (Eq, Ord, Read, Show, Typeable)+ +-- | simple string        +instance ToJSON AccessToken  where+        toJSON (AccessToken at)=String at         ++-- | simple string+instance FromJSON  AccessToken where+        parseJSON (String s)=pure $ AccessToken s+        parseJSON _= fail "AccessToken"++-- | User ID+type UserID = Text++-- | the User partial profile returned by the authentication        +data User = User {+        uID :: UserID,+        uUsername :: Text,+        uFullName :: Text,+        uProfilePicture :: Maybe Text,+        uWebsite :: Maybe Text+        }        +        deriving (Show,Read,Eq,Ord,Typeable)+    +-- | to json as per Instagram format    +instance ToJSON User  where+    toJSON u=object ["id" .= uID u, "username" .= uUsername u , "full_name" .= uFullName u, "profile_picture" .= uProfilePicture u, "website" .= uWebsite u] ++-- | from json as per Instagram format+instance FromJSON User where+    parseJSON (Object v) =User <$>+                         v .: "id" <*>+                         v .: "username" <*>+                         v .: "full_name" <*>+                         v .:? "profile_picture" <*>+                         v .:? "website"+    parseJSON _= fail "User"+    +-- | the scopes of the authentication+data Scope=Basic | Comments | Relationships | Likes+        deriving (Show,Read,Eq,Ord,Enum,Bounded,Typeable)++-- | an error returned to us by Instagram+data IGError = IGError {+  igeCode :: Int+  ,igeType :: Maybe Text+  ,igeMessage :: Maybe Text+  }+  deriving (Show,Read,Eq,Ord,Typeable)+  +-- | to json as per Instagram format    +instance ToJSON IGError  where+    toJSON e=object ["code" .= igeCode e, "error_type" .= igeType e , "error_message" .= igeMessage e] ++-- | from json as per Instagram format+instance FromJSON IGError where+    parseJSON (Object v) =IGError <$>+                         v .: "code" <*>+                         v .:? "error_type" <*>+                         v .:? "error_message"+    parseJSON _= fail "IGError"++-- | an exception that a call to instagram may throw+data IGException = JSONException String -- ^ JSON parsingError+  | IGAppException IGError -- ^ application exception+  deriving (Show,Typeable)++-- | make our exception type a normal exception  +instance Exception IGException ++-- | envelope for Instagram OK response+data Envelope d=Envelope{+  eMeta :: IGError -- ^ this should only say 200, no error, but put here for completeness+  ,eData :: d -- ^ data, garanteed to be present (otherwise we get an ErrEnvelope) +  ,ePagination :: Maybe Pagination+  }+  deriving (Show,Read,Eq,Ord,Typeable)+  +-- | to json as per Instagram format    +instance (ToJSON d)=>ToJSON (Envelope d)  where+    toJSON e=object ["meta" .= eMeta e, "data" .= eData e, "pagination" .= ePagination e]  +  +-- | from json as per Instagram format+instance (FromJSON d)=>FromJSON (Envelope d) where+    parseJSON (Object v) =Envelope <$>+                         v .: "meta" <*>+                         v .: "data" <*>+                         v .:? "pagination"+    parseJSON _= fail "Envelope"++-- | error envelope for Instagram error response+data ErrEnvelope=ErrEnvelope{+  eeMeta :: IGError+  }+  deriving (Show,Read,Eq,Ord,Typeable)+  +-- | to json as per Instagram format    +instance ToJSON ErrEnvelope  where+    toJSON e=object ["meta" .= eeMeta e]  +  +-- | from json as per Instagram format+instance FromJSON ErrEnvelope where+    parseJSON (Object v) =ErrEnvelope <$>+                         v .: "meta"+    parseJSON _= fail "ErrEnvelope"++-- | pagination info for responses that can return a lot of data  +data Pagination = Pagination {+   pNextUrl :: Maybe Text+   ,pNextMaxID :: Maybe Text+   ,pNextMinID :: Maybe Text+   ,pNextMaxTagID :: Maybe Text+   ,pMinTagID :: Maybe Text+   }+  deriving (Show,Read,Eq,Ord,Typeable)+  +-- | to json as per Instagram format    +instance ToJSON Pagination  where+    toJSON p=object ["next_url" .= pNextUrl p, "next_max_id" .= pNextMaxID p, "next_min_id" .= pNextMinID p, "next_max_tag_id" .= pNextMaxTagID p,"min_tag_id" .= pMinTagID p] ++-- | from json as per Instagram format+instance FromJSON Pagination where+    parseJSON (Object v) =Pagination <$>+                         v .:? "next_url" <*>+                         v .:? "next_max_id" <*>+                         v .:? "next_min_id" <*>+                         v .:? "next_max_tag_id" <*>+                         v .:? "min_tag_id"+    parseJSON _= fail "Pagination"  +  +-- | Media ID+type MediaID=Text+  +-- | instagram media object+data Media = Media {+  mID :: MediaID+  ,mCaption :: Maybe Comment+  ,mLink :: Text+  ,mUser :: User +  ,mCreated :: POSIXTime+  ,mImages :: Images+  ,mType :: Text+  ,mUsersInPhoto :: [UserPosition]+  ,mFilter :: Maybe Text+  ,mTags :: [Text]+  ,mLocation :: Maybe Location+  ,mComments :: Collection Comment+  ,mLikes :: Collection User+  ,mUserHasLiked :: Bool+  ,mAttribution :: Maybe Object -- ^ seems to be open format https://groups.google.com/forum/?fromgroups#!topic/instagram-api-developers/KvGH1cnjljQ+  }  +  deriving (Show,Eq,Typeable)+  +-- | to json as per Instagram format    +instance ToJSON Media  where+    toJSON m=object ["id" .= mID m,"caption" .= mCaption m,"user".= mUser m,"link" .= mLink m, "created_time" .= toJSON (show ((round $ mCreated m) :: Integer))+      ,"images" .= mImages m,"type" .= mType m,"users_in_photo" .= mUsersInPhoto m, "filter" .= mFilter m,"tags" .= mTags m+      ,"location" .= mLocation m,"comments" .= mComments m,"likes" .= mLikes m,"user_has_liked" .= mUserHasLiked m,"attribution" .= mAttribution m] ++-- | from json as per Instagram format+instance FromJSON Media where+    parseJSON (Object v) =do+      ct::String<-v .: "created_time"+      Media <$>+                         v .: "id" <*>+                         v .:? "caption" <*>+                         v .: "link" <*>+                         v .: "user" <*>+                         pure (fromIntegral (read ct::Integer)) <*>+                         v .: "images" <*>+                         v .: "type" <*>+                         v .: "users_in_photo" <*>+                         v .:? "filter" <*>+                         v .: "tags" <*>+                         v .:? "location" <*>+                         v .:? "comments" .!= Collection 0 [] <*>+                         v .:? "likes" .!= Collection 0 [] <*>+                         v .:? "user_has_liked" .!= False <*>+                         v .:? "attribution"+    parseJSON _= fail "Media"  ++-- | position in picture+data Position = Position {+  pX ::Double+  ,pY :: Double+} deriving (Show,Eq,Typeable)++  +-- | to json as per Instagram format      +instance ToJSON Position where+  toJSON p=object ["x" .= pX p,"y" .= pY p]+  +-- | from json as per Instagram format+instance FromJSON Position where+  parseJSON (Object v) = Position <$>+    v .: "x" <*>+    v .: "y" +  parseJSON _=fail "Position"+  +-- | position of a user+data UserPosition = UserPosition {+  upPosition :: Position+  ,upUser :: User+  } deriving (Show,Eq,Typeable)++  +-- | to json as per Instagram format      +instance ToJSON UserPosition where+  toJSON p=object ["position" .= upPosition p,"user" .= upUser p]+  +-- | from json as per Instagram format+instance FromJSON UserPosition where+  parseJSON (Object v) = UserPosition <$>+    v .: "position" <*>+    v .: "user" +  parseJSON _=fail "UserPosition"++-- | location ID+type LocationID = Text++-- | geographical location info+data Location = Location {+  lID :: Maybe LocationID+  ,lLatitude :: Maybe Double+  ,lLongitude :: Maybe Double+  ,lStreetAddress :: Maybe Text+  ,lName :: Maybe Text+  }  +  deriving (Show,Eq,Ord,Typeable)+  +-- | to json as per Instagram format      +instance ToJSON Location where+  toJSON l=object ["id" .= lID l,"latitude" .= lLatitude l,"longitude" .= lLongitude l, "street_address" .= lStreetAddress l,"name" .= lName l]+  +-- | from json as per Instagram format+instance FromJSON Location where+  parseJSON (Object v) = +    Location <$>+      parseID v <*>+      v .:? "latitude" <*>+      v .:? "longitude" <*>+      v .:? "street_address" <*>+      v .:? "name"+    where +      -- | the Instagram API hasn't made its mind up, sometimes location id is an int, sometimes a string+      parseID :: Object -> Parser (Maybe LocationID)+      parseID obj=case HM.lookup "id" obj of+        Just (String s)->pure $ Just s+        Just (Number n)->pure $ Just $ T.pack $ show n+        Nothing->pure Nothing+        _->fail "LocationID"+  parseJSON _= fail "Location"+  +-- | data for a single image+data ImageData = ImageData {+  idURL :: Text,+  idWidth :: Integer,+  idHeight :: Integer+  }  +  deriving (Show,Eq,Ord,Typeable)+  +-- | to json as per Instagram format      +instance ToJSON ImageData where+  toJSON i=object ["url" .= idURL i,"width" .= idWidth i,"height" .= idHeight i]+  +-- | from json as per Instagram format+instance FromJSON ImageData where+  parseJSON (Object v) = ImageData <$>+    v .: "url" <*>+    v .: "width" <*>+    v .: "height"+  parseJSON _= fail "ImageData"  +  +-- | different images for the same media+data Images = Images {+  iLowRes :: ImageData+  ,iThumbnail :: ImageData+  ,iStandardRes :: ImageData+  }+  deriving (Show,Eq,Ord,Typeable) + +-- | to json as per Instagram format      +instance ToJSON Images where+  toJSON i=object ["low_resolution" .= iLowRes i,"thumbnail" .= iThumbnail i,"standard_resolution" .= iStandardRes i]+  +-- | from json as per Instagram format+instance FromJSON Images where+  parseJSON (Object v) = Images <$>+    v .: "low_resolution" <*>+    v .: "thumbnail" <*>+    v .: "standard_resolution"+  parseJSON _= fail "Images"  + +-- | comment id+type CommentID = Text+ +-- | Commenton on a medium+data Comment = Comment {+  cID :: CommentID+  ,cCreated :: POSIXTime+  ,cText :: Text+  ,cFrom :: User+  }+  deriving (Show,Eq,Ord,Typeable) ++-- | to json asCommentstagram format    +instance ToJSON Comment  where+    toJSON c=object ["id" .= cID c,"created_time" .= toJSON (show ((round $ cCreated c) :: Integer))+      ,"text" .= cText c,"from" .= cFrom c] ++-- | from json asCommentstagram format+instance FromJSON Comment where+    parseJSON (Object v) =do+      ct::String<-v .: "created_time"+      Comment <$>+                         v .: "id" <*>+                         pure (fromIntegral (read ct::Integer)) <*>+                         v .: "text" <*>+                         v .: "from" +    parseJSON _= fail "Caption"  ++-- | a collection of items (count + data)+-- data can only be a subset+data Collection a= Collection {+  cCount :: Integer+  ,cData :: [a]+  }+  deriving (Show,Eq,Ord,Typeable) ++ +-- | to json as per Instagram format    +instance (ToJSON a)=>ToJSON (Collection a)  where+    toJSON igc=object ["count" .= cCount igc,"data" .= cData igc]++-- | from json as per Instagram format+instance (FromJSON a)=>FromJSON (Collection a) where+    parseJSON (Object v) = Collection <$>+                         v .: "count" <*>+                         v .: "data" +    parseJSON _= fail "Collection"  + ++-- | the URL to receive notifications to+type CallbackUrl = Text + +-- | notification aspect+data Aspect = Aspect Text+  deriving (Show, Read, Eq, Ord, Typeable)+  +-- | to json as per Instagram format    +instance ToJSON Aspect  where+    toJSON (Aspect t)=String t++-- | from json as per Instagram format+instance FromJSON Aspect where+    parseJSON (String t) = pure $ Aspect t+    parseJSON _= fail "Aspect"     ++-- | the media Aspect, the only one supported for now  +media :: Aspect+media = Aspect "media"++-- | a subscription to a real time notification+data Subscription= Subscription {+  sID :: Text+  ,sType :: Text+  ,sObject :: Text+  ,sObjectID :: Maybe Text+  ,sAspect :: Aspect+  ,sCallbackUrl :: CallbackUrl+  ,sLatitude :: Maybe Double+  ,sLongitude :: Maybe Double+  ,sRadius :: Maybe Integer+  }   +  deriving (Show,Eq,Typeable)+  +-- | to json as per Instagram format    +instance ToJSON Subscription  where+    toJSON s=object ["id" .= sID s,"type" .= sType s,"object" .= sObject s,"object_id" .= sObjectID s,"aspect" .= sAspect s+      ,"callback_url".=sCallbackUrl s,"lat".= sLatitude s,"lng".=sLongitude s,"radius".=sRadius s]++-- | from json as per Instagram format+instance FromJSON Subscription where+    parseJSON (Object v) = Subscription <$>+                         v .: "id" <*>+                         v .: "type" <*>+                         v .: "object" <*>+                         v .:? "object_id" <*>+                         v .: "aspect" <*>+                         v .: "callback_url" <*>+                         v .:? "lat" <*>+                         v .:? "lng" <*>+                         v .:? "radius"+    parseJSON _= fail "Subscription"   + +-- | an update from a subscription   +data Update = Update {+  uSubscriptionID :: Integer+  ,uObject :: Text+  ,uObjectID :: Text+  ,uChangedAspect :: Aspect+  ,uTime :: POSIXTime+  }+  deriving (Show,Eq,Typeable)+  +-- | to json as per Instagram format    +instance ToJSON Update  where+    toJSON u=object ["subscription_id" .= uSubscriptionID u      ,"object" .= uObject u,"object_id" .= uObjectID u+      ,"changed_aspect" .= uChangedAspect u,"time" .= toJSON ((round $ uTime u) :: Integer)] ++-- | from json as per Instagram format+instance FromJSON Update where+    parseJSON (Object v) =do+      ct::Integer<-v .: "time"+      Update <$>+                         v .: "subscription_id" <*>+                         v .: "object" <*>+                         v .: "object_id" <*>+                         v .: "changed_aspect" <*>+                         pure (fromIntegral ct)+    parseJSON _= fail "Update"    ++-- | Tag Name+type TagName = Text++-- | a Tag  +data Tag = Tag {+  tName :: TagName,+  tMediaCount :: Integer+  }+  deriving (Show,Read,Eq,Ord,Typeable) +  +-- | to json as per Instagram format    +instance ToJSON Tag  where+    toJSON t=object ["name" .= tName t,"media_count" .= tMediaCount t] ++-- | from json as per Instagram format+instance FromJSON Tag where+    parseJSON (Object v) = Tag <$>+                         v .: "name" <*>+                         v .:? "media_count" .!= 0+    parseJSON _= fail "Tag"      + +-- | outgoing relationship status   +data OutgoingStatus = Follows | Requested | OutNone+  deriving (Show,Read,Eq,Ord,Bounded,Enum,Typeable)++-- | to json as per Instagram format +instance ToJSON OutgoingStatus  where+    toJSON Follows = String "follows"+    toJSON Requested = String "requested"+    toJSON OutNone = String "none"++-- | from json as per Instagram format+instance FromJSON OutgoingStatus where+  parseJSON (String "follows")=pure Follows+  parseJSON (String "requested")=pure Requested+  parseJSON (String "none")=pure OutNone+  parseJSON _= fail "OutgoingStatus"  + +-- | incoming relationship status +data IncomingStatus = FollowedBy | RequestedBy | BlockedByYou | InNone+  deriving (Show,Read,Eq,Ord,Bounded,Enum,Typeable)++-- | to json as per Instagram format +instance ToJSON IncomingStatus  where+    toJSON FollowedBy = String "followed_by"+    toJSON RequestedBy = String "requested_by"+    toJSON BlockedByYou = String "blocked_by_you"+    toJSON InNone = String "none"++-- | from json as per Instagram format+instance FromJSON IncomingStatus where+  parseJSON (String "followed_by")=pure FollowedBy+  parseJSON (String "requested_by")=pure RequestedBy+  parseJSON (String "blocked_by_you")=pure BlockedByYou+  parseJSON (String "none")=pure InNone+  parseJSON _= fail "IncomingStatus" + +-- | a relationship between two users+data Relationship = Relationship {+  rOutgoing :: OutgoingStatus+  ,rIncoming :: IncomingStatus+  ,rTargetUserPrivate :: Bool -- ^ not present in doc+  }+  deriving (Show,Read,Eq,Ord,Typeable) ++-- | to json as per Instagram format    +instance ToJSON Relationship  where+    toJSON r=object ["outgoing_status" .= rOutgoing r,"incoming_status" .= rIncoming r,"target_user_is_private" .= rTargetUserPrivate r] ++-- | from json as per Instagram format+instance FromJSON Relationship where+    parseJSON (Object v) = Relationship <$>+                         v .:? "outgoing_status" .!= OutNone <*>+                         v .:? "incoming_status" .!= InNone <*>+                         v .:? "target_user_is_private" .!= False+    parseJSON _= fail "Relationship"    ++-- | Instagram returns data:null for nothing, but Aeson considers that () maps to an empty array...+-- so we model the fact that we expect null via NoResult    +data NoResult = NoResult+  deriving (Show,Read,Eq,Ord,Typeable)++-- | to json as per Instagram format  +instance ToJSON NoResult  where+  toJSON _=Null++-- | from json as per Instagram format+instance FromJSON NoResult where+    parseJSON Null = pure NoResult   +    parseJSON _= fail "NoResult"  ++-- | geography ID +type GeographyID = Text+
+ src/Instagram/Users.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE FlexibleContexts #-}+-- | Users end point handling+-- <http://instagram.com/developer/endpoints/users/#>+module Instagram.Users (+  getUser+  ,SelfFeedParams(..)+  ,getSelfFeed+  ,RecentParams(..)+  ,getRecent+  ,SelfLikedParams(..)+  ,getSelfLiked+  ,UserSearchParams(..)+  ,searchUsers+) where++import Instagram.Monad+import Instagram.Types++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 +  -> 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,+    sfpMaxID :: Maybe T.Text,+    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) +    ["count" ?+ c+    ,"max_id" ?+ maxI+    ,"min_id" ?+ minI]+    +    +-- |  See the authenticated user's feed.   +getSelfFeed :: (MonadBaseControl IO m, MonadResource m) =>+  OAuthToken+  -> SelfFeedParams +  -> InstagramT m (Envelope [Media])+getSelfFeed =getGetEnvelope ["/v1/users/self/feed/"] ++-- | Parameters for call to recent media+data RecentParams = RecentParams {+    rpCount :: Maybe Integer,+    rpMaxTimestamp :: Maybe POSIXTime,+    rpMinTimestamp :: Maybe POSIXTime,+    rpMaxID :: Maybe T.Text,+    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) +    ["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 +  -> OAuthToken+  -> RecentParams +  -> InstagramT m (Envelope [Media])+getRecent uid=getGetEnvelope ["/v1/users/",uid,"/media/recent/"]++-- | parameters for self liked call+data SelfLikedParams = SelfLikedParams {+  slpCount :: Maybe Integer,+  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] ++-- | See the authenticated user's list of media they've liked.+getSelfLiked :: (MonadBaseControl IO m, MonadResource m) => OAuthToken +  -> SelfLikedParams+  -> InstagramT m (Envelope [Media]) +getSelfLiked =getGetEnvelope ["/v1/users/self/media/liked"] ++-- | parameters for self liked call+data UserSearchParams = UserSearchParams {+  uspQuery :: T.Text,+  uspCount :: Maybe Integer+  }+  deriving (Show,Typeable)+  +instance HT.QueryLike UserSearchParams where+  toQuery (UserSearchParams q c )=filter (isJust .snd) +    ["count" ?+ c -- does not seem to be taken into account...+    ,"q" ?+ q] ++-- | Search for a user by name. +searchUsers :: (MonadBaseControl IO m, MonadResource m) => Maybe OAuthToken +  -> UserSearchParams+  -> InstagramT m (Envelope [User]) +searchUsers =getGetEnvelopeM ["/v1/users/search"]