User.hs

{-# 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
    , 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.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)
                 , Username
                 , mkUsername
                 )
import           Network.Reddit.Types.Award
import           Network.Reddit.Types.Comment
import           Network.Reddit.Types.Item
import           Network.Reddit.Types.Multireddit
import           Network.Reddit.Types.Submission
import           Network.Reddit.Types.Subreddit
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 ] }

-- | 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"