Live.hs

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