-- | 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.Lens
import Control.Monad
import Data.Traversable
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 :: (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 :: 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 :: [(* -> *) -> * -> *]) 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 :: [(* -> *) -> * -> *]).
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 :: [(* -> *) -> * -> *]).
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 :: [(* -> *) -> * -> *]) 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 :: [(* -> *) -> * -> *]).
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 :: [(* -> *) -> * -> *]).
Member (Reader i) r =>
(i -> j) -> Sem r j
P.asks (Client
-> Getting (InChan CalamityEvent) Client (InChan CalamityEvent)
-> InChan CalamityEvent
forall s a. s -> Getting a s a -> a
^. IsLabel
  "eventsIn"
  (Getting (InChan CalamityEvent) Client (InChan CalamityEvent))
Getting (InChan CalamityEvent) Client (InChan CalamityEvent)
#eventsIn)

  Right BotGatewayResponse
gateway <- MiscRequest BotGatewayResponse
-> Sem
     (Fail : r)
     (Either RestError (Result (MiscRequest BotGatewayResponse)))
forall (r :: [(* -> *) -> * -> *]) 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 -> Getting Int BotGatewayResponse Int -> Int
forall s a. s -> Getting a s a -> a
^. IsLabel "shards" (Getting Int BotGatewayResponse Int)
Getting Int BotGatewayResponse Int
#shards
  let host :: Text
host = BotGatewayResponse
gateway BotGatewayResponse -> Getting Text BotGatewayResponse Text -> Text
forall s a. s -> Getting a s a -> a
^. IsLabel "url" (Getting Text BotGatewayResponse Text)
Getting Text BotGatewayResponse Text
#url
  IO () -> Sem (Fail : r) ()
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) 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 :: [(* -> *) -> * -> *]).
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 :: [(* -> *) -> * -> *]).
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 :: [(* -> *) -> * -> *]) 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