{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeApplications #-} -- | -- Module : Network.Reddit.Me -- Copyright : (c) 2021 Rory Tyler Hayford -- License : BSD-3-Clause -- Maintainer : rory.hayford@protonmail.com -- Stability : experimental -- Portability : GHC -- -- Actions related to the currently logged-in user, such as accounts, friends, -- etc... For actions related to other users, see "Network.Reddit.User" -- module Network.Reddit.Me ( -- * Actions getMe , getPreferences , updatePreferences , getMyOverview , getMySaved , getMyComments , getMySubmissions , getMyHidden , getMyFriends , getMyBlocked , getMyKarma , makeFriend , unFriend , blockUser , needsCaptcha , getMyFlair , setMyFlair , getMySubscribed , getMyModerated , getMyContributing , getMyMultireddits ) where import Control.Monad.Catch ( MonadCatch(catch) , MonadThrow(throwM) ) import Data.Aeson ( KeyValue((.=)), object ) import Data.Bool ( bool ) import Data.Generics.Wrapped ( wrappedTo ) import Data.Sequence ( Seq ) import Data.Text ( Text ) import Lens.Micro import Network.Reddit.Internal import Network.Reddit.Types import Network.Reddit.Types.Account import Network.Reddit.Types.Comment import Network.Reddit.Types.Flair import Network.Reddit.Types.Item import Network.Reddit.Types.Multireddit import Network.Reddit.Types.Submission import Network.Reddit.Types.Subreddit import Network.Reddit.User import Network.Reddit.Utils import Web.FormUrlEncoded ( ToForm(toForm) ) import Web.HttpApiData ( ToHttpApiData(..) ) -- | Get account information for the currently logged-in user getMe :: MonadReddit m => m Account getMe = runAction defaultAPIAction { pathSegments = mePath mempty } -- | Get the user 'Preferences' for the currently authenticated user getPreferences :: MonadReddit m => m Preferences getPreferences = runAction defaultAPIAction { pathSegments = mePath [ "prefs" ] } -- | Update the authenticated users 'Preferences'. Returns the new preferences -- upon success -- -- __Warning__: Invalid fields or values are silently discarded by this -- endpoint. If you wish to check that an update has succeeded, consider -- an equality test between the existing preferences and the value returned -- by this action updatePreferences :: MonadReddit m => Preferences -> m Preferences updatePreferences prefs = runAction defaultAPIAction { pathSegments = mePath [ "prefs" ] , method = PATCH , requestData = mkTextFormData [ ("json", textEncode prefs) ] } -- | Get an overview of the authenticated user\'s 'Comment's and 'Submission's getMyOverview :: MonadReddit m => Paginator ItemID Item -> m (Listing ItemID Item) getMyOverview paginator = do Account { username } <- getMe getUserOverview username paginator -- | Get items that the authenticated user has saved getMySaved :: MonadReddit m => Paginator ItemID Item -> m (Listing ItemID Item) getMySaved paginator = do Account { username } <- getMe getUserSaved username paginator -- | Get an overview of the authenticated user\'s 'Comment's getMyComments :: MonadReddit m => Paginator CommentID Comment -> m (Listing CommentID Comment) getMyComments paginator = do Account { username } <- getMe getUserComments username paginator -- | Get an overview of the authenticated user\'s 'Submission's getMySubmissions :: MonadReddit m => Paginator SubmissionID Submission -> m (Listing SubmissionID Submission) getMySubmissions paginator = do Account { username } <- getMe getUserSubmissions username paginator -- | Get items that the authenticated user has hidden getMyHidden :: MonadReddit m => Paginator ItemID Item -> m (Listing ItemID Item) getMyHidden paginator = do Account { username } <- getMe getUserHidden username paginator -- | Get the 'Friend's of the currently logged-in user getMyFriends :: MonadReddit m => m (Seq Friend) getMyFriends = runAction @FriendList r <&> wrappedTo where r = defaultAPIAction { pathSegments = mePath [ "friends" ] } -- | Get blocked users (as 'Friend's) of the currently logged-in user getMyBlocked :: MonadReddit m => m (Seq Friend) getMyBlocked = runAction @FriendList r <&> wrappedTo where r = defaultAPIAction { pathSegments = [ "prefs", "blocked" ] } -- | Get a breakdown of the current user\'s karma getMyKarma :: MonadReddit m => m (Seq Karma) getMyKarma = runAction @KarmaList r <&> wrappedTo where r = defaultAPIAction { pathSegments = mePath [ "karma" ] } -- | Make friends with another user makeFriend :: MonadReddit m => Maybe Text -> Username -> m Friend makeFriend note uname = runAction defaultAPIAction { method = PUT , pathSegments = mePath [ "friends", toUrlPiece uname ] , requestData = WithJSON . object $ [ "name" .= toQueryParam uname ] <> foldMap (pure . ("note" .=)) note } -- | Remove an existing friend unFriend :: MonadReddit m => Username -> m () unFriend uname = runAction_ defaultAPIAction { pathSegments = mePath [ "friends", toUrlPiece uname ] , method = DELETE } -- | Block another user. Note that this cannot be reversed through the API; the -- logged-in user would need to manually revoke the block by visiting Reddit's -- website blockUser :: MonadReddit m => UserID -> m () blockUser uid = runAction_ defaultAPIAction { pathSegments = [ "api", "block_user" ] , method = POST , requestData = WithForm $ toForm @[(Text, Text)] [ ("account_id", fullname uid) ] } -- | Get the authenticated user\'s current flair for the given subreddit, if such -- flair exists getMyFlair :: MonadReddit m => SubredditName -> m (Maybe UserFlair) getMyFlair sname = catch @_ @APIException action $ \case JSONParseError _ _ -> pure Nothing e -> throwM e where action = runAction @CurrentUserFlair r <&> Just . wrappedTo r = defaultAPIAction { pathSegments = subAPIPath sname "flairselector" -- , method = POST } -- | Set the flair for the authenticated user, provided that the given subreddit -- allows users to perform this action. The @text@ field is ignored unless it is -- @Just@ /and/ the @textEditable@ field of the contained 'FlairChoice' is @True@ setMyFlair :: MonadReddit m => FlairSelection -> m () setMyFlair (FlairSelection FlairChoice { .. } txt sname) = do Account { username } <- getMe runAction_ defaultAPIAction { pathSegments = subAPIPath sname "selectflair" , method = POST , requestData = WithForm $ mkTextForm [ ( "flair_template_id" , toQueryParam templateID ) , ("name", toQueryParam username) ] <> maybe mempty sendText txt } where sendText t = mkTextForm $ bool mempty [ ("text", toQueryParam t) ] textEditable -- | Find out if the authenticated user needs to complete a captcha when performing -- certain transactions, such as submitting a link or sending a private message needsCaptcha :: MonadReddit m => m Bool needsCaptcha = runAction defaultAPIAction { pathSegments = [ "api", "needs_captcha.json" ] , needsAuth = False } getMySubscribed, getMyModerated, getMyContributing :: MonadReddit m => Paginator SubredditID Subreddit -> m (Listing SubredditID Subreddit) -- | Get a listing of subreddits the currently authenticated user is subscribed to getMySubscribed = mySubreddits "subscriber" -- | Get a listing of subreddits the currently authenticated user is a mod in getMyModerated = mySubreddits "moderator" -- | Get a listing of subreddits the currently authenticated user is an approved -- user in getMyContributing = mySubreddits "contributor" mySubreddits :: MonadReddit m => PathSegment -> Paginator SubredditID Subreddit -> m (Listing SubredditID Subreddit) mySubreddits path paginator = runAction defaultAPIAction { pathSegments = [ "subreddits", "mine", path ] , requestData = paginatorToFormData paginator } -- | Get all of the multireddits of the authenticated user getMyMultireddits :: MonadReddit m => m (Seq Multireddit) getMyMultireddits = runAction defaultAPIAction { pathSegments = [ "api", "multi", "mine" ] } mePath :: [PathSegment] -> [PathSegment] mePath ps = [ "api", "v1", "me" ] <> ps