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

-- | 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 Network.Tox.Network.Networked where

import           Control.Applicative                  (Applicative, (<$>))
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)
import           Data.Monoid                          (Monoid)

import           Network.Tox.Network.MonadRandomBytes (MonadRandomBytes)
import           Network.Tox.NodeInfo.NodeInfo        (NodeInfo)
import           Network.Tox.Protocol.Packet          (Packet (..))
import           Network.Tox.Timed                    (Timed)

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

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

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

type NetworkEvent = String
newtype NetworkLogged m a = NetworkLogged (WriterT [NetworkEvent] 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, [NetworkEvent])
runNetworkLogged :: NetworkLogged m a -> m (a, [NetworkEvent])
runNetworkLogged (NetworkLogged WriterT [NetworkEvent] m a
m) = WriterT [NetworkEvent] m a -> m (a, [NetworkEvent])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT WriterT [NetworkEvent] m a
m
evalNetworkLogged :: (Monad m, Applicative m) => NetworkLogged m a -> m a
evalNetworkLogged :: NetworkLogged m a -> m a
evalNetworkLogged = ((a, [NetworkEvent]) -> a
forall a b. (a, b) -> a
fst ((a, [NetworkEvent]) -> a) -> m (a, [NetworkEvent]) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (m (a, [NetworkEvent]) -> m a)
-> (NetworkLogged m a -> m (a, [NetworkEvent]))
-> NetworkLogged m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NetworkLogged m a -> m (a, [NetworkEvent])
forall (m :: * -> *) a.
Monad m =>
NetworkLogged m a -> m (a, [NetworkEvent])
runNetworkLogged
execNetworkLogged :: Monad m => NetworkLogged m a -> m [NetworkEvent]
execNetworkLogged :: NetworkLogged m a -> m [NetworkEvent]
execNetworkLogged (NetworkLogged WriterT [NetworkEvent] m a
m) = WriterT [NetworkEvent] m a -> m [NetworkEvent]
forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w
execWriterT WriterT [NetworkEvent] m a
m

-- | just log network events
instance Monad m => Networked (NetworkLogged m) where
  sendPacket :: NodeInfo -> Packet payload -> NetworkLogged m NetworkState
sendPacket NodeInfo
to Packet payload
packet = WriterT [NetworkEvent] m NetworkState
-> NetworkLogged m NetworkState
forall (m :: * -> *) a.
WriterT [NetworkEvent] m a -> NetworkLogged m a
NetworkLogged (WriterT [NetworkEvent] m NetworkState
 -> NetworkLogged m NetworkState)
-> WriterT [NetworkEvent] m NetworkState
-> NetworkLogged m NetworkState
forall a b. (a -> b) -> a -> b
$
    [NetworkEvent] -> WriterT [NetworkEvent] m NetworkState
forall w (m :: * -> *). MonadWriter w m => w -> m NetworkState
tell [NetworkEvent
">>> " NetworkEvent -> NetworkEvent -> NetworkEvent
forall a. [a] -> [a] -> [a]
++ NodeInfo -> NetworkEvent
forall a. Show a => a -> NetworkEvent
show NodeInfo
to NetworkEvent -> NetworkEvent -> NetworkEvent
forall a. [a] -> [a] -> [a]
++ NetworkEvent
" : " NetworkEvent -> NetworkEvent -> NetworkEvent
forall a. [a] -> [a] -> [a]
++ Packet payload -> NetworkEvent
forall a. Show a => a -> NetworkEvent
show Packet payload
packet]

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