-- | 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.Traversable
import Optics
import Polysemy (Sem)
import qualified Polysemy as P
import qualified Polysemy.Fail as P
import qualified Polysemy.Reader as P
import PyF

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 (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 (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 [fmt|Number of shards: {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