{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StrictData                 #-}

-- | Abstraction layer for network functionality.
--
-- The intention is to
--   (i) separate the logic of the protocol from its binary encoding, and
--   (ii) allow a simulated network in place of actual network IO.
module Tox.Network.Core.Networked where

import           Control.Monad.Random             (RandT)
import           Control.Monad.Reader             (ReaderT)
import           Control.Monad.State              (MonadState, StateT)
import           Control.Monad.Trans.Class        (lift)
import           Control.Monad.Writer             (WriterT, execWriterT,
                                                   runWriterT, tell)
import           Data.Binary                      (Binary, encode)
import qualified Data.ByteString                  as BS
import qualified Data.ByteString.Lazy             as LBS

import           Tox.Core.Timed                   (Timed)
import           Tox.Crypto.Core.Keyed            (KeyedT)
import           Tox.Crypto.Core.MonadRandomBytes (MonadRandomBytes)
import           Tox.Network.Core.NodeInfo        (NodeInfo)
import           Tox.Network.Core.Packet          (Packet (..))

class Monad m => Networked m where
  sendPacket :: (Binary payload, Show payload) => NodeInfo -> Packet payload -> m ()

instance Networked m => Networked (KeyedT m) where
  sendPacket :: NodeInfo -> Packet payload -> KeyedT m ()
sendPacket = (m () -> KeyedT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> KeyedT m ())
-> (Packet payload -> m ()) -> Packet payload -> KeyedT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Packet payload -> m ()) -> Packet payload -> KeyedT m ())
-> (NodeInfo -> Packet payload -> m ())
-> NodeInfo
-> Packet payload
-> KeyedT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeInfo -> Packet payload -> m ()
forall (m :: * -> *) payload.
(Networked m, Binary payload, Show payload) =>
NodeInfo -> Packet payload -> m ()
sendPacket

-- | actual network IO
instance Networked (StateT NetworkState IO) where
  -- | TODO
  sendPacket :: NodeInfo -> Packet payload -> StateT () IO ()
sendPacket NodeInfo
_ Packet payload
_ = () -> StateT () IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | TODO: sockets etc
type NetworkState = ()

data NetworkAction = SendPacket NodeInfo (Packet BS.ByteString)
  deriving (Int -> NetworkAction -> ShowS
[NetworkAction] -> ShowS
NetworkAction -> String
(Int -> NetworkAction -> ShowS)
-> (NetworkAction -> String)
-> ([NetworkAction] -> ShowS)
-> Show NetworkAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NetworkAction] -> ShowS
$cshowList :: [NetworkAction] -> ShowS
show :: NetworkAction -> String
$cshow :: NetworkAction -> String
showsPrec :: Int -> NetworkAction -> ShowS
$cshowsPrec :: Int -> NetworkAction -> ShowS
Show, NetworkAction -> NetworkAction -> Bool
(NetworkAction -> NetworkAction -> Bool)
-> (NetworkAction -> NetworkAction -> Bool) -> Eq NetworkAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NetworkAction -> NetworkAction -> Bool
$c/= :: NetworkAction -> NetworkAction -> Bool
== :: NetworkAction -> NetworkAction -> Bool
$c== :: NetworkAction -> NetworkAction -> Bool
Eq)

newtype NetworkLogged m a = NetworkLogged (WriterT [NetworkAction] m a)
  deriving (Applicative (NetworkLogged m)
a -> NetworkLogged m a
Applicative (NetworkLogged m)
-> (forall a b.
    NetworkLogged m a -> (a -> NetworkLogged m b) -> NetworkLogged m b)
-> (forall a b.
    NetworkLogged m a -> NetworkLogged m b -> NetworkLogged m b)
-> (forall a. a -> NetworkLogged m a)
-> Monad (NetworkLogged m)
NetworkLogged m a -> (a -> NetworkLogged m b) -> NetworkLogged m b
NetworkLogged m a -> NetworkLogged m b -> NetworkLogged m b
forall a. a -> NetworkLogged m a
forall a b.
NetworkLogged m a -> NetworkLogged m b -> NetworkLogged m b
forall a b.
NetworkLogged m a -> (a -> NetworkLogged m b) -> NetworkLogged m b
forall (m :: * -> *). Monad m => Applicative (NetworkLogged m)
forall (m :: * -> *) a. Monad m => a -> NetworkLogged m a
forall (m :: * -> *) a b.
Monad m =>
NetworkLogged m a -> NetworkLogged m b -> NetworkLogged m b
forall (m :: * -> *) a b.
Monad m =>
NetworkLogged m a -> (a -> NetworkLogged m b) -> NetworkLogged m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> NetworkLogged m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> NetworkLogged m a
>> :: NetworkLogged m a -> NetworkLogged m b -> NetworkLogged m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
NetworkLogged m a -> NetworkLogged m b -> NetworkLogged m b
>>= :: NetworkLogged m a -> (a -> NetworkLogged m b) -> NetworkLogged m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
NetworkLogged m a -> (a -> NetworkLogged m b) -> NetworkLogged m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (NetworkLogged m)
Monad, Functor (NetworkLogged m)
a -> NetworkLogged m a
Functor (NetworkLogged m)
-> (forall a. a -> NetworkLogged m a)
-> (forall a b.
    NetworkLogged m (a -> b) -> NetworkLogged m a -> NetworkLogged m b)
-> (forall a b c.
    (a -> b -> c)
    -> NetworkLogged m a -> NetworkLogged m b -> NetworkLogged m c)
-> (forall a b.
    NetworkLogged m a -> NetworkLogged m b -> NetworkLogged m b)
-> (forall a b.
    NetworkLogged m a -> NetworkLogged m b -> NetworkLogged m a)
-> Applicative (NetworkLogged m)
NetworkLogged m a -> NetworkLogged m b -> NetworkLogged m b
NetworkLogged m a -> NetworkLogged m b -> NetworkLogged m a
NetworkLogged m (a -> b) -> NetworkLogged m a -> NetworkLogged m b
(a -> b -> c)
-> NetworkLogged m a -> NetworkLogged m b -> NetworkLogged m c
forall a. a -> NetworkLogged m a
forall a b.
NetworkLogged m a -> NetworkLogged m b -> NetworkLogged m a
forall a b.
NetworkLogged m a -> NetworkLogged m b -> NetworkLogged m b
forall a b.
NetworkLogged m (a -> b) -> NetworkLogged m a -> NetworkLogged m b
forall a b c.
(a -> b -> c)
-> NetworkLogged m a -> NetworkLogged m b -> NetworkLogged m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (NetworkLogged m)
forall (m :: * -> *) a. Applicative m => a -> NetworkLogged m a
forall (m :: * -> *) a b.
Applicative m =>
NetworkLogged m a -> NetworkLogged m b -> NetworkLogged m a
forall (m :: * -> *) a b.
Applicative m =>
NetworkLogged m a -> NetworkLogged m b -> NetworkLogged m b
forall (m :: * -> *) a b.
Applicative m =>
NetworkLogged m (a -> b) -> NetworkLogged m a -> NetworkLogged m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> NetworkLogged m a -> NetworkLogged m b -> NetworkLogged m c
<* :: NetworkLogged m a -> NetworkLogged m b -> NetworkLogged m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
NetworkLogged m a -> NetworkLogged m b -> NetworkLogged m a
*> :: NetworkLogged m a -> NetworkLogged m b -> NetworkLogged m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
NetworkLogged m a -> NetworkLogged m b -> NetworkLogged m b
liftA2 :: (a -> b -> c)
-> NetworkLogged m a -> NetworkLogged m b -> NetworkLogged m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> NetworkLogged m a -> NetworkLogged m b -> NetworkLogged m c
<*> :: NetworkLogged m (a -> b) -> NetworkLogged m a -> NetworkLogged m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
NetworkLogged m (a -> b) -> NetworkLogged m a -> NetworkLogged m b
pure :: a -> NetworkLogged m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> NetworkLogged m a
$cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (NetworkLogged m)
Applicative, a -> NetworkLogged m b -> NetworkLogged m a
(a -> b) -> NetworkLogged m a -> NetworkLogged m b
(forall a b. (a -> b) -> NetworkLogged m a -> NetworkLogged m b)
-> (forall a b. a -> NetworkLogged m b -> NetworkLogged m a)
-> Functor (NetworkLogged m)
forall a b. a -> NetworkLogged m b -> NetworkLogged m a
forall a b. (a -> b) -> NetworkLogged m a -> NetworkLogged m b
forall (m :: * -> *) a b.
Functor m =>
a -> NetworkLogged m b -> NetworkLogged m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> NetworkLogged m a -> NetworkLogged m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> NetworkLogged m b -> NetworkLogged m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> NetworkLogged m b -> NetworkLogged m a
fmap :: (a -> b) -> NetworkLogged m a -> NetworkLogged m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> NetworkLogged m a -> NetworkLogged m b
Functor, MonadState s, Monad (NetworkLogged m)
Applicative (NetworkLogged m)
NetworkLogged m KeyPair
Monad (NetworkLogged m)
-> Applicative (NetworkLogged m)
-> (Int -> NetworkLogged m ByteString)
-> NetworkLogged m KeyPair
-> MonadRandomBytes (NetworkLogged m)
Int -> NetworkLogged m ByteString
forall (m :: * -> *).
Monad m
-> Applicative m
-> (Int -> m ByteString)
-> m KeyPair
-> MonadRandomBytes m
forall (m :: * -> *). MonadRandomBytes m => Monad (NetworkLogged m)
forall (m :: * -> *).
MonadRandomBytes m =>
Applicative (NetworkLogged m)
forall (m :: * -> *). MonadRandomBytes m => NetworkLogged m KeyPair
forall (m :: * -> *).
MonadRandomBytes m =>
Int -> NetworkLogged m ByteString
newKeyPair :: NetworkLogged m KeyPair
$cnewKeyPair :: forall (m :: * -> *). MonadRandomBytes m => NetworkLogged m KeyPair
randomBytes :: Int -> NetworkLogged m ByteString
$crandomBytes :: forall (m :: * -> *).
MonadRandomBytes m =>
Int -> NetworkLogged m ByteString
$cp2MonadRandomBytes :: forall (m :: * -> *).
MonadRandomBytes m =>
Applicative (NetworkLogged m)
$cp1MonadRandomBytes :: forall (m :: * -> *). MonadRandomBytes m => Monad (NetworkLogged m)
MonadRandomBytes, Monad (NetworkLogged m)
NetworkLogged m Timestamp
Monad (NetworkLogged m)
-> NetworkLogged m Timestamp -> Timed (NetworkLogged m)
forall (m :: * -> *). Monad m -> m Timestamp -> Timed m
forall (m :: * -> *). Timed m => Monad (NetworkLogged m)
forall (m :: * -> *). Timed m => NetworkLogged m Timestamp
askTime :: NetworkLogged m Timestamp
$caskTime :: forall (m :: * -> *). Timed m => NetworkLogged m Timestamp
$cp1Timed :: forall (m :: * -> *). Timed m => Monad (NetworkLogged m)
Timed)

runNetworkLogged :: Monad m => NetworkLogged m a -> m (a, [NetworkAction])
runNetworkLogged :: NetworkLogged m a -> m (a, [NetworkAction])
runNetworkLogged (NetworkLogged WriterT [NetworkAction] m a
m) = WriterT [NetworkAction] m a -> m (a, [NetworkAction])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT WriterT [NetworkAction] m a
m
evalNetworkLogged :: (Monad m, Applicative m) => NetworkLogged m a -> m a
evalNetworkLogged :: NetworkLogged m a -> m a
evalNetworkLogged = ((a, [NetworkAction]) -> a
forall a b. (a, b) -> a
fst ((a, [NetworkAction]) -> a) -> m (a, [NetworkAction]) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (m (a, [NetworkAction]) -> m a)
-> (NetworkLogged m a -> m (a, [NetworkAction]))
-> NetworkLogged m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NetworkLogged m a -> m (a, [NetworkAction])
forall (m :: * -> *) a.
Monad m =>
NetworkLogged m a -> m (a, [NetworkAction])
runNetworkLogged
execNetworkLogged :: Monad m => NetworkLogged m a -> m [NetworkAction]
execNetworkLogged :: NetworkLogged m a -> m [NetworkAction]
execNetworkLogged (NetworkLogged WriterT [NetworkAction] m a
m) = WriterT [NetworkAction] m a -> m [NetworkAction]
forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w
execWriterT WriterT [NetworkAction] m a
m

-- | just log network events
instance Monad m => Networked (NetworkLogged m) where
  sendPacket :: NodeInfo -> Packet payload -> NetworkLogged m ()
sendPacket NodeInfo
to Packet payload
packet = WriterT [NetworkAction] m () -> NetworkLogged m ()
forall (m :: * -> *) a.
WriterT [NetworkAction] m a -> NetworkLogged m a
NetworkLogged (WriterT [NetworkAction] m () -> NetworkLogged m ())
-> WriterT [NetworkAction] m () -> NetworkLogged m ()
forall a b. (a -> b) -> a -> b
$
    [NetworkAction] -> WriterT [NetworkAction] m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [NodeInfo -> Packet ByteString -> NetworkAction
SendPacket NodeInfo
to ((payload -> ByteString) -> Packet payload -> Packet ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString)
-> (payload -> ByteString) -> payload -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. payload -> ByteString
forall a. Binary a => a -> ByteString
encode) Packet payload
packet)]

instance Networked m => Networked (ReaderT r m) where
  sendPacket :: NodeInfo -> Packet payload -> ReaderT r m ()
sendPacket = (m () -> ReaderT r m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT r m ())
-> (Packet payload -> m ()) -> Packet payload -> ReaderT r m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Packet payload -> m ()) -> Packet payload -> ReaderT r m ())
-> (NodeInfo -> Packet payload -> m ())
-> NodeInfo
-> Packet payload
-> ReaderT r m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeInfo -> Packet payload -> m ()
forall (m :: * -> *) payload.
(Networked m, Binary payload, Show payload) =>
NodeInfo -> Packet payload -> m ()
sendPacket
instance (Monoid w, Networked m) => Networked (WriterT w m) where
  sendPacket :: NodeInfo -> Packet payload -> WriterT w m ()
sendPacket = (m () -> WriterT w m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> WriterT w m ())
-> (Packet payload -> m ()) -> Packet payload -> WriterT w m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Packet payload -> m ()) -> Packet payload -> WriterT w m ())
-> (NodeInfo -> Packet payload -> m ())
-> NodeInfo
-> Packet payload
-> WriterT w m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeInfo -> Packet payload -> m ()
forall (m :: * -> *) payload.
(Networked m, Binary payload, Show payload) =>
NodeInfo -> Packet payload -> m ()
sendPacket
instance Networked m => Networked (RandT s m) where
  sendPacket :: NodeInfo -> Packet payload -> RandT s m ()
sendPacket = (m () -> RandT s m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> RandT s m ())
-> (Packet payload -> m ()) -> Packet payload -> RandT s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Packet payload -> m ()) -> Packet payload -> RandT s m ())
-> (NodeInfo -> Packet payload -> m ())
-> NodeInfo
-> Packet payload
-> RandT s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeInfo -> Packet payload -> m ()
forall (m :: * -> *) payload.
(Networked m, Binary payload, Show payload) =>
NodeInfo -> Packet payload -> m ()
sendPacket
instance Networked m => Networked (StateT s m) where
  sendPacket :: NodeInfo -> Packet payload -> StateT s m ()
sendPacket = (m () -> StateT s m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT s m ())
-> (Packet payload -> m ()) -> Packet payload -> StateT s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Packet payload -> m ()) -> Packet payload -> StateT s m ())
-> (NodeInfo -> Packet payload -> m ())
-> NodeInfo
-> Packet payload
-> StateT s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeInfo -> Packet payload -> m ()
forall (m :: * -> *) payload.
(Networked m, Binary payload, Show payload) =>
NodeInfo -> Packet payload -> m ()
sendPacket