-- | Contains stuff for managing shards
module Calamity.Client.ShardManager (shardBot) where

import Calamity.Client.Types
import Calamity.Gateway
import Calamity.HTTP
import Calamity.Internal.Utils
import Control.Concurrent.MVar
import Control.Concurrent.STM
import Control.Monad
import Data.Text qualified as T
import Data.Traversable
import Optics
import Polysemy (Sem)
import Polysemy qualified as P
import Polysemy.Fail qualified as P
import Polysemy.Reader qualified as P

mapLeft :: (a -> c) -> Either a b -> Either c b
mapLeft :: forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft a -> c
f (Left a
a) = c -> Either c b
forall a b. a -> Either a b
Left (c -> Either c b) -> c -> Either c b
forall a b. (a -> b) -> a -> b
$ a -> c
f a
a
mapLeft a -> c
_ (Right b
b) = b -> Either c b
forall a b. b -> Either a b
Right b
b

-- | Connects the bot to the gateway over n shards
shardBot :: BotC r => Maybe StatusUpdateData -> Intents -> Sem r (Either StartupError ())
shardBot :: forall (r :: EffectRow).
BotC r =>
Maybe StatusUpdateData -> Intents -> Sem r (Either StartupError ())
shardBot Maybe StatusUpdateData
initialStatus Intents
intents = ((String -> StartupError)
-> Either String () -> Either StartupError ()
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft String -> StartupError
StartupError (Either String () -> Either StartupError ())
-> Sem r (Either String ()) -> Sem r (Either StartupError ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Sem r (Either String ()) -> Sem r (Either StartupError ()))
-> (Sem (Fail : r) () -> Sem r (Either String ()))
-> Sem (Fail : r) ()
-> Sem r (Either StartupError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Fail : r) () -> Sem r (Either String ())
forall (r :: EffectRow) a.
Sem (Fail : r) a -> Sem r (Either String a)
P.runFail (Sem (Fail : r) () -> Sem r (Either StartupError ()))
-> Sem (Fail : r) () -> Sem r (Either StartupError ())
forall a b. (a -> b) -> a -> b
$ do
  MVar Int
numShardsVar <- (Client -> MVar Int) -> Sem (Fail : r) (MVar Int)
forall i j (r :: EffectRow).
Member (Reader i) r =>
(i -> j) -> Sem r j
P.asks Client -> MVar Int
numShards
  TVar [(InChan ControlMessage, Async (Maybe ()))]
shardsVar <- (Client -> TVar [(InChan ControlMessage, Async (Maybe ()))])
-> Sem
     (Fail : r) (TVar [(InChan ControlMessage, Async (Maybe ()))])
forall i j (r :: EffectRow).
Member (Reader i) r =>
(i -> j) -> Sem r j
P.asks Client -> TVar [(InChan ControlMessage, Async (Maybe ()))]
shards

  Bool
hasShards <- IO Bool -> Sem (Fail : r) Bool
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
P.embed (IO Bool -> Sem (Fail : r) Bool) -> IO Bool -> Sem (Fail : r) Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool)
-> ([(InChan ControlMessage, Async (Maybe ()))] -> Bool)
-> [(InChan ControlMessage, Async (Maybe ()))]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(InChan ControlMessage, Async (Maybe ()))] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(InChan ControlMessage, Async (Maybe ()))] -> Bool)
-> IO [(InChan ControlMessage, Async (Maybe ()))] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar [(InChan ControlMessage, Async (Maybe ()))]
-> IO [(InChan ControlMessage, Async (Maybe ()))]
forall a. TVar a -> IO a
readTVarIO TVar [(InChan ControlMessage, Async (Maybe ()))]
shardsVar
  Bool -> Sem (Fail : r) () -> Sem (Fail : r) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hasShards (Sem (Fail : r) () -> Sem (Fail : r) ())
-> Sem (Fail : r) () -> Sem (Fail : r) ()
forall a b. (a -> b) -> a -> b
$ String -> Sem (Fail : r) ()
forall a. String -> Sem (Fail : r) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"don't use shardBot on an already running bot."

  Token
token <- (Client -> Token) -> Sem (Fail : r) Token
forall i j (r :: EffectRow).
Member (Reader i) r =>
(i -> j) -> Sem r j
P.asks Client -> Token
Calamity.Client.Types.token
  InChan CalamityEvent
inc <- (Client -> InChan CalamityEvent)
-> Sem (Fail : r) (InChan CalamityEvent)
forall i j (r :: EffectRow).
Member (Reader i) r =>
(i -> j) -> Sem r j
P.asks (Client
-> Optic' A_Lens NoIx Client (InChan CalamityEvent)
-> InChan CalamityEvent
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Client (InChan CalamityEvent)
#eventsIn)

  Right BotGatewayResponse
gateway <- MiscRequest BotGatewayResponse
-> Sem
     (Fail : r)
     (Either RestError (Result (MiscRequest BotGatewayResponse)))
forall (r :: EffectRow) a.
(Members '[RatelimitEff, TokenEff, LogEff, MetricEff, Embed IO] r,
 Request a, ReadResponse (Result a)) =>
a -> Sem r (Either RestError (Result a))
invoke MiscRequest BotGatewayResponse
GetGatewayBot

  let numShards' :: Int
numShards' = BotGatewayResponse
gateway BotGatewayResponse
-> Optic' A_Lens NoIx BotGatewayResponse Int -> Int
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx BotGatewayResponse Int
#shards
  let host :: Text
host = BotGatewayResponse
gateway BotGatewayResponse
-> Optic' A_Lens NoIx BotGatewayResponse Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx BotGatewayResponse Text
#url
  IO () -> Sem (Fail : r) ()
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
P.embed (IO () -> Sem (Fail : r) ()) -> IO () -> Sem (Fail : r) ()
forall a b. (a -> b) -> a -> b
$ MVar Int -> Int -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Int
numShardsVar Int
numShards'

  Text -> Sem (Fail : r) ()
forall (r :: EffectRow). Member LogEff r => Text -> Sem r ()
info (Text -> Sem (Fail : r) ())
-> (String -> Text) -> String -> Sem (Fail : r) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Sem (Fail : r) ()) -> String -> Sem (Fail : r) ()
forall a b. (a -> b) -> a -> b
$ String
"Number of shards: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
numShards'

  [(InChan ControlMessage, Async (Maybe ()))]
shards <- [Int]
-> (Int
    -> Sem (Fail : r) (InChan ControlMessage, Async (Maybe ())))
-> Sem (Fail : r) [(InChan ControlMessage, Async (Maybe ()))]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Int
0 .. Int
numShards' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ((Int -> Sem (Fail : r) (InChan ControlMessage, Async (Maybe ())))
 -> Sem (Fail : r) [(InChan ControlMessage, Async (Maybe ()))])
-> (Int
    -> Sem (Fail : r) (InChan ControlMessage, Async (Maybe ())))
-> Sem (Fail : r) [(InChan ControlMessage, Async (Maybe ()))]
forall a b. (a -> b) -> a -> b
$ \Int
id ->
    Text
-> Int
-> Int
-> Token
-> Maybe StatusUpdateData
-> Intents
-> InChan CalamityEvent
-> Sem (Fail : r) (InChan ControlMessage, Async (Maybe ()))
forall (r :: EffectRow).
Members '[LogEff, MetricEff, Embed IO, Final IO, Async] r =>
Text
-> Int
-> Int
-> Token
-> Maybe StatusUpdateData
-> Intents
-> InChan CalamityEvent
-> Sem r (InChan ControlMessage, Async (Maybe ()))
newShard Text
host Int
id Int
numShards' Token
token Maybe StatusUpdateData
initialStatus Intents
intents InChan CalamityEvent
inc

  IO () -> Sem (Fail : r) ()
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
P.embed (IO () -> Sem (Fail : r) ())
-> (STM () -> IO ()) -> STM () -> Sem (Fail : r) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> Sem (Fail : r) ()) -> STM () -> Sem (Fail : r) ()
forall a b. (a -> b) -> a -> b
$ TVar [(InChan ControlMessage, Async (Maybe ()))]
-> [(InChan ControlMessage, Async (Maybe ()))] -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar [(InChan ControlMessage, Async (Maybe ()))]
shardsVar [(InChan ControlMessage, Async (Maybe ()))]
shards