-- | Miscellaneous routes
module Calamity.HTTP.MiscRoutes where

import           Calamity.HTTP.Internal.Request
import           Calamity.HTTP.Internal.Route
import           Calamity.HTTP.Internal.Types

import           Data.Function

import           Network.Wreq.Session

data MiscRequest a where
  GetGateway    :: MiscRequest GatewayResponse
  GetGatewayBot :: MiscRequest BotGatewayResponse

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

  route :: MiscRequest a -> Route
route GetGateway = RouteBuilder '[]
mkRouteBuilder RouteBuilder '[] -> S -> ConsRes S '[]
forall a (ids :: [(*, RouteRequirement)]).
RouteFragmentable a ids =>
RouteBuilder ids -> a -> ConsRes a ids
// Text -> S
S "gateway"
    RouteBuilder '[] -> (RouteBuilder '[] -> Route) -> Route
forall a b. a -> (a -> b) -> b
& RouteBuilder '[] -> Route
forall (ids :: [(*, RouteRequirement)]).
EnsureFulfilled ids =>
RouteBuilder ids -> Route
buildRoute

  route GetGatewayBot = RouteBuilder '[]
mkRouteBuilder RouteBuilder '[] -> S -> ConsRes S '[]
forall a (ids :: [(*, RouteRequirement)]).
RouteFragmentable a ids =>
RouteBuilder ids -> a -> ConsRes a ids
// Text -> S
S "gateway" RouteBuilder '[] -> S -> ConsRes S '[]
forall a (ids :: [(*, RouteRequirement)]).
RouteFragmentable a ids =>
RouteBuilder ids -> a -> ConsRes a ids
// Text -> S
S "bot"
    RouteBuilder '[] -> (RouteBuilder '[] -> Route) -> Route
forall a b. a -> (a -> b) -> b
& RouteBuilder '[] -> Route
forall (ids :: [(*, RouteRequirement)]).
EnsureFulfilled ids =>
RouteBuilder ids -> Route
buildRoute

  action :: MiscRequest a
-> Options -> Session -> String -> IO (Response ByteString)
action GetGateway = Options -> Session -> String -> IO (Response ByteString)
getWith
  action GetGatewayBot = Options -> Session -> String -> IO (Response ByteString)
getWith