Me.hs

{-# 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