-- |
-- Module: M.IO.KeepAlive
-- Description: Keep-alive mechanism for maintaining server connections
-- License: BSD-3-Clause
--
-- This module implements the Minecraft protocol's keep-alive mechanism, which helps
-- detect stale connections by periodically exchanging random numbers.
module M.IO.KeepAlive
  ( -- * Types
    KeepAliveFail (..),

    -- * Keep-alive functions
    skeepalive, -- ^ Server keep-alive handler
  )
where

import Control.Applicative
import Control.Monad
import Data.Data
import Data.Functor
import Effectful
import Effectful.Concurrent
import Effectful.Exception
import M.IO.Internal.EffectTypes
import M.Pack
import System.Random

-- | keep-alive failure modes. Occurs when:
--
-- * the response number doesn't match the sent number ('KeepAliveFail')
-- * no response is received within timeout ('KeepAliveTimeout')
data KeepAliveFail a
  = KeepAliveFail
      -- | sent
      a
      -- | received
      a
  | KeepAliveTimeout
  deriving (KeepAliveFail a -> KeepAliveFail a -> Bool
(KeepAliveFail a -> KeepAliveFail a -> Bool)
-> (KeepAliveFail a -> KeepAliveFail a -> Bool)
-> Eq (KeepAliveFail a)
forall a. Eq a => KeepAliveFail a -> KeepAliveFail a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => KeepAliveFail a -> KeepAliveFail a -> Bool
== :: KeepAliveFail a -> KeepAliveFail a -> Bool
$c/= :: forall a. Eq a => KeepAliveFail a -> KeepAliveFail a -> Bool
/= :: KeepAliveFail a -> KeepAliveFail a -> Bool
Eq, Int -> KeepAliveFail a -> ShowS
[KeepAliveFail a] -> ShowS
KeepAliveFail a -> String
(Int -> KeepAliveFail a -> ShowS)
-> (KeepAliveFail a -> String)
-> ([KeepAliveFail a] -> ShowS)
-> Show (KeepAliveFail a)
forall a. Show a => Int -> KeepAliveFail a -> ShowS
forall a. Show a => [KeepAliveFail a] -> ShowS
forall a. Show a => KeepAliveFail a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> KeepAliveFail a -> ShowS
showsPrec :: Int -> KeepAliveFail a -> ShowS
$cshow :: forall a. Show a => KeepAliveFail a -> String
show :: KeepAliveFail a -> String
$cshowList :: forall a. Show a => [KeepAliveFail a] -> ShowS
showList :: [KeepAliveFail a] -> ShowS
Show, Typeable, Show (KeepAliveFail a)
Typeable (KeepAliveFail a)
(Typeable (KeepAliveFail a), Show (KeepAliveFail a)) =>
(KeepAliveFail a -> SomeException)
-> (SomeException -> Maybe (KeepAliveFail a))
-> (KeepAliveFail a -> String)
-> Exception (KeepAliveFail a)
SomeException -> Maybe (KeepAliveFail a)
KeepAliveFail a -> String
KeepAliveFail a -> SomeException
forall a. (Typeable a, Show a) => Show (KeepAliveFail a)
forall a. (Typeable a, Show a) => Typeable (KeepAliveFail a)
forall a.
(Typeable a, Show a) =>
SomeException -> Maybe (KeepAliveFail a)
forall a. (Typeable a, Show a) => KeepAliveFail a -> String
forall a. (Typeable a, Show a) => KeepAliveFail a -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: forall a. (Typeable a, Show a) => KeepAliveFail a -> SomeException
toException :: KeepAliveFail a -> SomeException
$cfromException :: forall a.
(Typeable a, Show a) =>
SomeException -> Maybe (KeepAliveFail a)
fromException :: SomeException -> Maybe (KeepAliveFail a)
$cdisplayException :: forall a. (Typeable a, Show a) => KeepAliveFail a -> String
displayException :: KeepAliveFail a -> String
Exception)

-- | server's keep-alive mechanism. sends a random number every 15 seconds
-- and verifies the client echoes it back correctly
--
-- throws:
--
-- * 'KeepAliveFail' if response doesn't match
-- * 'KeepAliveTimeout' if no response within timeout
skeepalive ::
  forall a es void.
  ( Concurrent :> es,
    Talking' es,
    IOE :> es,
    Random a,
    Show a,
    Eq a,
    Pack a,
    Unpack a,
    Typeable a
  ) =>
  Eff es void
skeepalive :: forall a (es :: [Effect]) void.
(Concurrent :> es, Talking' es, IOE :> es, Random a, Show a, Eq a,
 Pack a, Unpack a, Typeable a) =>
Eff es void
skeepalive =
  Eff es ()
wait Eff es () -> Eff es void -> Eff es void
forall a b. Eff es a -> Eff es b -> Eff es b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Eff es () -> Eff es void
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever do
    a
a <- Eff es a
send
    a
b <- Eff es ()
wait Eff es () -> Eff es a -> Eff es a
forall a b. Eff es a -> Eff es b -> Eff es b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Eff es a
receive Eff es a -> Eff es a -> Eff es a
forall a. Eff es a -> Eff es a -> Eff es a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Eff es a
timeout)
    Bool -> Eff es () -> Eff es ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b) do
      a -> a -> Eff es ()
forall {es :: [Effect]} {a}. a -> a -> Eff es a
mismatch a
a a
b
  where
    wait :: Eff es ()
wait = Int -> Eff es ()
forall (es :: [Effect]). (Concurrent :> es) => Int -> Eff es ()
threadDelay Int
15_000_000 -- microseconds
    send :: Eff es a
send = IO a -> Eff es a
forall a. IO a -> Eff es a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a
forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO :: IO a) Eff es a -> (a -> Eff es a) -> Eff es a
forall a b. Eff es a -> (a -> Eff es b) -> Eff es b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
n -> a -> Eff es ()
forall a (es :: [Effect]).
(HasCallStack, Talking :> es, Pack a, Typeable a) =>
a -> Eff es ()
say a
n Eff es () -> a -> Eff es a
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> a
n
    receive :: Eff es a
receive = forall a (es :: [Effect]).
(HasCallStack, Talking :> es, Unpack a, Typeable a) =>
Immediately -> Eff es a
hear @a Immediately
Immediately
    mismatch :: a -> a -> Eff es a
mismatch = (KeepAliveFail a -> Eff es a
forall e (es :: [Effect]) a.
(HasCallStack, Exception e) =>
e -> Eff es a
throwIO .) ((a -> KeepAliveFail a) -> a -> Eff es a)
-> (a -> a -> KeepAliveFail a) -> a -> a -> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> KeepAliveFail a
forall a. a -> a -> KeepAliveFail a
KeepAliveFail
    timeout :: Eff es a
timeout = KeepAliveFail a -> Eff es a
forall e (es :: [Effect]) a.
(HasCallStack, Exception e) =>
e -> Eff es a
throwIO (forall a. KeepAliveFail a
KeepAliveTimeout @a)