-- | Perhaps this module should be a separate package and published to hackage.
module Network.RabbitMqAdmin where

import Data.Aeson as Aeson
import Imports
import Servant
import Servant.Client
import Servant.Client.Generic

type RabbitMqBasicAuth = BasicAuth "RabbitMq Management" BasicAuthData

type VHost = Text

type QueueName = Text

-- | Upstream Docs:
-- https://rawcdn.githack.com/rabbitmq/rabbitmq-server/v3.12.0/deps/rabbitmq_management/priv/www/api/index.html
data AdminAPI route = AdminAPI
  { -- | NOTE: This endpoint can be made paginated, but that complicates
    -- consumer code a little. This might be needed for performance tuning
    -- later, but perhaps not.
    forall route.
AdminAPI route
-> route
   :- ("api"
       :> ("queues"
           :> (Capture "vhost" Text
               :> (QueryParam "name" Text
                   :> (QueryParam "use_regex" Bool :> Get '[JSON] [Queue])))))
listQueuesByVHost ::
      route
        :- "api"
          :> "queues"
          :> Capture "vhost" VHost
          :> QueryParam "name" Text
          :> QueryParam "use_regex" Bool
          :> Get '[JSON] [Queue],
    forall route.
AdminAPI route
-> route
   :- ("api"
       :> ("queues"
           :> (Capture "vhost" Text
               :> (Capture "queue" Text :> DeleteNoContent))))
deleteQueue ::
      route
        :- "api"
          :> "queues"
          :> Capture "vhost" VHost
          :> Capture "queue" QueueName
          :> DeleteNoContent,
    forall route.
AdminAPI route
-> route
   :- ("api"
       :> ("vhosts"
           :> (Capture "vhost" Text
               :> ("connections" :> Get '[JSON] [Connection]))))
listConnectionsByVHost ::
      route
        :- "api"
          :> "vhosts"
          :> Capture "vhost" Text
          :> "connections"
          :> Get '[JSON] [Connection],
    forall route.
AdminAPI route
-> route
   :- ("api"
       :> ("connections" :> (Capture "name" Text :> DeleteNoContent)))
deleteConnection ::
      route
        :- "api"
          :> "connections"
          :> Capture "name" Text
          :> DeleteNoContent
  }
  deriving ((forall x. AdminAPI route -> Rep (AdminAPI route) x)
-> (forall x. Rep (AdminAPI route) x -> AdminAPI route)
-> Generic (AdminAPI route)
forall x. Rep (AdminAPI route) x -> AdminAPI route
forall x. AdminAPI route -> Rep (AdminAPI route) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall route x. Rep (AdminAPI route) x -> AdminAPI route
forall route x. AdminAPI route -> Rep (AdminAPI route) x
$cfrom :: forall route x. AdminAPI route -> Rep (AdminAPI route) x
from :: forall x. AdminAPI route -> Rep (AdminAPI route) x
$cto :: forall route x. Rep (AdminAPI route) x -> AdminAPI route
to :: forall x. Rep (AdminAPI route) x -> AdminAPI route
Generic)

data AuthenticatedAPI route = AuthenticatedAPI
  { forall route.
AuthenticatedAPI route
-> route :- (RabbitMqBasicAuth :> ToServant AdminAPI AsApi)
api ::
      route
        :- RabbitMqBasicAuth
          :> ToServant AdminAPI AsApi
  }
  deriving ((forall x.
 AuthenticatedAPI route -> Rep (AuthenticatedAPI route) x)
-> (forall x.
    Rep (AuthenticatedAPI route) x -> AuthenticatedAPI route)
-> Generic (AuthenticatedAPI route)
forall x. Rep (AuthenticatedAPI route) x -> AuthenticatedAPI route
forall x. AuthenticatedAPI route -> Rep (AuthenticatedAPI route) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall route x.
Rep (AuthenticatedAPI route) x -> AuthenticatedAPI route
forall route x.
AuthenticatedAPI route -> Rep (AuthenticatedAPI route) x
$cfrom :: forall route x.
AuthenticatedAPI route -> Rep (AuthenticatedAPI route) x
from :: forall x. AuthenticatedAPI route -> Rep (AuthenticatedAPI route) x
$cto :: forall route x.
Rep (AuthenticatedAPI route) x -> AuthenticatedAPI route
to :: forall x. Rep (AuthenticatedAPI route) x -> AuthenticatedAPI route
Generic)

jsonOptions :: Aeson.Options
jsonOptions :: Options
jsonOptions = Options
defaultOptions {fieldLabelModifier = camelTo2 '_'}

data Queue = Queue {Queue -> Text
name :: Text, Queue -> Text
vhost :: Text}
  deriving (Int -> Queue -> String -> String
[Queue] -> String -> String
Queue -> String
(Int -> Queue -> String -> String)
-> (Queue -> String) -> ([Queue] -> String -> String) -> Show Queue
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Queue -> String -> String
showsPrec :: Int -> Queue -> String -> String
$cshow :: Queue -> String
show :: Queue -> String
$cshowList :: [Queue] -> String -> String
showList :: [Queue] -> String -> String
Show, Queue -> Queue -> Bool
(Queue -> Queue -> Bool) -> (Queue -> Queue -> Bool) -> Eq Queue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Queue -> Queue -> Bool
== :: Queue -> Queue -> Bool
$c/= :: Queue -> Queue -> Bool
/= :: Queue -> Queue -> Bool
Eq, (forall x. Queue -> Rep Queue x)
-> (forall x. Rep Queue x -> Queue) -> Generic Queue
forall x. Rep Queue x -> Queue
forall x. Queue -> Rep Queue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Queue -> Rep Queue x
from :: forall x. Queue -> Rep Queue x
$cto :: forall x. Rep Queue x -> Queue
to :: forall x. Rep Queue x -> Queue
Generic)

instance FromJSON Queue

instance ToJSON Queue

data Connection = Connection
  { Connection -> Maybe Text
userProvidedName :: Maybe Text,
    Connection -> Text
name :: Text
  }
  deriving (Connection -> Connection -> Bool
(Connection -> Connection -> Bool)
-> (Connection -> Connection -> Bool) -> Eq Connection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Connection -> Connection -> Bool
== :: Connection -> Connection -> Bool
$c/= :: Connection -> Connection -> Bool
/= :: Connection -> Connection -> Bool
Eq, Int -> Connection -> String -> String
[Connection] -> String -> String
Connection -> String
(Int -> Connection -> String -> String)
-> (Connection -> String)
-> ([Connection] -> String -> String)
-> Show Connection
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Connection -> String -> String
showsPrec :: Int -> Connection -> String -> String
$cshow :: Connection -> String
show :: Connection -> String
$cshowList :: [Connection] -> String -> String
showList :: [Connection] -> String -> String
Show, (forall x. Connection -> Rep Connection x)
-> (forall x. Rep Connection x -> Connection) -> Generic Connection
forall x. Rep Connection x -> Connection
forall x. Connection -> Rep Connection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Connection -> Rep Connection x
from :: forall x. Connection -> Rep Connection x
$cto :: forall x. Rep Connection x -> Connection
to :: forall x. Rep Connection x -> Connection
Generic)

instance FromJSON Connection where
  parseJSON :: Value -> Parser Connection
parseJSON = Options -> Value -> Parser Connection
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
jsonOptions

instance ToJSON Connection where
  toJSON :: Connection -> Value
toJSON = Options -> Connection -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
jsonOptions

adminClient :: BasicAuthData -> AdminAPI (AsClientT ClientM)
adminClient :: BasicAuthData -> AdminAPI (AsClientT ClientM)
adminClient BasicAuthData
ba = ToServant AdminAPI (AsClientT ClientM)
-> AdminAPI (AsClientT ClientM)
forall (routes :: * -> *) mode.
GenericServant routes mode =>
ToServant routes mode -> routes mode
fromServant (ToServant AdminAPI (AsClientT ClientM)
 -> AdminAPI (AsClientT ClientM))
-> ToServant AdminAPI (AsClientT ClientM)
-> AdminAPI (AsClientT ClientM)
forall a b. (a -> b) -> a -> b
$ AuthenticatedAPI (AsClientT ClientM)
clientWithAuth.api BasicAuthData
ba
  where
    clientWithAuth :: AuthenticatedAPI (AsClientT ClientM)
    clientWithAuth :: AuthenticatedAPI (AsClientT ClientM)
clientWithAuth = AuthenticatedAPI (AsClientT ClientM)
forall (routes :: * -> *) (m :: * -> *).
(HasClient m (ToServantApi routes),
 GenericServant routes (AsClientT m),
 Client m (ToServantApi routes) ~ ToServant routes (AsClientT m)) =>
routes (AsClientT m)
genericClient