{-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TypeApplications #-} -- | -- Module : Network.Reddit.Live -- Copyright : (c) 2021 Rory Tyler Hayford -- License : BSD-3-Clause -- Maintainer : rory.hayford@protonmail.com -- Stability : experimental -- Portability : GHC -- -- Actions for working with 'LiveThread's -- module Network.Reddit.Live ( -- * Actions getLiveThread , getLiveInfo , getAllLiveInfo , getLiveUpdates , getLiveUpdate , getLiveDiscussions , getLiveContributors , reportLiveThread , createLiveThread , closeLiveThread , updateLiveThread , addLiveUpdate , strikeLiveUpdate , deleteLiveUpdate -- ** Live thread contribution , removeLiveContributor , removeLiveContributorByName , updateLiveContributor , abdicateLiveContributor , inviteLiveContributor , inviteLiveContributorWithPerms , revokeLiveInvitation , revokeLiveInvitationByName -- * Types , module M ) where import Control.Monad.Catch ( MonadThrow(throwM) ) import qualified Data.Foldable as F import Data.Generics.Product ( HasField(field) ) import Data.Generics.Wrapped ( wrappedTo ) import Data.List.Split ( chunksOf ) import Data.Sequence ( Seq((:<|)) ) import Data.Traversable ( for ) import Lens.Micro import Network.Reddit.Internal import Network.Reddit.Types import Network.Reddit.Types.Account import Network.Reddit.Types.Live import Network.Reddit.Types.Live as M ( LiveContributor(LiveContributor) , LivePermission(..) , LiveReportType(..) , LiveState(..) , LiveThread(LiveThread) , LiveThreadID(LiveThreadID) , LiveUpdate(LiveUpdate) , LiveUpdateEmbed(LiveUpdateEmbed) , LiveUpdateID(LiveUpdateID) , NewLiveThread , PostableLiveThread(PostableLiveThread) , UpdatedLiveThread , liveThreadToPostable , mkNewLiveThread ) import Network.Reddit.Types.Submission import Network.Reddit.User import Network.Reddit.Utils import Web.FormUrlEncoded ( ToForm(toForm) ) import Web.HttpApiData ( ToHttpApiData(..) ) import Web.Internal.FormUrlEncoded ( Form ) -- | Get the details on a single 'LiveThread' given its ID getLiveThread :: MonadReddit m => LiveThreadID -> m LiveThread getLiveThread ltid = runAction defaultAPIAction { pathSegments = liveThreadPath [ toQueryParam ltid, "about" ] } -- | Get information about live threads corresponding to each of the -- 'LiveThreadID's in the given container. Invalid IDs are silently discarded -- by this endpoint -- -- __Note__: This endpoint will only accept a maximum of 100 'LiveThreadID's. If -- you would like to get all of the information for a larger number of 'LiveThread's -- at once, see 'getAllLiveInfo' getLiveInfo :: (MonadReddit m, Foldable t) => t LiveThreadID -> Paginator LiveThreadID LiveThread -> m (Listing LiveThreadID LiveThread) getLiveInfo ltids paginator = runAction defaultAPIAction { pathSegments = liveThreadPath [ "by_id", joinParams ltids ] , requestData = paginatorToFormData paginator } -- | Get all of the 'LiveThread's corresponding to a container of 'LiveThreadID's, -- without a limit getAllLiveInfo :: (MonadReddit m, Traversable t) => t LiveThreadID -> m (Seq LiveThread) getAllLiveInfo ltids = fmap mconcat . for (chunked ltids) $ \ls -> getLiveInfo ls emptyPaginator { limit = apiRequestLimit } <&> (^. field @"children") where chunked = chunksOf apiRequestLimit . F.toList -- | Get a @Listing@ of 'LiveUpdate's for the given live thread getLiveUpdates :: MonadReddit m => LiveThreadID -> Paginator LiveUpdateID LiveUpdate -> m (Listing LiveUpdateID LiveUpdate) getLiveUpdates ltid paginator = runAction defaultAPIAction { pathSegments = [ "live", toQueryParam ltid ] , requestData = paginatorToFormData paginator } -- | Get a single 'LiveUpdate' for the given live thread getLiveUpdate :: MonadReddit m => LiveThreadID -> LiveUpdateID -> m LiveUpdate getLiveUpdate ltid luid = do Listing { children } <- runAction @(Listing LiveUpdateID LiveUpdate) r case children of liveUpdate :<| _ -> pure liveUpdate _ -> throwM $ InvalidResponse "getLiveUpdate: No matching live update found" where r = defaultAPIAction { pathSegments = [ "live", toQueryParam ltid, "updates", toUrlPiece luid ] } -- | Get a @Listing@ of 'Submission's representing the discussions on the given -- live thread getLiveDiscussions :: MonadReddit m => LiveThreadID -> Paginator SubmissionID Submission -> m (Listing SubmissionID Submission) getLiveDiscussions ltid paginator = runAction defaultAPIAction { pathSegments = liveThreadPath [ toQueryParam ltid, "discussions" ] , requestData = paginatorToFormData paginator } -- | Get a list of contributors to the live thread getLiveContributors :: MonadReddit m => LiveThreadID -> m (Seq LiveContributor) getLiveContributors ltid = runAction @LiveContributorList r <&> wrappedTo where r = defaultAPIAction { pathSegments = liveThreadPath [ toQueryParam ltid, "contributors" ] } -- | Report the given live thread to Reddit admins with the provided reason reportLiveThread :: MonadReddit m => LiveReportType -> LiveThreadID -> m () reportLiveThread lrt ltid = runAction_ defaultAPIAction { pathSegments = liveThreadPath [ toQueryParam ltid, "report" ] , method = POST , requestData = mkTextFormData [ ("type", toQueryParam lrt) , ("api_type", "json") ] } -- | Create a 'NewLiveThread', returning the 'LiveThread' upon success. Also see -- 'mkNewLiveThread' createLiveThread :: MonadReddit m => NewLiveThread -> m LiveThread createLiveThread nlt = getLiveThread =<< (runAction @PostedLiveThread r <&> wrappedTo) where r = defaultAPIAction { pathSegments = liveThreadPath [ "create" ] , method = POST , requestData = WithForm $ toForm nlt } -- | Close an existing live thread. After closing, it is no longer possible to -- update or modify the live thread -- -- __Warning__: This action is irreversible closeLiveThread :: MonadReddit m => LiveThreadID -> m () closeLiveThread ltid = runAction_ defaultAPIAction { pathSegments = liveThreadPath [ toQueryParam ltid, "close_thread" ] , method = POST , requestData = mkTextFormData [ ("api_type", "json") ] } -- | Update the existing live thread with new settings updateLiveThread :: MonadReddit m => LiveThreadID -> UpdatedLiveThread -> m () updateLiveThread ltid ult = runAction defaultAPIAction { pathSegments = liveThreadPath [ toQueryParam ltid, "edit" ] , method = POST , requestData = WithForm $ toForm ult } -- | Add an update to the live thread addLiveUpdate :: MonadReddit m => LiveThreadID -> Body -> m () addLiveUpdate ltid b = runAction_ defaultAPIAction { pathSegments = liveThreadPath [ toQueryParam ltid, "update" ] , method = POST , requestData = mkTextFormData [ ("body", b), ("api_type", "json") ] } -- | Strike the existing 'LiveUpdate', causing its @stricken@ field to be @True@ -- and the content to be crossed-out and marked incorrect on the web UI strikeLiveUpdate :: MonadReddit m => LiveThreadID -> LiveUpdateID -> m () strikeLiveUpdate = strikeDeleteUpdate "strike_update" -- | Strike the existing 'LiveUpdate', causing its @stricken@ field to be @True@ -- and the content to be crossed-out and marked incorrect on the web UI deleteLiveUpdate :: MonadReddit m => LiveThreadID -> LiveUpdateID -> m () deleteLiveUpdate = strikeDeleteUpdate "delete_update" strikeDeleteUpdate :: MonadReddit m => PathSegment -> LiveThreadID -> LiveUpdateID -> m () strikeDeleteUpdate path ltid luid = runAction_ defaultAPIAction { pathSegments = liveThreadPath [ toQueryParam ltid, path ] , method = POST , requestData = mkTextFormData [ ("id", fullname luid) , ("api_type", "json") ] } -- | Remove the user as a contributor to the live thread. If you don\'t know the -- contributor\'s user ID, you can use 'removeLiveContributorByName' removeLiveContributor :: MonadReddit m => LiveThreadID -> UserID -> m () removeLiveContributor ltid uid = runAction defaultAPIAction { pathSegments = liveThreadPath [ toQueryParam ltid , "remove_live_contributor" ] , requestData = mkTextFormData [ ("id", fullname uid) ] } -- | Remove the live contributor by username. Note that this action must perform -- an additional network request to fetch the user ID from the given username removeLiveContributorByName :: MonadReddit m => LiveThreadID -> Username -> m () removeLiveContributorByName ltid uname = do Account { userID } <- getUser uname removeLiveContributor ltid userID -- | Update the permissions for the live contributor updateLiveContributor :: (MonadReddit m, Foldable t) => Maybe (t LivePermission) -- ^ If @Nothing@, grants all contributor permissions. If @Just@ but empty, -- removes all permissions -> LiveThreadID -> Username -> m () updateLiveContributor perms ltid uname = runAction_ defaultAPIAction { pathSegments = [ toQueryParam ltid, "set_contributor_permissions" ] , method = POST , requestData = mkTextFormData [ ("name", toQueryParam uname) , ("type", "liveupdate_contributor") , ( "permissions" , maybe "+all" joinPerms perms ) , ("api_type", "json") ] } -- | Abdicate your role as a live contributor, removing all access and permissions -- -- __Warning__: This cannot be undone, even if you are the creator of the live -- thread abdicateLiveContributor :: MonadReddit m => LiveThreadID -> m () abdicateLiveContributor ltid = runAction_ defaultAPIAction { pathSegments = liveThreadPath [ toQueryParam ltid, "leave_contributor" ] , method = POST , requestData = mkTextFormData [ ("api_type", "json") ] } -- | Invite a user to contribute to the live thread. Note that this implicitly -- grants all permissions to the invitee. If you would like more fine-grained -- control over permissions, see 'inviteLiveContributorWithPerms' inviteLiveContributor :: MonadReddit m => LiveThreadID -> Username -> m () inviteLiveContributor = inviteContributors $ mkTextForm [ ("permissions", "+all") ] -- | As 'inviteLiveContributor', but allows customization of the permissions -- granted to the invitee inviteLiveContributorWithPerms :: (MonadReddit m, Foldable t) => t LivePermission -- ^ If empty, grants no permissions -> LiveThreadID -> Username -> m () inviteLiveContributorWithPerms perms = inviteContributors $ mkTextForm [ ("permissions", joinPerms perms) ] -- | Revoke the invitation to contribute to the live thread. If you don\'t know -- the contributor\'s user ID, you can use 'revokeLiveInvitationByName' revokeLiveInvitation :: MonadReddit m => LiveThreadID -> UserID -> m () revokeLiveInvitation ltid uid = runAction_ defaultAPIAction { pathSegments = liveThreadPath [ toQueryParam ltid , "rm_contributor_invite" ] , method = POST , requestData = mkTextFormData [ ("id", fullname uid) , ("api_type", "json") ] } -- | Revoke the live invitation by username. Note that this action must perform -- an additional network request to fetch the user ID from the given username revokeLiveInvitationByName :: MonadReddit m => LiveThreadID -> Username -> m () revokeLiveInvitationByName ltid uname = do Account { userID } <- getUser uname revokeLiveInvitation ltid userID inviteContributors :: MonadReddit m => Form -> LiveThreadID -> Username -> m () inviteContributors form ltid uname = runAction_ defaultAPIAction { pathSegments = liveThreadPath [ toQueryParam ltid , "invite_contributor" ] , method = POST , requestData = WithForm $ mkTextForm [ ("name", toQueryParam uname) , ("type", "liveupdate_contributor_invite") , ("api_type", "json") ] <> form } liveThreadPath :: [PathSegment] -> [PathSegment] liveThreadPath ps = [ "api", "live" ] <> ps