{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-} -- | -- Module : Network.Reddit.User -- Copyright : (c) 2021 Rory Tyler Hayford -- License : BSD-3-Clause -- Maintainer : rory.hayford@protonmail.com -- Stability : experimental -- Portability : GHC -- -- Actions related to users, excluding the currently logged-in one. For actions -- on the current account, see "Network.Reddit.Me" -- module Network.Reddit.User ( -- * Actions isUsernameAvailable , getUser , getUserTrophies , getUserComments , getUserSubmissions , getUserUpvoted , getUserDownvoted , getUserHidden , getUserOverview , getUserGilded , getUserSaved , getUserMultireddits , getUserSubreddit , getUserModerated , gildUser -- ** User @Listing@s and summaries -- | These actions return @Listing@s for special user subreddits, -- user accounts, or 'UserSummary's for existing user IDs , getNewUsers , getPopularUsers , searchUsers , getUserSummaries , getUserSummary -- * Types , module M , Trophy ) where import Control.Monad ( (<=<), unless ) import Control.Monad.Catch ( MonadThrow(throwM) ) import Data.Aeson ( FromJSON ) import qualified Data.Foldable as F import Data.Generics.Wrapped ( wrappedTo ) import Data.Ix ( Ix(inRange) ) import Data.List.Split ( chunksOf ) import Data.Maybe ( fromMaybe ) import Data.Sequence ( Seq((:<|)) ) import Data.Text ( Text ) import Lens.Micro import Network.Reddit.Internal import Network.Reddit.Subreddit import Network.Reddit.Types import Network.Reddit.Types.Account import Network.Reddit.Types.Account as M ( AcceptPMs(..) , Account(Account) , AccountSearchOpts(AccountSearchOpts) , AccountSearchSort(..) , Friend(Friend) , Karma(Karma) , MediaPreference(..) , Preferences(Preferences) , UserID(UserID) , UserSummary(UserSummary) ) import Network.Reddit.Types.Award import Network.Reddit.Types.Comment import Network.Reddit.Types.Internal as M ( Username , mkUsername ) import Network.Reddit.Types.Item import Network.Reddit.Types.Multireddit import Network.Reddit.Types.Submission import Network.Reddit.Utils import Web.FormUrlEncoded ( ToForm(toForm) ) import Web.HttpApiData ( ToHttpApiData(..) ) -- | Check if a 'Username' is available for use isUsernameAvailable :: MonadReddit m => Username -> m Bool isUsernameAvailable uname = runAction defaultAPIAction { requestData = mkTextFormData [ ("user", toQueryParam uname) ] , pathSegments = [ "api", "username_available.json" ] , needsAuth = False } -- | Get information about another user getUser :: MonadReddit m => Username -> m Account getUser uname = runAction defaultAPIAction { pathSegments = [ "user", toUrlPiece uname, "about" ] } -- | Get a user\'s 'Trophy's getUserTrophies :: MonadReddit m => Username -> m (Seq Trophy) getUserTrophies uname = runAction @TrophyList r <&> wrappedTo where r = defaultAPIAction { pathSegments = [ "user", toUrlPiece uname, "trophies" ] } -- | Get a 'Listing' of a user\'s 'Comment's getUserComments :: MonadReddit m => Username -> Paginator CommentID Comment -> m (Listing CommentID Comment) getUserComments = userItems "comments" -- | Get a 'Listing' of a user\'s 'Submission's getUserSubmissions :: MonadReddit m => Username -> Paginator SubmissionID Submission -> m (Listing SubmissionID Submission) getUserSubmissions = userItems "submitted" getUserUpvoted, getUserDownvoted, getUserGilded :: MonadReddit m => Username -> Paginator ItemID Item -> m (Listing ItemID Item) -- | Get 'Item's that a user has upvoted. You must be authorized to access this, -- or an exception will be raised getUserUpvoted = userItems "upvoted" -- | Get 'Item's that a user has upvoted. You must be authorized to access this, -- or an exception will be raised getUserDownvoted = userItems "downvoted" getUserHidden, getUserOverview, getUserSaved :: MonadReddit m => Username -> Paginator ItemID Item -> m (Listing ItemID Item) -- | Get the 'Item's that a user has gilded getUserGilded = userItems "gilded" -- | Get 'Item's that a user has hidden. You must be authorized to access this, -- or an exception will be raised getUserHidden = userItems "hidden" -- | Get an overview of a user\'s 'Comment's and 'Submission's getUserOverview = userItems "overview" -- | Get the 'Item's that a user has saved. You must be authorized to access this, -- or an exception will be raised getUserSaved = userItems "saved" userItems :: (MonadReddit m, Thing t, Paginable a, FromJSON a, FromJSON t) => Text -> Username -> Paginator t a -> m (Listing t a) userItems path uname paginator = runAction defaultAPIAction { pathSegments = [ "user", toUrlPiece uname, path ] , requestData = paginatorToFormData paginator } -- | Get the public 'Multireddit's belonging to the given user getUserMultireddits :: MonadReddit m => Username -> m (Seq Multireddit) getUserMultireddits uname = runAction defaultAPIAction { pathSegments = [ "api", "multi", "user", toUrlPiece uname ] } -- | Get the special user 'Subreddit' for the given username getUserSubreddit :: MonadReddit m => Username -> m Subreddit getUserSubreddit = getSubreddit <=< mkSubredditName . usernameToDisplayName -- | Get a list of the subreddits that a user moderates -- -- __Note__: Strangely, this will not include the user\'s special user subreddit getUserModerated :: MonadReddit m => Username -> m (Seq Subreddit) getUserModerated uname = runAction @UserModeratedList r <&> wrappedTo where r = defaultAPIAction { pathSegments = [ "user", toUrlPiece uname, "moderated_subreddits" ] } -- | Give the user Reddit gold, optionally specifying the duration gildUser :: MonadReddit m => Maybe Word -- ^ Defaults to 1 when @Nothing@. Must be between 1 and 36 -> Username -> m () gildUser (fromMaybe 1 -> months) uname = do unless (inRange (1, 36) months) . throwM $ InvalidRequest "Duration must be between 1 and 36" runAction_ defaultAPIAction { pathSegments = [ "api", "v1", "gold", "give", toUrlPiece uname ] , method = POST , requestData = mkTextFormData [ ("months", toQueryParam months) ] } -- | Get a @Listing@ of special user subreddits, sorted on creation date (newest -- first) getNewUsers :: MonadReddit m => Paginator SubredditID Subreddit -> m (Listing SubredditID Subreddit) getNewUsers paginator = runAction defaultAPIAction { pathSegments = [ "users", "new" ] , requestData = paginatorToFormData paginator } -- | Get a @Listing@ of special user subreddits, sorted on popularity getPopularUsers :: MonadReddit m => Paginator SubredditID Subreddit -> m (Listing SubredditID Subreddit) getPopularUsers paginator = runAction defaultAPIAction { pathSegments = [ "users", "new" ] , requestData = paginatorToFormData paginator } -- | Get a @Listing@ of user profiles whose titles and descriptions which match -- the given @query@ searchUsers :: MonadReddit m => Text -> Paginator UserID Account -> m (Listing UserID Account) searchUsers query paginator = runAction defaultAPIAction { pathSegments = [ "users", "search" ] , requestData = WithForm $ mkTextForm [ ("q", query) ] <> toForm paginator } -- | Get a brief 'UserSummary' for each valid 'UserID'. Note that Reddit silently -- ignores invalid IDs, so the output may be shorted than the input container getUserSummaries :: (MonadReddit m, Foldable t) => t UserID -> m (Seq UserSummary) getUserSummaries uids = mconcat <$> traverse mkAction (chunked uids) where chunked = chunksOf apiRequestLimit . F.toList mkAction ids = runAction @UserSummaryList r <&> wrappedTo where r = defaultAPIAction { pathSegments = [ "api", "user_data_by_account_ids" ] , requestData = mkTextFormData [ ("ids", fullname ids) ] } -- | Get the 'UserSummary' for a single user ID getUserSummary :: MonadReddit m => UserID -> m UserSummary getUserSummary uid = getUserSummaries [ uid ] >>= \case us :<| _ -> pure us _ -> throwM $ InvalidResponse "getUserSummary: No such user"