-- | Audit Log endpoints
module Calamity.HTTP.AuditLog
    ( AuditLogRequest(..)
    , GetAuditLogOptions(..) ) where

import           Calamity.HTTP.Internal.Request
import           Calamity.HTTP.Internal.Route
import           Calamity.Internal.Utils        ()
import           Calamity.Types.Model.Guild
import           Calamity.Types.Model.User
import           Calamity.Types.Snowflake

import           Control.Lens
import           Control.Arrow                  ( (>>>) )

import           Data.Default.Class
import           Data.Maybe                     ( maybeToList )

import           GHC.Generics

import           Network.Wreq.Lens

import           TextShow                       ( showt )

data GetAuditLogOptions = GetAuditLogOptions
  { GetAuditLogOptions -> Maybe (Snowflake User)
userID     :: Maybe (Snowflake User)
  , GetAuditLogOptions -> Maybe AuditLogAction
actionType :: Maybe AuditLogAction
  , GetAuditLogOptions -> Maybe (Snowflake AuditLogEntry)
before     :: Maybe (Snowflake AuditLogEntry)
  , GetAuditLogOptions -> Maybe Integer
limit      :: Maybe Integer
  }
  deriving ( Int -> GetAuditLogOptions -> ShowS
[GetAuditLogOptions] -> ShowS
GetAuditLogOptions -> String
(Int -> GetAuditLogOptions -> ShowS)
-> (GetAuditLogOptions -> String)
-> ([GetAuditLogOptions] -> ShowS)
-> Show GetAuditLogOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetAuditLogOptions] -> ShowS
$cshowList :: [GetAuditLogOptions] -> ShowS
show :: GetAuditLogOptions -> String
$cshow :: GetAuditLogOptions -> String
showsPrec :: Int -> GetAuditLogOptions -> ShowS
$cshowsPrec :: Int -> GetAuditLogOptions -> ShowS
Show, (forall x. GetAuditLogOptions -> Rep GetAuditLogOptions x)
-> (forall x. Rep GetAuditLogOptions x -> GetAuditLogOptions)
-> Generic GetAuditLogOptions
forall x. Rep GetAuditLogOptions x -> GetAuditLogOptions
forall x. GetAuditLogOptions -> Rep GetAuditLogOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetAuditLogOptions x -> GetAuditLogOptions
$cfrom :: forall x. GetAuditLogOptions -> Rep GetAuditLogOptions x
Generic, GetAuditLogOptions
GetAuditLogOptions -> Default GetAuditLogOptions
forall a. a -> Default a
def :: GetAuditLogOptions
$cdef :: GetAuditLogOptions
Default )

data AuditLogRequest a where
  GetAuditLog :: HasID Guild g => g -> GetAuditLogOptions -> AuditLogRequest AuditLog

instance Request (AuditLogRequest a) where
  type Result (AuditLogRequest a) = a

  route :: AuditLogRequest a -> Route
route (GetAuditLog (forall a. HasID Guild a => a -> Snowflake Guild
forall b a. HasID b a => a -> Snowflake b
getID @Guild -> Snowflake Guild
gid) _) = RouteBuilder '[]
mkRouteBuilder RouteBuilder '[] -> S -> ConsRes S '[]
forall a (ids :: [(*, RouteRequirement)]).
RouteFragmentable a ids =>
RouteBuilder ids -> a -> ConsRes a ids
// Text -> S
S "guilds" RouteBuilder '[] -> ID Guild -> ConsRes (ID Guild) '[]
forall a (ids :: [(*, RouteRequirement)]).
RouteFragmentable a ids =>
RouteBuilder ids -> a -> ConsRes a ids
// ID Guild
forall k (a :: k). ID a
ID @Guild RouteBuilder '[ '(Guild, 'Required)]
-> S -> ConsRes S '[ '(Guild, 'Required)]
forall a (ids :: [(*, RouteRequirement)]).
RouteFragmentable a ids =>
RouteBuilder ids -> a -> ConsRes a ids
// Text -> S
S "audit-logs"
    RouteBuilder '[ '(Guild, 'Required)]
-> (RouteBuilder '[ '(Guild, 'Required)]
    -> RouteBuilder '[ '(Guild, 'Satisfied), '(Guild, 'Required)])
-> RouteBuilder '[ '(Guild, 'Satisfied), '(Guild, 'Required)]
forall a b. a -> (a -> b) -> b
& Snowflake Guild
-> RouteBuilder '[ '(Guild, 'Required)]
-> RouteBuilder '[ '(Guild, 'Satisfied), '(Guild, 'Required)]
forall k (ids :: [(*, RouteRequirement)]).
Typeable k =>
Snowflake k
-> RouteBuilder ids -> RouteBuilder ('(k, 'Satisfied) : ids)
giveID Snowflake Guild
gid
    RouteBuilder '[ '(Guild, 'Satisfied), '(Guild, 'Required)]
-> (RouteBuilder '[ '(Guild, 'Satisfied), '(Guild, 'Required)]
    -> Route)
-> Route
forall a b. a -> (a -> b) -> b
& RouteBuilder '[ '(Guild, 'Satisfied), '(Guild, 'Required)] -> Route
forall (ids :: [(*, RouteRequirement)]).
EnsureFulfilled ids =>
RouteBuilder ids -> Route
buildRoute

  action :: AuditLogRequest a
-> Options -> Session -> String -> IO (Response ByteString)
action (GetAuditLog _ GetAuditLogOptions { Maybe (Snowflake User)
userID :: Maybe (Snowflake User)
$sel:userID:GetAuditLogOptions :: GetAuditLogOptions -> Maybe (Snowflake User)
userID, Maybe AuditLogAction
actionType :: Maybe AuditLogAction
$sel:actionType:GetAuditLogOptions :: GetAuditLogOptions -> Maybe AuditLogAction
actionType, Maybe (Snowflake AuditLogEntry)
before :: Maybe (Snowflake AuditLogEntry)
$sel:before:GetAuditLogOptions :: GetAuditLogOptions -> Maybe (Snowflake AuditLogEntry)
before, Maybe Integer
limit :: Maybe Integer
$sel:limit:GetAuditLogOptions :: GetAuditLogOptions -> Maybe Integer
limit }) = (Options -> Options)
-> Options -> Session -> String -> IO (Response ByteString)
getWithP
    (Text -> Lens' Options [Text]
param "user_id" (([Text] -> Identity [Text]) -> Options -> Identity Options)
-> [Text] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList (Snowflake User -> Text
forall a. TextShow a => a -> Text
showt (Snowflake User -> Text) -> Maybe (Snowflake User) -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Snowflake User)
userID) (Options -> Options) -> (Options -> Options) -> Options -> Options
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
     Text -> Lens' Options [Text]
param "action_type" (([Text] -> Identity [Text]) -> Options -> Identity Options)
-> [Text] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList (Int -> Text
forall a. TextShow a => a -> Text
showt (Int -> Text) -> (AuditLogAction -> Int) -> AuditLogAction -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AuditLogAction -> Int
forall a. Enum a => a -> Int
fromEnum (AuditLogAction -> Text) -> Maybe AuditLogAction -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe AuditLogAction
actionType) (Options -> Options) -> (Options -> Options) -> Options -> Options
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
     Text -> Lens' Options [Text]
param "before" (([Text] -> Identity [Text]) -> Options -> Identity Options)
-> [Text] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList (Snowflake AuditLogEntry -> Text
forall a. TextShow a => a -> Text
showt (Snowflake AuditLogEntry -> Text)
-> Maybe (Snowflake AuditLogEntry) -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Snowflake AuditLogEntry)
before) (Options -> Options) -> (Options -> Options) -> Options -> Options
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
     Text -> Lens' Options [Text]
param "limit" (([Text] -> Identity [Text]) -> Options -> Identity Options)
-> [Text] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList (Integer -> Text
forall a. TextShow a => a -> Text
showt (Integer -> Text) -> Maybe Integer -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
limit))