{-# Language OverloadedStrings #-}
module Client.State.Extensions
( clientChatExtension
, clientCommandExtension
, clientStartExtensions
, clientNotifyExtensions
, clientStopExtensions
, clientExtTimer
, clientThreadJoin
) where
import Client.CApi
import Client.CApi.Types
import Client.Configuration (configExtensions, ExtensionConfiguration)
import Client.Message
import Client.State
import Control.Concurrent.MVar (putMVar, takeMVar)
import Control.Exception (displayException, try)
import Control.Lens
import Control.Monad (foldM)
import Control.Monad.IO.Class (liftIO)
import Data.Foldable (find)
import Data.IntMap qualified as IntMap
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Time (getZonedTime)
import Foreign.Ptr (Ptr, nullFunPtr)
import Foreign.StablePtr (castStablePtrToPtr)
import Irc.RawIrcMsg (RawIrcMsg)
clientStartExtensions ::
ClientState ->
IO ClientState
clientStartExtensions :: ClientState -> IO ClientState
clientStartExtensions ClientState
st =
do let cfg :: Configuration
cfg = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Configuration
clientConfig ClientState
st
ClientState
st1 <- ClientState -> IO ClientState
clientStopExtensions ClientState
st
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ClientState -> ExtensionConfiguration -> IO ClientState
start1 ClientState
st1 (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Configuration [ExtensionConfiguration]
configExtensions Configuration
cfg)
start1 :: ClientState -> ExtensionConfiguration -> IO ClientState
start1 :: ClientState -> ExtensionConfiguration -> IO ClientState
start1 ClientState
st ExtensionConfiguration
config =
do Either IOError ActiveExtension
res <- forall e a. Exception e => IO a -> IO (Either e a)
try (ExtensionConfiguration -> IO ActiveExtension
openExtension ExtensionConfiguration
config) :: IO (Either IOError ActiveExtension)
case Either IOError ActiveExtension
res of
Left IOError
err ->
do ZonedTime
now <- IO ZonedTime
getZonedTime
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! ClientMessage -> ClientState -> ClientState
recordNetworkMessage ClientMessage
{ _msgTime :: ZonedTime
_msgTime = ZonedTime
now
, _msgBody :: MessageBody
_msgBody = Text -> MessageBody
ErrorBody (String -> Text
Text.pack (forall e. Exception e => e -> String
displayException IOError
err))
, _msgNetwork :: Text
_msgNetwork = Text
""
} ClientState
st
Right ActiveExtension
ae ->
do let i :: Int
i = case forall a. IntMap a -> Maybe ((Int, a), IntMap a)
IntMap.maxViewWithKey (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' ClientState ExtensionState
clientExtensions forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ExtensionState (IntMap ActiveExtension)
esActive) ClientState
st) of
Just ((Int
k,ActiveExtension
_),IntMap ActiveExtension
_) -> Int
kforall a. Num a => a -> a -> a
+Int
1
Maybe ((Int, ActiveExtension), IntMap ActiveExtension)
Nothing -> Int
0
let st1 :: ClientState
st1 = ClientState
st forall a b. a -> (a -> b) -> b
& Lens' ClientState ExtensionState
clientExtensions forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ExtensionState (IntMap ActiveExtension)
esActive forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Int
i forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ActiveExtension
ae
(ClientState
st2, Ptr ()
h) <- forall a. Int -> ClientState -> IO a -> IO (ClientState, a)
clientPark Int
i ClientState
st1 (Ptr () -> ExtensionConfiguration -> ActiveExtension -> IO (Ptr ())
startExtension (ClientState -> Ptr ()
clientToken ClientState
st1) ExtensionConfiguration
config ActiveExtension
ae)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! ClientState
st2 forall a b. a -> (a -> b) -> b
& Lens' ClientState ExtensionState
clientExtensions forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ExtensionState (IntMap ActiveExtension)
esActive forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
i forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \ActiveExtension
ae' ->
ActiveExtension
ae' { aeSession :: Ptr ()
aeSession = Ptr ()
h }
clientStopExtensions ::
ClientState ->
IO ClientState
clientStopExtensions :: ClientState -> IO ClientState
clientStopExtensions ClientState
st =
do let (IntMap ActiveExtension
aes,ClientState
st1) = ClientState
st forall a b. a -> (a -> b) -> b
& Lens' ClientState ExtensionState
clientExtensions forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ExtensionState (IntMap ActiveExtension)
esActive forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ IntMap ActiveExtension
-> (IntMap ActiveExtension, IntMap ActiveExtension)
upd
forall i (f :: * -> *) (m :: * -> *) b a.
(FoldableWithIndex i f, Monad m) =>
(i -> b -> a -> m b) -> b -> f a -> m b
ifoldlM Int -> ClientState -> ActiveExtension -> IO ClientState
step ClientState
st1 IntMap ActiveExtension
aes
where
upd :: IntMap ActiveExtension
-> (IntMap ActiveExtension, IntMap ActiveExtension)
upd = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ActiveExtension -> ActiveExtension
disable) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> IntMap a -> (IntMap a, IntMap a)
IntMap.partition ActiveExtension -> Bool
readyToClose
disable :: ActiveExtension -> ActiveExtension
disable ActiveExtension
ae = ActiveExtension
ae { aeLive :: Bool
aeLive = Bool
False }
readyToClose :: ActiveExtension -> Bool
readyToClose ActiveExtension
ae = ActiveExtension -> Int
aeThreads ActiveExtension
ae forall a. Eq a => a -> a -> Bool
== Int
0
step :: Int -> ClientState -> ActiveExtension -> IO ClientState
step Int
i ClientState
st2 ActiveExtension
ae =
do (ClientState
st3,()
_) <- forall a. Int -> ClientState -> IO a -> IO (ClientState, a)
clientPark Int
i ClientState
st2 (ActiveExtension -> IO ()
stopExtension ActiveExtension
ae)
forall (m :: * -> *) a. Monad m => a -> m a
return ClientState
st3
clientChatExtension ::
Text ->
Text ->
Text ->
ClientState ->
IO (ClientState, Bool)
clientChatExtension :: Text -> Text -> Text -> ClientState -> IO (ClientState, Bool)
clientChatExtension Text
net Text
tgt Text
msg ClientState
st
| Bool
noCallback = forall (m :: * -> *) a. Monad m => a -> m a
return (ClientState
st, Bool
True)
| Bool
otherwise = forall a. NestedIO a -> IO a
evalNestedIO forall a b. (a -> b) -> a -> b
$
do Ptr FgnChat
chat <- Text -> Text -> Text -> NestedIO (Ptr FgnChat)
withChat Text
net Text
tgt Text
msg
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ptr FgnChat
-> ClientState
-> [(Int, ActiveExtension)]
-> IO (ClientState, Bool)
chat1 Ptr FgnChat
chat ClientState
st (forall a. IntMap a -> [(Int, a)]
IntMap.toList (forall a. (a -> Bool) -> IntMap a -> IntMap a
IntMap.filter ActiveExtension -> Bool
aeLive IntMap ActiveExtension
aes)))
where
aes :: IntMap ActiveExtension
aes = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' ClientState ExtensionState
clientExtensions forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ExtensionState (IntMap ActiveExtension)
esActive) ClientState
st
noCallback :: Bool
noCallback = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\ActiveExtension
ae -> FgnExtension -> FunPtr ProcessChat
fgnChat (ActiveExtension -> FgnExtension
aeFgn ActiveExtension
ae) forall a. Eq a => a -> a -> Bool
== forall a. FunPtr a
nullFunPtr) IntMap ActiveExtension
aes
chat1 ::
Ptr FgnChat ->
ClientState ->
[(Int,ActiveExtension)] ->
IO (ClientState, Bool)
chat1 :: Ptr FgnChat
-> ClientState
-> [(Int, ActiveExtension)]
-> IO (ClientState, Bool)
chat1 Ptr FgnChat
_ ClientState
st [] = forall (m :: * -> *) a. Monad m => a -> m a
return (ClientState
st, Bool
True)
chat1 Ptr FgnChat
chat ClientState
st ((Int
i,ActiveExtension
ae):[(Int, ActiveExtension)]
aes) =
do (ClientState
st1, Bool
allow) <- forall a. Int -> ClientState -> IO a -> IO (ClientState, a)
clientPark Int
i ClientState
st (ActiveExtension -> Ptr FgnChat -> IO Bool
chatExtension ActiveExtension
ae Ptr FgnChat
chat)
if Bool
allow then Ptr FgnChat
-> ClientState
-> [(Int, ActiveExtension)]
-> IO (ClientState, Bool)
chat1 Ptr FgnChat
chat ClientState
st1 [(Int, ActiveExtension)]
aes
else forall (m :: * -> *) a. Monad m => a -> m a
return (ClientState
st1, Bool
False)
clientNotifyExtensions ::
Text ->
RawIrcMsg ->
ClientState ->
IO (ClientState, Bool)
clientNotifyExtensions :: Text -> RawIrcMsg -> ClientState -> IO (ClientState, Bool)
clientNotifyExtensions Text
network RawIrcMsg
raw ClientState
st
| Bool
noCallback = forall (m :: * -> *) a. Monad m => a -> m a
return (ClientState
st, Bool
True)
| Bool
otherwise = forall a. NestedIO a -> IO a
evalNestedIO forall a b. (a -> b) -> a -> b
$
do Ptr FgnMsg
fgn <- Text -> RawIrcMsg -> NestedIO (Ptr FgnMsg)
withRawIrcMsg Text
network RawIrcMsg
raw
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ptr FgnMsg
-> ClientState
-> [(Int, ActiveExtension)]
-> IO (ClientState, Bool)
message1 Ptr FgnMsg
fgn ClientState
st (forall a. IntMap a -> [(Int, a)]
IntMap.toList (forall a. (a -> Bool) -> IntMap a -> IntMap a
IntMap.filter ActiveExtension -> Bool
aeLive IntMap ActiveExtension
aes)))
where
aes :: IntMap ActiveExtension
aes = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' ClientState ExtensionState
clientExtensions forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ExtensionState (IntMap ActiveExtension)
esActive) ClientState
st
noCallback :: Bool
noCallback = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\ActiveExtension
ae -> FgnExtension -> FunPtr ProcessMessage
fgnMessage (ActiveExtension -> FgnExtension
aeFgn ActiveExtension
ae) forall a. Eq a => a -> a -> Bool
== forall a. FunPtr a
nullFunPtr) IntMap ActiveExtension
aes
message1 ::
Ptr FgnMsg ->
ClientState ->
[(Int,ActiveExtension)] ->
IO (ClientState, Bool)
message1 :: Ptr FgnMsg
-> ClientState
-> [(Int, ActiveExtension)]
-> IO (ClientState, Bool)
message1 Ptr FgnMsg
_ ClientState
st [] = forall (m :: * -> *) a. Monad m => a -> m a
return (ClientState
st, Bool
True)
message1 Ptr FgnMsg
chat ClientState
st ((Int
i,ActiveExtension
ae):[(Int, ActiveExtension)]
aes) =
do (ClientState
st1, Bool
allow) <- forall a. Int -> ClientState -> IO a -> IO (ClientState, a)
clientPark Int
i ClientState
st (ActiveExtension -> Ptr FgnMsg -> IO Bool
notifyExtension ActiveExtension
ae Ptr FgnMsg
chat)
if Bool
allow then Ptr FgnMsg
-> ClientState
-> [(Int, ActiveExtension)]
-> IO (ClientState, Bool)
message1 Ptr FgnMsg
chat ClientState
st1 [(Int, ActiveExtension)]
aes
else forall (m :: * -> *) a. Monad m => a -> m a
return (ClientState
st1, Bool
False)
clientCommandExtension ::
Text ->
Text ->
ClientState ->
IO (Maybe ClientState)
clientCommandExtension :: Text -> Text -> ClientState -> IO (Maybe ClientState)
clientCommandExtension Text
name Text
command ClientState
st =
case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(Int
_,ActiveExtension
ae) -> ActiveExtension -> Text
aeName ActiveExtension
ae forall a. Eq a => a -> a -> Bool
== Text
name)
(forall a. IntMap a -> [(Int, a)]
IntMap.toList (forall a. (a -> Bool) -> IntMap a -> IntMap a
IntMap.filter ActiveExtension -> Bool
aeLive (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' ClientState ExtensionState
clientExtensions forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ExtensionState (IntMap ActiveExtension)
esActive) ClientState
st))) of
Maybe (Int, ActiveExtension)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just (Int
i,ActiveExtension
ae) ->
do (ClientState
st', ()
_) <- forall a. Int -> ClientState -> IO a -> IO (ClientState, a)
clientPark Int
i ClientState
st (Text -> ActiveExtension -> IO ()
commandExtension Text
command ActiveExtension
ae)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just ClientState
st')
clientPark ::
Int ->
ClientState ->
IO a ->
IO (ClientState, a)
clientPark :: forall a. Int -> ClientState -> IO a -> IO (ClientState, a)
clientPark Int
i ClientState
st IO a
k =
do let mvar :: MVar ParkState
mvar = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' ClientState ExtensionState
clientExtensions forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ExtensionState (MVar ParkState)
esMVar) ClientState
st
forall a. MVar a -> a -> IO ()
putMVar MVar ParkState
mvar (Int
i,ClientState
st)
a
res <- IO a
k
(Int
_,ClientState
st') <- forall a. MVar a -> IO a
takeMVar MVar ParkState
mvar
forall (m :: * -> *) a. Monad m => a -> m a
return (ClientState
st', a
res)
clientToken :: ClientState -> Ptr ()
clientToken :: ClientState -> Ptr ()
clientToken = forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views (Lens' ClientState ExtensionState
clientExtensions forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ExtensionState (StablePtr (MVar ParkState))
esStablePtr) forall a. StablePtr a -> Ptr ()
castStablePtrToPtr
clientExtTimer ::
Int ->
ClientState ->
IO ClientState
clientExtTimer :: Int -> ClientState -> IO ClientState
clientExtTimer Int
i ClientState
st =
do let ae :: ActiveExtension
ae = ClientState
st forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Lens' ClientState ExtensionState
clientExtensions forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ExtensionState (IntMap ActiveExtension)
esActive forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
i
case ActiveExtension
-> Maybe
(UTCTime, TimerId, FunPtr TimerCallback, Ptr (), ActiveExtension)
popTimer ActiveExtension
ae of
Maybe
(UTCTime, TimerId, FunPtr TimerCallback, Ptr (), ActiveExtension)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ClientState
st
Just (UTCTime
_, TimerId
timerId, FunPtr TimerCallback
fun, Ptr ()
dat, ActiveExtension
ae') ->
do let st1 :: ClientState
st1 = forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' ClientState ExtensionState
clientExtensions forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ExtensionState (IntMap ActiveExtension)
esActive forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
i) ActiveExtension
ae' ClientState
st
(ClientState
st2,()
_) <- forall a. Int -> ClientState -> IO a -> IO (ClientState, a)
clientPark Int
i ClientState
st1 (Dynamic TimerCallback
runTimerCallback FunPtr TimerCallback
fun Ptr ()
dat TimerId
timerId)
forall (m :: * -> *) a. Monad m => a -> m a
return ClientState
st2
clientThreadJoin ::
Int ->
ThreadEntry ->
ClientState ->
IO ClientState
clientThreadJoin :: Int -> ThreadEntry -> ClientState -> IO ClientState
clientThreadJoin Int
i ThreadEntry
thread ClientState
st =
let ae :: ActiveExtension
ae = ClientState
st forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Lens' ClientState ExtensionState
clientExtensions forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ExtensionState (IntMap ActiveExtension)
esActive forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
i
in ActiveExtension -> IO ClientState
finish ActiveExtension
ae { aeThreads :: Int
aeThreads = ActiveExtension -> Int
aeThreads ActiveExtension
ae forall a. Num a => a -> a -> a
- Int
1}
where
finish :: ActiveExtension -> IO ClientState
finish ActiveExtension
ae
| ActiveExtension -> Bool
aeLive ActiveExtension
ae =
do let st1 :: ClientState
st1 = forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' ClientState ExtensionState
clientExtensions forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ExtensionState (IntMap ActiveExtension)
esActive forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
i) ActiveExtension
ae ClientState
st
(ClientState
st2,()
_) <- forall a. Int -> ClientState -> IO a -> IO (ClientState, a)
clientPark Int
i ClientState
st1 (ThreadEntry -> IO ()
threadFinish ThreadEntry
thread)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClientState
st2
| ActiveExtension -> Int
aeThreads ActiveExtension
ae forall a. Eq a => a -> a -> Bool
== Int
0 =
do let st1 :: ClientState
st1 = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' ClientState ExtensionState
clientExtensions forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ExtensionState (IntMap ActiveExtension)
esActive) (forall m. At m => Index m -> m -> m
sans Int
i) ClientState
st
(ClientState
st2,()
_) <- forall a. Int -> ClientState -> IO a -> IO (ClientState, a)
clientPark Int
i ClientState
st1 (ActiveExtension -> IO ()
stopExtension ActiveExtension
ae)
forall (m :: * -> *) a. Monad m => a -> m a
return ClientState
st2
| Bool
otherwise =
do forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' ClientState ExtensionState
clientExtensions forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ExtensionState (IntMap ActiveExtension)
esActive forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
i) ActiveExtension
ae ClientState
st)