Safe Haskell | None |
---|---|
Language | Haskell98 |
Description
the public API for Instagram access
- data InstagramT m a
- runInstagramT :: Credentials -> Manager -> InstagramT m a -> m a
- runResourceInIs :: (MonadResource m, MonadBaseControl IO m) => InstagramT (ResourceT m) a -> InstagramT m a
- data IGException
- type RedirectUri = Text
- getUserAccessTokenURL1 :: Monad m => RedirectUri -> [Scope] -> InstagramT m Text
- getUserAccessTokenURL2 :: (MonadBaseControl IO m, MonadResource m) => RedirectUri -> Text -> InstagramT m OAuthToken
- data Credentials = Credentials {
- cClientID :: Text
- cClientSecret :: Text
- data OAuthToken = OAuthToken {}
- newtype AccessToken = AccessToken Text
- data User = User {}
- data UserCounts = UserCounts {}
- data Scope
- = Basic
- | Comments
- | Relationships
- | Likes
- data Envelope d = Envelope {
- eMeta :: IGError
- eData :: d
- ePagination :: Maybe Pagination
- getNextPage :: (MonadBaseControl IO m, MonadResource m, FromJSON v) => Envelope v -> InstagramT m (Maybe (Envelope v))
- data Pagination = Pagination {
- pNextUrl :: Maybe Text
- pNextMaxID :: Maybe Text
- pNextMinID :: Maybe Text
- pNextMaxTagID :: Maybe Text
- pMinTagID :: Maybe Text
- 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
- data Position = Position {}
- data UserPosition = UserPosition {
- upPosition :: Position
- upUser :: User
- data Location = Location {
- lID :: Maybe LocationID
- lLatitude :: Maybe Double
- lLongitude :: Maybe Double
- lStreetAddress :: Maybe Text
- lName :: Maybe Text
- data ImageData = ImageData {}
- data Images = Images {}
- data Comment = Comment {}
- data Collection a = Collection {}
- data NoResult
- type UserID = Text
- getUser :: (MonadBaseControl IO m, MonadResource m) => UserID -> Maybe OAuthToken -> InstagramT m (Envelope (Maybe User))
- data SelfFeedParams = SelfFeedParams {}
- getSelfFeed :: (MonadBaseControl IO m, MonadResource m) => OAuthToken -> SelfFeedParams -> InstagramT m (Envelope [Media])
- data RecentParams = RecentParams {}
- getRecent :: (MonadBaseControl IO m, MonadResource m) => UserID -> OAuthToken -> RecentParams -> InstagramT m (Envelope [Media])
- data SelfLikedParams = SelfLikedParams {}
- getSelfLiked :: (MonadBaseControl IO m, MonadResource m) => OAuthToken -> SelfLikedParams -> InstagramT m (Envelope [Media])
- data UserSearchParams = UserSearchParams {}
- searchUsers :: (MonadBaseControl IO m, MonadResource m) => Maybe OAuthToken -> UserSearchParams -> InstagramT m (Envelope [User])
- data Aspect
- media :: Aspect
- type CallbackUrl = Text
- data Subscription = Subscription {}
- createSubscription :: (MonadBaseControl IO m, MonadResource m) => SubscriptionParams -> InstagramT m (Envelope Subscription)
- listSubscriptions :: (MonadBaseControl IO m, MonadResource m) => InstagramT m (Envelope [Subscription])
- deleteSubscriptions :: (MonadBaseControl IO m, MonadResource m) => DeletionParams -> InstagramT m (Envelope Value)
- data SubscriptionRequest
- = UserRequest
- | TagRequest { }
- | LocationRequest { }
- | GeographyRequest {
- grLatitude :: Double
- grLongitude :: Double
- grRadius :: Integer
- data SubscriptionParams = SubscriptionParams {}
- data DeletionParams
- data Update = Update {
- uSubscriptionID :: Integer
- uObject :: Text
- uObjectID :: Text
- uChangedAspect :: Aspect
- uTime :: POSIXTime
- verifySignature :: Monad m => ByteString -> ByteString -> InstagramT m Bool
- data Tag = Tag {
- tName :: TagName
- tMediaCount :: Integer
- type TagName = Text
- getTag :: (MonadBaseControl IO m, MonadResource m) => TagName -> Maybe OAuthToken -> InstagramT m (Envelope (Maybe Tag))
- data RecentTagParams = RecentTagParams {}
- getRecentTagged :: (MonadBaseControl IO m, MonadResource m) => TagName -> Maybe OAuthToken -> RecentTagParams -> InstagramT m (Envelope [Media])
- searchTags :: (MonadBaseControl IO m, MonadResource m) => TagName -> Maybe OAuthToken -> InstagramT m (Envelope [Tag])
- data OutgoingStatus
- data IncomingStatus
- data Relationship = Relationship {}
- getFollows :: (MonadBaseControl IO m, MonadResource m) => UserID -> Maybe OAuthToken -> InstagramT m (Envelope [User])
- getFollowedBy :: (MonadBaseControl IO m, MonadResource m) => UserID -> Maybe OAuthToken -> InstagramT m (Envelope [User])
- data FollowParams = FollowParams {}
- getFollowsParams :: (MonadBaseControl IO m, MonadResource m) => UserID -> Maybe OAuthToken -> FollowParams -> InstagramT m (Envelope [User])
- getFollowedByParams :: (MonadBaseControl IO m, MonadResource m) => UserID -> Maybe OAuthToken -> FollowParams -> InstagramT m (Envelope [User])
- getRequestedBy :: (MonadBaseControl IO m, MonadResource m) => OAuthToken -> InstagramT m (Envelope [User])
- getRelationship :: (MonadBaseControl IO m, MonadResource m) => UserID -> OAuthToken -> InstagramT m (Envelope Relationship)
- setRelationShip :: (MonadBaseControl IO m, MonadResource m) => UserID -> OAuthToken -> RelationShipAction -> InstagramT m (Envelope (Maybe Relationship))
- data RelationShipAction
- type MediaID = Text
- getMedia :: (MonadBaseControl IO m, MonadResource m) => MediaID -> Maybe OAuthToken -> InstagramT m (Envelope (Maybe Media))
- getPopularMedia :: (MonadBaseControl IO m, MonadResource m) => Maybe OAuthToken -> InstagramT m (Envelope [Media])
- data MediaSearchParams = MediaSearchParams {}
- searchMedia :: (MonadBaseControl IO m, MonadResource m) => Maybe OAuthToken -> MediaSearchParams -> InstagramT m (Envelope [Media])
- type CommentID = Text
- getComments :: (MonadBaseControl IO m, MonadResource m) => MediaID -> Maybe OAuthToken -> InstagramT m (Envelope [Comment])
- postComment :: (MonadBaseControl IO m, MonadResource m) => MediaID -> OAuthToken -> Text -> InstagramT m (Envelope NoResult)
- deleteComment :: (MonadBaseControl IO m, MonadResource m) => MediaID -> CommentID -> OAuthToken -> InstagramT m (Envelope NoResult)
- getLikes :: (MonadBaseControl IO m, MonadResource m) => MediaID -> Maybe OAuthToken -> InstagramT m (Envelope [User])
- like :: (MonadBaseControl IO m, MonadResource m) => MediaID -> OAuthToken -> InstagramT m (Envelope NoResult)
- unlike :: (MonadBaseControl IO m, MonadResource m) => MediaID -> OAuthToken -> InstagramT m (Envelope NoResult)
- type LocationID = Text
- getLocation :: (MonadBaseControl IO m, MonadResource m) => LocationID -> Maybe OAuthToken -> InstagramT m (Envelope (Maybe Location))
- data LocationMediaParams = LocationMediaParams {}
- getLocationRecentMedia :: (MonadBaseControl IO m, MonadResource m) => LocationID -> Maybe OAuthToken -> LocationMediaParams -> InstagramT m (Envelope [Media])
- data LocationSearchParams = LocationSearchParams {}
- searchLocations :: (MonadBaseControl IO m, MonadResource m) => Maybe OAuthToken -> LocationSearchParams -> InstagramT m (Envelope [Location])
- type GeographyID = Text
- data GeographyMediaParams = GeographyMediaParams {}
- getGeographyRecentMedia :: (MonadBaseControl IO m, MonadResource m) => GeographyID -> GeographyMediaParams -> InstagramT m (Envelope [Media])
Documentation
data InstagramT m a Source
the instagram monad transformer this encapsulates the data necessary to pass the app credentials, etc
Instances
MonadTrans InstagramT | |
MonadTransControl InstagramT | |
MonadBaseControl b m => MonadBaseControl b (InstagramT m) | |
MonadBase b m => MonadBase b (InstagramT m) | |
Alternative m => Alternative (InstagramT m) | |
Monad m => Monad (InstagramT m) | |
Functor m => Functor (InstagramT m) | |
MonadFix m => MonadFix (InstagramT m) | |
MonadPlus m => MonadPlus (InstagramT m) | |
Applicative m => Applicative (InstagramT m) | |
MonadThrow m => MonadThrow (InstagramT m) | |
MonadIO m => MonadIO (InstagramT m) | |
MonadResource m => MonadResource (InstagramT m) | |
type StT InstagramT a | |
type StM (InstagramT m) a = ComposeSt InstagramT m a |
Arguments
:: Credentials | Your app's credentials. |
-> Manager | Connection manager (see |
-> InstagramT m a | the action to run |
-> m a | the result |
Run a computation in the InstagramT
monad transformer with
your credentials.
runResourceInIs :: (MonadResource m, MonadBaseControl IO m) => InstagramT (ResourceT m) a -> InstagramT m a Source
Run a ResourceT
inside a InstagramT
.
data IGException Source
an exception that a call to instagram may throw
Instances
Show IGException | |
Exception IGException | make our exception type a normal exception |
Typeable * IGException |
type RedirectUri = Text Source
the URI to redirect the user after she accepts/refuses to authorize the app
Arguments
:: 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 |
get the authorize url to redirect your user to
Arguments
:: (MonadBaseControl IO m, MonadResource m) | |
=> RedirectUri | the redirect uri |
-> Text | the code sent back to your app |
-> InstagramT m OAuthToken | the auth token |
second step of authorization: get the access token once the user has been redirected with a code
data Credentials Source
the app credentials
Constructors
Credentials | |
Fields
|
Instances
data OAuthToken Source
the oauth token returned after authentication
Constructors
OAuthToken | |
Fields
|
Instances
Eq OAuthToken | |
Ord OAuthToken | |
Read OAuthToken | |
Show OAuthToken | |
ToJSON OAuthToken | to json as per Instagram format |
FromJSON OAuthToken | from json as per Instagram format |
Typeable * OAuthToken |
newtype AccessToken Source
the access token is simply a Text
Constructors
AccessToken Text |
Instances
Eq AccessToken | |
Ord AccessToken | |
Read AccessToken | |
Show AccessToken | |
ToJSON AccessToken | simple string |
FromJSON AccessToken | simple string |
Typeable * AccessToken |
the User partial profile returned by the authentication
Constructors
User | |
data UserCounts Source
the User counts info returned by some endpoints
Constructors
UserCounts | |
Instances
Eq UserCounts | |
Ord UserCounts | |
Read UserCounts | |
Show UserCounts | |
ToJSON UserCounts | to json as per Instagram format |
FromJSON UserCounts | from json as per Instagram format |
Typeable * UserCounts |
the scopes of the authentication
Constructors
Basic | |
Comments | |
Relationships | |
Likes |
envelope for Instagram OK response
Constructors
Envelope | |
Fields
|
getNextPage :: (MonadBaseControl IO m, MonadResource m, FromJSON v) => Envelope v -> InstagramT m (Maybe (Envelope v)) Source
Use the pagination links in an Envelope
to fetch the next page of
results.
If the Envelope has no pagination, or we have reached the final page (indicated by the pNextUrl field being missing), returns Nothing.
data Pagination Source
pagination info for responses that can return a lot of data
Constructors
Pagination | |
Fields
|
Instances
Eq Pagination | |
Ord Pagination | |
Read Pagination | |
Show Pagination | |
ToJSON Pagination | to json as per Instagram format |
FromJSON Pagination | from json as per Instagram format |
Typeable * Pagination |
instagram media object
Constructors
Media | |
Fields
|
position in picture
data UserPosition Source
position of a user
Constructors
UserPosition | |
Fields
|
Instances
Eq UserPosition | |
Show UserPosition | |
ToJSON UserPosition | to json as per Instagram format |
FromJSON UserPosition | from json as per Instagram format |
Typeable * UserPosition |
geographical location info
data for a single image
different images for the same media
Constructors
Images | |
Fields
|
Commenton on a medium
data Collection a Source
a collection of items (count + data) data can only be a subset
Constructors
Collection | |
Instances
Eq a => Eq (Collection a) | |
Ord a => Ord (Collection a) | |
Show a => Show (Collection a) | |
ToJSON a => ToJSON (Collection a) | to json as per Instagram format |
FromJSON a => FromJSON (Collection a) | from json as per Instagram format |
Typeable (* -> *) Collection |
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
getUser :: (MonadBaseControl IO m, MonadResource m) => UserID -> Maybe OAuthToken -> InstagramT m (Envelope (Maybe User)) Source
Get basic information about a user.
getSelfFeed :: (MonadBaseControl IO m, MonadResource m) => OAuthToken -> SelfFeedParams -> InstagramT m (Envelope [Media]) Source
See the authenticated user's feed.
getRecent :: (MonadBaseControl IO m, MonadResource m) => UserID -> OAuthToken -> RecentParams -> InstagramT m (Envelope [Media]) Source
Get the most recent media published by a user.
getSelfLiked :: (MonadBaseControl IO m, MonadResource m) => OAuthToken -> SelfLikedParams -> InstagramT m (Envelope [Media]) Source
See the authenticated user's list of media they've liked.
data UserSearchParams Source
parameters for self liked call
searchUsers :: (MonadBaseControl IO m, MonadResource m) => Maybe OAuthToken -> UserSearchParams -> InstagramT m (Envelope [User]) Source
Search for a user by name.
notification aspect
type CallbackUrl = Text Source
the URL to receive notifications to
data Subscription Source
a subscription to a real time notification
Constructors
Subscription | |
Instances
Eq Subscription | |
Show Subscription | |
ToJSON Subscription | to json as per Instagram format |
FromJSON Subscription | from json as per Instagram format |
Typeable * Subscription |
Arguments
:: (MonadBaseControl IO m, MonadResource m) | |
=> SubscriptionParams | the subscription parameters |
-> InstagramT m (Envelope Subscription) | the created subscription |
create a subscription
Arguments
:: (MonadBaseControl IO m, MonadResource m) | |
=> InstagramT m (Envelope [Subscription]) | the ID of the subscription |
list all subscriptions for the application
Arguments
:: (MonadBaseControl IO m, MonadResource m) | |
=> DeletionParams | the parameters for the deletion |
-> InstagramT m (Envelope Value) | the ID of the subscription |
delete subscriptions based on criteria
data SubscriptionRequest Source
details of subscription request
Constructors
UserRequest | when a user uploads a picture |
TagRequest | when a picture is tagged with the given tag |
LocationRequest | when a picture is tagged with a specific location |
GeographyRequest | when a picture is tagged with a location inside the given region |
Fields
|
data SubscriptionParams Source
parameters for the subscription creation
Constructors
SubscriptionParams | |
Fields
|
data DeletionParams Source
deletion parameters
Constructors
DeleteAll | delete all subscriptions |
DeleteOne | delete one subscription, given its ID |
DeleteUsers | delete all user subscriptions |
DeleteTags | delete all tag subscriptions |
DeleteLocations | delete all location subscriptions |
DeleteGeographies | delete all geography subscriptions |
Instances
an update from a subscription
Arguments
:: Monad m | |
=> ByteString | the signature |
-> ByteString | the content |
-> InstagramT m Bool |
verify the signature with the content, using the secret as the key
a Tag
Constructors
Tag | |
Fields
|
getTag :: (MonadBaseControl IO m, MonadResource m) => TagName -> Maybe OAuthToken -> InstagramT m (Envelope (Maybe Tag)) Source
Get information about a tag object.
data RecentTagParams Source
parameters for recent tag pagination
getRecentTagged :: (MonadBaseControl IO m, MonadResource m) => TagName -> Maybe OAuthToken -> RecentTagParams -> InstagramT m (Envelope [Media]) Source
Get a list of recently tagged media.
searchTags :: (MonadBaseControl IO m, MonadResource m) => TagName -> Maybe OAuthToken -> InstagramT m (Envelope [Tag]) Source
Search for tags by name.
data OutgoingStatus Source
outgoing relationship status
Instances
Bounded OutgoingStatus | |
Enum OutgoingStatus | |
Eq OutgoingStatus | |
Ord OutgoingStatus | |
Read OutgoingStatus | |
Show OutgoingStatus | |
ToJSON OutgoingStatus | to json as per Instagram format |
FromJSON OutgoingStatus | from json as per Instagram format |
Typeable * OutgoingStatus |
data IncomingStatus Source
incoming relationship status
Constructors
FollowedBy | |
RequestedBy | |
BlockedByYou | |
InNone |
Instances
Bounded IncomingStatus | |
Enum IncomingStatus | |
Eq IncomingStatus | |
Ord IncomingStatus | |
Read IncomingStatus | |
Show IncomingStatus | |
ToJSON IncomingStatus | to json as per Instagram format |
FromJSON IncomingStatus | from json as per Instagram format |
Typeable * IncomingStatus |
data Relationship Source
a relationship between two users
Constructors
Relationship | |
Fields
|
Instances
Eq Relationship | |
Ord Relationship | |
Read Relationship | |
Show Relationship | |
ToJSON Relationship | to json as per Instagram format |
FromJSON Relationship | from json as per Instagram format |
Typeable * Relationship |
getFollows :: (MonadBaseControl IO m, MonadResource m) => UserID -> Maybe OAuthToken -> InstagramT m (Envelope [User]) Source
Get the list of users this user follows.
getFollowedBy :: (MonadBaseControl IO m, MonadResource m) => UserID -> Maybe OAuthToken -> InstagramT m (Envelope [User]) Source
Get the list of users this user is followed by.
data FollowParams Source
Constructors
FollowParams | |
getFollowsParams :: (MonadBaseControl IO m, MonadResource m) => UserID -> Maybe OAuthToken -> FollowParams -> InstagramT m (Envelope [User]) Source
Get the list of users this user follows.
getFollowedByParams :: (MonadBaseControl IO m, MonadResource m) => UserID -> Maybe OAuthToken -> FollowParams -> InstagramT m (Envelope [User]) Source
Get the list of users this user is followed by.
getRequestedBy :: (MonadBaseControl IO m, MonadResource m) => OAuthToken -> InstagramT m (Envelope [User]) Source
List the users who have requested this user's permission to follow.
getRelationship :: (MonadBaseControl IO m, MonadResource m) => UserID -> OAuthToken -> InstagramT m (Envelope Relationship) Source
Get information about a relationship to another user.
setRelationShip :: (MonadBaseControl IO m, MonadResource m) => UserID -> OAuthToken -> RelationShipAction -> InstagramT m (Envelope (Maybe Relationship)) Source
Modify the relationship between the current user and the target user.
data RelationShipAction Source
relationship action
getMedia :: (MonadBaseControl IO m, MonadResource m) => MediaID -> Maybe OAuthToken -> InstagramT m (Envelope (Maybe Media)) Source
Get information about a media object.
getPopularMedia :: (MonadBaseControl IO m, MonadResource m) => Maybe OAuthToken -> InstagramT m (Envelope [Media]) Source
Get a list of what media is most popular at the moment.
data MediaSearchParams Source
Parameters for call to media search
Constructors
MediaSearchParams | |
Fields |
searchMedia :: (MonadBaseControl IO m, MonadResource m) => Maybe OAuthToken -> MediaSearchParams -> InstagramT m (Envelope [Media]) Source
Search for media in a given area.
getComments :: (MonadBaseControl IO m, MonadResource m) => MediaID -> Maybe OAuthToken -> InstagramT m (Envelope [Comment]) Source
Get a full list of comments on a media.
postComment :: (MonadBaseControl IO m, MonadResource m) => MediaID -> OAuthToken -> Text -> InstagramT m (Envelope NoResult) Source
Create a comment on a media.
deleteComment :: (MonadBaseControl IO m, MonadResource m) => MediaID -> CommentID -> OAuthToken -> InstagramT m (Envelope NoResult) Source
Remove a comment either on the authenticated user's media or authored by the authenticated user.
getLikes :: (MonadBaseControl IO m, MonadResource m) => MediaID -> Maybe OAuthToken -> InstagramT m (Envelope [User]) Source
Get a list of users who have liked this media.
like :: (MonadBaseControl IO m, MonadResource m) => MediaID -> OAuthToken -> InstagramT m (Envelope NoResult) Source
Set a like on this media by the currently authenticated user.
unlike :: (MonadBaseControl IO m, MonadResource m) => MediaID -> OAuthToken -> InstagramT m (Envelope NoResult) Source
Remove a like on this media by the currently authenticated user.
type LocationID = Text Source
location ID
getLocation :: (MonadBaseControl IO m, MonadResource m) => LocationID -> Maybe OAuthToken -> InstagramT m (Envelope (Maybe Location)) Source
Get information about a location.
data LocationMediaParams Source
Parameters for call to recent media in location search
Constructors
LocationMediaParams | |
getLocationRecentMedia :: (MonadBaseControl IO m, MonadResource m) => LocationID -> Maybe OAuthToken -> LocationMediaParams -> InstagramT m (Envelope [Media]) Source
Get a list of recent media objects from a given location.
data LocationSearchParams Source
Parameters for call to media search
Constructors
LocationSearchParams | |
Fields |
searchLocations :: (MonadBaseControl IO m, MonadResource m) => Maybe OAuthToken -> LocationSearchParams -> InstagramT m (Envelope [Location]) Source
Search for a location by geographic coordinate.
type GeographyID = Text Source
geography ID
data GeographyMediaParams Source
Parameters for call to recent media in geography search
getGeographyRecentMedia :: (MonadBaseControl IO m, MonadResource m) => GeographyID -> GeographyMediaParams -> InstagramT m (Envelope [Media]) Source
Get very recent media from a geography subscription that you created