{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Module      : Network.Reddit.Types.Moderation
-- Copyright   : (c) 2021 Rory Tyler Hayford
-- License     : BSD-3-Clause
-- Maintainer  : rory.hayford@protonmail.com
-- Stability   : experimental
-- Portability : GHC
--
module Network.Reddit.Types.Moderation
    ( -- * Item moderation
      ModItem(..)
    , ModItemOpts(..)
    , RemovalMessage(..)
    , RemovalType(..)
    , RemovalReason(..)
    , RemovalReasonID
    , NewRemovalReasonID
    , RemovalReasonList
      -- * Subreddit relationships
    , ModPermission(..)
    , SubredditRelationship(..)
    , RelID(RelID)
    , MuteID(MuteID)
    , ModInvitee(..)
    , ModInviteeList(..)
    , ModList
    , ModAccount(..)
    , RelInfo(..)
    , MuteInfo(..)
    , RelInfoOpts(..)
    , Ban(..)
    , BanNotes(..)
      -- * Subreddit settings
    , SubredditSettings(..)
    , CrowdControlLevel(..)
    , SubredditType(..)
    , SpamFilter(..)
    , Wikimode(..)
    , ContentOptions(..)
      -- * Modmail
    , Modmail(..)
    , ModmailConversation(..)
    , ModmailMessage(..)
    , ModmailID
    , BulkReadIDs
    , ModmailAuthor(..)
    , ModmailObjID(..)
    , ModmailState(..)
    , ModmailSort(..)
    , ModmailOpts(..)
    , defaultModmailOpts
    , ConversationDetails
    , ModmailReply(..)
    , mkModmailReply
    , NewConversation(..)
      -- * Modlog
    , ModAction(..)
    , ModActionID
    , ModActionType(..)
    , ModActionOpts(..)
      -- * Styles and images
    , Stylesheet(..)
    , SubredditImage(..)
    , S3ModerationLease(..)
    , StructuredStyleImage(..)
    , StyleImageAlignment(..)
      -- * Misc
    , TrafficStat(..)
    , Traffic(..)
    , LanguageCode(AF, AR, BE, BG, BS, CA, CS, CY, DA, DE, EL, EN, EO,
             ES, ET, EU, FA, FI, FR, GD, GL, HE, HI, HR, HU, HY, ID, IS, IT, JA,
             KO, LA, LT, LV, MS, NL, NN, NO, PL, PT, RO, RU, SK, SL, SR, SV, TA,
             TH, TR, UK, VI, ZH)
    ) where

import           Control.Applicative            ( Alternative((<|>))
                                                , optional
                                                )
import           Control.Monad                  ( (<=<), (>=>) )

import           Data.Aeson
                 ( (.:)
                 , (.:?)
                 , FromJSON(..)
                 , FromJSONKey(..)
                 , JSONKeyOptions(..)
                 , KeyValue((.=))
                 , Options(..)
                 , Value(Object)
                 , defaultJSONKeyOptions
                 , defaultOptions
                 , genericFromJSONKey
                 , genericParseJSON
                 , withArray
                 , withObject
                 , withScientific
                 , withText
                 )
import           Data.Aeson.Casing              ( snakeCase )
import           Data.Aeson.Types               ( Parser )
import           Data.Char                      ( toLower )
import           Data.Coerce                    ( coerce )
import           Data.Foldable                  ( asum )
import qualified Data.HashMap.Strict            as HM
import           Data.HashMap.Strict            ( HashMap )
import           Data.Hashable                  ( Hashable )
import           Data.Maybe
                 ( catMaybes
                 , fromMaybe
                 , mapMaybe
                 , maybeToList
                 )
import           Data.Sequence                  ( Seq )
import           Data.Text                      ( Text )
import           Data.Time                      ( UTCTime, zonedTimeToUTC )
import           Data.Time.Format.ISO8601       ( iso8601ParseM )

import           GHC.Exts                       ( IsList(fromList, toList) )
import           GHC.Generics                   ( Generic )

import           Lens.Micro

import           Network.Reddit.Types.Account
import           Network.Reddit.Types.Flair
import           Network.Reddit.Types.Internal
import           Network.Reddit.Types.Item
import           Network.Reddit.Types.Subreddit

import           Web.FormUrlEncoded
                 ( FormOptions(fieldLabelModifier)
                 , ToForm(..)
                 , defaultFormOptions
                 , genericToForm
                 )
import           Web.HttpApiData                ( ToHttpApiData(..)
                                                , showTextData
                                                )

--Item moderation--------------------------------------------------------------
-- | An 'Item' of interest to moderators (spam, modqueue, etc...)
newtype ModItem = ModItem Item
    deriving stock ( Show, Generic )
    deriving newtype ( Eq, FromJSON )

instance Paginable ModItem where
    type PaginateOptions ModItem = ModItemOpts

    type PaginateThing ModItem = ItemID

    defaultOpts = ModItemOpts { only = Nothing }

    getFullname (ModItem item) = getFullname item

-- | Options for 'Listing's of 'ModItem's. Only contains one field, @only@ to
-- constrain the request to a single type (i.e. comments or links)
data ModItemOpts = ModItemOpts { only :: Maybe ItemType }
    deriving stock ( Show, Eq, Generic )

instance ToForm ModItemOpts where
    toForm ModItemOpts { .. } = fromList
        $ foldMap pure (("only", ) . toQueryParam <$> only)

-- | A message to explain\/note the removal an 'Item'
data RemovalMessage = RemovalMessage
    { itemID      :: ItemID
    , message     :: Body
    , title       :: Title
    , removalType :: RemovalType
    }
    deriving stock ( Show, Eq, Generic )

instance ToForm RemovalMessage where
    toForm RemovalMessage { .. } =
        fromList [ ( "model"
                   , textObject [ "item_id" .= [ fullname itemID ]
                                , "message" .= message
                                , "title" .= title
                                , "type" .= toQueryParam removalType
                                ]
                   )
                 ]

-- | Controls how the 'RemovalMessage' will be disseminated
data RemovalType
    = PublicComment -- ^ Leaves the message as a public comment
    | PrivateExposed -- ^ Leaves moderator note with exposed username
    | PrivateHidden -- ^ Leaves mod note with hidden username
    deriving stock ( Show, Eq, Generic )

instance ToHttpApiData RemovalType where
    toQueryParam = \case
        PublicComment  -> "public"
        PrivateExposed -> "private_exposed"
        PrivateHidden  -> "private"

-- | A subreddit-specific reason for item removal
data RemovalReason = RemovalReason
    { removalReasonID :: RemovalReasonID, message :: Body, title :: Title }
    deriving stock ( Show, Eq, Generic )

instance FromJSON RemovalReason where
    parseJSON = genericParseJSON defaultOptions { fieldLabelModifier }
      where
        fieldLabelModifier = \case
            "removalReasonID" -> "id"
            s                 -> s

instance ToForm RemovalReason where
    toForm RemovalReason { .. } =
        fromList [ ("title", title), ("message", message) ]

newtype RemovalReasonList = RemovalReasonList (Seq RemovalReason)
    deriving stock ( Show, Generic )

instance FromJSON RemovalReasonList where
    parseJSON = withObject "RemovalReasonList"
        $ fmap RemovalReasonList . (removalsP <=< (.: "data"))
      where
        removalsP = withObject "HashMap Text RemovalReason" getVals

-- | Identifier for a 'RemovalReason'
type RemovalReasonID = Text

newtype NewRemovalReasonID = NewRemovalReasonID RemovalReasonID
    deriving stock ( Show, Generic )

instance FromJSON NewRemovalReasonID where
    parseJSON = withObject "NewRemovalReasonID"
        $ fmap NewRemovalReasonID . (.: "id")

--Relationships----------------------------------------------------------------
-- | Various permissions that can be afforded to moderators and invitees
data ModPermission
    = Access
    | Flair
    | Mail
    | Configuration
    | ChatConfig
    | ChatOperator
    | Posts
    | Wiki
    deriving stock ( Show, Eq, Generic, Ord, Enum, Bounded )

instance ToHttpApiData ModPermission where
    toQueryParam = \case
        Configuration -> "config"
        ChatOperator  -> "chat_operator"
        ChatConfig    -> "chat_config"
        s             -> showTextData s

instance FromJSON ModPermission where
    parseJSON = genericParseJSON --
        defaultOptions { constructorTagModifier = modPermissionTagModifier }

instance FromJSONKey ModPermission where
    fromJSONKey = genericFromJSONKey --
        defaultJSONKeyOptions { keyModifier = modPermissionTagModifier }

modPermissionTagModifier :: [Char] -> [Char]
modPermissionTagModifier = \case
    tag
        | tag `elem` [ "ChatConfig", "ChatOperator" ] -> snakeCase tag
        | tag == "Configuration" -> "config"
        | otherwise -> toLower <$> tag

instance Hashable ModPermission

-- | The types of relationships that mods can manipulate
data SubredditRelationship
    = Mod
    | ModInvitation
    | Contributor
    | BannedFromWiki
    | WikiContributor
    | Banned
    | Muted
    deriving stock ( Show, Eq, Generic )

instance ToHttpApiData SubredditRelationship where
    toQueryParam = \case
        Mod             -> "moderator"
        ModInvitation   -> "moderator_invite"
        Contributor     -> "contributor"
        BannedFromWiki  -> "wikibanned"
        WikiContributor -> "wikicontributor"
        Banned          -> "banned"
        Muted           -> "muted"

    toUrlPiece = \case
        rel
            | rel `elem` [ Contributor, WikiContributor ] ->
                toQueryParam rel <> "s" -- these types are pluralized in
                                        -- get requests
            | otherwise -> toQueryParam rel

-- | Information about a user who has been invited to moderate the subreddit
data ModInvitee = ModInvitee
    { userID      :: UserID
    , username    :: Username
      -- | Flair text on this subreddit
    , flairText   :: Maybe FlairText
    , permissions :: HashMap ModPermission Bool
    , moddedAt    :: UTCTime
    , postKarma   :: Integer
    }
    deriving stock ( Show, Eq, Generic )

instance FromJSON ModInvitee where
    parseJSON = withObject "ModInvitee" $ \o -> ModInvitee <$> o .: "id"
        <*> o .: "username"
        <*> o .:? "authorFlairText"
        <*> (handlePerms =<< o .: "modPermissions")
        <*> (integerToUTC <$> o .: "moddedAtUTC")
        <*> o .: "postKarma"
      where
        -- Reddit uses "all" as an permission, but this perm is not exposed
        -- as a constructor for @ModPermission@, as doing so would allow
        -- invalid states where @All@ is selected, but not all permissions
        -- are provided
        handlePerms = withObject "HashMap ModPermission Bool"
            $ \o -> parseJSON . Object $ HM.delete "all" o

-- | A list containing users invited to moderate the subreddit. For some reason,
-- the endpoints listing moderator invites do not use the same @Listing@ mechanism
-- that most other endpoints do
data ModInviteeList = ModInviteeList
    { -- | At most 25 of the invited moderators
      invited        :: Seq ModInvitee
      -- | If the list contains all invitees
    , allUsersLoaded :: Bool
      -- | Pagination controls for the next moderator invites
    , after          :: Maybe UserID
      -- | Pagination controls for the previous moderator invites
    , before         :: Maybe UserID
    }
    deriving stock ( Show, Eq, Generic )

instance FromJSON ModInviteeList where
    parseJSON = withObject "ModInviteeList" $ \o -> ModInviteeList
        <$> (getVals =<< o .: "moderators")
        <*> o .: "allUsersLoaded"
        <*> o .: "after"
        <*> o .: "before"

-- | This instance can be used to paginate through the listings, with a bias
-- towards @after@
instance ToForm ModInviteeList where
    toForm ModInviteeList { .. } = fromList . maybeToList
        $ asum [ ("after", ) . fullname <$> after
               , ("before", ) . fullname <$> before
               ]

-- | Account information about a moderator, similar to a 'Account', but
-- with less information
data ModAccount = ModAccount
    { username    :: Username
    , userID      :: UserID
    , relID       :: RelID
      -- | Flair text on the subreddit
    , flairText   :: Maybe FlairText
      -- | Flair CSS class on the subreddit
    , flairCSS    :: Maybe CSSClass
    , date        :: UTCTime
      -- | If @Nothing@, indicates the user has all mod permissions
    , permissions :: Maybe [ModPermission]
    }
    deriving stock ( Show, Eq, Generic )

instance FromJSON ModAccount where
    parseJSON = withObject "ModAccount" $ \o -> ModAccount <$> o .: "name"
        <*> o .: "id"
        <*> o .: "rel_id"
        <*> o .: "author_flair_text"
        <*> o .: "author_flair_css_class"
        <*> (integerToUTC <$> o .: "date")
        <*> optional (o .: "mod_permissions")

-- | Wrapped for list of moderators, which resembles a 'Listing', but cannot be
-- paginated or filtered
newtype ModList = ModList (Seq ModAccount)
    deriving stock ( Show, Generic )

instance FromJSON ModList where
    parseJSON =
        withKind UserListKind "ModList" $ \o -> ModList <$> o .: "children"

-- | Information about a contributor on the subreddit
data RelInfo = RelInfo
    { userID   :: UserID
    , relID    :: RelID
    , username :: Username
    , date     :: UTCTime
    }
    deriving stock ( Show, Eq, Generic )

instance FromJSON RelInfo where
    parseJSON = withObject "RelInfo" $ \o -> RelInfo <$> o .: "id"
        <*> o .: "rel_id"
        <*> o .: "name"
        <*> (integerToUTC <$> o .: "date")

instance Paginable RelInfo where
    type PaginateOptions RelInfo = RelInfoOpts

    type PaginateThing RelInfo = RelID

    defaultOpts = RelInfoOpts { username = Nothing }

    getFullname RelInfo { relID } = relID

-- | Information about a muted user
data MuteInfo = MuteInfo
    { userID   :: UserID
    , muteID   :: MuteID
    , username :: Username
    , date     :: UTCTime
    }
    deriving stock ( Show, Eq, Generic )

instance FromJSON MuteInfo where
    parseJSON = withObject "MuteInfo" $ \o -> MuteInfo <$> o .: "id"
        <*> o .: "rel_id"
        <*> o .: "name"
        <*> (integerToUTC <$> o .: "date")

instance Paginable MuteInfo where
    type PaginateOptions MuteInfo = RelInfoOpts

    type PaginateThing MuteInfo = MuteID

    defaultOpts = RelInfoOpts { username = Nothing }

    getFullname MuteInfo { muteID } = muteID

-- | Options for 'Listing's of 'RelInfo'. Currently only takes a single
-- field, @user@, to limit the listing to a single user
data RelInfoOpts = RelInfoOpts { username :: Maybe Username }
    deriving stock ( Show, Eq, Generic )

instance ToForm RelInfoOpts where
    toForm RelInfoOpts { .. } = fromList
        $ foldMap pure (("user", ) . toQueryParam <$> username)

--Subreddit settings-----------------------------------------------------------
-- | The settings that may be configured for a particular subreddit
data SubredditSettings = SubredditSettings
    { subredditID             :: SubredditID
    , title                   :: Title
    , description             :: Body
      -- | The text that appears on the submission page
    , submitText              :: Text
      -- | Custom label for creating submissions
    , submitTextLabel         :: Text
      -- | The text seen when hovering over the snoo
    , headerHoverText         :: Text
    , language                :: LanguageCode
    , subredditType           :: SubredditType
    , contentOptions          :: ContentOptions
      -- | A hex string specifying the color theme on mobile
    , keyColor                :: RGBText
    , wikimode                :: Wikimode
    , wikiEditKarma           :: Integer
    , wikiEditAge             :: Integer
    , commentScoreHideMins    :: Integer
    , spamComments            :: SpamFilter
    , spamSelfposts           :: SpamFilter
    , spamLinks               :: SpamFilter
    , crowdControlLevel       :: CrowdControlLevel
    , crowdControlChatLevel   :: CrowdControlLevel
    , crowdControlMode        :: Bool
    , suggestedCommentSort    :: Maybe ItemSort
    , welcomeMessageText      :: Maybe Text
    , welcomeMessageEnabled   :: Bool
    , allowImages             :: Bool
    , allowVideos             :: Bool
    , allowPolls              :: Bool
    , allowCrossposts         :: Bool
    , allowChatPostCreation   :: Bool
    , spoilersEnabled         :: Bool
    , showMedia               :: Bool
    , showMediaPreview        :: Bool
      -- | Restrict all posting to only approved users
    , restrictPosting         :: Bool
      -- | Restrict all commenting to only approved users
    , restrictCommenting      :: Bool
    , over18                  :: Bool
    , collapseDeletedComments :: Bool
      -- | Allows the sub to appear in \"r/all\" and trending subs
    , defaultSet              :: Bool
      -- | Whether users may send modmail messages approval as a submitter
    , disableContribRequests  :: Bool
      -- | Allow users to enter custom report reasons
    , freeFormReports         :: Bool
      -- | Exclude posts from site-wide banned users in the modqueue
    , excludeBannedModqueue   :: Bool
      -- | Whether the \"original content\" tag is enabled
    , ocTagEnabled            :: Bool
      -- | Whether to mandate that all submissions be OC
    , allOC                   :: Bool
    }
    deriving stock ( Show, Eq, Generic )

instance FromJSON SubredditSettings where
    parseJSON = withKind SubredditSettingsKind
                         "SubredditSettings"
                         (subredditSettingsP . Object)
      where
        subredditSettingsP =
            genericParseJSON defaultOptions { fieldLabelModifier }

        fieldLabelModifier = \case
            "allowCrossposts" -> "allow_post_crossposts"
            "over18" -> "over_18"
            "subredditID" -> "subreddit_id"
            "disableContribRequests" -> "disable_contributor_requests"
            "ocTagEnabled" -> "original_content_tag_enabled"
            "allOC" -> "all_original_content"
            s -> snakeCase s

instance ToForm SubredditSettings where
    toForm SubredditSettings { .. } = fromList
        $ [ ("sr", fullname subredditID)
          , ("api_type", "json")
          , ("title", title)
          , ("description", description)
          , ("submit_text", submitText)
          , ("submit_text_label", submitTextLabel)
          , ("header_hover_text", headerHoverText)
          , ("language", toQueryParam language)
          , ("type", toQueryParam subredditType)
          , ("link_type", toQueryParam contentOptions)
          , ("key_color", keyColor)
          , ("wikimode", toQueryParam wikimode)
          , ("wiki_edit_karma", tshow wikiEditKarma)
          , ("wiki_edit_age", tshow wikiEditAge)
          , ("comment_score_hide_mins", tshow commentScoreHideMins)
          , ("spam_comments", toQueryParam spamComments)
          , ("spam_selfposts", toQueryParam spamSelfposts)
          , ("spam_links", toQueryParam spamLinks)
          , ("crowd_control_level", toQueryParam crowdControlLevel)
          , ("crowd_control_chat_level", toQueryParam crowdControlChatLevel)
          , ("crowd_control_mode", toQueryParam crowdControlMode)
          , ("welcome_message_text", fromMaybe mempty welcomeMessageText)
          , ("welcome_message_enabled", toQueryParam welcomeMessageEnabled)
          , ("allow_images", toQueryParam allowImages)
          , ("allow_videos", toQueryParam allowVideos)
          , ("allow_polls", toQueryParam allowPolls)
          , ("allow_post_crossposts", toQueryParam allowCrossposts)
          , ("allow_chat_post_creation", toQueryParam allowChatPostCreation)
          , ("spoilers_enabled", toQueryParam spoilersEnabled)
          , ("show_media", toQueryParam showMedia)
          , ("show_media_preview", toQueryParam showMediaPreview)
          , ("restrict_posting", toQueryParam restrictPosting)
          , ("restrict_commenting", toQueryParam restrictCommenting)
          , ("over_18", toQueryParam over18)
          , ("collapse_delete_comments", toQueryParam collapseDeletedComments)
          , ("default_se", toQueryParam defaultSet)
          , ( "disable_contributor_requests"
            , toQueryParam disableContribRequests
            )
          , ("free_form_report", toQueryParam freeFormReports)
          , ("exclude_banned_modqueu", toQueryParam excludeBannedModqueue)
          , ("oc_tag_enable", toQueryParam ocTagEnabled)
          , ("all_original_conten", toQueryParam allOC)
          ]
        <> foldMap pure
                   (("suggested_comment_sort", ) . toQueryParam
                    <$> suggestedCommentSort)

-- | The setting for crowd controls, from lenient to strict
data CrowdControlLevel
    = Zero
    | One
    | Two
    | Three
    deriving stock ( Show, Eq, Generic, Ord, Enum )

instance FromJSON CrowdControlLevel where
    parseJSON = withScientific "CrowdControlLevel" $ \case
        0 -> pure Zero
        1 -> pure One
        2 -> pure Two
        3 -> pure Three
        _ -> mempty

instance ToHttpApiData CrowdControlLevel where
    toQueryParam = showTextData . fromEnum

-- | Permissible submissions on the subreddit
data ContentOptions
    = AnyContent
    | LinkOnly
    | SelfOnly
    deriving stock ( Show, Eq, Generic )

instance FromJSON ContentOptions where
    parseJSON = withText "ContentOptions" $ \case
        "any"  -> pure AnyContent
        "link" -> pure LinkOnly
        "self" -> pure SelfOnly
        _      -> mempty

instance ToHttpApiData ContentOptions where
    toQueryParam = \case
        AnyContent -> "any"
        LinkOnly   -> "link"
        SelfOnly   -> "self"

-- | The strength of the subreddit's spam filter
data SpamFilter
    = LowFilter
    | HighFilter
    | AllFilter
    deriving stock ( Show, Eq, Generic )

instance ToHttpApiData SpamFilter where
    toQueryParam = \case
        LowFilter  -> "low"
        HighFilter -> "high"
        AllFilter  -> "all"

instance FromJSON SpamFilter where
    parseJSON = withText "SpamFilter" $ \case
        "low"  -> pure LowFilter
        "high" -> pure HighFilter
        "all"  -> pure AllFilter
        _      -> mempty

-- | The editing mode for a subreddit\'s wiki
data Wikimode
    = EditDisabled
      -- ^ Only mods can edit
    | ApprovedEdit
      -- ^ Only mods and approved editors can edit
    | ContributorEdit
      -- ^ Any sub contributor can edit
    deriving stock ( Show, Eq, Generic, Ord )

instance FromJSON Wikimode where
    parseJSON = withText "WikiMode" $ \case
        "disabled" -> pure EditDisabled
        "modonly"  -> pure ApprovedEdit
        "anyone"   -> pure ContributorEdit
        _          -> mempty

instance ToHttpApiData Wikimode where
    toQueryParam = \case
        EditDisabled    -> "disabled"
        ApprovedEdit    -> "modonly"
        ContributorEdit -> "anyone"

-- | Represents an account that has been banned from a particular subreddit
data Ban = Ban
    { banID    :: RelID
    , username :: Username
    , userID   :: UserID
    , note     :: Maybe Text
    , since    :: UTCTime
      -- | The number of days remaining until the ban expires
    , daysLeft :: Maybe Word
    }
    deriving stock ( Show, Eq, Generic )

instance FromJSON Ban where
    parseJSON = withObject "Ban" $ \o -> Ban <$> o .: "rel_id"
        <*> o .: "name"
        <*> o .: "id"
        <*> o .:? "note"
        <*> (integerToUTC <$> o .: "date")
        <*> o .:? "days_left"

-- The endpoints that list bans are a @Listing@, but only take a single option
-- to limit the listing to a single user
instance Paginable Ban where
    type PaginateOptions Ban = RelInfoOpts

    type PaginateThing Ban = RelID

    defaultOpts = RelInfoOpts { username = Nothing }

    getFullname Ban { banID } = banID

-- | Uniquely identifies a subreddit relationship, excluding mutes (see 'MuteID')
newtype RelID = RelID Text
    deriving stock ( Show, Generic )
    deriving newtype ( Eq )

instance FromJSON RelID where
    parseJSON = withText "RelID" (coerce . dropTypePrefix RelKind)

instance Thing RelID where
    fullname (RelID bid) = prependType RelKind bid

-- | Identifies relationships representing muted users
newtype MuteID = MuteID Text
    deriving stock ( Show, Generic )
    deriving newtype ( Eq )

instance FromJSON MuteID where
    parseJSON = withText "MuteID" (breakOnType "Mute")

instance Thing MuteID where
    fullname (MuteID bid) = "Mute_" <> bid

-- | Details of a new ban to apply to a user
data BanNotes = BanNotes
    {  -- | The message sent to the user
      banMessage :: Body
      -- | Reason for the ban, not sent to the user
    , banReason  :: Body
      -- | Duration in days for the ban. @Nothing@ implies infinite ban
    , duration   :: Maybe Word
      -- | A note about the ban. Not sent to the user
    , note       :: Body
    }
    deriving stock ( Show, Eq, Generic )

instance ToForm BanNotes where
    toForm BanNotes { .. } = fromList
        $ [ ("ban_message", banMessage)
          , ("ban_reason", banReason)
          , ("note", note)
          ]
        <> foldMap pure (("duration", ) . tshow <$> duration)

--Modmail----------------------------------------------------------------------
-- | Moderator mail. Reddit no longer supports the older, message-based interface
-- for modmail
newtype Modmail = Modmail { conversations :: Seq ModmailConversation }
    deriving stock ( Show, Eq, Generic )

instance FromJSON Modmail where
    parseJSON = withObject "Modmail" $ \o -> do
        cs <- getVals =<< o .: "conversations"
        ms <- o .: "messages"
        pure . Modmail $ cs <&> \c@ModmailConversation { objIDs } ->
            let messages = fromList . flip mapMaybe (toList objIDs)
                    $ \ModmailObjID { objID } -> HM.lookup objID ms
            in
                c { messages }

-- | A single modmail conversation
data ModmailConversation = ModmailConversation
    { modmailID      :: ModmailID
    , subject        :: Subject
      -- | This field may be empty, depending on how the 'ModmailConversation' was
      -- obtained. When parsed as part of a 'Modmail' or 'ConversationDetails', the
      -- messages will be present
    , messages       :: Seq ModmailMessage
    , numMessages    :: Integer
    , subreddit      :: SubredditName
      -- | The non-mod user participating in the conversation
    , participant    :: Maybe ModmailAuthor
    , objIDs         :: Seq ModmailObjID
    , lastUpdated    :: UTCTime
    , lastUserUpdate :: Maybe UTCTime
    , lastModUpdate  :: Maybe UTCTime
    , isHighlighted  :: Bool
    , isInternal     :: Bool
    }
    deriving stock ( Show, Eq, Generic )

instance FromJSON ModmailConversation where
    parseJSON = withObject "ModmailConversation" $ \o -> ModmailConversation
        <$> o .: "id"
        <*> o .: "subject"
        -- There are no messages at the moment; they will be added later when the entire
        -- @Modmail@ or @ConversationDetails@ is parsed
        <*> pure mempty
        <*> o .: "numMessages"
        <*> ((.: "displayName") =<< o .: "owner")
        <*> optional (o .: "participant")
        <*> o .: "objIds"
        <*> (iso8601P =<< o .: "lastUpdated")
        <*> tryISO o "lastUserUpdate"
        <*> tryISO o "lastModUpdate"
        <*> o .: "isHighlighted"
        <*> o .: "isInternal"
      where
        tryISO o fld = maybe (pure Nothing) (iso8601P >=> pure . Just)
            =<< o .:? fld

iso8601P :: [Char] -> Parser UTCTime
iso8601P = fmap zonedTimeToUTC . iso8601ParseM

-- | Wrapper for parsing the JSON returned from the conversation details API endpoint.
-- This is formatted differently and has different fields than the modmail overview
-- endpoint
newtype ConversationDetails = ConversationDetails ModmailConversation
    deriving stock ( Show, Generic )

instance FromJSON ConversationDetails where
    parseJSON = withObject "ConversationDetails" $ \o -> do
        conversation <- o .: "conversation" <|> o .: "conversations"
        messages <- getVals =<< o .: "messages"
        pure . ConversationDetails $ conversation { messages }

-- | The ID of a particular modmail conversation
type ModmailID = Text

newtype BulkReadIDs = BulkReadIDs (Seq ModmailID)
    deriving stock ( Show, Generic )

instance FromJSON BulkReadIDs where
    parseJSON = withObject "BulkReadIDs"
        $ \o -> BulkReadIDs <$> o .: "conversation_ids"

-- | A mapping to a modmail action to its ID
data ModmailObjID = ModmailObjID { objID :: Text, key :: Text }
    deriving stock ( Show, Eq, Generic )

instance FromJSON ModmailObjID where
    parseJSON = withObject "ModmailObjID"
        $ \o -> ModmailObjID <$> o .: "id" <*> o .: "key"

-- | A single message in a 'ModmailConversation'
data ModmailMessage = ModmailMessage
    { modmailMessageID :: Text
    , author           :: ModmailAuthor
    , body             :: Body
    , bodyHTML         :: Body
    , date             :: UTCTime
    , isInternal       :: Bool
    }
    deriving stock ( Show, Eq, Generic )

instance FromJSON ModmailMessage where
    parseJSON = withObject "ModmailMessage" $ \o -> ModmailMessage
        <$> o .: "id"
        <*> o .: "author"
        <*> o .: "bodyMarkdown"
        <*> o .: "body"
        <*> (iso8601P =<< o .: "date")
        <*> o .: "isInternal"

-- | An author in a 'ModmailConversation'; can be either a mod or a non-mod user
data ModmailAuthor = ModmailAuthor
    { name          :: Username
    , isAdmin       :: Bool
    , isDeleted     :: Bool
    , isHidden      :: Bool
    , isMod         :: Bool
    , isOP          :: Bool
    , isParticipant :: Bool
    }
    deriving stock ( Show, Eq, Generic )

instance FromJSON ModmailAuthor where
    parseJSON = genericParseJSON defaultOptions { fieldLabelModifier }
      where
        fieldLabelModifier = \case
            "isOP" -> "isOp"
            s      -> s

-- | Options for filtering\/paginating modmail endpoints. Notably, this is an
-- entirely different mechanism than the usual @Listing@s elsewhere on Reddit
data ModmailOpts = ModmailOpts
    { after      :: Maybe ModmailID
    , subreddits :: Maybe [SubredditName]
      -- | Should be between 0 and 100. The implicit API default is 25
    , limit      :: Maybe Word
    , itemSort   :: Maybe ModmailSort
    , state      :: Maybe ModmailState
    }
    deriving stock ( Show, Eq, Generic )

instance ToForm ModmailOpts where
    toForm ModmailOpts { .. } = fromList
        $ catMaybes [ ("after", ) . toQueryParam <$> after
                    , ("entity", ) . joinParams <$> subreddits
                    , ("limit", ) . toQueryParam <$> limit
                    , ("sort", ) . toQueryParam <$> itemSort
                    , ("state", ) . toQueryParam <$> state
                    ]

-- | Default options for filtering modmail
defaultModmailOpts :: ModmailOpts
defaultModmailOpts = ModmailOpts
    { after      = Nothing
    , subreddits = Nothing
    , limit      = Nothing
    , itemSort   = Nothing
    , state      = Nothing
    }

-- | Order to sort modmail in
data ModmailSort
    = FromUser
    | FromMod
    | RecentMail
    | UnreadMail
    deriving stock ( Show, Eq, Generic )

instance ToHttpApiData ModmailSort where
    toQueryParam = \case
        FromUser   -> "user"
        FromMod    -> "mod"
        RecentMail -> "recent"
        UnreadMail -> "unread"

-- | The state of the modmail, for use when filtering mail
data ModmailState
    = AllModmail
    | NewModmail
    | Appeals
    | Notifications
    | Inbox
    | InProgress
    | ArchivedMail
    | Highlighted
    | JoinRequests
    | ModModmail
    deriving stock ( Show, Eq, Generic )

instance Hashable ModmailState

instance ToHttpApiData ModmailState where
    toQueryParam = \case
        AllModmail    -> "all"
        NewModmail    -> "new"
        Appeals       -> "appeals"
        Notifications -> "notifications"
        Inbox         -> "inbox"
        InProgress    -> "inprogress"
        ArchivedMail  -> "archived"
        Highlighted   -> "highlighted"
        JoinRequests  -> "join_requests"
        ModModmail    -> "mod"

instance FromJSON ModmailState where
    parseJSON =
        genericParseJSON defaultOptions
                         { constructorTagModifier = modmailStateTagModifier }

instance FromJSONKey ModmailState where
    fromJSONKey = genericFromJSONKey --
        defaultJSONKeyOptions { keyModifier = modmailStateTagModifier }

modmailStateTagModifier :: [Char] -> [Char]
modmailStateTagModifier = \case
    "AllModmail"     -> "all"
    "NewModmail"     -> "new"
    "ArchivedMail"   -> "archived"
    "ModModmail"     -> "mod"
    s@"JoinRequests" -> snakeCase s
    s                -> toLower <$> s

-- | A new reply to a 'ModmailConversation'
data ModmailReply = ModmailReply
    { -- | Markdown-formatted body
      body           :: Body
      -- | Hides the identity of the reply author from non-mods
    , isAuthorHidden :: Bool
      -- | Indicates that this is a private moderator note, and thus
      -- hides it from non-mod users
    , isInternal     :: Bool
    }
    deriving stock ( Show, Eq, Generic )

instance ToForm ModmailReply where
    toForm = genericToForm defaultFormOptions

-- | 'ModmailReply' with default values for boolean fields
mkModmailReply :: Body -> ModmailReply
mkModmailReply body =
    ModmailReply { body, isAuthorHidden = False, isInternal = False }

-- | A new, mod-created modmail conversation
data NewConversation = NewConversation
    { -- | Must not be empty
      body           :: Body
      -- | Must not be empty, and should be less than 100 characters
    , subject        :: Subject
      -- | The intended recipient of the message
    , dest           :: Username
    , subreddit      :: SubredditName
      -- | Hides the identity of the reply author from non-mods
    , isAuthorHidden :: Bool
    }
    deriving stock ( Show, Eq, Generic )

instance ToForm NewConversation where
    toForm = genericToForm defaultFormOptions { fieldLabelModifier }
      where
        fieldLabelModifier = \case
            "dest"      -> "to"
            "subreddit" -> "srName"
            s           -> s

--Modlog-----------------------------------------------------------------------
-- | An action issued by a moderator. The various fields prefixed @target@ can
-- refer to comments or submissions, where applicable
data ModAction = ModAction
    { modActionID     :: ModActionID
    , moderator       :: Username
    , action          :: ModActionType
    , created         :: UTCTime
    , description     :: Maybe Body
    , details         :: Maybe Text
    , targetID        :: Maybe ItemID
    , targetAuthor    :: Maybe Username
    , targetTitle     :: Maybe Title
    , targetPermalink :: Maybe URL
    }
    deriving stock ( Show, Eq, Generic )

instance FromJSON ModAction where
    parseJSON = withKind ModActionKind "ModAction" $ \o -> ModAction
        <$> o .: "id"
        <*> o .: "mod"
        -- In case an uknown mod action field is encountered. Perhaps
        -- just make the field a @Maybe ModActionType@?
        <*> (o .: "action" <|> pure OtherModAction)
        <*> (integerToUTC <$> o .: "created_utc")
        <*> o .: "description"
        <*> o .: "details"
        -- It appears that the @target@ fields are only present
        -- when the mod action is taken on comments or submissions.
        -- Nevertheless, @optional@ can be applied here to make
        -- sure that parsing doesn't fail in case that assumption
        -- is mistaken
        <*> optional (o .: "target_fullname")
        <*> optional (o .: "target_author")
        <*> optional (o .: "target_title")
        <*> optional (o .: "target_permalink")

instance Paginable ModAction where
    type PaginateOptions ModAction = ModActionOpts

    type PaginateThing ModAction = ModActionID

    defaultOpts = ModActionOpts { action = Nothing, moderator = Nothing }

    optsToForm ModActionOpts { .. } = fromList
        $ catMaybes [ ("type", ) . toQueryParam <$> action
                    , ("mod", ) . toQueryParam <$> moderator
                    ]

    getFullname ModAction { modActionID } = modActionID

-- | Options for filtering\/paginating 'Listing's of 'ModAction's
data ModActionOpts = ModActionOpts
    { -- | Limits the returned 'Listing' to only this type of action
      action    :: Maybe ModActionType
      -- | Limits the returned 'Listing' to only those issued by this
      -- moderator
    , moderator :: Maybe Username
    }
    deriving stock ( Show, Eq, Generic )

-- | Identifier for an issued 'ModAction'
newtype ModActionID = ModActionID Text
    deriving stock ( Show, Generic )
    deriving newtype ( Eq, ToHttpApiData )

instance FromJSON ModActionID where
    parseJSON = withText "ModActionID" (breakOnType "ModAction")

instance Thing ModActionID where
    fullname (ModActionID mid) = "ModAction_" <> mid

-- | Classification for 'ModAction's
data ModActionType
    = BanUser
    | UnbanUser
    | SpamLink
    | RemoveLink
    | ApproveLink
    | SpamComment
    | RemoveComment
    | ApproveComment
    | AddModerator
    | ShowComment
    | InviteModerator
    | UninviteModerator
    | AcceptModeratorInvite
    | RemoveModerator
    | AddContributor
    | RemoveContributor
    | EditSettings
    | EditFlair
    | Distinguish
    | MarkNSFW
    | WikiBanned
    | WikiContrib
    | WikiUnbanned
    | WikiPageListed
    | RemoveWikiContributor
    | WikiRevise
    | WikiPermLevel
    | IgnoreReports
    | UnignoreReports
    | SetPermissions
    | SetSuggestedSort
    | Sticky
    | Unsticky
    | SetContestMode
    | UnsetContestMode
    | Lock
    | Unlock
    | MuteUser
    | UnmuteUser
    | CreateRule
    | EditRule
    | ReorderRules
    | DeleteRule
    | Spoiler
    | Unspoiler
    | MarkOriginalContent
    | Collections
    | Events
    | DeleteOverriddenClassification
    | OverrideClassification
    | ReorderModerators
    | SnoozeReports
    | UnsnoozeReports
      -- In case the preceding is not exhaustive:
    | OtherModAction
    deriving stock ( Show, Eq, Ord, Generic )

instance FromJSON ModActionType where
    parseJSON = genericParseJSON --
        defaultOptions { constructorTagModifier }
      where
        constructorTagModifier = \case
            "WikiContrib" -> "wikicontributor"
            s             -> toLower <$> s

instance ToHttpApiData ModActionType where
    toQueryParam = showTextData

--Styles and images------------------------------------------------------------
-- | The CSS stylesheet and images for a subreddit
data Stylesheet = Stylesheet
    { stylesheet  :: Text
    , images      :: Seq SubredditImage
    , subredditID :: SubredditID
    }
    deriving stock ( Show, Eq, Generic )

instance FromJSON Stylesheet where
    parseJSON = withKind StylesheetKind "Stylesheet" $ \o -> Stylesheet
        <$> o .: "stylesheet"
        <*> o .: "images"
        <*> o .: "subreddit_id"

-- | An image belonging to a 'Stylesheet'
data SubredditImage = SubredditImage
    { name :: Name
    , link :: Text -- ^ CSS link
    , url  :: URL
    }
    deriving stock ( Show, Eq, Generic )

instance FromJSON SubredditImage where
    parseJSON = genericParseJSON defaultOptions

-- | Used to upload style assets and images to Reddit\'s servers with moderator
-- privileges
data S3ModerationLease = S3ModerationLease
    { action       :: URL
      -- | S3 metadata and headers
    , fields       :: HashMap Text Text
      -- | This is required to get the final upload URL
    , key          :: Text
    , websocketURL :: URL
    }
    deriving stock ( Show, Eq, Generic )

instance FromJSON S3ModerationLease where
    parseJSON = withObject "S3ModerationLease" $ \o -> do
        lease <- o .: "s3ModerationLease"
        -- The protocol isn't included, for some reason
        action <- ("https:" <>) <$> lease .: "action"
        fields <- fieldsP =<< lease .: "fields"
        key <- maybe (fail "Missing key") pure $ HM.lookup "key" fields
        websocketURL <- o .: "websocketUrl"
        pure S3ModerationLease { .. }
      where
        fieldsP = withArray "S3ModerationLease.fields"
            $ fmap HM.fromList . traverse fieldP . toList

        fieldP  = withObject "S3ModerationLease.fields.field"
            $ \o -> (,) <$> o .: "name" <*> o .: "value"

-- | Represents one of the style images that may be uploaded
data StructuredStyleImage
    = BannerBackground
    | BannerAdditional
    | BannerHover
    deriving stock ( Show, Eq, Generic )

instance ToHttpApiData StructuredStyleImage where
    toQueryParam = \case
        BannerBackground -> "bannerBackgroundImage"
        BannerHover      -> "secondaryBannerPositionedImage"
        BannerAdditional -> "bannerPositionedImage"

-- | Alignment for certain 'StructuredStyleImage's
data StyleImageAlignment
    = LeftAligned
    | CenterAligned
    | RightAligned
    deriving stock ( Show, Eq, Generic )

instance ToHttpApiData StyleImageAlignment where
    toQueryParam = \case
        LeftAligned   -> "left"
        CenterAligned -> "center"
        RightAligned  -> "right"

--Misc-------------------------------------------------------------------------
-- | An individual statistic for a subreddit\'s traffic
data TrafficStat = TrafficStat
    { timestamp   :: UTCTime
    , uniqueViews :: Integer
    , totalViews  :: Integer
      -- | This statistic is only available in the @day@ and @month@ fields
      -- of a 'Traffic'
    , subscribers :: Maybe Integer
    }
    deriving stock ( Show, Eq, Generic )

instance FromJSON TrafficStat where
    parseJSON = withArray "TrafficStat" (statP . toList)
      where
        statP (timestamp : uniqueViews : totalViews : rest) = TrafficStat
            <$> (integerToUTC <$> parseJSON timestamp)
            <*> parseJSON uniqueViews
            <*> parseJSON totalViews
            <*> case rest of
                subscribers : _ -> Just <$> parseJSON subscribers
                _               -> pure Nothing
        statP _ = mempty

-- | Traffic statistics for a given subreddit
data Traffic = Traffic
    { -- | Does not contain subscriber information
      hour  :: Seq TrafficStat
    , day   :: Seq TrafficStat
    , month :: Seq TrafficStat
    }
    deriving stock ( Show, Eq, Generic )

instance FromJSON Traffic where
    parseJSON = genericParseJSON defaultOptions

-- | The language in which the subreddit is available, as configured in the
-- 'SubredditSettings'
newtype LanguageCode = LanguageCode Text
    deriving stock ( Show, Generic )
    deriving newtype ( Eq, FromJSON, ToHttpApiData )

pattern AF :: LanguageCode
pattern AF = LanguageCode "af"

pattern AR :: LanguageCode
pattern AR = LanguageCode "ar"

pattern BE :: LanguageCode
pattern BE = LanguageCode "be"

pattern BG :: LanguageCode
pattern BG = LanguageCode "bg"

pattern BS :: LanguageCode
pattern BS = LanguageCode "bs"

pattern CA :: LanguageCode
pattern CA = LanguageCode "ca"

pattern CS :: LanguageCode
pattern CS = LanguageCode "cs"

pattern CY :: LanguageCode
pattern CY = LanguageCode "cy"

pattern DA :: LanguageCode
pattern DA = LanguageCode "da"

pattern DE :: LanguageCode
pattern DE = LanguageCode "de"

pattern EL :: LanguageCode
pattern EL = LanguageCode "el"

pattern EN :: LanguageCode
pattern EN = LanguageCode "en"

pattern EO :: LanguageCode
pattern EO = LanguageCode "eo"

pattern ES :: LanguageCode
pattern ES = LanguageCode "es"

pattern ET :: LanguageCode
pattern ET = LanguageCode "et"

pattern EU :: LanguageCode
pattern EU = LanguageCode "eu"

pattern FA :: LanguageCode
pattern FA = LanguageCode "fa"

pattern FI :: LanguageCode
pattern FI = LanguageCode "fi"

pattern FR :: LanguageCode
pattern FR = LanguageCode "fr"

pattern GD :: LanguageCode
pattern GD = LanguageCode "gd"

pattern GL :: LanguageCode
pattern GL = LanguageCode "gl"

pattern HE :: LanguageCode
pattern HE = LanguageCode "he"

pattern HI :: LanguageCode
pattern HI = LanguageCode "hi"

pattern HR :: LanguageCode
pattern HR = LanguageCode "hr"

pattern HU :: LanguageCode
pattern HU = LanguageCode "hu"

pattern HY :: LanguageCode
pattern HY = LanguageCode "hy"

pattern ID :: LanguageCode
pattern ID = LanguageCode "id"

pattern IS :: LanguageCode
pattern IS = LanguageCode "is"

pattern IT :: LanguageCode
pattern IT = LanguageCode "it"

pattern JA :: LanguageCode
pattern JA = LanguageCode "ja"

pattern KO :: LanguageCode
pattern KO = LanguageCode "ko"

pattern LA :: LanguageCode
pattern LA = LanguageCode "la"

pattern LT :: LanguageCode
pattern LT = LanguageCode "lt"

pattern LV :: LanguageCode
pattern LV = LanguageCode "lv"

pattern MS :: LanguageCode
pattern MS = LanguageCode "ms"

pattern NL :: LanguageCode
pattern NL = LanguageCode "nl"

pattern NN :: LanguageCode
pattern NN = LanguageCode "nn"

pattern NO :: LanguageCode
pattern NO = LanguageCode "no"

pattern PL :: LanguageCode
pattern PL = LanguageCode "pl"

pattern PT :: LanguageCode
pattern PT = LanguageCode "pt"

pattern RO :: LanguageCode
pattern RO = LanguageCode "ro"

pattern RU :: LanguageCode
pattern RU = LanguageCode "ru"

pattern SK :: LanguageCode
pattern SK = LanguageCode "sk"

pattern SL :: LanguageCode
pattern SL = LanguageCode "sl"

pattern SR :: LanguageCode
pattern SR = LanguageCode "sr"

pattern SV :: LanguageCode
pattern SV = LanguageCode "sv"

pattern TA :: LanguageCode
pattern TA = LanguageCode "ta"

pattern TH :: LanguageCode
pattern TH = LanguageCode "th"

pattern TR :: LanguageCode
pattern TR = LanguageCode "tr"

pattern UK :: LanguageCode
pattern UK = LanguageCode "uk"

pattern VI :: LanguageCode
pattern VI = LanguageCode "vi"

pattern ZH :: LanguageCode
pattern ZH = LanguageCode "zh"