{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}

-- |
-- Module      : Network.Reddit.Moderation
-- Copyright   : (c) 2021 Rory Tyler Hayford
-- License     : BSD-3-Clause
-- Maintainer  : rory.hayford@protonmail.com
-- Stability   : experimental
-- Portability : GHC
--
-- Actions related to moderation. Assume that each action in this module requires
-- moderator privileges, unless stated otherwise
--
module Network.Reddit.Moderation
    (  -- * Item moderation
        -- | These actions work on 'Item's, i.e either 'Comment's or 'Submission's.
        -- This module also exports variants that take unwrapped 'SubmissionID's
        -- and 'CommentID's to work with just one type of item (see below)
      distinguishItem
    , undistinguishItem
    , removeItem
    , sendRemovalMessage
    , approveItem
    , lockItem
    , unlockItem
    , ignoreItemReports
    , unignoreItemReports
      -- ** Removal reasons
    , getRemovalReasons
    , createRemovalReason
    , updateRemovalReason
    , deleteRemovalReason
      -- ** Moderation listings
      -- | Each of these retrieves a @Listing ItemID ModItem@. You can constrain
      -- the type of reports by passing the appropriate 'ItemType' to the
      -- paginator options
    , getReports
    , getModqueue
    , getSpam
    , getEdited
    , getUnmoderated
    , getModlog
      -- ** Submission moderation
      -- | Includes re-exports from "Network.Reddit.Submission"
    , distinguishSubmission
    , undistinguishSubmission
    , approveSubmission
    , lockSubmission
    , unlockSubmission
    , ignoreSubmissionReports
    , unignoreSubmissionReports
    , unmarkNSFW
    , markNSFW
    , setOC
    , unsetOC
    , setSpoiler
    , unsetSpoiler
    , stickySubmission
    , unstickySubmission
    , setSuggestedSort
      -- ** Comment moderation
    , showComment
    , distinguishComment
    , undistinguishComment
    , approveComment
    , lockComment
    , unlockComment
    , ignoreCommentReports
    , unignoreCommentReports
      -- ** Collections moderation
    , createCollection
    , deleteCollection
    , addSubmissionToCollection
    , removeSubmissionFromCollection
    , reorderCollection
    , updateCollectionDescription
    , updateCollectionTitle
      -- * Subreddit relationships
      -- ** Moderators
    , getModerators
    , getModerator
    , updateModerator
    , removeModerator
    , abdicateModerator
      -- ** Mod invitations
    , inviteModerator
    , inviteModeratorWithPerms
    , getInvitees
    , getInvitee
    , updateInvitation
    , revokeInvitation
    , acceptInvitation
      -- ** Contributors
    , getContributors
    , getContributor
    , addContributor
    , removeContributor
    , abdicateContributor
    , getWikiContributors
    , getWikiContributor
    , addWikiContributor
    , removeWikiContributor
      -- ** Bans
    , getBans
    , getBan
    , banUser
    , unbanUser
    , getWikibans
    , getWikiban
    , wikibanUser
    , wikiUnbanUser
    , getMuted
    , getMutedUser
    , unmuteUser
    , muteUser
      -- * Subreddit settings
    , getSubredditSettings
    , setSubredditSettings
      -- * Subreddit rules
      -- | To get a list of the current rules for a Subreddit,
      -- an action which does not require moderator privileges,
      -- see 'Network.Reddit.Actions.Subreddit.getSubredditRules'.
      -- Also note that a subreddit may only configure up to 15
      -- individual rules at a time, and that trying to add more may
      -- raise an exception
    , addSubredditRule
    , deleteSubredditRule
    , updateSubredditRule
    , reorderSubredditRules
      -- * Flair
    , configureSubredditFlair
    , getFlairList
    , getUserFlair
    , setUserFlair
    , setUserFlairs
    , deleteUserFlair
    , createFlairTemplate
    , updateFlairTemplate
    , createUserFlairTemplate
    , createSubmissionFlairTemplate
    , updateSubmissionFlairTemplate
    , updateUserFlairTemplate
    , deleteFlairTemplate
    , clearUserFlairTemplates
    , clearSubmissionFlairTemplates
    , clearFlairTemplates
      -- * Stylesheets, images and widgets
    , getStylesheet
    , updateStylesheet
      -- ** Images
      -- | Reddit only allows JPEG or PNG images in stylsheets, and further requires
      -- that all -- uploaded images be less than 500Kb in size. Each action that
      -- uploads an image file to stylesheets validates both of these constraints,
      -- throwing a 'ClientException' in the event that they are not satisfied.
      --
      -- Note that most of the actions that delete images will appear to succeed
      -- even if the named image does not exists
    , uploadImage
    , uploadHeader
    , uploadMobileIcon
    , uploadMobileHeader
    , deleteImage
    , deleteHeader
    , deleteMobileIcon
    , uploadBanner
    , deleteBanner
    , uploadBannerAdditional
    , deleteBannerAdditional
    , uploadBannerHover
    , deleteBannerHover
      -- * Wiki
    , addWikiEditor
    , removeWikiEditor
    , getWikiPageSettings
    , revertWikiPage
      -- * Modmail
    , getModmail
    , getModmailWithOpts
    , getModmailConversation
    , getUnreadModmailCount
    , replyToConversation
    , archiveConversation
    , unarchiveConversation
    , highlightConversation
    , unhighlightConversation
    , markConversationsRead
    , markConversationRead
    , markConversationsUnread
    , markConversationUnread
    , bulkReadConversations
    , muteModmailUser
    , unmuteModmailUser
    , createConversation
      -- * Widgets
    , deleteWidget
    , updateWidget
    , reorderWidgets
    , addButtonWidget
    , addCalendarWidget
    , addCommunityListWidget
    , addCustomWidget
    , addImageWidget
    , addMenuWidget
    , addPostFlairWidget
    , addTextAreaWidget
    , uploadWidgetImage
      -- * Emoji
    , addEmoji
    , deleteEmoji
    , updateEmoji
    , setCustomEmojiSize
      -- * Misc
    , getTraffic
      -- * Types
    , module M
    ) where

import           Conduit
                 ( (.|)
                 , runConduit
                 , withSourceFile
                 )

import           Control.Monad                         ( void, when )
import           Control.Monad.Catch
                 ( MonadCatch(catch)
                 , MonadThrow(throwM)
                 )

import           Data.Aeson
                 ( FromJSON
                 , KeyValue((.=))
                 , ToJSON(toJSON)
                 , Value(..)
                 )
import           Data.Bifunctor                        ( Bifunctor(bimap) )
import           Data.Bool                             ( bool )
import           Data.ByteString                       ( ByteString )
import qualified Data.ByteString.Lazy                  as LB
import           Data.Conduit.Binary                   ( sinkLbs )
import qualified Data.Foldable                         as F
import           Data.Foldable                         ( for_ )
import           Data.Generics.Wrapped
import           Data.HashMap.Strict                   ( HashMap )
import qualified Data.HashMap.Strict                   as HM
import           Data.Ix                               ( Ix(inRange) )
import           Data.List.Split                       ( chunksOf )
import           Data.Maybe                            ( fromMaybe )
import           Data.Sequence                         ( Seq((:<|)) )
import qualified Data.Text                             as T
import           Data.Text                             ( Text )
import qualified Data.Text.Encoding                    as T

import           Lens.Micro

import           Network.HTTP.Client.MultipartFormData ( partBS, partFile )
import           Network.Reddit.Internal
import           Network.Reddit.Submission
import           Network.Reddit.Types
import           Network.Reddit.Types.Account
import           Network.Reddit.Types.Comment
import           Network.Reddit.Types.Emoji
import           Network.Reddit.Types.Flair
import           Network.Reddit.Types.Flair            as M
                 ( FlairConfig(FlairConfig)
                 , FlairPosition(..)
                 , defaultFlairConfig
                 )
import           Network.Reddit.Types.Item
import           Network.Reddit.Types.Moderation
import           Network.Reddit.Types.Moderation       as M
                 ( Ban(Ban)
                 , BanNotes(BanNotes)
                 , ContentOptions(..)
                 , CrowdControlLevel(..)
                 , LanguageCode(..)
                 , ModAccount(ModAccount)
                 , ModAction(ModAction)
                 , ModActionID
                 , ModActionOpts(ModActionOpts)
                 , ModActionType(..)
                 , ModInvitee(ModInvitee)
                 , ModInviteeList(ModInviteeList)
                 , ModItem(..)
                 , ModItemOpts(ModItemOpts)
                 , ModPermission(..)
                 , Modmail(Modmail)
                 , ModmailAuthor(ModmailAuthor)
                 , ModmailConversation(ModmailConversation)
                 , ModmailID
                 , ModmailMessage(ModmailMessage)
                 , ModmailObjID(ModmailObjID)
                 , ModmailOpts(ModmailOpts)
                 , ModmailReply(ModmailReply)
                 , ModmailSort(..)
                 , ModmailState(..)
                 , MuteID(MuteID)
                 , MuteInfo(MuteInfo)
                 , NewConversation(NewConversation)
                 , NewRemovalReasonID
                 , RelID(RelID)
                 , RelInfo(RelInfo)
                 , RelInfoOpts(RelInfoOpts)
                 , RemovalMessage(RemovalMessage)
                 , RemovalReason(RemovalReason)
                 , RemovalReasonID
                 , RemovalType(..)
                 , S3ModerationLease(S3ModerationLease)
                 , SpamFilter(..)
                 , StructuredStyleImage(..)
                 , StyleImageAlignment(..)
                 , Stylesheet(Stylesheet)
                 , SubredditImage(SubredditImage)
                 , SubredditRelationship(..)
                 , SubredditSettings(SubredditSettings)
                 , SubredditType(..)
                 , Traffic(Traffic)
                 , TrafficStat(TrafficStat)
                 , Wikimode(..)
                 , defaultModmailOpts
                 , mkModmailReply
                 )
import           Network.Reddit.Types.Subreddit
import           Network.Reddit.Types.Widget
import           Network.Reddit.Types.Wiki
import           Network.Reddit.Utils

import qualified System.FilePath                       as FP

import           Web.FormUrlEncoded
                 ( Form
                 , ToForm(toForm)
                 )
import           Web.HttpApiData                       ( ToHttpApiData(..) )

--Item moderation--------------------------------------------------------------
-- | Distinguish an item. See 'distinguishComment' for further comment-specific
-- options
distinguishItem :: MonadReddit m => Distinction -> ItemID -> m ()
distinguishItem :: Distinction -> ItemID -> m ()
distinguishItem Distinction
how ItemID
iid =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [ PathSegment
"api", PathSegment
"distinguish" ]
               , $sel:method:APIAction :: Method
method       = Method
POST
               , $sel:requestData:APIAction :: WithData
requestData  = [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ (PathSegment
"id", ItemID -> PathSegment
forall a. Thing a => a -> PathSegment
fullname ItemID
iid)
                                               , (PathSegment
"how", Distinction -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam Distinction
how)
                                               ]
               }

-- | Remove the distinction from an item, also removing the sticky flag
-- for top-level comments
undistinguishItem :: MonadReddit m => ItemID -> m ()
undistinguishItem :: ItemID -> m ()
undistinguishItem = Distinction -> ItemID -> m ()
forall (m :: * -> *).
MonadReddit m =>
Distinction -> ItemID -> m ()
distinguishItem Distinction
Undistinguished

-- | Remove an item from the subreddit with an optional note to other mods.
-- Setting the @isSpam@ parameter to @True@ will entirely remove the item
-- from subreddit listings
removeItem
    :: MonadReddit m
    => Maybe Body -- ^ A note for other mods. This is sent in second request
                  -- if @Just@
    -> Bool  -- ^ Spam flag. Will remove the item from all listings if @True@
    -> ItemID
    -> m ()
removeItem :: Maybe PathSegment -> Bool -> ItemID -> m ()
removeItem Maybe PathSegment
note Bool
isSpam ItemID
iid = do
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [ PathSegment
"api", PathSegment
"remove" ]
               , $sel:method:APIAction :: Method
method       = Method
POST
               , $sel:requestData:APIAction :: WithData
requestData  = [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ (PathSegment
"id", ItemID -> PathSegment
forall a. Thing a => a -> PathSegment
fullname ItemID
iid)
                                               , (PathSegment
"spam", Bool -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam Bool
isSpam)
                                               ]
               }
    Maybe PathSegment -> (PathSegment -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe PathSegment
note ((PathSegment -> m ()) -> m ()) -> (PathSegment -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \PathSegment
n ->
        APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
                   { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments =
                         [ PathSegment
"api", PathSegment
"v1", PathSegment
"modactions", PathSegment
"removal_reasons" ]
                   , $sel:method:APIAction :: Method
method       = Method
POST
                   , $sel:requestData:APIAction :: WithData
requestData  =
                         [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ ( PathSegment
"json"
                                          , [Pair] -> PathSegment
textObject [ PathSegment
"item_ids"
                                                         PathSegment -> [PathSegment] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => PathSegment -> v -> kv
.= [ ItemID -> PathSegment
forall a. Thing a => a -> PathSegment
fullname ItemID
iid ]
                                                       , PathSegment
"mod_note" PathSegment -> PathSegment -> Pair
forall kv v. (KeyValue kv, ToJSON v) => PathSegment -> v -> kv
.= PathSegment
n
                                                       ]
                                          )
                                        ]
                   }

-- | Send a removal message for an item. The precise action depends on the form
-- of 'RemovalType'
sendRemovalMessage :: MonadReddit m => RemovalMessage -> m ()
sendRemovalMessage :: RemovalMessage -> m ()
sendRemovalMessage rm :: RemovalMessage
rm@RemovalMessage { PathSegment
ItemID
RemovalType
$sel:removalType:RemovalMessage :: RemovalMessage -> RemovalType
$sel:title:RemovalMessage :: RemovalMessage -> PathSegment
$sel:message:RemovalMessage :: RemovalMessage -> PathSegment
$sel:itemID:RemovalMessage :: RemovalMessage -> ItemID
removalType :: RemovalType
title :: PathSegment
message :: PathSegment
itemID :: ItemID
.. } =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [ PathSegment
"api", PathSegment
"v1", PathSegment
"modactions" ] [PathSegment] -> [PathSegment] -> [PathSegment]
forall a. Semigroup a => a -> a -> a
<> [ PathSegment
getPath ]
               , $sel:method:APIAction :: Method
method       = Method
POST
               , $sel:requestData:APIAction :: WithData
requestData  = Form -> WithData
WithForm (Form -> WithData) -> Form -> WithData
forall a b. (a -> b) -> a -> b
$ RemovalMessage -> Form
forall a. ToForm a => a -> Form
toForm RemovalMessage
rm
               }
  where
    getPath :: PathSegment
getPath = case ItemID
itemID of
        CommentItemID CommentID
_    -> PathSegment
"removal_comment_message"
        SubmissionItemID SubmissionID
_ -> PathSegment
"removal_link_message"

approveItem, lockItem, unlockItem :: MonadReddit m => ItemID -> m ()

-- | Approve an item, reverting a removal and resetting its report counter
approveItem :: ItemID -> m ()
approveItem = PathSegment -> ItemID -> m ()
forall (m :: * -> *).
MonadReddit m =>
PathSegment -> ItemID -> m ()
withID PathSegment
"approve"

-- | Lock an item. See also 'unlockItem'
lockItem :: ItemID -> m ()
lockItem = PathSegment -> ItemID -> m ()
forall (m :: * -> *).
MonadReddit m =>
PathSegment -> ItemID -> m ()
withID PathSegment
"lock"

-- | Unlock an item
unlockItem :: ItemID -> m ()
unlockItem = PathSegment -> ItemID -> m ()
forall (m :: * -> *).
MonadReddit m =>
PathSegment -> ItemID -> m ()
withID PathSegment
"unlock"

ignoreItemReports, unignoreItemReports :: MonadReddit m => ItemID -> m ()

-- | Prevent all future reports on this item from sending notifications or appearing
-- in moderation listings. See also 'unignoreItemReports', which reverses this action
ignoreItemReports :: ItemID -> m ()
ignoreItemReports = PathSegment -> ItemID -> m ()
forall (m :: * -> *).
MonadReddit m =>
PathSegment -> ItemID -> m ()
withID PathSegment
"ignore_reports"

-- | Re-allow the item to trigger notifications and appear in moderation listings
unignoreItemReports :: ItemID -> m ()
unignoreItemReports = PathSegment -> ItemID -> m ()
forall (m :: * -> *).
MonadReddit m =>
PathSegment -> ItemID -> m ()
withID PathSegment
"unignore_reports"

withID :: MonadReddit m => Text -> ItemID -> m ()
withID :: PathSegment -> ItemID -> m ()
withID PathSegment
path ItemID
iid =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [ PathSegment
"api", PathSegment
path ]
               , $sel:method:APIAction :: Method
method       = Method
POST
               , $sel:requestData:APIAction :: WithData
requestData  = [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ (PathSegment
"id", ItemID -> PathSegment
forall a. Thing a => a -> PathSegment
fullname ItemID
iid) ]
               }

-- | Get a list of 'RemovalReason's for the given subreddit
getRemovalReasons :: MonadReddit m => SubredditName -> m (Seq RemovalReason)
getRemovalReasons :: SubredditName -> m (Seq RemovalReason)
getRemovalReasons SubredditName
sname = APIAction RemovalReasonList -> m RemovalReasonList
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction @RemovalReasonList APIAction RemovalReasonList
r m RemovalReasonList
-> (RemovalReasonList -> Seq RemovalReason)
-> m (Seq RemovalReason)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> RemovalReasonList -> Seq RemovalReason
forall s t a b. Wrapped s t a b => s -> a
wrappedTo
  where
    r :: APIAction RemovalReasonList
r = APIAction Any
forall a. APIAction a
defaultAPIAction
        { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [ PathSegment
"api", PathSegment
"v1", SubredditName -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toUrlPiece SubredditName
sname, PathSegment
"removal_reasons" ]
        }

-- | Create a new 'RemovalReason', returning the 'RemovalReasonID' of the newly
-- created reason
createRemovalReason
    :: MonadReddit m => SubredditName -> Title -> Body -> m RemovalReasonID
createRemovalReason :: SubredditName -> PathSegment -> PathSegment -> m PathSegment
createRemovalReason SubredditName
sname PathSegment
t PathSegment
m = APIAction NewRemovalReasonID -> m NewRemovalReasonID
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction @NewRemovalReasonID APIAction NewRemovalReasonID
r m NewRemovalReasonID
-> (NewRemovalReasonID -> PathSegment) -> m PathSegment
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> NewRemovalReasonID -> PathSegment
forall s t a b. Wrapped s t a b => s -> a
wrappedTo
  where
    r :: APIAction NewRemovalReasonID
r = APIAction Any
forall a. APIAction a
defaultAPIAction
        { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [ PathSegment
"api", PathSegment
"v1", SubredditName -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toUrlPiece SubredditName
sname, PathSegment
"removal_reasons" ]
        , $sel:method:APIAction :: Method
method       = Method
POST
        , $sel:requestData:APIAction :: WithData
requestData  = [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ (PathSegment
"title", PathSegment
t), (PathSegment
"message", PathSegment
m) ]
        }

-- | Update a single 'RemovalReason'
updateRemovalReason :: MonadReddit m => SubredditName -> RemovalReason -> m ()
updateRemovalReason :: SubredditName -> RemovalReason -> m ()
updateRemovalReason SubredditName
sname rr :: RemovalReason
rr@RemovalReason { PathSegment
$sel:title:RemovalReason :: RemovalReason -> PathSegment
$sel:message:RemovalReason :: RemovalReason -> PathSegment
$sel:removalReasonID:RemovalReason :: RemovalReason -> PathSegment
title :: PathSegment
message :: PathSegment
removalReasonID :: PathSegment
.. } =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [ PathSegment
"api"
                                , PathSegment
"v1"
                                , SubredditName -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toUrlPiece SubredditName
sname
                                , PathSegment
"removal_reasons"
                                , PathSegment -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toUrlPiece PathSegment
removalReasonID
                                ]
               , $sel:method:APIAction :: Method
method       = Method
PUT
               , $sel:requestData:APIAction :: WithData
requestData  = Form -> WithData
WithForm (Form -> WithData) -> Form -> WithData
forall a b. (a -> b) -> a -> b
$ RemovalReason -> Form
forall a. ToForm a => a -> Form
toForm RemovalReason
rr
               }

-- | Delete the given removal reason
deleteRemovalReason
    :: MonadReddit m => SubredditName -> RemovalReasonID -> m ()
deleteRemovalReason :: SubredditName -> PathSegment -> m ()
deleteRemovalReason SubredditName
sname PathSegment
rrid =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [ PathSegment
"api"
                                , PathSegment
"v1"
                                , SubredditName -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toUrlPiece SubredditName
sname
                                , PathSegment
"removal_reasons"
                                , PathSegment -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toUrlPiece PathSegment
rrid
                                ]
               , $sel:method:APIAction :: Method
method       = Method
DELETE
               }

--Moderation listings----------------------------------------------------------
getReports, getModqueue, getSpam, getEdited, getUnmoderated
    :: MonadReddit m
    => SubredditName
    -> Paginator ItemID ModItem
    -> m (Listing ItemID ModItem)

-- | Get the given subreddit\'s reported items
getReports :: SubredditName
-> Paginator ItemID ModItem -> m (Listing ItemID ModItem)
getReports = PathSegment
-> SubredditName
-> Paginator ItemID ModItem
-> m (Listing ItemID ModItem)
forall (m :: * -> *).
MonadReddit m =>
PathSegment
-> SubredditName
-> Paginator ItemID ModItem
-> m (Listing ItemID ModItem)
modItems PathSegment
"reports"

-- | Get the given subreddit\'s moderation queue
getModqueue :: SubredditName
-> Paginator ItemID ModItem -> m (Listing ItemID ModItem)
getModqueue = PathSegment
-> SubredditName
-> Paginator ItemID ModItem
-> m (Listing ItemID ModItem)
forall (m :: * -> *).
MonadReddit m =>
PathSegment
-> SubredditName
-> Paginator ItemID ModItem
-> m (Listing ItemID ModItem)
modItems PathSegment
"modqueue"

-- | Get the given subreddit\'s items marked as spam
getSpam :: SubredditName
-> Paginator ItemID ModItem -> m (Listing ItemID ModItem)
getSpam = PathSegment
-> SubredditName
-> Paginator ItemID ModItem
-> m (Listing ItemID ModItem)
forall (m :: * -> *).
MonadReddit m =>
PathSegment
-> SubredditName
-> Paginator ItemID ModItem
-> m (Listing ItemID ModItem)
modItems PathSegment
"spam"

-- | Get the given subreddit\'s recently edited items
getEdited :: SubredditName
-> Paginator ItemID ModItem -> m (Listing ItemID ModItem)
getEdited = PathSegment
-> SubredditName
-> Paginator ItemID ModItem
-> m (Listing ItemID ModItem)
forall (m :: * -> *).
MonadReddit m =>
PathSegment
-> SubredditName
-> Paginator ItemID ModItem
-> m (Listing ItemID ModItem)
modItems PathSegment
"edited"

-- | Get the given subreddit\'s unmoderated items
getUnmoderated :: SubredditName
-> Paginator ItemID ModItem -> m (Listing ItemID ModItem)
getUnmoderated = PathSegment
-> SubredditName
-> Paginator ItemID ModItem
-> m (Listing ItemID ModItem)
forall (m :: * -> *).
MonadReddit m =>
PathSegment
-> SubredditName
-> Paginator ItemID ModItem
-> m (Listing ItemID ModItem)
modItems PathSegment
"unmoderated"

modItems :: MonadReddit m
         => Text
         -> SubredditName
         -> Paginator ItemID ModItem
         -> m (Listing ItemID ModItem)
modItems :: PathSegment
-> SubredditName
-> Paginator ItemID ModItem
-> m (Listing ItemID ModItem)
modItems PathSegment
path SubredditName
sname Paginator ItemID ModItem
paginator =
    APIAction (Listing ItemID ModItem) -> m (Listing ItemID ModItem)
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction APIAction Any
forall a. APIAction a
defaultAPIAction
              { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = SubredditName -> PathSegment -> [PathSegment]
subAboutPath SubredditName
sname PathSegment
path
              , $sel:requestData:APIAction :: WithData
requestData  = Paginator ItemID ModItem -> WithData
forall t a. (Thing t, Paginable a) => Paginator t a -> WithData
paginatorToFormData Paginator ItemID ModItem
paginator
              }

-- | Get a log of moderator actions for the given subreddit
getModlog :: MonadReddit m
          => SubredditName
          -> Paginator ModActionID ModAction
          -> m (Listing ModActionID ModAction)
getModlog :: SubredditName
-> Paginator ModActionID ModAction
-> m (Listing ModActionID ModAction)
getModlog SubredditName
sname Paginator ModActionID ModAction
paginator =
    APIAction (Listing ModActionID ModAction)
-> m (Listing ModActionID ModAction)
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction APIAction Any
forall a. APIAction a
defaultAPIAction
              { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = SubredditName -> PathSegment -> [PathSegment]
subAboutPath SubredditName
sname PathSegment
"log"
              , $sel:requestData:APIAction :: WithData
requestData  = Paginator ModActionID ModAction -> WithData
forall t a. (Thing t, Paginable a) => Paginator t a -> WithData
paginatorToFormData Paginator ModActionID ModAction
paginator
              }

--Submission moderation--------------------------------------------------------
approveSubmission, lockSubmission, unlockSubmission
    :: MonadReddit m => SubmissionID -> m ()

-- | Approve a submission. See 'approveItem'
approveSubmission :: SubmissionID -> m ()
approveSubmission = ItemID -> m ()
forall (m :: * -> *). MonadReddit m => ItemID -> m ()
approveItem (ItemID -> m ())
-> (SubmissionID -> ItemID) -> SubmissionID -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubmissionID -> ItemID
SubmissionItemID

-- | Lock a submission. See 'lockItem'
lockSubmission :: SubmissionID -> m ()
lockSubmission = ItemID -> m ()
forall (m :: * -> *). MonadReddit m => ItemID -> m ()
lockItem (ItemID -> m ())
-> (SubmissionID -> ItemID) -> SubmissionID -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubmissionID -> ItemID
SubmissionItemID

-- | Unlock a submission. See 'unlockItem'
unlockSubmission :: SubmissionID -> m ()
unlockSubmission = ItemID -> m ()
forall (m :: * -> *). MonadReddit m => ItemID -> m ()
unlockItem (ItemID -> m ())
-> (SubmissionID -> ItemID) -> SubmissionID -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubmissionID -> ItemID
SubmissionItemID

ignoreSubmissionReports, unignoreSubmissionReports
    :: MonadReddit m => SubmissionID -> m ()

-- | Ignore reports for a submission. See 'ignoreItemReports'
ignoreSubmissionReports :: SubmissionID -> m ()
ignoreSubmissionReports = ItemID -> m ()
forall (m :: * -> *). MonadReddit m => ItemID -> m ()
ignoreItemReports (ItemID -> m ())
-> (SubmissionID -> ItemID) -> SubmissionID -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubmissionID -> ItemID
SubmissionItemID

-- | Resume reports for a submission. See 'unignoreItemReports'
unignoreSubmissionReports :: SubmissionID -> m ()
unignoreSubmissionReports = ItemID -> m ()
forall (m :: * -> *). MonadReddit m => ItemID -> m ()
unignoreItemReports (ItemID -> m ())
-> (SubmissionID -> ItemID) -> SubmissionID -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubmissionID -> ItemID
SubmissionItemID

-- | Distinguish a submission
distinguishSubmission :: MonadReddit m => Distinction -> SubmissionID -> m ()
distinguishSubmission :: Distinction -> SubmissionID -> m ()
distinguishSubmission Distinction
how = Distinction -> ItemID -> m ()
forall (m :: * -> *).
MonadReddit m =>
Distinction -> ItemID -> m ()
distinguishItem Distinction
how (ItemID -> m ())
-> (SubmissionID -> ItemID) -> SubmissionID -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubmissionID -> ItemID
SubmissionItemID

-- | Remove the distinction from a submission
undistinguishSubmission :: MonadReddit m => SubmissionID -> m ()
undistinguishSubmission :: SubmissionID -> m ()
undistinguishSubmission = ItemID -> m ()
forall (m :: * -> *). MonadReddit m => ItemID -> m ()
undistinguishItem (ItemID -> m ())
-> (SubmissionID -> ItemID) -> SubmissionID -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubmissionID -> ItemID
SubmissionItemID

-- | Sticky the submission in the subreddit
stickySubmission :: MonadReddit m
                 => Bool -- ^ When @True@, this will set the submission as
                         -- the \"bottom\" sticky. Otherwise, the stickied
                         -- submission will go to the top slot
                 -> SubmissionID
                 -> m ()
stickySubmission :: Bool -> SubmissionID -> m ()
stickySubmission = Bool -> Bool -> SubmissionID -> m ()
forall (m :: * -> *).
MonadReddit m =>
Bool -> Bool -> SubmissionID -> m ()
stickyUnsticky Bool
True

-- | Unsticky the submission in the subreddit
unstickySubmission :: MonadReddit m => SubmissionID -> m ()
unstickySubmission :: SubmissionID -> m ()
unstickySubmission = Bool -> Bool -> SubmissionID -> m ()
forall (m :: * -> *).
MonadReddit m =>
Bool -> Bool -> SubmissionID -> m ()
stickyUnsticky Bool
False Bool
True

stickyUnsticky :: MonadReddit m => Bool -> Bool -> SubmissionID -> m ()
stickyUnsticky :: Bool -> Bool -> SubmissionID -> m ()
stickyUnsticky Bool
state Bool
bottom SubmissionID
sid =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [ PathSegment
"api", PathSegment
"set_subreddit_sticky" ]
               , $sel:method:APIAction :: Method
method       = Method
POST
               , $sel:requestData:APIAction :: WithData
requestData  = [(PathSegment, PathSegment)] -> WithData
mkTextFormData
                     ([(PathSegment, PathSegment)] -> WithData)
-> [(PathSegment, PathSegment)] -> WithData
forall a b. (a -> b) -> a -> b
$ [ (PathSegment
"id", SubmissionID -> PathSegment
forall a. Thing a => a -> PathSegment
fullname SubmissionID
sid)
                       , (PathSegment
"state", Bool -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam Bool
state)
                       , (PathSegment
"api_type", PathSegment
"json")
                       ]
                     [(PathSegment, PathSegment)]
-> [(PathSegment, PathSegment)] -> [(PathSegment, PathSegment)]
forall a. Semigroup a => a -> a -> a
<> [(PathSegment, PathSegment)]
-> [(PathSegment, PathSegment)]
-> Bool
-> [(PathSegment, PathSegment)]
forall a. a -> a -> Bool -> a
bool [ (PathSegment
"num", PathSegment
"1") ] [(PathSegment, PathSegment)]
forall a. Monoid a => a
mempty Bool
bottom
               }

-- | Set the suggested sort order for a submission
setSuggestedSort
    :: MonadReddit m
    => Maybe ItemSort -- ^ If @Nothing@, will clear the existing sort
    -> SubmissionID
    -> m ()
setSuggestedSort :: Maybe ItemSort -> SubmissionID -> m ()
setSuggestedSort Maybe ItemSort
isort SubmissionID
sid =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [ PathSegment
"api", PathSegment
"set_suggested_sort" ]
               , $sel:method:APIAction :: Method
method       = Method
POST
               , $sel:requestData:APIAction :: WithData
requestData  =
                     [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ (PathSegment
"id", SubmissionID -> PathSegment
forall a. Thing a => a -> PathSegment
fullname SubmissionID
sid)
                                    , ( PathSegment
"sort"
                                      , PathSegment
-> (ItemSort -> PathSegment) -> Maybe ItemSort -> PathSegment
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PathSegment
"blank" ItemSort -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam Maybe ItemSort
isort
                                      )
                                    , (PathSegment
"api_type", PathSegment
"json")
                                    ]
               }

--Comment moderation-----------------------------------------------------------
-- | Distinguish aa comment. If @True@, the @sticky@ param will set the comment
-- at the top of the page. This only applies to top-level comments; the flg is
-- otherwise ignored
distinguishComment :: MonadReddit m
                   => Distinction
                   -> Bool -- ^ Sticky flag
                   -> CommentID
                   -> m ()
distinguishComment :: Distinction -> Bool -> CommentID -> m ()
distinguishComment Distinction
how Bool
sticky CommentID
cid =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [ PathSegment
"api", PathSegment
"distinguish" ]
               , $sel:method:APIAction :: Method
method       = Method
POST
               , $sel:requestData:APIAction :: WithData
requestData  =
                     [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ (PathSegment
"id", CommentID -> PathSegment
forall a. Thing a => a -> PathSegment
fullname CommentID
cid)
                                    , (PathSegment
"how", Distinction -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam Distinction
how)
                                    , (PathSegment
"sticky", Bool -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam Bool
sticky)
                                    ]
               }

-- | Undistinguish a comment, also removing its sticky flag if applicable
undistinguishComment :: MonadReddit m => CommentID -> m ()
undistinguishComment :: CommentID -> m ()
undistinguishComment = ItemID -> m ()
forall (m :: * -> *). MonadReddit m => ItemID -> m ()
undistinguishItem (ItemID -> m ()) -> (CommentID -> ItemID) -> CommentID -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommentID -> ItemID
CommentItemID

approveComment, lockComment, unlockComment
    :: MonadReddit m => CommentID -> m ()

-- | Approve a comment. See 'approveItem'
approveComment :: CommentID -> m ()
approveComment = ItemID -> m ()
forall (m :: * -> *). MonadReddit m => ItemID -> m ()
approveItem (ItemID -> m ()) -> (CommentID -> ItemID) -> CommentID -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommentID -> ItemID
CommentItemID

-- | Lock a comment. See 'lockItem'
lockComment :: CommentID -> m ()
lockComment = ItemID -> m ()
forall (m :: * -> *). MonadReddit m => ItemID -> m ()
lockItem (ItemID -> m ()) -> (CommentID -> ItemID) -> CommentID -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommentID -> ItemID
CommentItemID

-- | Unlock a comment. See 'unlockItem'
unlockComment :: CommentID -> m ()
unlockComment = ItemID -> m ()
forall (m :: * -> *). MonadReddit m => ItemID -> m ()
unlockItem (ItemID -> m ()) -> (CommentID -> ItemID) -> CommentID -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommentID -> ItemID
CommentItemID

ignoreCommentReports, unignoreCommentReports
    :: MonadReddit m => CommentID -> m ()

-- | Ignore reports for a comment. See 'ignoreItemReports'
ignoreCommentReports :: CommentID -> m ()
ignoreCommentReports = ItemID -> m ()
forall (m :: * -> *). MonadReddit m => ItemID -> m ()
ignoreItemReports (ItemID -> m ()) -> (CommentID -> ItemID) -> CommentID -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommentID -> ItemID
CommentItemID

-- | Resume reports for a comment. See 'unignoreItemReports'
unignoreCommentReports :: CommentID -> m ()
unignoreCommentReports = ItemID -> m ()
forall (m :: * -> *). MonadReddit m => ItemID -> m ()
unignoreItemReports (ItemID -> m ()) -> (CommentID -> ItemID) -> CommentID -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommentID -> ItemID
CommentItemID

-- | Show a comment that has been \"collapsed\" by crowd-control
showComment :: MonadReddit m => CommentID -> m ()
showComment :: CommentID -> m ()
showComment CommentID
cid =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [ PathSegment
"api", PathSegment
"show_comment" ]
               , $sel:method:APIAction :: Method
method       = Method
POST
               , $sel:requestData:APIAction :: WithData
requestData  = [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ (PathSegment
"id", CommentID -> PathSegment
forall a. Thing a => a -> PathSegment
fullname CommentID
cid) ]
               }

-- | Create a new collection, returning the new 'Collection' upon success
createCollection :: MonadReddit m => NewCollection -> m Collection
createCollection :: NewCollection -> m Collection
createCollection NewCollection
nc =
    APIAction Collection -> m Collection
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction APIAction Any
forall a. APIAction a
defaultAPIAction
              { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = PathSegment -> [PathSegment]
collectionsPath PathSegment
"create_collection"
              , $sel:method:APIAction :: Method
method       = Method
POST
              , $sel:requestData:APIAction :: WithData
requestData  = Form -> WithData
WithForm (Form -> WithData) -> Form -> WithData
forall a b. (a -> b) -> a -> b
$ NewCollection -> Form
forall a. ToForm a => a -> Form
toForm NewCollection
nc
              }

-- | Delete the entire collection from the subreddit
deleteCollection :: MonadReddit m => CollectionID -> m ()
deleteCollection :: PathSegment -> m ()
deleteCollection PathSegment
cid =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = PathSegment -> [PathSegment]
collectionsPath PathSegment
"delete_collection"
               , $sel:method:APIAction :: Method
method       = Method
POST
               , $sel:requestData:APIAction :: WithData
requestData  = [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ (PathSegment
"collection_id", PathSegment
cid) ]
               }

-- | Add a submission to a collection
addSubmissionToCollection
    :: MonadReddit m => CollectionID -> SubmissionID -> m ()
addSubmissionToCollection :: PathSegment -> SubmissionID -> m ()
addSubmissionToCollection = PathSegment -> PathSegment -> SubmissionID -> m ()
forall (m :: * -> *).
MonadReddit m =>
PathSegment -> PathSegment -> SubmissionID -> m ()
collectionAddRemove PathSegment
"add_post_to_collection"

-- | Remove a submission from a collection
removeSubmissionFromCollection
    :: MonadReddit m => CollectionID -> SubmissionID -> m ()
removeSubmissionFromCollection :: PathSegment -> SubmissionID -> m ()
removeSubmissionFromCollection =
    PathSegment -> PathSegment -> SubmissionID -> m ()
forall (m :: * -> *).
MonadReddit m =>
PathSegment -> PathSegment -> SubmissionID -> m ()
collectionAddRemove PathSegment
"remove_post_in_collection"

-- | Reorder the submissions that comprise the collection by providing a
-- container of 'SubmissionID's in the new intended order
reorderCollection
    :: (MonadReddit m, Foldable t) => CollectionID -> t SubmissionID -> m ()
reorderCollection :: PathSegment -> t SubmissionID -> m ()
reorderCollection PathSegment
cid t SubmissionID
ss =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = PathSegment -> [PathSegment]
collectionsPath PathSegment
"reorder_collection"
               , $sel:method:APIAction :: Method
method       = Method
POST
               , $sel:requestData:APIAction :: WithData
requestData  = [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ (PathSegment
"collection_id", PathSegment
cid)
                                               , (PathSegment
"link_ids", t SubmissionID -> PathSegment
forall a. Thing a => a -> PathSegment
fullname t SubmissionID
ss)
                                               ]
               }

-- | Update the description of the collection
updateCollectionDescription :: MonadReddit m => CollectionID -> Body -> m ()
updateCollectionDescription :: PathSegment -> PathSegment -> m ()
updateCollectionDescription PathSegment
cid PathSegment
b =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = PathSegment -> [PathSegment]
collectionsPath PathSegment
"update_collection_description"
               , $sel:method:APIAction :: Method
method       = Method
POST
               , $sel:requestData:APIAction :: WithData
requestData  = [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ (PathSegment
"collection_id", PathSegment
cid)
                                               , (PathSegment
"description", PathSegment
b)
                                               ]
               }

-- | Update the title of the collection
updateCollectionTitle :: MonadReddit m => CollectionID -> Title -> m ()
updateCollectionTitle :: PathSegment -> PathSegment -> m ()
updateCollectionTitle PathSegment
cid PathSegment
t =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = PathSegment -> [PathSegment]
collectionsPath PathSegment
"update_collection_title"
               , $sel:method:APIAction :: Method
method       = Method
POST
               , $sel:requestData:APIAction :: WithData
requestData  =
                     [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ (PathSegment
"collection_id", PathSegment
cid), (PathSegment
"title", PathSegment
t) ]
               }

collectionAddRemove
    :: MonadReddit m => PathSegment -> CollectionID -> SubmissionID -> m ()
collectionAddRemove :: PathSegment -> PathSegment -> SubmissionID -> m ()
collectionAddRemove PathSegment
path PathSegment
cid SubmissionID
sid =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = PathSegment -> [PathSegment]
collectionsPath PathSegment
path
               , $sel:method:APIAction :: Method
method       = Method
POST
               , $sel:requestData:APIAction :: WithData
requestData  =
                     [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ (PathSegment
"collection_id", PathSegment
cid)
                                    , (PathSegment
"link_fullname", SubmissionID -> PathSegment
forall a. Thing a => a -> PathSegment
fullname SubmissionID
sid)
                                    ]
               }

collectionsPath :: PathSegment -> [PathSegment]
collectionsPath :: PathSegment -> [PathSegment]
collectionsPath PathSegment
path = [ PathSegment
"api", PathSegment
"v1", PathSegment
"collections", PathSegment
path ]

--Subreddit relationships------------------------------------------------------
-- | Get a list of information on all moderators for the given subreddit
getModerators :: MonadReddit m => SubredditName -> m (Seq ModAccount)
getModerators :: SubredditName -> m (Seq ModAccount)
getModerators SubredditName
sname = APIAction ModList -> m ModList
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction @ModList APIAction ModList
r m ModList -> (ModList -> Seq ModAccount) -> m (Seq ModAccount)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ModList -> Seq ModAccount
forall s t a b. Wrapped s t a b => s -> a
wrappedTo
  where
    r :: APIAction ModList
r = APIAction Any
forall a. APIAction a
defaultAPIAction { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = SubredditName -> PathSegment -> [PathSegment]
subAboutPath SubredditName
sname PathSegment
"moderators" }

-- | Get information about a single moderator, if such a moderator exists
getModerator
    :: MonadReddit m => SubredditName -> Username -> m (Maybe ModAccount)
getModerator :: SubredditName -> Username -> m (Maybe ModAccount)
getModerator SubredditName
sname Username
uname = do
    Seq ModAccount
mods <- APIAction ModList -> m ModList
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction @ModList APIAction ModList
r m ModList -> (ModList -> Seq ModAccount) -> m (Seq ModAccount)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ModList -> Seq ModAccount
forall s t a b. Wrapped s t a b => s -> a
wrappedTo
    case Seq ModAccount
mods of
        ModAccount
modInfo :<| Seq ModAccount
_ -> Maybe ModAccount -> m (Maybe ModAccount)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ModAccount -> m (Maybe ModAccount))
-> Maybe ModAccount -> m (Maybe ModAccount)
forall a b. (a -> b) -> a -> b
$ ModAccount -> Maybe ModAccount
forall a. a -> Maybe a
Just ModAccount
modInfo
        Seq ModAccount
_             -> Maybe ModAccount -> m (Maybe ModAccount)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ModAccount
forall a. Maybe a
Nothing
  where
    r :: APIAction ModList
r = APIAction Any
forall a. APIAction a
defaultAPIAction
        { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = SubredditName -> PathSegment -> [PathSegment]
subAboutPath SubredditName
sname PathSegment
"moderators"
        , $sel:requestData:APIAction :: WithData
requestData  = [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ (PathSegment
"user", Username -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam Username
uname) ]
        }

-- | Update the permissions granted to a current moderator
updateModerator
    :: (MonadReddit m, Foldable t)
    => Maybe (t ModPermission)
    -- ^ If @Nothing@, grants all permissions. If @Just@ and empty,
    -- all permissions are revoked. Otherwise, each of the given container
    -- of permissions is granted
    -> SubredditName
    -> Username
    -> m ()
updateModerator :: Maybe (t ModPermission) -> SubredditName -> Username -> m ()
updateModerator = SubredditRelationship
-> Maybe (t ModPermission) -> SubredditName -> Username -> m ()
forall (m :: * -> *) (t :: * -> *).
(MonadReddit m, Foldable t) =>
SubredditRelationship
-> Maybe (t ModPermission) -> SubredditName -> Username -> m ()
postUpdate SubredditRelationship
Mod

-- | Revoke the given user\'s mod status
removeModerator :: MonadReddit m => SubredditName -> Username -> m ()
removeModerator :: SubredditName -> Username -> m ()
removeModerator = SubredditRelationship -> SubredditName -> Username -> m ()
forall (m :: * -> *).
MonadReddit m =>
SubredditRelationship -> SubredditName -> Username -> m ()
postUnfriend SubredditRelationship
Mod

-- | Revoke the authenticated user\'s mod status in the given subreddit.
-- __Caution__!
abdicateModerator :: MonadReddit m => SubredditName -> m ()
abdicateModerator :: SubredditName -> m ()
abdicateModerator SubredditName
sname = do
    Account { Username
$sel:username:Account :: Account -> Username
username :: Username
username } <- m Account
forall (m :: * -> *). MonadReddit m => m Account
getMe
    SubredditRelationship -> SubredditName -> Username -> m ()
forall (m :: * -> *).
MonadReddit m =>
SubredditRelationship -> SubredditName -> Username -> m ()
postUnfriend SubredditRelationship
Mod SubredditName
sname Username
username

-- | Invite a user to moderate the subreddit. This action will implicitly grant
-- the invitee all moderator permissions on the subreddit. To control which
-- specific set of permissions the invitee shall be allowed instead, see
-- 'inviteModeratorWithPerms'
inviteModerator :: MonadReddit m => SubredditName -> Username -> m ()
inviteModerator :: SubredditName -> Username -> m ()
inviteModerator = Form -> SubredditName -> Username -> m ()
forall (m :: * -> *).
MonadReddit m =>
Form -> SubredditName -> Username -> m ()
invite (Form -> SubredditName -> Username -> m ())
-> Form -> SubredditName -> Username -> m ()
forall a b. (a -> b) -> a -> b
$ [(PathSegment, PathSegment)] -> Form
mkTextForm [ (PathSegment
"permissions", PathSegment
"+all") ]

-- | Invite a user to moderate the subreddit with a specific set of permissions
inviteModeratorWithPerms
    :: (MonadReddit m, Foldable t)
    => t ModPermission -- ^ If empty, no permissions are granted
    -> SubredditName
    -> Username
    -> m ()
inviteModeratorWithPerms :: t ModPermission -> SubredditName -> Username -> m ()
inviteModeratorWithPerms t ModPermission
perms =
    Form -> SubredditName -> Username -> m ()
forall (m :: * -> *).
MonadReddit m =>
Form -> SubredditName -> Username -> m ()
invite (Form -> SubredditName -> Username -> m ())
-> Form -> SubredditName -> Username -> m ()
forall a b. (a -> b) -> a -> b
$ [(PathSegment, PathSegment)] -> Form
mkTextForm [ (PathSegment
"permissions", t ModPermission -> PathSegment
forall (t :: * -> *) a.
(Foldable t, Ord a, Enum a, Bounded a, ToHttpApiData a) =>
t a -> PathSegment
joinPerms t ModPermission
perms) ]

invite :: MonadReddit m => Form -> SubredditName -> Username -> m ()
invite :: Form -> SubredditName -> Username -> m ()
invite = SubredditRelationship -> Form -> SubredditName -> Username -> m ()
forall (m :: * -> *).
MonadReddit m =>
SubredditRelationship -> Form -> SubredditName -> Username -> m ()
postFriend SubredditRelationship
ModInvitation

-- | Get a listing of users invited to moderate the subreddit. This endpoint only
-- returns 25 results at a time, and does not use the @Listing@ mechanism that
-- prevails elsewhere. You can paginate through all invitees by passing previous
-- 'ModInviteeList' results to subsequent invocations
getInvitees :: MonadReddit m
            => Maybe ModInviteeList
            -- ^ A previously obtained 'ModInviteeList' that may contain
            -- @before@ and @after@ fields to paginate through entries
            -> SubredditName
            -> m ModInviteeList
getInvitees :: Maybe ModInviteeList -> SubredditName -> m ModInviteeList
getInvitees Maybe ModInviteeList
mil SubredditName
sname =
    APIAction ModInviteeList -> m ModInviteeList
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction APIAction Any
forall a. APIAction a
defaultAPIAction
              { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments =
                    [ PathSegment
"api", PathSegment
"v1", SubredditName -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toUrlPiece SubredditName
sname, PathSegment
"moderators_invited" ]
              , $sel:requestData:APIAction :: WithData
requestData  = Form -> WithData
WithForm (Form -> WithData) -> Form -> WithData
forall a b. (a -> b) -> a -> b
$ Form -> (ModInviteeList -> Form) -> Maybe ModInviteeList -> Form
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Form
forall a. Monoid a => a
mempty ModInviteeList -> Form
forall a. ToForm a => a -> Form
toForm Maybe ModInviteeList
mil
              }

-- | Get information about a single invited user
getInvitee
    :: MonadReddit m => SubredditName -> Username -> m (Maybe ModInvitee)
getInvitee :: SubredditName -> Username -> m (Maybe ModInvitee)
getInvitee SubredditName
sname Username
uname = do
    ModInviteeList { Seq ModInvitee
$sel:invited:ModInviteeList :: ModInviteeList -> Seq ModInvitee
invited :: Seq ModInvitee
invited } <- APIAction ModInviteeList -> m ModInviteeList
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction APIAction ModInviteeList
r
    case Seq ModInvitee
invited of
        ModInvitee
invitee :<| Seq ModInvitee
_ -> Maybe ModInvitee -> m (Maybe ModInvitee)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ModInvitee -> m (Maybe ModInvitee))
-> Maybe ModInvitee -> m (Maybe ModInvitee)
forall a b. (a -> b) -> a -> b
$ ModInvitee -> Maybe ModInvitee
forall a. a -> Maybe a
Just ModInvitee
invitee
        Seq ModInvitee
_             -> Maybe ModInvitee -> m (Maybe ModInvitee)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ModInvitee
forall a. Maybe a
Nothing
  where
    r :: APIAction ModInviteeList
r = APIAction Any
forall a. APIAction a
defaultAPIAction
        { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments =
              [ PathSegment
"api", PathSegment
"v1", SubredditName -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toUrlPiece SubredditName
sname, PathSegment
"moderators_invited" ]
        , $sel:requestData:APIAction :: WithData
requestData  = [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ (PathSegment
"username", Username -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam Username
uname) ]
        }

-- | Update the permissions granted to the mod invitee
updateInvitation
    :: (MonadReddit m, Foldable t)
    => Maybe (t ModPermission)
    -- ^ If @Nothing@, grants all permissions. If @Just@ and empty,
    -- all permissions are revoked. Otherwise, each of the given container
    -- of permissions is granted
    -> SubredditName
    -> Username
    -> m ()
updateInvitation :: Maybe (t ModPermission) -> SubredditName -> Username -> m ()
updateInvitation = SubredditRelationship
-> Maybe (t ModPermission) -> SubredditName -> Username -> m ()
forall (m :: * -> *) (t :: * -> *).
(MonadReddit m, Foldable t) =>
SubredditRelationship
-> Maybe (t ModPermission) -> SubredditName -> Username -> m ()
postUpdate SubredditRelationship
ModInvitation

postUpdate :: (MonadReddit m, Foldable t)
           => SubredditRelationship
           -> Maybe (t ModPermission)
           -> SubredditName
           -> Username
           -> m ()
postUpdate :: SubredditRelationship
-> Maybe (t ModPermission) -> SubredditName -> Username -> m ()
postUpdate SubredditRelationship
ty Maybe (t ModPermission)
ps SubredditName
sname Username
uname =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = SubredditName -> PathSegment -> [PathSegment]
subAPIPath SubredditName
sname PathSegment
"setpermissions"
               , $sel:method:APIAction :: Method
method       = Method
POST
               , $sel:requestData:APIAction :: WithData
requestData  = [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ (PathSegment
"name", Username -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam Username
uname)
                                               , (PathSegment
"type", SubredditRelationship -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam SubredditRelationship
ty)
                                               , ( PathSegment
"permissions"
                                                 , PathSegment
-> (t ModPermission -> PathSegment)
-> Maybe (t ModPermission)
-> PathSegment
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PathSegment
"+all" t ModPermission -> PathSegment
forall (t :: * -> *) a.
(Foldable t, Ord a, Enum a, Bounded a, ToHttpApiData a) =>
t a -> PathSegment
joinPerms Maybe (t ModPermission)
ps
                                                 )
                                               , (PathSegment
"api_type", PathSegment
"json")
                                               ]
               }

-- | Revoke an existing moderator invitation for the given user
revokeInvitation :: MonadReddit m => SubredditName -> Username -> m ()
revokeInvitation :: SubredditName -> Username -> m ()
revokeInvitation = SubredditRelationship -> SubredditName -> Username -> m ()
forall (m :: * -> *).
MonadReddit m =>
SubredditRelationship -> SubredditName -> Username -> m ()
postUnfriend SubredditRelationship
ModInvitation

-- | Accept the invitation issued to the authenticated user to moderate the
-- given subreddit
acceptInvitation :: MonadReddit m => SubredditName -> m ()
acceptInvitation :: SubredditName -> m ()
acceptInvitation SubredditName
sname =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = SubredditName -> PathSegment -> [PathSegment]
subAPIPath SubredditName
sname PathSegment
"accept_moderator_invitation"
               , $sel:method:APIAction :: Method
method       = Method
POST
               , $sel:requestData:APIAction :: WithData
requestData  = [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ (PathSegment
"api_type", PathSegment
"json") ]
               }

-- | Get a list of contributors on the subreddit
getContributors :: MonadReddit m
                => SubredditName
                -> Paginator RelID RelInfo
                -> m (Listing RelID RelInfo)
getContributors :: SubredditName
-> Paginator RelID RelInfo -> m (Listing RelID RelInfo)
getContributors = SubredditRelationship
-> SubredditName
-> Paginator RelID RelInfo
-> m (Listing RelID RelInfo)
forall (m :: * -> *) a t.
(MonadReddit m, FromJSON a, Paginable a, FromJSON t, Thing t) =>
SubredditRelationship
-> SubredditName -> Paginator t a -> m (Listing t a)
relListing SubredditRelationship
Contributor

-- | Get a single contributor, if such a user exists
getContributor
    :: MonadReddit m => SubredditName -> Username -> m (Maybe RelInfo)
getContributor :: SubredditName -> Username -> m (Maybe RelInfo)
getContributor = (SubredditName
 -> Paginator RelID RelInfo -> m (Listing RelID RelInfo))
-> SubredditName -> Username -> m (Maybe RelInfo)
forall (m :: * -> *) a t.
(MonadReddit m, Paginable a, PaginateOptions a ~ RelInfoOpts) =>
(SubredditName -> Paginator t a -> m (Listing t a))
-> SubredditName -> Username -> m (Maybe a)
singleRel SubredditName
-> Paginator RelID RelInfo -> m (Listing RelID RelInfo)
forall (m :: * -> *).
MonadReddit m =>
SubredditName
-> Paginator RelID RelInfo -> m (Listing RelID RelInfo)
getContributors

-- | Give a user contributor status on the subreddit
addContributor :: MonadReddit m => SubredditName -> Username -> m ()
addContributor :: SubredditName -> Username -> m ()
addContributor = SubredditRelationship -> Form -> SubredditName -> Username -> m ()
forall (m :: * -> *).
MonadReddit m =>
SubredditRelationship -> Form -> SubredditName -> Username -> m ()
postFriend SubredditRelationship
Contributor Form
forall a. Monoid a => a
mempty

-- | Remove a contributor from the subreddit
removeContributor :: MonadReddit m => SubredditName -> Username -> m ()
removeContributor :: SubredditName -> Username -> m ()
removeContributor = SubredditRelationship -> SubredditName -> Username -> m ()
forall (m :: * -> *).
MonadReddit m =>
SubredditRelationship -> SubredditName -> Username -> m ()
postUnfriend SubredditRelationship
Contributor

-- | AbdicateModerator your contributor status on the given subreddit
abdicateContributor :: MonadReddit m => SubredditID -> m ()
abdicateContributor :: SubredditID -> m ()
abdicateContributor SubredditID
sid =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [ PathSegment
"api", PathSegment
"leavecontributor" ]
               , $sel:method:APIAction :: Method
method       = Method
POST
               , $sel:requestData:APIAction :: WithData
requestData  = [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ (PathSegment
"id", SubredditID -> PathSegment
forall a. Thing a => a -> PathSegment
fullname SubredditID
sid) ]
               }

-- | Get a list of wiki contributors on the subreddit
getWikiContributors :: MonadReddit m
                    => SubredditName
                    -> Paginator RelID RelInfo
                    -> m (Listing RelID RelInfo)
getWikiContributors :: SubredditName
-> Paginator RelID RelInfo -> m (Listing RelID RelInfo)
getWikiContributors = SubredditRelationship
-> SubredditName
-> Paginator RelID RelInfo
-> m (Listing RelID RelInfo)
forall (m :: * -> *) a t.
(MonadReddit m, FromJSON a, Paginable a, FromJSON t, Thing t) =>
SubredditRelationship
-> SubredditName -> Paginator t a -> m (Listing t a)
relListing SubredditRelationship
WikiContributor

-- | Get a single wiki contributor, if such a user exists
getWikiContributor
    :: MonadReddit m => SubredditName -> Username -> m (Maybe RelInfo)
getWikiContributor :: SubredditName -> Username -> m (Maybe RelInfo)
getWikiContributor = (SubredditName
 -> Paginator RelID RelInfo -> m (Listing RelID RelInfo))
-> SubredditName -> Username -> m (Maybe RelInfo)
forall (m :: * -> *) a t.
(MonadReddit m, Paginable a, PaginateOptions a ~ RelInfoOpts) =>
(SubredditName -> Paginator t a -> m (Listing t a))
-> SubredditName -> Username -> m (Maybe a)
singleRel SubredditName
-> Paginator RelID RelInfo -> m (Listing RelID RelInfo)
forall (m :: * -> *).
MonadReddit m =>
SubredditName
-> Paginator RelID RelInfo -> m (Listing RelID RelInfo)
getWikiContributors

-- | Give a user wiki contributor privileges on the subreddit
addWikiContributor :: MonadReddit m => SubredditName -> Username -> m ()
addWikiContributor :: SubredditName -> Username -> m ()
addWikiContributor = SubredditRelationship -> Form -> SubredditName -> Username -> m ()
forall (m :: * -> *).
MonadReddit m =>
SubredditRelationship -> Form -> SubredditName -> Username -> m ()
postFriend SubredditRelationship
WikiContributor Form
forall a. Monoid a => a
mempty

-- | Revoke wiki contributor privileges on the subreddit
removeWikiContributor :: MonadReddit m => SubredditName -> Username -> m ()
removeWikiContributor :: SubredditName -> Username -> m ()
removeWikiContributor = SubredditRelationship -> SubredditName -> Username -> m ()
forall (m :: * -> *).
MonadReddit m =>
SubredditRelationship -> SubredditName -> Username -> m ()
postUnfriend SubredditRelationship
WikiContributor

-- | Get the banned users for a given subreddit
getBans :: MonadReddit m
        => SubredditName
        -> Paginator RelID Ban
        -> m (Listing RelID Ban)
getBans :: SubredditName -> Paginator RelID Ban -> m (Listing RelID Ban)
getBans = SubredditRelationship
-> SubredditName -> Paginator RelID Ban -> m (Listing RelID Ban)
forall (m :: * -> *) a t.
(MonadReddit m, FromJSON a, Paginable a, FromJSON t, Thing t) =>
SubredditRelationship
-> SubredditName -> Paginator t a -> m (Listing t a)
relListing SubredditRelationship
Banned

-- | Check to see if a given user is banned on a particular subreddit,
-- returning the details of the 'Ban' if so
getBan :: MonadReddit m => SubredditName -> Username -> m (Maybe Ban)
getBan :: SubredditName -> Username -> m (Maybe Ban)
getBan = (SubredditName -> Paginator RelID Ban -> m (Listing RelID Ban))
-> SubredditName -> Username -> m (Maybe Ban)
forall (m :: * -> *) a t.
(MonadReddit m, Paginable a, PaginateOptions a ~ RelInfoOpts) =>
(SubredditName -> Paginator t a -> m (Listing t a))
-> SubredditName -> Username -> m (Maybe a)
singleRel SubredditName -> Paginator RelID Ban -> m (Listing RelID Ban)
forall (m :: * -> *).
MonadReddit m =>
SubredditName -> Paginator RelID Ban -> m (Listing RelID Ban)
getBans

-- | Issue a ban against a user on the given subreddit, with the provided notes
-- and (optional) duration
banUser :: MonadReddit m => BanNotes -> SubredditName -> Username -> m ()
banUser :: BanNotes -> SubredditName -> Username -> m ()
banUser BanNotes
ban = SubredditRelationship -> Form -> SubredditName -> Username -> m ()
forall (m :: * -> *).
MonadReddit m =>
SubredditRelationship -> Form -> SubredditName -> Username -> m ()
postFriend SubredditRelationship
Banned (BanNotes -> Form
forall a. ToForm a => a -> Form
toForm BanNotes
ban)

-- | Remove an existing ban on a user
unbanUser :: MonadReddit m => SubredditName -> Username -> m ()
unbanUser :: SubredditName -> Username -> m ()
unbanUser = SubredditRelationship -> SubredditName -> Username -> m ()
forall (m :: * -> *).
MonadReddit m =>
SubredditRelationship -> SubredditName -> Username -> m ()
postUnfriend SubredditRelationship
Banned

-- | Ban a user from participating in the wiki
wikibanUser :: MonadReddit m => BanNotes -> SubredditName -> Username -> m ()
wikibanUser :: BanNotes -> SubredditName -> Username -> m ()
wikibanUser BanNotes
ban = SubredditRelationship -> Form -> SubredditName -> Username -> m ()
forall (m :: * -> *).
MonadReddit m =>
SubredditRelationship -> Form -> SubredditName -> Username -> m ()
postFriend SubredditRelationship
BannedFromWiki (BanNotes -> Form
forall a. ToForm a => a -> Form
toForm BanNotes
ban)

-- | Reverse an existing wiki ban for a user
wikiUnbanUser :: MonadReddit m => SubredditName -> Username -> m ()
wikiUnbanUser :: SubredditName -> Username -> m ()
wikiUnbanUser = SubredditRelationship -> SubredditName -> Username -> m ()
forall (m :: * -> *).
MonadReddit m =>
SubredditRelationship -> SubredditName -> Username -> m ()
postUnfriend SubredditRelationship
BannedFromWiki

-- | Get a list of users banned on the subreddit wiki
getWikibans :: MonadReddit m
            => SubredditName
            -> Paginator RelID RelInfo
            -> m (Listing RelID RelInfo)
getWikibans :: SubredditName
-> Paginator RelID RelInfo -> m (Listing RelID RelInfo)
getWikibans = SubredditRelationship
-> SubredditName
-> Paginator RelID RelInfo
-> m (Listing RelID RelInfo)
forall (m :: * -> *) a t.
(MonadReddit m, FromJSON a, Paginable a, FromJSON t, Thing t) =>
SubredditRelationship
-> SubredditName -> Paginator t a -> m (Listing t a)
relListing SubredditRelationship
BannedFromWiki

-- | Get information on a single user banned on the subreddit wiki, if such a ban
-- exists
getWikiban :: MonadReddit m => SubredditName -> Username -> m (Maybe RelInfo)
getWikiban :: SubredditName -> Username -> m (Maybe RelInfo)
getWikiban = (SubredditName
 -> Paginator RelID RelInfo -> m (Listing RelID RelInfo))
-> SubredditName -> Username -> m (Maybe RelInfo)
forall (m :: * -> *) a t.
(MonadReddit m, Paginable a, PaginateOptions a ~ RelInfoOpts) =>
(SubredditName -> Paginator t a -> m (Listing t a))
-> SubredditName -> Username -> m (Maybe a)
singleRel SubredditName
-> Paginator RelID RelInfo -> m (Listing RelID RelInfo)
forall (m :: * -> *).
MonadReddit m =>
SubredditName
-> Paginator RelID RelInfo -> m (Listing RelID RelInfo)
getWikibans

-- | Get a list of users muted on the subreddit wiki
getMuted :: MonadReddit m
         => SubredditName
         -> Paginator MuteID MuteInfo
         -> m (Listing MuteID MuteInfo)
getMuted :: SubredditName
-> Paginator MuteID MuteInfo -> m (Listing MuteID MuteInfo)
getMuted = SubredditRelationship
-> SubredditName
-> Paginator MuteID MuteInfo
-> m (Listing MuteID MuteInfo)
forall (m :: * -> *) a t.
(MonadReddit m, FromJSON a, Paginable a, FromJSON t, Thing t) =>
SubredditRelationship
-> SubredditName -> Paginator t a -> m (Listing t a)
relListing SubredditRelationship
Muted

-- | Get information on a single user muted on the subreddit wiki, if such a ban
-- exists
getMutedUser
    :: MonadReddit m => SubredditName -> Username -> m (Maybe MuteInfo)
getMutedUser :: SubredditName -> Username -> m (Maybe MuteInfo)
getMutedUser = (SubredditName
 -> Paginator MuteID MuteInfo -> m (Listing MuteID MuteInfo))
-> SubredditName -> Username -> m (Maybe MuteInfo)
forall (m :: * -> *) a t.
(MonadReddit m, Paginable a, PaginateOptions a ~ RelInfoOpts) =>
(SubredditName -> Paginator t a -> m (Listing t a))
-> SubredditName -> Username -> m (Maybe a)
singleRel SubredditName
-> Paginator MuteID MuteInfo -> m (Listing MuteID MuteInfo)
forall (m :: * -> *).
MonadReddit m =>
SubredditName
-> Paginator MuteID MuteInfo -> m (Listing MuteID MuteInfo)
getMuted

-- | Mute a single user on the subreddit
muteUser :: MonadReddit m => BanNotes -> SubredditName -> Username -> m ()
muteUser :: BanNotes -> SubredditName -> Username -> m ()
muteUser BanNotes
ban = SubredditRelationship -> Form -> SubredditName -> Username -> m ()
forall (m :: * -> *).
MonadReddit m =>
SubredditRelationship -> Form -> SubredditName -> Username -> m ()
postFriend SubredditRelationship
Muted (BanNotes -> Form
forall a. ToForm a => a -> Form
toForm BanNotes
ban)

-- | Unmute a single user on the subreddit
unmuteUser :: MonadReddit m => SubredditName -> Username -> m ()
unmuteUser :: SubredditName -> Username -> m ()
unmuteUser = SubredditRelationship -> SubredditName -> Username -> m ()
forall (m :: * -> *).
MonadReddit m =>
SubredditRelationship -> SubredditName -> Username -> m ()
postUnfriend SubredditRelationship
Muted

postFriend :: MonadReddit m
           => SubredditRelationship
           -> Form
           -> SubredditName
           -> Username
           -> m ()
postFriend :: SubredditRelationship -> Form -> SubredditName -> Username -> m ()
postFriend SubredditRelationship
ty Form
form SubredditName
sname Username
uname =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = SubredditName -> PathSegment -> [PathSegment]
subAPIPath SubredditName
sname PathSegment
"friend"
               , $sel:method:APIAction :: Method
method       = Method
POST
               , $sel:requestData:APIAction :: WithData
requestData  = Form -> WithData
WithForm
                     (Form -> WithData) -> Form -> WithData
forall a b. (a -> b) -> a -> b
$ [(PathSegment, PathSegment)] -> Form
mkTextForm [ (PathSegment
"name", Username -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam Username
uname)
                                  , (PathSegment
"type", SubredditRelationship -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam SubredditRelationship
ty)
                                  , (PathSegment
"api_type", PathSegment
"json")
                                  ]
                     Form -> Form -> Form
forall a. Semigroup a => a -> a -> a
<> Form
form
               }

postUnfriend :: MonadReddit m
             => SubredditRelationship
             -> SubredditName
             -> Username
             -> m ()
postUnfriend :: SubredditRelationship -> SubredditName -> Username -> m ()
postUnfriend SubredditRelationship
ty SubredditName
sname Username
uname =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = SubredditName -> PathSegment -> [PathSegment]
subAPIPath SubredditName
sname PathSegment
"unfriend"
               , $sel:method:APIAction :: Method
method       = Method
POST
               , $sel:requestData:APIAction :: WithData
requestData  = [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ (PathSegment
"name", Username -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam Username
uname)
                                               , (PathSegment
"type", SubredditRelationship -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam SubredditRelationship
ty)
                                               , (PathSegment
"api_type", PathSegment
"json")
                                               ]
               }

relListing :: (MonadReddit m, FromJSON a, Paginable a, FromJSON t, Thing t)
           => SubredditRelationship
           -> SubredditName
           -> Paginator t a
           -> m (Listing t a)
relListing :: SubredditRelationship
-> SubredditName -> Paginator t a -> m (Listing t a)
relListing SubredditRelationship
ty SubredditName
sname Paginator t a
paginator =
    APIAction (Listing t a) -> m (Listing t a)
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction APIAction Any
forall a. APIAction a
defaultAPIAction
              { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = SubredditName -> PathSegment -> [PathSegment]
subAboutPath SubredditName
sname (SubredditRelationship -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toUrlPiece SubredditRelationship
ty)
              , $sel:requestData:APIAction :: WithData
requestData  = Paginator t a -> WithData
forall t a. (Thing t, Paginable a) => Paginator t a -> WithData
paginatorToFormData Paginator t a
paginator
              }

singleRel :: forall m a t.
          (MonadReddit m, Paginable a, PaginateOptions a ~ RelInfoOpts)
          => (SubredditName -> Paginator t a -> m (Listing t a))
          -> SubredditName
          -> Username
          -> m (Maybe a)
singleRel :: (SubredditName -> Paginator t a -> m (Listing t a))
-> SubredditName -> Username -> m (Maybe a)
singleRel SubredditName -> Paginator t a -> m (Listing t a)
action SubredditName
sname Username
uname = do
    Listing { Seq a
$sel:children:Listing :: forall t a. Listing t a -> Seq a
children :: Seq a
children } <- SubredditName -> Paginator t a -> m (Listing t a)
action SubredditName
sname Paginator t a
pag
    case Seq a
children of
        a
child :<| Seq a
_ -> Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
child
        Seq a
_           -> Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
  where
    pag :: Paginator t a
pag = (Paginable a => Paginator t a
forall t a. Paginable a => Paginator t a
emptyPaginator @t @a)
        { $sel:opts:Paginator :: PaginateOptions a
opts = RelInfoOpts :: Maybe Username -> RelInfoOpts
RelInfoOpts { $sel:username:RelInfoOpts :: Maybe Username
username = Username -> Maybe Username
forall a. a -> Maybe a
Just Username
uname } }

--Subreddit settings-----------------------------------------------------------
-- | Get the configured 'SubredditSettings' for a given subreddit
getSubredditSettings :: MonadReddit m => SubredditName -> m SubredditSettings
getSubredditSettings :: SubredditName -> m SubredditSettings
getSubredditSettings SubredditName
sname =
    APIAction SubredditSettings -> m SubredditSettings
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction APIAction Any
forall a. APIAction a
defaultAPIAction { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = SubredditName -> PathSegment -> [PathSegment]
subAboutPath SubredditName
sname PathSegment
"edit" }

-- | Configure a subreddit with the provided 'SubredditSettings'
setSubredditSettings :: MonadReddit m => SubredditSettings -> m ()
setSubredditSettings :: SubredditSettings -> m ()
setSubredditSettings SubredditSettings
ss =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [ PathSegment
"api", PathSegment
"site_admin" ]
               , $sel:method:APIAction :: Method
method       = Method
POST
               , $sel:requestData:APIAction :: WithData
requestData  = Form -> WithData
WithForm (Form -> WithData) -> Form -> WithData
forall a b. (a -> b) -> a -> b
$ SubredditSettings -> Form
forall a. ToForm a => a -> Form
toForm SubredditSettings
ss
               }

--Subreddit rules--------------------------------------------------------------
-- | Add a rule to the subreddit. The newly created 'SubredditRule' is returned
-- upon success
addSubredditRule
    :: MonadReddit m => SubredditName -> NewSubredditRule -> m SubredditRule
addSubredditRule :: SubredditName -> NewSubredditRule -> m SubredditRule
addSubredditRule SubredditName
sname NewSubredditRule
nsr = APIAction PostedSubredditRule -> m PostedSubredditRule
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction @PostedSubredditRule APIAction PostedSubredditRule
r m PostedSubredditRule
-> (PostedSubredditRule -> SubredditRule) -> m SubredditRule
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> PostedSubredditRule -> SubredditRule
forall s t a b. Wrapped s t a b => s -> a
wrappedTo
  where
    r :: APIAction PostedSubredditRule
r = APIAction Any
forall a. APIAction a
defaultAPIAction
        { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [ PathSegment
"api", PathSegment
"add_subreddit_rule" ]
        , $sel:method:APIAction :: Method
method       = Method
POST
        , $sel:requestData:APIAction :: WithData
requestData  = Form -> WithData
WithForm
              (Form -> WithData) -> Form -> WithData
forall a b. (a -> b) -> a -> b
$ [(PathSegment, PathSegment)] -> Form
mkTextForm [ (PathSegment
"r", SubredditName -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam SubredditName
sname), (PathSegment
"api_type", PathSegment
"json") ]
              Form -> Form -> Form
forall a. Semigroup a => a -> a -> a
<> NewSubredditRule -> Form
forall a. ToForm a => a -> Form
toForm NewSubredditRule
nsr
        }

-- | Delete the rule identified by the given name from the subreddit
deleteSubredditRule :: MonadReddit m => SubredditName -> Name -> m ()
deleteSubredditRule :: SubredditName -> PathSegment -> m ()
deleteSubredditRule SubredditName
sname PathSegment
n =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [ PathSegment
"api", PathSegment
"remove_subreddit_rule" ]
               , $sel:method:APIAction :: Method
method       = Method
POST
               , $sel:requestData:APIAction :: WithData
requestData  = [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ (PathSegment
"r", SubredditName -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam SubredditName
sname)
                                               , (PathSegment
"short_name", PathSegment
n)
                                               ]
               }

-- | Update an existing subreddit rule. You must provide the @shortName@ of the
-- existing rule as a parameter in order for Reddit to identify the rule. The
-- @shortName@ can be changed by updating the 'SubredditRule' record, however
updateSubredditRule
    :: MonadReddit m
    => SubredditName
    -> Name
    -- ^ The old name for the rule. This is required even if you are not
    -- changing the name of the rule, as Reddit has no other data to
    -- uniquely identify the rule
    -> SubredditRule
    -> m SubredditRule
updateSubredditRule :: SubredditName -> PathSegment -> SubredditRule -> m SubredditRule
updateSubredditRule SubredditName
sname PathSegment
oldName SubredditRule
srule =
    APIAction PostedSubredditRule -> m PostedSubredditRule
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction @PostedSubredditRule APIAction PostedSubredditRule
r m PostedSubredditRule
-> (PostedSubredditRule -> SubredditRule) -> m SubredditRule
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> PostedSubredditRule -> SubredditRule
forall s t a b. Wrapped s t a b => s -> a
wrappedTo
  where
    r :: APIAction PostedSubredditRule
r = APIAction Any
forall a. APIAction a
defaultAPIAction
        { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [ PathSegment
"api", PathSegment
"update_subreddit_rule" ]
        , $sel:method:APIAction :: Method
method       = Method
POST
        , $sel:requestData:APIAction :: WithData
requestData  = Form -> WithData
WithForm
              (Form -> WithData) -> Form -> WithData
forall a b. (a -> b) -> a -> b
$ [(PathSegment, PathSegment)] -> Form
mkTextForm [ (PathSegment
"old_short_name", PathSegment
oldName)
                           , (PathSegment
"r", SubredditName -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam SubredditName
sname)
                           , (PathSegment
"api_type", PathSegment
"json")
                           ]
              Form -> Form -> Form
forall a. Semigroup a => a -> a -> a
<> SubredditRule -> Form
forall a. ToForm a => a -> Form
toForm SubredditRule
srule
        }

-- | Reorder the subreddit rules
reorderSubredditRules
    :: (MonadReddit m, Foldable t)
    => SubredditName
    -> t Name
    -- ^ The desired order of the rules. Must contain all of the @shortName@s
    -- of currently configured 'SubredditRule's on the subreddit
    -> m ()
reorderSubredditRules :: SubredditName -> t PathSegment -> m ()
reorderSubredditRules SubredditName
sname t PathSegment
ns =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [ PathSegment
"api", PathSegment
"reorder_subreddit_rules" ]
               , $sel:method:APIAction :: Method
method       = Method
POST
               , $sel:requestData:APIAction :: WithData
requestData  =
                     [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ (PathSegment
"r", SubredditName -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam SubredditName
sname)
                                    , (PathSegment
"new_rule_order", t PathSegment -> PathSegment
forall (t :: * -> *) a.
(Foldable t, ToHttpApiData a) =>
t a -> PathSegment
joinParams t PathSegment
ns)
                                    ]
               }

--Flair------------------------------------------------------------------------
-- | Get a list of usernames and the flair currently assigned to them
configureSubredditFlair
    :: MonadReddit m => SubredditName -> FlairConfig -> m ()
configureSubredditFlair :: SubredditName -> FlairConfig -> m ()
configureSubredditFlair SubredditName
sname FlairConfig
fc =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = SubredditName -> PathSegment -> [PathSegment]
subAPIPath SubredditName
sname PathSegment
"flairconfig"
               , $sel:method:APIAction :: Method
method       = Method
POST
               , $sel:requestData:APIAction :: WithData
requestData  = Form -> WithData
WithForm (Form -> WithData) -> Form -> WithData
forall a b. (a -> b) -> a -> b
$ FlairConfig -> Form
forall a. ToForm a => a -> Form
toForm FlairConfig
fc
               }

getFlairList :: MonadReddit m
             => SubredditName
             -> Paginator UserID AssignedFlair
             -> m (Listing UserID AssignedFlair)
getFlairList :: SubredditName
-> Paginator UserID AssignedFlair
-> m (Listing UserID AssignedFlair)
getFlairList SubredditName
sname Paginator UserID AssignedFlair
paginator = FlairList -> Listing UserID AssignedFlair
flairlistToListing
    (FlairList -> Listing UserID AssignedFlair)
-> m FlairList -> m (Listing UserID AssignedFlair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> APIAction FlairList -> m FlairList
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction APIAction Any
forall a. APIAction a
defaultAPIAction
                  { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = SubredditName -> PathSegment -> [PathSegment]
subAPIPath SubredditName
sname PathSegment
"flairlist"
                  , $sel:requestData:APIAction :: WithData
requestData  = Paginator UserID AssignedFlair -> WithData
forall t a. (Thing t, Paginable a) => Paginator t a -> WithData
paginatorToFormData Paginator UserID AssignedFlair
paginator
                  }

-- | Get the 'UserFlair' that corresponds to a 'Username'
getUserFlair
    :: MonadReddit m => SubredditName -> Username -> m (Maybe UserFlair)
getUserFlair :: SubredditName -> Username -> m (Maybe UserFlair)
getUserFlair SubredditName
sname Username
uname = m (Maybe UserFlair)
-> (APIException -> m (Maybe UserFlair)) -> m (Maybe UserFlair)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch @_ @APIException m (Maybe UserFlair)
action ((APIException -> m (Maybe UserFlair)) -> m (Maybe UserFlair))
-> (APIException -> m (Maybe UserFlair)) -> m (Maybe UserFlair)
forall a b. (a -> b) -> a -> b
$ \case
    JSONParseError PathSegment
_ ByteString
_ -> Maybe UserFlair -> m (Maybe UserFlair)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe UserFlair
forall a. Maybe a
Nothing
    APIException
e                  -> APIException -> m (Maybe UserFlair)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM APIException
e
  where
    action :: m (Maybe UserFlair)
action = APIAction CurrentUserFlair -> m CurrentUserFlair
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction @CurrentUserFlair APIAction CurrentUserFlair
r m CurrentUserFlair
-> (CurrentUserFlair -> Maybe UserFlair) -> m (Maybe UserFlair)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> UserFlair -> Maybe UserFlair
forall a. a -> Maybe a
Just (UserFlair -> Maybe UserFlair)
-> (CurrentUserFlair -> UserFlair)
-> CurrentUserFlair
-> Maybe UserFlair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CurrentUserFlair -> UserFlair
forall s t a b. Wrapped s t a b => s -> a
wrappedTo

    r :: APIAction CurrentUserFlair
r      = APIAction Any
forall a. APIAction a
defaultAPIAction
        { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = SubredditName -> PathSegment -> [PathSegment]
subAPIPath SubredditName
sname PathSegment
"flairselector"
        , $sel:method:APIAction :: Method
method       = Method
POST
        , $sel:requestData:APIAction :: WithData
requestData  = [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ (PathSegment
"name", Username -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam Username
uname) ]
        }

-- | Set a user\'s flair. If the 'CSSClass' is provided in the 'FlairChoice', it
-- takes precedence over the 'FlairID' contained in that record
setUserFlair :: MonadReddit m => FlairSelection -> Username -> m ()
setUserFlair :: FlairSelection -> Username -> m ()
setUserFlair (FlairSelection FlairChoice { Bool
Maybe PathSegment
PathSegment
FlairText
$sel:cssClass:FlairChoice :: FlairChoice -> Maybe PathSegment
$sel:textEditable:FlairChoice :: FlairChoice -> Bool
$sel:text:FlairChoice :: FlairChoice -> FlairText
$sel:templateID:FlairChoice :: FlairChoice -> PathSegment
cssClass :: Maybe PathSegment
textEditable :: Bool
text :: FlairText
templateID :: PathSegment
.. } Maybe PathSegment
txt SubredditName
sname) Username
uname =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction ()
route
  where
    route :: APIAction ()
route     = case Maybe PathSegment
cssClass of
        Just PathSegment
css -> APIAction Any
forall a. APIAction a
baseRoute
            { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = SubredditName -> PathSegment -> [PathSegment]
subAPIPath SubredditName
sname PathSegment
"selectflair"
            , $sel:requestData:APIAction :: WithData
requestData  = Form -> WithData
WithForm
                  (Form -> WithData) -> Form -> WithData
forall a b. (a -> b) -> a -> b
$ Form
baseForm Form -> Form -> Form
forall a. Semigroup a => a -> a -> a
<> [(PathSegment, PathSegment)] -> Form
mkTextForm [ (PathSegment
"css_class", PathSegment -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam PathSegment
css) ]
            }
        Maybe PathSegment
Nothing  -> APIAction Any
forall a. APIAction a
baseRoute
            { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = SubredditName -> PathSegment -> [PathSegment]
subAPIPath SubredditName
sname PathSegment
"flair"
            , $sel:requestData:APIAction :: WithData
requestData  = Form -> WithData
WithForm
                  (Form -> WithData) -> Form -> WithData
forall a b. (a -> b) -> a -> b
$ Form
baseForm
                  Form -> Form -> Form
forall a. Semigroup a => a -> a -> a
<> [(PathSegment, PathSegment)] -> Form
mkTextForm [ ( PathSegment
"flair_template_id"
                                  , PathSegment -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam PathSegment
templateID
                                  )
                                ]
            }

    baseForm :: Form
baseForm  = [(PathSegment, PathSegment)] -> Form
mkTextForm
        ([(PathSegment, PathSegment)] -> Form)
-> [(PathSegment, PathSegment)] -> Form
forall a b. (a -> b) -> a -> b
$ [ (PathSegment
"name", Username -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam Username
uname) ]
        [(PathSegment, PathSegment)]
-> [(PathSegment, PathSegment)] -> [(PathSegment, PathSegment)]
forall a. Semigroup a => a -> a -> a
<> ((PathSegment, PathSegment) -> [(PathSegment, PathSegment)])
-> Maybe (PathSegment, PathSegment) -> [(PathSegment, PathSegment)]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (PathSegment, PathSegment) -> [(PathSegment, PathSegment)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((PathSegment
"text", ) (PathSegment -> (PathSegment, PathSegment))
-> Maybe PathSegment -> Maybe (PathSegment, PathSegment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PathSegment
txt)

    baseRoute :: APIAction a
baseRoute = APIAction Any
forall a. APIAction a
defaultAPIAction { $sel:method:APIAction :: Method
method = Method
POST }

-- | Set, update, or deleteSRImage the flair of multiple users at once, given a
-- container of 'AssignedFlair's
setUserFlairs :: (MonadReddit m, Foldable t)
              => SubredditName
              -> t AssignedFlair
              -> m (Seq FlairResult)
setUserFlairs :: SubredditName -> t AssignedFlair -> m (Seq FlairResult)
setUserFlairs SubredditName
sname t AssignedFlair
afs = [Seq FlairResult] -> Seq FlairResult
forall a. Monoid a => [a] -> a
mconcat
    ([Seq FlairResult] -> Seq FlairResult)
-> m [Seq FlairResult] -> m (Seq FlairResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([AssignedFlair] -> m (Seq FlairResult))
-> [[AssignedFlair]] -> m [Seq FlairResult]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (APIAction (Seq FlairResult) -> m (Seq FlairResult)
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction (APIAction (Seq FlairResult) -> m (Seq FlairResult))
-> ([AssignedFlair] -> APIAction (Seq FlairResult))
-> [AssignedFlair]
-> m (Seq FlairResult)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AssignedFlair] -> APIAction (Seq FlairResult)
r) (Int -> [AssignedFlair] -> [[AssignedFlair]]
forall e. Int -> [e] -> [[e]]
chunksOf Int
forall n. Num n => n
apiRequestLimit (t AssignedFlair -> [AssignedFlair]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList t AssignedFlair
afs))
  where
    r :: [AssignedFlair] -> APIAction (Seq FlairResult)
r [AssignedFlair]
as = APIAction Any
forall a. APIAction a
defaultAPIAction
        { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = SubredditName -> PathSegment -> [PathSegment]
subAPIPath SubredditName
sname PathSegment
"flaircsv"
        , $sel:method:APIAction :: Method
method       = Method
POST
        , $sel:requestData:APIAction :: WithData
requestData  =
              [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ (PathSegment
"flair_csv", [PathSegment] -> PathSegment
T.unlines ([PathSegment] -> PathSegment) -> [PathSegment] -> PathSegment
forall a b. (a -> b) -> a -> b
$ AssignedFlair -> PathSegment
mkRow (AssignedFlair -> PathSegment) -> [AssignedFlair] -> [PathSegment]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AssignedFlair]
as) ]
        }

    mkRow :: AssignedFlair -> PathSegment
mkRow AssignedFlair { Maybe PathSegment
Maybe FlairText
Username
$sel:cssClass:AssignedFlair :: AssignedFlair -> Maybe PathSegment
$sel:text:AssignedFlair :: AssignedFlair -> Maybe FlairText
$sel:user:AssignedFlair :: AssignedFlair -> Username
cssClass :: Maybe PathSegment
text :: Maybe FlairText
user :: Username
.. } =
        [PathSegment] -> PathSegment
forall (t :: * -> *) a.
(Foldable t, ToHttpApiData a) =>
t a -> PathSegment
joinParams [ Username -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam Username
user
                   , PathSegment
-> (FlairText -> PathSegment) -> Maybe FlairText -> PathSegment
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PathSegment
forall a. Monoid a => a
mempty FlairText -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam Maybe FlairText
text
                   , PathSegment -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam (PathSegment -> PathSegment) -> PathSegment -> PathSegment
forall a b. (a -> b) -> a -> b
$ PathSegment -> Maybe PathSegment -> PathSegment
forall a. a -> Maybe a -> a
fromMaybe PathSegment
forall a. Monoid a => a
mempty Maybe PathSegment
cssClass
                   ]

-- | Delete a user\'s flair on the given subreddit
deleteUserFlair :: MonadReddit m => SubredditName -> Username -> m ()
deleteUserFlair :: SubredditName -> Username -> m ()
deleteUserFlair SubredditName
sname Username
uname =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = SubredditName -> PathSegment -> [PathSegment]
subAPIPath SubredditName
sname PathSegment
"deleteflair"
               , $sel:method:APIAction :: Method
method       = Method
POST
               , $sel:requestData:APIAction :: WithData
requestData  = [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ (PathSegment
"name", Username -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam Username
uname)
                                               , (PathSegment
"api_type", PathSegment
"json")
                                               ]
               }

-- | Create a new 'FlairTemplate' for either users or submissions, returning the
-- newly created template
createFlairTemplate :: MonadReddit m
                    => FlairType
                    -> SubredditName
                    -> FlairTemplate
                    -> m FlairTemplate
createFlairTemplate :: FlairType -> SubredditName -> FlairTemplate -> m FlairTemplate
createFlairTemplate FlairType
fty SubredditName
sname FlairTemplate
tmpl = APIAction FlairTemplate -> m FlairTemplate
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction
    (APIAction FlairTemplate -> m FlairTemplate)
-> APIAction FlairTemplate -> m FlairTemplate
forall a b. (a -> b) -> a -> b
$ Form -> FlairType -> SubredditName -> APIAction FlairTemplate
forall a. Form -> FlairType -> SubredditName -> APIAction a
flairRoute (FlairTemplate -> Form
forall a. ToForm a => a -> Form
toForm FlairTemplate
tmpl) FlairType
fty SubredditName
sname

-- | Create a new 'FlairTemplate' for users, returning the newly created template
createUserFlairTemplate
    :: MonadReddit m => SubredditName -> FlairTemplate -> m FlairTemplate
createUserFlairTemplate :: SubredditName -> FlairTemplate -> m FlairTemplate
createUserFlairTemplate = FlairType -> SubredditName -> FlairTemplate -> m FlairTemplate
forall (m :: * -> *).
MonadReddit m =>
FlairType -> SubredditName -> FlairTemplate -> m FlairTemplate
createFlairTemplate FlairType
UserFlairType

-- | Create a new 'FlairTemplate' for submissions, returning the newly created
-- template
createSubmissionFlairTemplate
    :: MonadReddit m => SubredditName -> FlairTemplate -> m FlairTemplate
createSubmissionFlairTemplate :: SubredditName -> FlairTemplate -> m FlairTemplate
createSubmissionFlairTemplate = FlairType -> SubredditName -> FlairTemplate -> m FlairTemplate
forall (m :: * -> *).
MonadReddit m =>
FlairType -> SubredditName -> FlairTemplate -> m FlairTemplate
createFlairTemplate FlairType
SubmissionFlairType

-- | Update an existing 'FlairTemplate' for either users or submissions
updateFlairTemplate
    :: MonadReddit m => FlairType -> SubredditName -> FlairTemplate -> m ()
updateFlairTemplate :: FlairType -> SubredditName -> FlairTemplate -> m ()
updateFlairTemplate FlairType
fty SubredditName
sname FlairTemplate
tmpl = APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ (APIAction () -> m ()) -> APIAction () -> m ()
forall a b. (a -> b) -> a -> b
$ Form -> FlairType -> SubredditName -> APIAction ()
forall a. Form -> FlairType -> SubredditName -> APIAction a
flairRoute Form
form FlairType
fty SubredditName
sname
  where
    form :: Form
form = PostedFlairTemplate -> Form
forall a. ToForm a => a -> Form
toForm (PostedFlairTemplate -> Form) -> PostedFlairTemplate -> Form
forall a b. (a -> b) -> a -> b
$ FlairTemplate -> PostedFlairTemplate
forall s t a b. Wrapped s t a b => b -> t
wrappedFrom @PostedFlairTemplate FlairTemplate
tmpl

-- | Update an existing 'FlairTemplate' for users
updateUserFlairTemplate
    :: MonadReddit m => SubredditName -> FlairTemplate -> m ()
updateUserFlairTemplate :: SubredditName -> FlairTemplate -> m ()
updateUserFlairTemplate = FlairType -> SubredditName -> FlairTemplate -> m ()
forall (m :: * -> *).
MonadReddit m =>
FlairType -> SubredditName -> FlairTemplate -> m ()
updateFlairTemplate FlairType
UserFlairType

-- | Update an existing 'FlairTemplate' for submissions
updateSubmissionFlairTemplate
    :: MonadReddit m => SubredditName -> FlairTemplate -> m ()
updateSubmissionFlairTemplate :: SubredditName -> FlairTemplate -> m ()
updateSubmissionFlairTemplate = FlairType -> SubredditName -> FlairTemplate -> m ()
forall (m :: * -> *).
MonadReddit m =>
FlairType -> SubredditName -> FlairTemplate -> m ()
updateFlairTemplate FlairType
SubmissionFlairType

flairRoute :: Form -> FlairType -> SubredditName -> APIAction a
flairRoute :: Form -> FlairType -> SubredditName -> APIAction a
flairRoute Form
form FlairType
fty SubredditName
sname = APIAction Any
forall a. APIAction a
defaultAPIAction
    { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = SubredditName -> PathSegment -> [PathSegment]
subAPIPath SubredditName
sname PathSegment
"flairtemplate_v2"
    , $sel:method:APIAction :: Method
method       = Method
POST
    , $sel:requestData:APIAction :: WithData
requestData  =
          Form -> WithData
WithForm (Form -> WithData) -> Form -> WithData
forall a b. (a -> b) -> a -> b
$ Form
form Form -> Form -> Form
forall a. Semigroup a => a -> a -> a
<> [(PathSegment, PathSegment)] -> Form
mkTextForm [ (PathSegment
"flair_type", FlairType -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam FlairType
fty) ]
    }

-- | Delete a user or submission flair template given its 'FlairID'
deleteFlairTemplate :: MonadReddit m => SubredditName -> FlairID -> m ()
deleteFlairTemplate :: SubredditName -> PathSegment -> m ()
deleteFlairTemplate SubredditName
sname PathSegment
ftid =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = SubredditName -> PathSegment -> [PathSegment]
subAPIPath SubredditName
sname PathSegment
"deleteflairtemplate"
               , $sel:method:APIAction :: Method
method       = Method
POST
               , $sel:requestData:APIAction :: WithData
requestData  =
                     [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ (PathSegment
"flair_template_id", PathSegment -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam PathSegment
ftid)
                                    ]
               }

-- | Clear all of the user flair templates on the subreddit
clearUserFlairTemplates :: MonadReddit m => SubredditName -> m ()
clearUserFlairTemplates :: SubredditName -> m ()
clearUserFlairTemplates = FlairType -> SubredditName -> m ()
forall (m :: * -> *).
MonadReddit m =>
FlairType -> SubredditName -> m ()
clearFlairTemplates FlairType
UserFlairType

-- | Clear all of the user flair templates on the subreddit
clearSubmissionFlairTemplates :: MonadReddit m => SubredditName -> m ()
clearSubmissionFlairTemplates :: SubredditName -> m ()
clearSubmissionFlairTemplates = FlairType -> SubredditName -> m ()
forall (m :: * -> *).
MonadReddit m =>
FlairType -> SubredditName -> m ()
clearFlairTemplates FlairType
SubmissionFlairType

-- | Clear all of the user or submission flair templates on the subreddit
clearFlairTemplates :: MonadReddit m => FlairType -> SubredditName -> m ()
clearFlairTemplates :: FlairType -> SubredditName -> m ()
clearFlairTemplates FlairType
fty SubredditName
sname =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = SubredditName -> PathSegment -> [PathSegment]
subAPIPath SubredditName
sname PathSegment
"clearflairtemplates"
               , $sel:method:APIAction :: Method
method       = Method
POST
               , $sel:requestData:APIAction :: WithData
requestData  =
                     [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ (PathSegment
"flair_type", FlairType -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam FlairType
fty) ]
               }

--Wikis------------------------------------------------------------------------
-- | Get the 'WikiPageSettings' for the subreddit\'s given wikipage
getWikiPageSettings
    :: MonadReddit m => SubredditName -> WikiPageName -> m WikiPageSettings
getWikiPageSettings :: SubredditName -> WikiPageName -> m WikiPageSettings
getWikiPageSettings SubredditName
sname WikiPageName
wpage =
    APIAction WikiPageSettings -> m WikiPageSettings
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction APIAction Any
forall a. APIAction a
defaultAPIAction
              { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [ PathSegment
"r"
                               , SubredditName -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toUrlPiece SubredditName
sname
                               , PathSegment
"wiki"
                               , PathSegment
"settings"
                               , WikiPageName -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam WikiPageName
wpage
                               ]
              }

-- | Grant editing privileges to the given 'Username' on the subreddit\'s wikipage
addWikiEditor
    :: MonadReddit m => SubredditName -> WikiPageName -> Username -> m ()
addWikiEditor :: SubredditName -> WikiPageName -> Username -> m ()
addWikiEditor = PathSegment -> SubredditName -> WikiPageName -> Username -> m ()
forall (m :: * -> *).
MonadReddit m =>
PathSegment -> SubredditName -> WikiPageName -> Username -> m ()
allowedEditor PathSegment
"add"

-- | Revoke the given 'Username'\'s editing privileges on the subreddit\'s wikipage
removeWikiEditor
    :: MonadReddit m => SubredditName -> WikiPageName -> Username -> m ()
removeWikiEditor :: SubredditName -> WikiPageName -> Username -> m ()
removeWikiEditor = PathSegment -> SubredditName -> WikiPageName -> Username -> m ()
forall (m :: * -> *).
MonadReddit m =>
PathSegment -> SubredditName -> WikiPageName -> Username -> m ()
allowedEditor PathSegment
"del"

allowedEditor :: MonadReddit m
              => Text
              -> SubredditName
              -> WikiPageName
              -> Username
              -> m ()
allowedEditor :: PathSegment -> SubredditName -> WikiPageName -> Username -> m ()
allowedEditor PathSegment
path SubredditName
sname WikiPageName
wpage Username
uname =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [ PathSegment
"r"
                                , SubredditName -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam SubredditName
sname
                                , PathSegment
"api"
                                , PathSegment
"wiki"
                                , PathSegment
"allowededitor"
                                , PathSegment
path
                                ]
               , $sel:method:APIAction :: Method
method       = Method
POST
               , $sel:requestData:APIAction :: WithData
requestData  =
                     [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ (PathSegment
"page", WikiPageName -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam WikiPageName
wpage)
                                    , (PathSegment
"username", Username -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam Username
uname)
                                    ]
               }

-- | Revert the wikipage to the given revision
revertWikiPage :: MonadReddit m
               => SubredditName
               -> WikiPageName
               -> WikiRevisionID
               -> m ()
revertWikiPage :: SubredditName -> WikiPageName -> WikiRevisionID -> m ()
revertWikiPage SubredditName
sname WikiPageName
wpage WikiRevisionID
wr =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments =
                     [ PathSegment
"r", SubredditName -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toUrlPiece SubredditName
sname, PathSegment
"api", PathSegment
"wiki", PathSegment
"revert" ]
               , $sel:method:APIAction :: Method
method       = Method
POST
               , $sel:requestData:APIAction :: WithData
requestData  = [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ (PathSegment
"page", WikiPageName -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam WikiPageName
wpage)
                                               , (PathSegment
"revision", WikiRevisionID -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam WikiRevisionID
wr)
                                               ]
               }

--Stylesheets, images and widgets ----------------------------------------------
-- | Get the 'Stylesheet' that has been configured for the given subreddit
getStylesheet :: MonadReddit m => SubredditName -> m Stylesheet
getStylesheet :: SubredditName -> m Stylesheet
getStylesheet SubredditName
sname =
    APIAction Stylesheet -> m Stylesheet
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction APIAction Any
forall a. APIAction a
defaultAPIAction
              { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments =
                    [ PathSegment
"r", SubredditName -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toUrlPiece SubredditName
sname, PathSegment
"about", PathSegment
"stylesheet" ]
              }

-- | Update a given subreddit\'s stylesheet with new contents, which must be
-- valid CSS
updateStylesheet :: MonadReddit m
                 => SubredditName
                 -> Maybe Text -- ^ The reason for the change, if any
                 -> Text -- ^ The new contents of the stylesheet
                 -> m ()
updateStylesheet :: SubredditName -> Maybe PathSegment -> PathSegment -> m ()
updateStylesheet SubredditName
sname Maybe PathSegment
r PathSegment
contents =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = SubredditName -> PathSegment -> [PathSegment]
subAPIPath SubredditName
sname PathSegment
"subreddit_stylesheet"
               , $sel:method:APIAction :: Method
method       = Method
POST
               , $sel:requestData:APIAction :: WithData
requestData  = [(PathSegment, PathSegment)] -> WithData
mkTextFormData
                     ([(PathSegment, PathSegment)] -> WithData)
-> [(PathSegment, PathSegment)] -> WithData
forall a b. (a -> b) -> a -> b
$ [ (PathSegment
"stylesheet_contents", PathSegment
contents)
                       , (PathSegment
"op", PathSegment
"save")
                       , (PathSegment
"api_type", PathSegment
"json")
                       ]
                     [(PathSegment, PathSegment)]
-> [(PathSegment, PathSegment)] -> [(PathSegment, PathSegment)]
forall a. Semigroup a => a -> a -> a
<> ((PathSegment, PathSegment) -> [(PathSegment, PathSegment)])
-> Maybe (PathSegment, PathSegment) -> [(PathSegment, PathSegment)]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (PathSegment, PathSegment) -> [(PathSegment, PathSegment)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((PathSegment
"reason", ) (PathSegment -> (PathSegment, PathSegment))
-> Maybe PathSegment -> Maybe (PathSegment, PathSegment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PathSegment
r)
               }

uploadImage, uploadHeader
    :: MonadReddit m => Text -> FilePath -> SubredditName -> m ()

-- | Upload an image file to add to the given subreddit\'s stylesheet
uploadImage :: PathSegment -> FilePath -> SubredditName -> m ()
uploadImage = ByteString -> PathSegment -> FilePath -> SubredditName -> m ()
forall (m :: * -> *).
MonadReddit m =>
ByteString -> PathSegment -> FilePath -> SubredditName -> m ()
uploadSRImage ByteString
"img"

-- | Upload the image header for the given subreddit\'s stylesheet
uploadHeader :: PathSegment -> FilePath -> SubredditName -> m ()
uploadHeader = ByteString -> PathSegment -> FilePath -> SubredditName -> m ()
forall (m :: * -> *).
MonadReddit m =>
ByteString -> PathSegment -> FilePath -> SubredditName -> m ()
uploadSRImage ByteString
"header"

uploadMobileIcon, uploadMobileHeader
    :: MonadReddit m => Text -> FilePath -> SubredditName -> m ()

-- | Upload a mobile icon for the given subreddit
uploadMobileIcon :: PathSegment -> FilePath -> SubredditName -> m ()
uploadMobileIcon = ByteString -> PathSegment -> FilePath -> SubredditName -> m ()
forall (m :: * -> *).
MonadReddit m =>
ByteString -> PathSegment -> FilePath -> SubredditName -> m ()
uploadSRImage ByteString
"icon"

-- | Upload the mobile header for the given subreddit
uploadMobileHeader :: PathSegment -> FilePath -> SubredditName -> m ()
uploadMobileHeader = ByteString -> PathSegment -> FilePath -> SubredditName -> m ()
forall (m :: * -> *).
MonadReddit m =>
ByteString -> PathSegment -> FilePath -> SubredditName -> m ()
uploadSRImage ByteString
"banner"

-- | Delete the named image from the given subreddit\'s stylesheet
deleteImage :: MonadReddit m => Text -> SubredditName -> m ()
deleteImage :: PathSegment -> SubredditName -> m ()
deleteImage = PathSegment -> PathSegment -> SubredditName -> m ()
forall (m :: * -> *).
MonadReddit m =>
PathSegment -> PathSegment -> SubredditName -> m ()
deleteSRImage PathSegment
"img"

-- | Delete the named image from the given subreddit\'s stylesheet
deleteMobileIcon :: MonadReddit m => Text -> SubredditName -> m ()
deleteMobileIcon :: PathSegment -> SubredditName -> m ()
deleteMobileIcon = PathSegment -> PathSegment -> SubredditName -> m ()
forall (m :: * -> *).
MonadReddit m =>
PathSegment -> PathSegment -> SubredditName -> m ()
deleteSRImage PathSegment
"icon"

-- | Delete header image from the given subreddit
deleteHeader :: MonadReddit m => SubredditName -> m ()
deleteHeader :: SubredditName -> m ()
deleteHeader SubredditName
sname =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = SubredditName -> PathSegment -> [PathSegment]
subAPIPath SubredditName
sname PathSegment
"delete_sr_header"
               , $sel:method:APIAction :: Method
method       = Method
POST
               , $sel:requestData:APIAction :: WithData
requestData  = [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ (PathSegment
"api_type", PathSegment
"json") ]
               }

-- | Upload a banner for the subreddit (redesign only)
uploadBanner :: MonadReddit m => SubredditName -> FilePath -> m ()
uploadBanner :: SubredditName -> FilePath -> m ()
uploadBanner SubredditName
sname FilePath
fp = do
    PathSegment
imgURL <- SubredditName -> StructuredStyleImage -> FilePath -> m PathSegment
forall (m :: * -> *).
MonadReddit m =>
SubredditName -> StructuredStyleImage -> FilePath -> m PathSegment
uploadS3Asset SubredditName
sname StructuredStyleImage
BannerBackground FilePath
fp
    SubredditName -> Form -> m ()
forall (m :: * -> *).
MonadReddit m =>
SubredditName -> Form -> m ()
updateStructuredStyles SubredditName
sname
        (Form -> m ()) -> Form -> m ()
forall a b. (a -> b) -> a -> b
$ [(PathSegment, PathSegment)] -> Form
mkTextForm [ (StructuredStyleImage -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam StructuredStyleImage
BannerBackground, PathSegment
imgURL) ]

-- | Delete the subreddit banner, even if it does not exist (redesign only)
deleteBanner :: MonadReddit m => SubredditName -> m ()
deleteBanner :: SubredditName -> m ()
deleteBanner SubredditName
sname = SubredditName -> Form -> m ()
forall (m :: * -> *).
MonadReddit m =>
SubredditName -> Form -> m ()
updateStructuredStyles SubredditName
sname
    (Form -> m ()) -> Form -> m ()
forall a b. (a -> b) -> a -> b
$ [(PathSegment, PathSegment)] -> Form
mkTextForm [ (StructuredStyleImage -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam StructuredStyleImage
BannerBackground, PathSegment
forall a. Monoid a => a
mempty) ]

-- | Upload the additional image banner for the subreddit (redesign only)
uploadBannerAdditional
    :: MonadReddit m
    => Maybe StyleImageAlignment
    -> SubredditName
    -> FilePath
    -> m ()
uploadBannerAdditional :: Maybe StyleImageAlignment -> SubredditName -> FilePath -> m ()
uploadBannerAdditional Maybe StyleImageAlignment
sia SubredditName
sname FilePath
fp = do
    PathSegment
imgURL <- SubredditName -> StructuredStyleImage -> FilePath -> m PathSegment
forall (m :: * -> *).
MonadReddit m =>
SubredditName -> StructuredStyleImage -> FilePath -> m PathSegment
uploadS3Asset SubredditName
sname StructuredStyleImage
BannerAdditional FilePath
fp
    SubredditName -> Form -> m ()
forall (m :: * -> *).
MonadReddit m =>
SubredditName -> Form -> m ()
updateStructuredStyles SubredditName
sname (Form -> m ())
-> ([(PathSegment, PathSegment)] -> Form)
-> [(PathSegment, PathSegment)]
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PathSegment, PathSegment)] -> Form
mkTextForm
        ([(PathSegment, PathSegment)] -> m ())
-> [(PathSegment, PathSegment)] -> m ()
forall a b. (a -> b) -> a -> b
$ [ (StructuredStyleImage -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam StructuredStyleImage
BannerAdditional, PathSegment
imgURL) ]
        [(PathSegment, PathSegment)]
-> [(PathSegment, PathSegment)] -> [(PathSegment, PathSegment)]
forall a. Semigroup a => a -> a -> a
<> ((PathSegment, PathSegment) -> [(PathSegment, PathSegment)])
-> Maybe (PathSegment, PathSegment) -> [(PathSegment, PathSegment)]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (PathSegment, PathSegment) -> [(PathSegment, PathSegment)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                   ((PathSegment
"bannerPositionedImagePosition", ) (PathSegment -> (PathSegment, PathSegment))
-> (StyleImageAlignment -> PathSegment)
-> StyleImageAlignment
-> (PathSegment, PathSegment)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StyleImageAlignment -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam (StyleImageAlignment -> (PathSegment, PathSegment))
-> Maybe StyleImageAlignment -> Maybe (PathSegment, PathSegment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe StyleImageAlignment
sia)

-- | Delete all additional banners, including the hover banner (redesign only)
deleteBannerAdditional :: MonadReddit m => SubredditName -> m ()
deleteBannerAdditional :: SubredditName -> m ()
deleteBannerAdditional SubredditName
sname = SubredditName -> Form -> m ()
forall (m :: * -> *).
MonadReddit m =>
SubredditName -> Form -> m ()
updateStructuredStyles SubredditName
sname
    (Form -> m ()) -> Form -> m ()
forall a b. (a -> b) -> a -> b
$ [(PathSegment, PathSegment)] -> Form
mkTextForm [ (StructuredStyleImage -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam StructuredStyleImage
BannerAdditional, PathSegment
forall a. Monoid a => a
mempty)
                 , (StructuredStyleImage -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam StructuredStyleImage
BannerHover, PathSegment
forall a. Monoid a => a
mempty)
                 ]

-- | Upload the banner hover image for the subreddit (redesign only)
uploadBannerHover :: MonadReddit m => SubredditName -> FilePath -> m ()
uploadBannerHover :: SubredditName -> FilePath -> m ()
uploadBannerHover SubredditName
sname FilePath
fp = do
    PathSegment
imgURL <- SubredditName -> StructuredStyleImage -> FilePath -> m PathSegment
forall (m :: * -> *).
MonadReddit m =>
SubredditName -> StructuredStyleImage -> FilePath -> m PathSegment
uploadS3Asset SubredditName
sname StructuredStyleImage
BannerHover FilePath
fp
    SubredditName -> Form -> m ()
forall (m :: * -> *).
MonadReddit m =>
SubredditName -> Form -> m ()
updateStructuredStyles SubredditName
sname
        (Form -> m ()) -> Form -> m ()
forall a b. (a -> b) -> a -> b
$ [(PathSegment, PathSegment)] -> Form
mkTextForm [ (StructuredStyleImage -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam StructuredStyleImage
BannerHover, PathSegment
imgURL) ]

-- | Delete the subreddit banner hover image (redesign only)
deleteBannerHover :: MonadReddit m => SubredditName -> m ()
deleteBannerHover :: SubredditName -> m ()
deleteBannerHover SubredditName
sname = SubredditName -> Form -> m ()
forall (m :: * -> *).
MonadReddit m =>
SubredditName -> Form -> m ()
updateStructuredStyles SubredditName
sname
    (Form -> m ()) -> Form -> m ()
forall a b. (a -> b) -> a -> b
$ [(PathSegment, PathSegment)] -> Form
mkTextForm [ (StructuredStyleImage -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam StructuredStyleImage
BannerHover, PathSegment
forall a. Monoid a => a
mempty) ]

uploadSRImage :: forall m.
              MonadReddit m
              => ByteString
              -> Text
              -> FilePath
              -> SubredditName
              -> m ()
uploadSRImage :: ByteString -> PathSegment -> FilePath -> SubredditName -> m ()
uploadSRImage ByteString
ty PathSegment
name FilePath
fp SubredditName
sname = FilePath -> (ConduitM () ByteString m () -> m ()) -> m ()
forall (m :: * -> *) (n :: * -> *) i a.
(MonadUnliftIO m, MonadIO n) =>
FilePath -> (ConduitM i ByteString n () -> m a) -> m a
withSourceFile @_ @m FilePath
fp ((ConduitM () ByteString m () -> m ()) -> m ())
-> (ConduitM () ByteString m () -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \ConduitM () ByteString m ()
bs -> do
    ByteString
img <- ConduitT () Void m ByteString -> m ByteString
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void m ByteString -> m ByteString)
-> ConduitT () Void m ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ ConduitM () ByteString m ()
bs ConduitM () ByteString m ()
-> ConduitM ByteString Void m ByteString
-> ConduitT () Void m ByteString
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM ByteString Void m ByteString
forall (m :: * -> *) o.
Monad m =>
ConduitT ByteString o m ByteString
sinkLbs
    ByteString
imageType <- ByteString -> m ByteString
getImageType ByteString
img
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Int64
LB.length ByteString
img Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
maxImageSize) (m () -> m ())
-> (ClientException -> m ()) -> ClientException -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientException -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
        (ClientException -> m ()) -> ClientException -> m ()
forall a b. (a -> b) -> a -> b
$ PathSegment -> ClientException
InvalidRequest PathSegment
"uploadSRImage: exceeded maximum image size"
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = SubredditName -> PathSegment -> [PathSegment]
subAPIPath SubredditName
sname PathSegment
"upload_sr_img"
               , $sel:method:APIAction :: Method
method       = Method
POST
               , $sel:requestData:APIAction :: WithData
requestData  =
                     [Part] -> WithData
WithMultipart [ PathSegment -> ByteString -> Part
forall (m :: * -> *).
Applicative m =>
PathSegment -> ByteString -> PartM m
partBS PathSegment
"img_type" ByteString
imageType
                                     -- This seems to work, but @partLBS img@ causes
                                     -- reddit to freak out
                                   , PathSegment -> FilePath -> Part
partFile PathSegment
"file" FilePath
fp
                                   , PathSegment -> ByteString -> Part
forall (m :: * -> *).
Applicative m =>
PathSegment -> ByteString -> PartM m
partBS PathSegment
"name" (ByteString -> Part) -> ByteString -> Part
forall a b. (a -> b) -> a -> b
$ PathSegment -> ByteString
T.encodeUtf8 PathSegment
name
                                   , PathSegment -> ByteString -> Part
forall (m :: * -> *).
Applicative m =>
PathSegment -> ByteString -> PartM m
partBS PathSegment
"upload_type" ByteString
ty
                                   , PathSegment -> ByteString -> Part
forall (m :: * -> *).
Applicative m =>
PathSegment -> ByteString -> PartM m
partBS PathSegment
"api_type" ByteString
"json"
                                   ]
               }
  where
    maxImageSize :: Int64
maxImageSize = Int64
512000

    getImageType :: ByteString -> m ByteString
getImageType = \case
        ByteString
bs
            | Int64 -> ByteString -> ByteString
LB.take Int64
4 (Int64 -> ByteString -> ByteString
LB.drop Int64
6 ByteString
bs) ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"JFIF" -> ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
"jpeg"
            | ByteString -> ByteString -> Bool
LB.isPrefixOf ByteString
"\137PNG\r\n\26\n" ByteString
bs -> ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
"png"
            | Bool
otherwise -> ClientException -> m ByteString
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
                (ClientException -> m ByteString)
-> ClientException -> m ByteString
forall a b. (a -> b) -> a -> b
$ PathSegment -> ClientException
InvalidRequest PathSegment
"uploadSRImage: Can't detect image type"

deleteSRImage :: MonadReddit m => Text -> Text -> SubredditName -> m ()
deleteSRImage :: PathSegment -> PathSegment -> SubredditName -> m ()
deleteSRImage PathSegment
path PathSegment
name SubredditName
sname =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = SubredditName -> PathSegment -> [PathSegment]
subAPIPath SubredditName
sname (PathSegment -> [PathSegment]) -> PathSegment -> [PathSegment]
forall a b. (a -> b) -> a -> b
$ PathSegment
"delete_sr_" PathSegment -> PathSegment -> PathSegment
forall a. Semigroup a => a -> a -> a
<> PathSegment
path
               , $sel:method:APIAction :: Method
method       = Method
POST
               , $sel:requestData:APIAction :: WithData
requestData  = [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ (PathSegment
"img_name", PathSegment
name)
                                               , (PathSegment
"api_type", PathSegment
"json")
                                               ]
               }

uploadS3Asset :: MonadReddit m
              => SubredditName
              -> StructuredStyleImage
              -> FilePath
              -> m URL
uploadS3Asset :: SubredditName -> StructuredStyleImage -> FilePath -> m PathSegment
uploadS3Asset SubredditName
sname StructuredStyleImage
imageType FilePath
fp = do
    PathSegment
mimetype <- case FilePath -> FilePath
FP.takeExtension FilePath
fp of
        FilePath
ext
            | FilePath
ext FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ FilePath
".jpeg", FilePath
".jpg" ] -> PathSegment -> m PathSegment
forall (f :: * -> *) a. Applicative f => a -> f a
pure PathSegment
"image/jpeg"
            | FilePath
ext FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".png" -> PathSegment -> m PathSegment
forall (f :: * -> *) a. Applicative f => a -> f a
pure PathSegment
"image/png"
            | Bool
otherwise ->
                ClientException -> m PathSegment
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ClientException -> m PathSegment)
-> ClientException -> m PathSegment
forall a b. (a -> b) -> a -> b
$ PathSegment -> ClientException
InvalidRequest PathSegment
"uploadS3Asset: invalid file type"
    S3ModerationLease { PathSegment
HashMap PathSegment PathSegment
$sel:websocketURL:S3ModerationLease :: S3ModerationLease -> PathSegment
$sel:key:S3ModerationLease :: S3ModerationLease -> PathSegment
$sel:fields:S3ModerationLease :: S3ModerationLease -> HashMap PathSegment PathSegment
$sel:action:S3ModerationLease :: S3ModerationLease -> PathSegment
websocketURL :: PathSegment
key :: PathSegment
fields :: HashMap PathSegment PathSegment
action :: PathSegment
.. }
        <- APIAction S3ModerationLease -> m S3ModerationLease
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction APIAction Any
forall a. APIAction a
defaultAPIAction
                     { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [ PathSegment
"api"
                                      , PathSegment
"v1"
                                      , PathSegment
"style_asset_upload_s3"
                                      , SubredditName -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toUrlPiece SubredditName
sname
                                      ]
                     , $sel:method:APIAction :: Method
method       = Method
POST
                     , $sel:requestData:APIAction :: WithData
requestData  = [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ ( PathSegment
"filepath"
                                                       , FilePath -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam
                                                         (FilePath -> PathSegment) -> FilePath -> PathSegment
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
FP.takeFileName FilePath
fp
                                                       )
                                                     , (PathSegment
"mimetype", PathSegment
mimetype)
                                                     , ( PathSegment
"imagetype"
                                                       , StructuredStyleImage -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam StructuredStyleImage
imageType
                                                       )
                                                     ]
                     }
    (ByteString
url, [PathSegment]
ps) <- PathSegment -> m (ByteString, [PathSegment])
forall (m :: * -> *).
MonadThrow m =>
PathSegment -> m (ByteString, [PathSegment])
splitURL PathSegment
action
    m (Response (RawBody m)) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Response (RawBody m)) -> m ())
-> (Request -> m (Response (RawBody m))) -> Request -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> m (Response (RawBody m))
forall (m :: * -> *).
MonadReddit m =>
Request -> m (Response (RawBody m))
runActionWith_
        (Request -> m ()) -> m Request -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> APIAction Any -> m Request
forall (m :: * -> *) a.
MonadIO m =>
ByteString -> APIAction a -> m Request
mkRequest ByteString
url
                      APIAction Any
forall a. APIAction a
defaultAPIAction
                      { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [PathSegment]
ps
                      , $sel:method:APIAction :: Method
method       = Method
POST
                      , $sel:requestData:APIAction :: WithData
requestData  = [Part] -> WithData
WithMultipart
                            ([Part] -> WithData) -> [Part] -> WithData
forall a b. (a -> b) -> a -> b
$ (PathSegment -> PathSegment -> [Part] -> [Part])
-> [Part] -> HashMap PathSegment PathSegment -> [Part]
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HM.foldrWithKey PathSegment -> PathSegment -> [Part] -> [Part]
forall (m :: * -> *).
Applicative m =>
PathSegment -> PathSegment -> [PartM m] -> [PartM m]
mkParts
                                              [ PathSegment -> FilePath -> Part
partFile PathSegment
"file" FilePath
fp ]
                                              HashMap PathSegment PathSegment
fields
                      , $sel:rawJSON:APIAction :: Bool
rawJSON      = Bool
False
                      }
    PathSegment -> m PathSegment
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PathSegment -> m PathSegment) -> PathSegment -> m PathSegment
forall a b. (a -> b) -> a -> b
$ PathSegment -> [PathSegment] -> PathSegment
T.intercalate PathSegment
"/" [ PathSegment
action, PathSegment
key ]
  where
    mkParts :: PathSegment -> PathSegment -> [PartM m] -> [PartM m]
mkParts PathSegment
name PathSegment
value [PartM m]
ps = PathSegment -> ByteString -> PartM m
forall (m :: * -> *).
Applicative m =>
PathSegment -> ByteString -> PartM m
partBS PathSegment
name (PathSegment -> ByteString
T.encodeUtf8 PathSegment
value) PartM m -> [PartM m] -> [PartM m]
forall a. a -> [a] -> [a]
: [PartM m]
ps

updateStructuredStyles :: MonadReddit m => SubredditName -> Form -> m ()
updateStructuredStyles :: SubredditName -> Form -> m ()
updateStructuredStyles SubredditName
sname Form
form =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments =
                     [ PathSegment
"api", PathSegment
"v1", PathSegment
"structured_styles", SubredditName -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toUrlPiece SubredditName
sname ]
               , $sel:method:APIAction :: Method
method       = Method
PATCH
               , $sel:requestData:APIAction :: WithData
requestData  = Form -> WithData
WithForm Form
form
               }

--Modmail----------------------------------------------------------------------
-- | Get all of the authenticated user\'s modmail. See 'getModmailWithOpts' in
-- order to control how modmail is sorted or filtered
getModmail :: MonadReddit m => m Modmail
getModmail :: m Modmail
getModmail =
    APIAction Modmail -> m Modmail
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction APIAction Any
forall a. APIAction a
defaultAPIAction
              { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [PathSegment]
modmailPath
              , $sel:requestData:APIAction :: WithData
requestData  = Form -> WithData
WithForm
                    (Form -> WithData) -> Form -> WithData
forall a b. (a -> b) -> a -> b
$ ModmailOpts -> Form
forall a. ToForm a => a -> Form
toForm ModmailOpts
defaultModmailOpts { $sel:state:ModmailOpts :: Maybe ModmailState
state = ModmailState -> Maybe ModmailState
forall a. a -> Maybe a
Just ModmailState
AllModmail }
              }

-- | Get the authenticated user\'s modmail with the provided 'ModmailOpts'
getModmailWithOpts :: MonadReddit m => ModmailOpts -> m Modmail
getModmailWithOpts :: ModmailOpts -> m Modmail
getModmailWithOpts ModmailOpts
opts =
    APIAction Modmail -> m Modmail
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction APIAction Any
forall a. APIAction a
defaultAPIAction
              { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [PathSegment]
modmailPath
              , $sel:requestData:APIAction :: WithData
requestData  = Form -> WithData
WithForm (Form -> WithData) -> Form -> WithData
forall a b. (a -> b) -> a -> b
$ ModmailOpts -> Form
forall a. ToForm a => a -> Form
toForm ModmailOpts
opts
              }

-- | Get a single 'ModmailConversation' given its ID
getModmailConversation :: MonadReddit m => ModmailID -> m ModmailConversation
getModmailConversation :: PathSegment -> m ModmailConversation
getModmailConversation PathSegment
m = APIAction ConversationDetails -> m ConversationDetails
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction @ConversationDetails APIAction ConversationDetails
r m ConversationDetails
-> (ConversationDetails -> ModmailConversation)
-> m ModmailConversation
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ConversationDetails -> ModmailConversation
forall s t a b. Wrapped s t a b => s -> a
wrappedTo
  where
    r :: APIAction ConversationDetails
r = APIAction Any
forall a. APIAction a
defaultAPIAction { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [PathSegment]
modmailPath [PathSegment] -> [PathSegment] -> [PathSegment]
forall a. Semigroup a => a -> a -> a
<> [ PathSegment -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toUrlPiece PathSegment
m ] }

-- | Get the number of unread modmail conversations according to conversation
-- state
getUnreadModmailCount :: MonadReddit m => m (HashMap ModmailState Word)
getUnreadModmailCount :: m (HashMap ModmailState Word)
getUnreadModmailCount =
    APIAction (HashMap ModmailState Word)
-> m (HashMap ModmailState Word)
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction APIAction Any
forall a. APIAction a
defaultAPIAction
              { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [PathSegment]
modmailPath [PathSegment] -> [PathSegment] -> [PathSegment]
forall a. Semigroup a => a -> a -> a
<> [ PathSegment
"unread", PathSegment
"count" ] }

-- | Create a new 'ModmailConversation'
createConversation
    :: MonadReddit m => NewConversation -> m ModmailConversation
createConversation :: NewConversation -> m ModmailConversation
createConversation NewConversation
nc = APIAction ConversationDetails -> m ConversationDetails
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction @ConversationDetails APIAction ConversationDetails
r m ConversationDetails
-> (ConversationDetails -> ModmailConversation)
-> m ModmailConversation
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ConversationDetails -> ModmailConversation
forall s t a b. Wrapped s t a b => s -> a
wrappedTo
  where
    r :: APIAction ConversationDetails
r = APIAction Any
forall a. APIAction a
defaultAPIAction
        { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [PathSegment]
modmailPath
        , $sel:method:APIAction :: Method
method       = Method
POST
        , $sel:requestData:APIAction :: WithData
requestData  = Form -> WithData
WithForm (Form -> WithData) -> Form -> WithData
forall a b. (a -> b) -> a -> b
$ NewConversation -> Form
forall a. ToForm a => a -> Form
toForm NewConversation
nc
        }

-- | Reply to the modmail conversation
replyToConversation
    :: MonadReddit m => ModmailReply -> ModmailID -> m ModmailConversation
replyToConversation :: ModmailReply -> PathSegment -> m ModmailConversation
replyToConversation ModmailReply
mr PathSegment
m = APIAction ConversationDetails -> m ConversationDetails
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction @ConversationDetails APIAction ConversationDetails
r m ConversationDetails
-> (ConversationDetails -> ModmailConversation)
-> m ModmailConversation
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ConversationDetails -> ModmailConversation
forall s t a b. Wrapped s t a b => s -> a
wrappedTo
  where
    r :: APIAction ConversationDetails
r = APIAction Any
forall a. APIAction a
defaultAPIAction
        { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [PathSegment]
modmailPath [PathSegment] -> [PathSegment] -> [PathSegment]
forall a. Semigroup a => a -> a -> a
<> [ PathSegment -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toUrlPiece PathSegment
m ]
        , $sel:method:APIAction :: Method
method       = Method
POST
        , $sel:requestData:APIAction :: WithData
requestData  = Form -> WithData
WithForm (Form -> WithData) -> Form -> WithData
forall a b. (a -> b) -> a -> b
$ ModmailReply -> Form
forall a. ToForm a => a -> Form
toForm ModmailReply
mr
        }

-- | Archive a modmail conversation
archiveConversation :: MonadReddit m => ModmailID -> m ()
archiveConversation :: PathSegment -> m ()
archiveConversation PathSegment
m =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [PathSegment]
modmailPath [PathSegment] -> [PathSegment] -> [PathSegment]
forall a. Semigroup a => a -> a -> a
<> [ PathSegment -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toUrlPiece PathSegment
m, PathSegment
"archive" ]
               , $sel:method:APIAction :: Method
method       = Method
POST
               }

-- | Archive a modmail conversation
unarchiveConversation :: MonadReddit m => ModmailID -> m ()
unarchiveConversation :: PathSegment -> m ()
unarchiveConversation PathSegment
m =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [PathSegment]
modmailPath [PathSegment] -> [PathSegment] -> [PathSegment]
forall a. Semigroup a => a -> a -> a
<> [ PathSegment -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toUrlPiece PathSegment
m, PathSegment
"unarchive" ]
               , $sel:method:APIAction :: Method
method       = Method
POST
               }

-- | Highlight a given conversation
highlightConversation :: MonadReddit m => ModmailID -> m ()
highlightConversation :: PathSegment -> m ()
highlightConversation = Method -> PathSegment -> m ()
forall (m :: * -> *).
MonadReddit m =>
Method -> PathSegment -> m ()
highlightUnhighlight Method
POST

-- | Unhighlight a given conversation
unhighlightConversation :: MonadReddit m => ModmailID -> m ()
unhighlightConversation :: PathSegment -> m ()
unhighlightConversation = Method -> PathSegment -> m ()
forall (m :: * -> *).
MonadReddit m =>
Method -> PathSegment -> m ()
highlightUnhighlight Method
DELETE

highlightUnhighlight :: MonadReddit m => Method -> ModmailID -> m ()
highlightUnhighlight :: Method -> PathSegment -> m ()
highlightUnhighlight Method
method PathSegment
m =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [PathSegment]
modmailPath [PathSegment] -> [PathSegment] -> [PathSegment]
forall a. Semigroup a => a -> a -> a
<> [ PathSegment -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toUrlPiece PathSegment
m, PathSegment
"highlight" ]
               , Method
method :: Method
$sel:method:APIAction :: Method
method
               }

-- | Mark the conversations corresponding to a container of 'ModmailID's as read
markConversationsRead :: (Foldable t, MonadReddit m) => t ModmailID -> m ()
markConversationsRead :: t PathSegment -> m ()
markConversationsRead = PathSegment -> t PathSegment -> m ()
forall (t :: * -> *) (m :: * -> *).
(Foldable t, MonadReddit m) =>
PathSegment -> t PathSegment -> m ()
readUnread PathSegment
"read"

-- | Mark the conversation corresponding to a single 'ModmailID' as read
markConversationRead :: MonadReddit m => ModmailID -> m ()
markConversationRead :: PathSegment -> m ()
markConversationRead PathSegment
m = [PathSegment] -> m ()
forall (t :: * -> *) (m :: * -> *).
(Foldable t, MonadReddit m) =>
t PathSegment -> m ()
markConversationsRead [ PathSegment
m ]

-- | Mark the conversations corresponding to a container of 'ModmailID's as unread
markConversationsUnread :: (Foldable t, MonadReddit m) => t ModmailID -> m ()
markConversationsUnread :: t PathSegment -> m ()
markConversationsUnread = PathSegment -> t PathSegment -> m ()
forall (t :: * -> *) (m :: * -> *).
(Foldable t, MonadReddit m) =>
PathSegment -> t PathSegment -> m ()
readUnread PathSegment
"unread"

-- | Mark the conversation corresponding to a single 'ModmailID' as unread
markConversationUnread :: MonadReddit m => ModmailID -> m ()
markConversationUnread :: PathSegment -> m ()
markConversationUnread PathSegment
m = [PathSegment] -> m ()
forall (t :: * -> *) (m :: * -> *).
(Foldable t, MonadReddit m) =>
t PathSegment -> m ()
markConversationsUnread [ PathSegment
m ]

readUnread
    :: (Foldable t, MonadReddit m) => PathSegment -> t ModmailID -> m ()
readUnread :: PathSegment -> t PathSegment -> m ()
readUnread PathSegment
path t PathSegment
ms =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [PathSegment]
modmailPath [PathSegment] -> [PathSegment] -> [PathSegment]
forall a. Semigroup a => a -> a -> a
<> [ PathSegment
path ]
               , $sel:method:APIAction :: Method
method       = Method
POST
               , $sel:requestData:APIAction :: WithData
requestData  =
                     [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ (PathSegment
"conversationIds", t PathSegment -> PathSegment
forall (t :: * -> *) a.
(Foldable t, ToHttpApiData a) =>
t a -> PathSegment
joinParams t PathSegment
ms) ]
               }

-- | Mark all mail belonging to the subreddits as read, returning the 'ModmailID's
-- of the newly read conversations
bulkReadConversations :: (MonadReddit m, Foldable t)
                      => Maybe ModmailState
                      -> t SubredditName
                      -> m (Seq ModmailID)
bulkReadConversations :: Maybe ModmailState -> t SubredditName -> m (Seq PathSegment)
bulkReadConversations Maybe ModmailState
mms t SubredditName
snames = APIAction BulkReadIDs -> m BulkReadIDs
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction @BulkReadIDs APIAction BulkReadIDs
r m BulkReadIDs
-> (BulkReadIDs -> Seq PathSegment) -> m (Seq PathSegment)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> BulkReadIDs -> Seq PathSegment
forall s t a b. Wrapped s t a b => s -> a
wrappedTo
  where
    r :: APIAction BulkReadIDs
r = APIAction Any
forall a. APIAction a
defaultAPIAction
        { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [PathSegment]
modmailPath [PathSegment] -> [PathSegment] -> [PathSegment]
forall a. Semigroup a => a -> a -> a
<> [ PathSegment
"bulk", PathSegment
"read" ]
        , $sel:method:APIAction :: Method
method       = Method
POST
        , $sel:requestData:APIAction :: WithData
requestData  = Form -> WithData
WithForm (Form -> WithData)
-> ([(PathSegment, PathSegment)] -> Form)
-> [(PathSegment, PathSegment)]
-> WithData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PathSegment, PathSegment)] -> Form
mkTextForm
              ([(PathSegment, PathSegment)] -> WithData)
-> [(PathSegment, PathSegment)] -> WithData
forall a b. (a -> b) -> a -> b
$ [ (PathSegment
"entity", t SubredditName -> PathSegment
forall (t :: * -> *) a.
(Foldable t, ToHttpApiData a) =>
t a -> PathSegment
joinParams t SubredditName
snames) ]
              [(PathSegment, PathSegment)]
-> [(PathSegment, PathSegment)] -> [(PathSegment, PathSegment)]
forall a. Semigroup a => a -> a -> a
<> ((PathSegment, PathSegment) -> [(PathSegment, PathSegment)])
-> Maybe (PathSegment, PathSegment) -> [(PathSegment, PathSegment)]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (PathSegment, PathSegment) -> [(PathSegment, PathSegment)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((PathSegment
"state", ) (PathSegment -> (PathSegment, PathSegment))
-> (ModmailState -> PathSegment)
-> ModmailState
-> (PathSegment, PathSegment)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModmailState -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam (ModmailState -> (PathSegment, PathSegment))
-> Maybe ModmailState -> Maybe (PathSegment, PathSegment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ModmailState
mms)
        }

-- | Mute the non-moderator user associated with the modmail conversation. Valid
-- durations for the @days@ parameter are 3, 7, and 28
muteModmailUser :: MonadReddit m => Word -> ModmailID -> m ()
muteModmailUser :: Word -> PathSegment -> m ()
muteModmailUser Word
days PathSegment
m = do
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
days Word -> [Word] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [ Word
3, Word
7, Word
28 ]) (m () -> m ())
-> (ClientException -> m ()) -> ClientException -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientException -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
        (ClientException -> m ()) -> ClientException -> m ()
forall a b. (a -> b) -> a -> b
$ PathSegment -> ClientException
InvalidRequest --
        PathSegment
"muteModmailUser: mute duration must be one of 3, 7, or 28"
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [PathSegment]
modmailPath [PathSegment] -> [PathSegment] -> [PathSegment]
forall a. Semigroup a => a -> a -> a
<> [ PathSegment -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toUrlPiece PathSegment
m, PathSegment
"mute" ]
               , $sel:method:APIAction :: Method
method       = Method
POST
               , $sel:requestData:APIAction :: WithData
requestData  =
                     [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ (PathSegment
"num_hours", Word -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam (Word -> PathSegment) -> Word -> PathSegment
forall a b. (a -> b) -> a -> b
$ Word
days Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
24)
                                    ]
               }

-- | Unmute the non-moderator user associated with the modmail conversation
unmuteModmailUser :: MonadReddit m => ModmailID -> m ()
unmuteModmailUser :: PathSegment -> m ()
unmuteModmailUser PathSegment
m =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [PathSegment]
modmailPath [PathSegment] -> [PathSegment] -> [PathSegment]
forall a. Semigroup a => a -> a -> a
<> [ PathSegment -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toUrlPiece PathSegment
m, PathSegment
"unmute" ]
               , $sel:method:APIAction :: Method
method       = Method
POST
               }

modmailPath :: [PathSegment]
modmailPath :: [PathSegment]
modmailPath = [ PathSegment
"api", PathSegment
"mod", PathSegment
"conversations" ]

--Widgets----------------------------------------------------------------------
-- | Delete a widget, given its ID
deleteWidget :: MonadReddit m => SubredditName -> WidgetID -> m ()
deleteWidget :: SubredditName -> WidgetID -> m ()
deleteWidget SubredditName
sname WidgetID
wid =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments =
                     SubredditName -> PathSegment -> [PathSegment]
subAPIPath SubredditName
sname PathSegment
"widget" [PathSegment] -> [PathSegment] -> [PathSegment]
forall a. Semigroup a => a -> a -> a
<> [ WidgetID -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toUrlPiece WidgetID
wid ]
               , $sel:method:APIAction :: Method
method       = Method
DELETE
               }

-- | Reorder the widgets corresponding to a container of widget IDs in the given
-- section. At the moment, reddit does not allow for the 'Topbar' to be reordered.
-- If you attempt to reorder this section, you might receive an 'InvalidJSON'
-- exception
reorderWidgets :: (MonadReddit m, Foldable t)
               => Maybe WidgetSection
               -> SubredditName
               -> t WidgetID
               -> m ()
reorderWidgets :: Maybe WidgetSection -> SubredditName -> t WidgetID -> m ()
reorderWidgets Maybe WidgetSection
sm SubredditName
sname t WidgetID
ws =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments =
                     SubredditName -> PathSegment -> [PathSegment]
subAPIPath SubredditName
sname PathSegment
"widget_order" [PathSegment] -> [PathSegment] -> [PathSegment]
forall a. Semigroup a => a -> a -> a
<> [ WidgetSection -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toUrlPiece WidgetSection
section ]
               , $sel:method:APIAction :: Method
method       = Method
PATCH
               , $sel:requestData:APIAction :: WithData
requestData  =
                     [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ (PathSegment
"json", [WidgetID] -> PathSegment
forall a. ToJSON a => a -> PathSegment
textEncode ([WidgetID] -> PathSegment) -> [WidgetID] -> PathSegment
forall a b. (a -> b) -> a -> b
$ t WidgetID -> [WidgetID]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList t WidgetID
ws)
                                    , (PathSegment
"section", WidgetSection -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam WidgetSection
section)
                                    ]
               }
  where
    section :: WidgetSection
section = WidgetSection -> Maybe WidgetSection -> WidgetSection
forall a. a -> Maybe a -> a
fromMaybe WidgetSection
Sidebar Maybe WidgetSection
sm

-- | Update an existing widget, given its ID. You must wrap the widget type in
-- the appropriate 'Widget' constructors, as this action may be performed on
-- heterogeneous widget types. The update widget is returned upon success
updateWidget
    :: MonadReddit m => SubredditName -> WidgetID -> Widget -> m Widget
updateWidget :: SubredditName -> WidgetID -> Widget -> m Widget
updateWidget SubredditName
sname WidgetID
wid Widget
w =
    APIAction Widget -> m Widget
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction APIAction Any
forall a. APIAction a
defaultAPIAction
              { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = SubredditName -> PathSegment -> [PathSegment]
subAPIPath SubredditName
sname PathSegment
"widget" [PathSegment] -> [PathSegment] -> [PathSegment]
forall a. Semigroup a => a -> a -> a
<> [ WidgetID -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toUrlPiece WidgetID
wid ]
              , $sel:method:APIAction :: Method
method       = Method
PUT
              , $sel:requestData:APIAction :: WithData
requestData  = [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ (PathSegment
"json", Widget -> PathSegment
forall a. ToJSON a => a -> PathSegment
textEncode Widget
w) ]
              }

-- | Add a button widget. Returns the created widget upon success. See the docs for
-- 'ButtonWidget' for the available options
addButtonWidget
    :: MonadReddit m => SubredditName -> ButtonWidget -> m ButtonWidget
addButtonWidget :: SubredditName -> ButtonWidget -> m ButtonWidget
addButtonWidget = SubredditName -> ButtonWidget -> m ButtonWidget
forall (m :: * -> *) a.
(MonadReddit m, ToJSON a, FromJSON a) =>
SubredditName -> a -> m a
addNormalWidget

-- | Add a calendar widget, which requires an active Google account and public
-- calendar. Returns the created widget upon success. See the docs for
-- 'CalendarWidget' for the available options
addCalendarWidget
    :: MonadReddit m
    => Maybe Body -- ^ A short description of the widget, in markdown
    -> SubredditName
    -> CalendarWidget
    -> m CalendarWidget
addCalendarWidget :: Maybe PathSegment
-> SubredditName -> CalendarWidget -> m CalendarWidget
addCalendarWidget = Maybe PathSegment
-> SubredditName -> CalendarWidget -> m CalendarWidget
forall (m :: * -> *) a.
(MonadReddit m, ToJSON a, FromJSON a) =>
Maybe PathSegment -> SubredditName -> a -> m a
addDescribableWidget

-- | Add a community list widget. Returns the created widget upon success. See
-- the docs for 'CommunityListWidget' for the available options
addCommunityListWidget
    :: MonadReddit m
    => Maybe Body -- ^ A short description of the widget, in markdown
    -> SubredditName
    -> CommunityListWidget
    -> m CommunityListWidget
addCommunityListWidget :: Maybe PathSegment
-> SubredditName -> CommunityListWidget -> m CommunityListWidget
addCommunityListWidget = Maybe PathSegment
-> SubredditName -> CommunityListWidget -> m CommunityListWidget
forall (m :: * -> *) a.
(MonadReddit m, ToJSON a, FromJSON a) =>
Maybe PathSegment -> SubredditName -> a -> m a
addDescribableWidget

-- | Add a custom widget. Returns the created widget upon success. See
-- the docs for 'CustomWidget' for the available options
addCustomWidget
    :: MonadReddit m => SubredditName -> CustomWidget -> m CustomWidget
addCustomWidget :: SubredditName -> CustomWidget -> m CustomWidget
addCustomWidget = SubredditName -> CustomWidget -> m CustomWidget
forall (m :: * -> *) a.
(MonadReddit m, ToJSON a, FromJSON a) =>
SubredditName -> a -> m a
addNormalWidget

-- | Add an image widget. Returns the created widget upon success. See
-- the docs for 'ImageWidget' for the available options
addImageWidget
    :: MonadReddit m => SubredditName -> ImageWidget -> m ImageWidget
addImageWidget :: SubredditName -> ImageWidget -> m ImageWidget
addImageWidget = SubredditName -> ImageWidget -> m ImageWidget
forall (m :: * -> *) a.
(MonadReddit m, ToJSON a, FromJSON a) =>
SubredditName -> a -> m a
addNormalWidget

-- | Add a menu widget. Returns the created widget upon success. See
-- the docs for 'MenuWidget' for the available options
addMenuWidget :: MonadReddit m => SubredditName -> MenuWidget -> m MenuWidget
addMenuWidget :: SubredditName -> MenuWidget -> m MenuWidget
addMenuWidget = SubredditName -> MenuWidget -> m MenuWidget
forall (m :: * -> *) a.
(MonadReddit m, ToJSON a, FromJSON a) =>
SubredditName -> a -> m a
addNormalWidget

-- | Add a post flair widget. Returns the created widget upon success. See
-- the docs for 'PostFlairWidget' for the available options along with
-- 'mkPostFlairWidget'
addPostFlairWidget
    :: MonadReddit m => SubredditName -> PostFlairWidget -> m PostFlairWidget
addPostFlairWidget :: SubredditName -> PostFlairWidget -> m PostFlairWidget
addPostFlairWidget = SubredditName -> PostFlairWidget -> m PostFlairWidget
forall (m :: * -> *) a.
(MonadReddit m, ToJSON a, FromJSON a) =>
SubredditName -> a -> m a
addNormalWidget

-- | Add a text area widget. Returns the created widget upon success. See
-- the docs for 'TextAreaWidget' for the available options as well as
-- 'mkTextAreaWidget'
addTextAreaWidget
    :: MonadReddit m => SubredditName -> TextAreaWidget -> m TextAreaWidget
addTextAreaWidget :: SubredditName -> TextAreaWidget -> m TextAreaWidget
addTextAreaWidget = SubredditName -> TextAreaWidget -> m TextAreaWidget
forall (m :: * -> *) a.
(MonadReddit m, ToJSON a, FromJSON a) =>
SubredditName -> a -> m a
addNormalWidget

addNormalWidget
    :: (MonadReddit m, ToJSON a, FromJSON a) => SubredditName -> a -> m a
addNormalWidget :: SubredditName -> a -> m a
addNormalWidget SubredditName
sname a
x =
    APIAction a -> m a
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction APIAction Any
forall a. APIAction a
defaultAPIAction
              { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = SubredditName -> PathSegment -> [PathSegment]
subAPIPath SubredditName
sname PathSegment
"widget"
              , $sel:method:APIAction :: Method
method       = Method
POST
              , $sel:requestData:APIAction :: WithData
requestData  = [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ (PathSegment
"json", a -> PathSegment
forall a. ToJSON a => a -> PathSegment
textEncode a
x) ]
              }

addDescribableWidget
    :: (MonadReddit m, ToJSON a, FromJSON a)
    => Maybe Body
    -> SubredditName
    -> a
    -> m a
addDescribableWidget :: Maybe PathSegment -> SubredditName -> a -> m a
addDescribableWidget Maybe PathSegment
desc SubredditName
sname a
x =
    APIAction a -> m a
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction APIAction Any
forall a. APIAction a
defaultAPIAction
              { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = SubredditName -> PathSegment -> [PathSegment]
subAPIPath SubredditName
sname PathSegment
"widget"
              , $sel:method:APIAction :: Method
method       = Method
POST
              , $sel:requestData:APIAction :: WithData
requestData  =
                    [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ ( PathSegment
"json"
                                     , Value -> PathSegment
forall a. ToJSON a => a -> PathSegment
textEncode (Value -> PathSegment)
-> (PathSegment -> Value) -> PathSegment -> PathSegment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PathSegment -> Value
forall a. ToJSON a => a -> PathSegment -> Value
describeWidget a
x
                                       (PathSegment -> PathSegment) -> PathSegment -> PathSegment
forall a b. (a -> b) -> a -> b
$ PathSegment -> Maybe PathSegment -> PathSegment
forall a. a -> Maybe a -> a
fromMaybe PathSegment
forall a. Monoid a => a
mempty Maybe PathSegment
desc
                                     )
                                   ]
              }

-- Certain 'Widget's can be given markdown-formatted description field. This
-- function injects the field into the widget\'s JSON 'Object' if applicable,
-- otherwise returning the value as-is
describeWidget :: ToJSON a => a -> Body -> Value
describeWidget :: a -> PathSegment -> Value
describeWidget a
widget (PathSegment -> Value
String -> Value
desc) = case a -> Value
forall a. ToJSON a => a -> Value
toJSON a
widget of
    Object Object
o -> Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ PathSegment -> Value -> Object -> Object
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert PathSegment
"description" Value
desc Object
o
    Value
v        -> Value
v

-- | Upload a widget image from a filepath. This returns the URL of the new image,
-- which is required for creating certain widgets
uploadWidgetImage :: MonadReddit m => SubredditName -> FilePath -> m UploadURL
uploadWidgetImage :: SubredditName -> FilePath -> m UploadURL
uploadWidgetImage SubredditName
sname FilePath
fp = do
    S3ModerationLease { PathSegment
action :: PathSegment
$sel:action:S3ModerationLease :: S3ModerationLease -> PathSegment
action, PathSegment
key :: PathSegment
$sel:key:S3ModerationLease :: S3ModerationLease -> PathSegment
key }
        <- Bool -> [PathSegment] -> FilePath -> m S3ModerationLease
forall (m :: * -> *).
MonadReddit m =>
Bool -> [PathSegment] -> FilePath -> m S3ModerationLease
uploadS3Image Bool
True (SubredditName -> PathSegment -> [PathSegment]
subAPIPath SubredditName
sname PathSegment
"widget_image_upload_s3") FilePath
fp
    UploadURL -> m UploadURL
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UploadURL -> m UploadURL)
-> (PathSegment -> UploadURL) -> PathSegment -> m UploadURL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathSegment -> UploadURL
forall s t a b. Wrapped s t a b => b -> t
wrappedFrom (PathSegment -> m UploadURL) -> PathSegment -> m UploadURL
forall a b. (a -> b) -> a -> b
$ PathSegment -> [PathSegment] -> PathSegment
T.intercalate PathSegment
"/" [ PathSegment
action, PathSegment
key ]

uploadS3Image :: MonadReddit m
              => Bool
              -> [PathSegment]
              -> FilePath
              -> m S3ModerationLease
uploadS3Image :: Bool -> [PathSegment] -> FilePath -> m S3ModerationLease
uploadS3Image Bool
rawJSON [PathSegment]
pathSegments FilePath
fp = do
    PathSegment
mimetype <- case FilePath -> FilePath
FP.takeExtension FilePath
fp of
        FilePath
ext
            | FilePath
ext FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ FilePath
".jpeg", FilePath
".jpg" ] -> PathSegment -> m PathSegment
forall (f :: * -> *) a. Applicative f => a -> f a
pure PathSegment
"image/jpeg"
            | FilePath
ext FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".png" -> PathSegment -> m PathSegment
forall (f :: * -> *) a. Applicative f => a -> f a
pure PathSegment
"image/png"
            | Bool
otherwise ->
                ClientException -> m PathSegment
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ClientException -> m PathSegment)
-> ClientException -> m PathSegment
forall a b. (a -> b) -> a -> b
$ PathSegment -> ClientException
InvalidRequest PathSegment
"uploadS3Image: invalid file type"
    s3 :: S3ModerationLease
s3@S3ModerationLease { PathSegment
HashMap PathSegment PathSegment
websocketURL :: PathSegment
key :: PathSegment
fields :: HashMap PathSegment PathSegment
action :: PathSegment
$sel:websocketURL:S3ModerationLease :: S3ModerationLease -> PathSegment
$sel:key:S3ModerationLease :: S3ModerationLease -> PathSegment
$sel:fields:S3ModerationLease :: S3ModerationLease -> HashMap PathSegment PathSegment
$sel:action:S3ModerationLease :: S3ModerationLease -> PathSegment
.. }
        <- APIAction S3ModerationLease -> m S3ModerationLease
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction APIAction Any
forall a. APIAction a
defaultAPIAction
                     { [PathSegment]
pathSegments :: [PathSegment]
$sel:pathSegments:APIAction :: [PathSegment]
pathSegments
                     , $sel:method:APIAction :: Method
method       = Method
POST
                     , $sel:requestData:APIAction :: WithData
requestData  = [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ ( PathSegment
"filepath"
                                                       , FilePath -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam
                                                         (FilePath -> PathSegment) -> FilePath -> PathSegment
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
FP.takeFileName FilePath
fp
                                                       )
                                                     , (PathSegment
"mimetype", PathSegment
mimetype)
                                                     ]
                     }
    (ByteString
url, [PathSegment]
ps) <- PathSegment -> m (ByteString, [PathSegment])
forall (m :: * -> *).
MonadThrow m =>
PathSegment -> m (ByteString, [PathSegment])
splitURL PathSegment
action
    m (Response (RawBody m)) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Response (RawBody m)) -> m ())
-> (Request -> m (Response (RawBody m))) -> Request -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> m (Response (RawBody m))
forall (m :: * -> *).
MonadReddit m =>
Request -> m (Response (RawBody m))
runActionWith_
        (Request -> m ()) -> m Request -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> APIAction Any -> m Request
forall (m :: * -> *) a.
MonadIO m =>
ByteString -> APIAction a -> m Request
mkRequest ByteString
url
                      APIAction Any
forall a. APIAction a
defaultAPIAction
                      { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [PathSegment]
ps
                      , $sel:method:APIAction :: Method
method       = Method
POST
                      , $sel:requestData:APIAction :: WithData
requestData  = [Part] -> WithData
WithMultipart
                            ([Part] -> WithData) -> [Part] -> WithData
forall a b. (a -> b) -> a -> b
$ (PathSegment -> PathSegment -> [Part] -> [Part])
-> [Part] -> HashMap PathSegment PathSegment -> [Part]
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HM.foldrWithKey PathSegment -> PathSegment -> [Part] -> [Part]
forall (m :: * -> *).
Applicative m =>
PathSegment -> PathSegment -> [PartM m] -> [PartM m]
mkParts
                                              [ PathSegment -> FilePath -> Part
partFile PathSegment
"file" FilePath
fp ]
                                              HashMap PathSegment PathSegment
fields
                      , Bool
rawJSON :: Bool
$sel:rawJSON:APIAction :: Bool
rawJSON
                      }
    S3ModerationLease -> m S3ModerationLease
forall (f :: * -> *) a. Applicative f => a -> f a
pure S3ModerationLease
s3
  where
    mkParts :: PathSegment -> PathSegment -> [PartM m] -> [PartM m]
mkParts PathSegment
name PathSegment
value [PartM m]
ps = PathSegment -> ByteString -> PartM m
forall (m :: * -> *).
Applicative m =>
PathSegment -> ByteString -> PartM m
partBS PathSegment
name (PathSegment -> ByteString
T.encodeUtf8 PathSegment
value) PartM m -> [PartM m] -> [PartM m]
forall a. a -> [a] -> [a]
: [PartM m]
ps

--Emoji------------------------------------------------------------------------
-- | Add a new emoji by uploading an image. See 'mkEmoji' to conveniently create
-- new 'Emoji's to add. Also note the restrictions on the filepath argument below,
-- which are not currently validated by this action. This action can also be used
-- to update the image for an existing emoji (see
-- 'Network.Reddit.Actions.Subreddit.getSubredditEmoji') to get a list of emojis
-- for a subreddit
addEmoji :: MonadReddit m
         => SubredditName
         -> FilePath
         -- ^ Must be an image in jpeg/png format, with maximum dimensions of
         -- 128 x 128px and size of 64KB
         -> Emoji
         -> m ()
addEmoji :: SubredditName -> FilePath -> Emoji -> m ()
addEmoji SubredditName
sname FilePath
fp Emoji
emoji = do
    S3ModerationLease { PathSegment
key :: PathSegment
$sel:key:S3ModerationLease :: S3ModerationLease -> PathSegment
key }
        <- Bool -> [PathSegment] -> FilePath -> m S3ModerationLease
forall (m :: * -> *).
MonadReddit m =>
Bool -> [PathSegment] -> FilePath -> m S3ModerationLease
uploadS3Image Bool
False (SubredditName -> PathSegment -> [PathSegment]
forall a. ToHttpApiData a => a -> PathSegment -> [PathSegment]
v1Path SubredditName
sname PathSegment
"emoji_asset_upload_s3.json") FilePath
fp
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = SubredditName -> PathSegment -> [PathSegment]
forall a. ToHttpApiData a => a -> PathSegment -> [PathSegment]
v1Path SubredditName
sname PathSegment
"emoji.json"
               , $sel:method:APIAction :: Method
method       = Method
POST
               , $sel:requestData:APIAction :: WithData
requestData  = Form -> WithData
WithForm
                     (Form -> WithData) -> Form -> WithData
forall a b. (a -> b) -> a -> b
$ NewEmoji -> Form
forall a. ToForm a => a -> Form
toForm @NewEmoji (Emoji -> NewEmoji
forall s t a b. Wrapped s t a b => b -> t
wrappedFrom Emoji
emoji)
                     Form -> Form -> Form
forall a. Semigroup a => a -> a -> a
<> [(PathSegment, PathSegment)] -> Form
mkTextForm [ (PathSegment
"s3_key", PathSegment -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam PathSegment
key) ]
               }

-- | Delete a single emoji and associated s3 image
deleteEmoji :: MonadReddit m => SubredditName -> EmojiName -> m ()
deleteEmoji :: SubredditName -> EmojiName -> m ()
deleteEmoji SubredditName
sname EmojiName
ename =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = SubredditName -> PathSegment -> [PathSegment]
forall a. ToHttpApiData a => a -> PathSegment -> [PathSegment]
v1Path SubredditName
sname PathSegment
"emoji" [PathSegment] -> [PathSegment] -> [PathSegment]
forall a. Semigroup a => a -> a -> a
<> [ EmojiName -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toUrlPiece EmojiName
ename ]
               , $sel:method:APIAction :: Method
method       = Method
DELETE
               }

-- | Update an emoji. Only the boolean permissions fields will be sent. If you
-- would like to change the image associated with the emoji name, use 'addEmoji'
-- with an updated filepath
updateEmoji :: MonadReddit m => SubredditName -> Emoji -> m ()
updateEmoji :: SubredditName -> Emoji -> m ()
updateEmoji SubredditName
sname Emoji
emoji =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = SubredditName -> PathSegment -> [PathSegment]
forall a. ToHttpApiData a => a -> PathSegment -> [PathSegment]
v1Path SubredditName
sname PathSegment
"emoji_permissions"
               , $sel:method:APIAction :: Method
method       = Method
POST
               , $sel:requestData:APIAction :: WithData
requestData  = Form -> WithData
WithForm (Form -> WithData) -> Form -> WithData
forall a b. (a -> b) -> a -> b
$ Emoji -> Form
forall a. ToForm a => a -> Form
toForm Emoji
emoji
               }

-- | Set the (h, w) dimensions for /all/ custom emojis on the subreddit. Both
-- dimensions must be between 16px and 40px. A @Nothing@ argument will disable
-- custom sizes
setCustomEmojiSize
    :: MonadReddit m => SubredditName -> Maybe (Int, Int) -> m ()
setCustomEmojiSize :: SubredditName -> Maybe (Int, Int) -> m ()
setCustomEmojiSize SubredditName
sname = \case
    Maybe (Int, Int)
Nothing        -> APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
r { $sel:requestData:APIAction :: WithData
requestData = Form -> WithData
WithForm Form
forall a. Monoid a => a
mempty }
    Just ss :: (Int, Int)
ss@(Int
h, Int
w) -> case (Int -> Bool) -> (Int -> Bool) -> (Int, Int) -> (Bool, Bool)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Int -> Bool
inR Int -> Bool
inR (Int, Int)
ss of
        (Bool
True, Bool
True) ->
            APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
r
                       { $sel:requestData:APIAction :: WithData
requestData =
                             [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ (PathSegment
"height", Int -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam Int
h)
                                            , (PathSegment
"width", Int -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam Int
w)
                                            ]
                       }
        (Bool, Bool)
_            -> ClientException -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ClientException -> m ())
-> (PathSegment -> ClientException) -> PathSegment -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathSegment -> ClientException
InvalidRequest
            (PathSegment -> m ()) -> PathSegment -> m ()
forall a b. (a -> b) -> a -> b
$ PathSegment
"setCustomEmojiSize: Height and width must be between 16px and 40px"
  where
    inR :: Int -> Bool
inR = (Int, Int) -> Int -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Int
16, Int
40)

    r :: APIAction Any
r   = APIAction Any
forall a. APIAction a
defaultAPIAction
        { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = SubredditName -> PathSegment -> [PathSegment]
forall a. ToHttpApiData a => a -> PathSegment -> [PathSegment]
v1Path SubredditName
sname PathSegment
"emoji_custom_size", $sel:method:APIAction :: Method
method = Method
POST }

v1Path :: ToHttpApiData a => a -> PathSegment -> [PathSegment]
v1Path :: a -> PathSegment -> [PathSegment]
v1Path a
sname PathSegment
path = [ PathSegment
"api", PathSegment
"v1", a -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toUrlPiece a
sname ] [PathSegment] -> [PathSegment] -> [PathSegment]
forall a. Semigroup a => a -> a -> a
<> [ PathSegment
path ]

--Misc-------------------------------------------------------------------------
-- | Get traffic statistics for the given subreddit
getTraffic :: MonadReddit m => SubredditName -> m Traffic
getTraffic :: SubredditName -> m Traffic
getTraffic SubredditName
sname =
    APIAction Traffic -> m Traffic
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction APIAction Any
forall a. APIAction a
defaultAPIAction { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = SubredditName -> PathSegment -> [PathSegment]
subAboutPath SubredditName
sname PathSegment
"traffic" }