module Reddit.Routes.Moderation where

import Reddit.Types.Message
import Reddit.Types.Moderation
import Reddit.Types.Options
import Reddit.Types.Subreddit
import Reddit.Types.User

import Network.API.Builder.Routes

bansListing :: Options BanID -> SubredditName -> Route
bansListing :: Options BanID -> SubredditName -> Route
bansListing Options BanID
opts (R Text
sub) =
  [Text] -> [URLParam] -> Method -> Route
Route [ Text
"r", Text
sub, Text
"about", Text
"banned" ]
        [ Text
"before" Text -> Maybe BanID -> URLParam
forall a. ToQuery a => Text -> a -> URLParam
=. Options BanID -> Maybe BanID
forall a. Options a -> Maybe a
before Options BanID
opts
        , Text
"after" Text -> Maybe BanID -> URLParam
forall a. ToQuery a => Text -> a -> URLParam
=. Options BanID -> Maybe BanID
forall a. Options a -> Maybe a
after Options BanID
opts
        , Text
"limit" Text -> Maybe Int -> URLParam
forall a. ToQuery a => Text -> a -> URLParam
=. Options BanID -> Maybe Int
forall a. Options a -> Maybe Int
limit Options BanID
opts]
        Method
"GET"

banLookup :: Username -> SubredditName -> Route
banLookup :: Username -> SubredditName -> Route
banLookup (Username Text
u) (R Text
sub) =
  [Text] -> [URLParam] -> Method -> Route
Route [ Text
"r", Text
sub, Text
"about", Text
"banned" ]
        [ Text
"user" Text -> Text -> URLParam
forall a. ToQuery a => Text -> a -> URLParam
=. Text
u ]
        Method
"GET"

modmail :: Options MessageID -> Route
modmail :: Options MessageID -> Route
modmail Options MessageID
opts =
  [Text] -> [URLParam] -> Method -> Route
Route [ Text
"message", Text
"moderator" ]
        [ Text
"before" Text -> Maybe MessageID -> URLParam
forall a. ToQuery a => Text -> a -> URLParam
=. Options MessageID -> Maybe MessageID
forall a. Options a -> Maybe a
before Options MessageID
opts
        , Text
"after" Text -> Maybe MessageID -> URLParam
forall a. ToQuery a => Text -> a -> URLParam
=. Options MessageID -> Maybe MessageID
forall a. Options a -> Maybe a
after Options MessageID
opts
        , Text
"limit" Text -> Maybe Int -> URLParam
forall a. ToQuery a => Text -> a -> URLParam
=. Options MessageID -> Maybe Int
forall a. Options a -> Maybe Int
limit Options MessageID
opts ]
        Method
"GET"