{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes       #-}
module Tox.Conduit.Encoding where

import           Control.Monad             (forever)
import           Control.Monad.IO.Class    (MonadIO, liftIO)
import           Data.Binary               (Binary, get, put)
import           Data.Binary.Get           (getRemainingLazyByteString,
                                            runGetOrFail)
import           Data.Binary.Put           (putByteString, runPut)
import qualified Data.ByteString           as BS
import qualified Data.ByteString.Lazy      as LBS
import           Data.Conduit              (ConduitT, await, yield)
import qualified Network.Socket            as Socket

import           Tox.Conduit.Network       (toSockAddr)
import           Tox.Network.Core.NodeInfo (NodeInfo (..))
import           Tox.Network.Core.Packet   (Packet (..))

-- | Decodes raw UDP packets into Tox packets, keeping the sender's address.
decodePacket :: MonadIO m
             => ConduitT (Socket.SockAddr, BS.ByteString) (Socket.SockAddr, Packet BS.ByteString) m ()
decodePacket :: ConduitT (SockAddr, ByteString) (SockAddr, Packet ByteString) m ()
decodePacket = ConduitT (SockAddr, ByteString) (SockAddr, Packet ByteString) m ()
-> ConduitT
     (SockAddr, ByteString) (SockAddr, Packet ByteString) m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (ConduitT (SockAddr, ByteString) (SockAddr, Packet ByteString) m ()
 -> ConduitT
      (SockAddr, ByteString) (SockAddr, Packet ByteString) m ())
-> ConduitT
     (SockAddr, ByteString) (SockAddr, Packet ByteString) m ()
-> ConduitT
     (SockAddr, ByteString) (SockAddr, Packet ByteString) m ()
forall a b. (a -> b) -> a -> b
$ do
    Maybe (SockAddr, ByteString)
mInp <- ConduitT
  (SockAddr, ByteString)
  (SockAddr, Packet ByteString)
  m
  (Maybe (SockAddr, ByteString))
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await
    case Maybe (SockAddr, ByteString)
mInp of
        Maybe (SockAddr, ByteString)
Nothing -> ()
-> ConduitT
     (SockAddr, ByteString) (SockAddr, Packet ByteString) m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just (SockAddr
addr, ByteString
bs) -> do
            IO ()
-> ConduitT
     (SockAddr, ByteString) (SockAddr, Packet ByteString) m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> ConduitT
      (SockAddr, ByteString) (SockAddr, Packet ByteString) m ())
-> IO ()
-> ConduitT
     (SockAddr, ByteString) (SockAddr, Packet ByteString) m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Raw packet from " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SockAddr -> String
forall a. Show a => a -> String
show SockAddr
addr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (ByteString -> Int
BS.length ByteString
bs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" bytes)"
            case Get (Packet ByteString)
-> ByteString
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, Packet ByteString)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
runGetOrFail Get (Packet ByteString)
getPacket (ByteString -> ByteString
LBS.fromStrict ByteString
bs) of
                Right (ByteString
_, ByteOffset
_, Packet ByteString
pkt) -> (SockAddr, Packet ByteString)
-> ConduitT
     (SockAddr, ByteString) (SockAddr, Packet ByteString) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (SockAddr
addr, Packet ByteString
pkt)
                Left (ByteString, ByteOffset, String)
_ -> IO ()
-> ConduitT
     (SockAddr, ByteString) (SockAddr, Packet ByteString) m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> ConduitT
      (SockAddr, ByteString) (SockAddr, Packet ByteString) m ())
-> IO ()
-> ConduitT
     (SockAddr, ByteString) (SockAddr, Packet ByteString) m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"Failed to decode packet kind"
  where
    getPacket :: Get (Packet ByteString)
getPacket = PacketKind -> ByteString -> Packet ByteString
forall payload. PacketKind -> payload -> Packet payload
Packet (PacketKind -> ByteString -> Packet ByteString)
-> Get PacketKind -> Get (ByteString -> Packet ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get PacketKind
forall t. Binary t => Get t
get Get (ByteString -> Packet ByteString)
-> Get ByteString -> Get (Packet ByteString)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> Get ByteString -> Get ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getRemainingLazyByteString)

-- | Encodes Tox packets into raw UDP packets.
encodePacket :: MonadIO m
             => ConduitT (NodeInfo, Packet BS.ByteString) (Socket.SockAddr, BS.ByteString) m ()
encodePacket :: ConduitT (NodeInfo, Packet ByteString) (SockAddr, ByteString) m ()
encodePacket = ConduitT (NodeInfo, Packet ByteString) (SockAddr, ByteString) m ()
-> ConduitT
     (NodeInfo, Packet ByteString) (SockAddr, ByteString) m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (ConduitT (NodeInfo, Packet ByteString) (SockAddr, ByteString) m ()
 -> ConduitT
      (NodeInfo, Packet ByteString) (SockAddr, ByteString) m ())
-> ConduitT
     (NodeInfo, Packet ByteString) (SockAddr, ByteString) m ()
-> ConduitT
     (NodeInfo, Packet ByteString) (SockAddr, ByteString) m ()
forall a b. (a -> b) -> a -> b
$ do
    Maybe (NodeInfo, Packet ByteString)
mInp <- ConduitT
  (NodeInfo, Packet ByteString)
  (SockAddr, ByteString)
  m
  (Maybe (NodeInfo, Packet ByteString))
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await
    case Maybe (NodeInfo, Packet ByteString)
mInp of
        Maybe (NodeInfo, Packet ByteString)
Nothing -> ()
-> ConduitT
     (NodeInfo, Packet ByteString) (SockAddr, ByteString) m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just (NodeInfo
ni, Packet PacketKind
kind ByteString
payload) -> do
            let addr :: SockAddr
addr = SocketAddress -> SockAddr
toSockAddr (NodeInfo -> SocketAddress
address NodeInfo
ni)
            let bs :: ByteString
bs = ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ PacketKind -> Put
forall t. Binary t => t -> Put
put PacketKind
kind Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Put
putByteString ByteString
payload
            IO ()
-> ConduitT
     (NodeInfo, Packet ByteString) (SockAddr, ByteString) m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> ConduitT
      (NodeInfo, Packet ByteString) (SockAddr, ByteString) m ())
-> IO ()
-> ConduitT
     (NodeInfo, Packet ByteString) (SockAddr, ByteString) m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Sending packet to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SockAddr -> String
forall a. Show a => a -> String
show SockAddr
addr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (ByteString -> Int
BS.length ByteString
bs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" bytes)"
            (SockAddr, ByteString)
-> ConduitT
     (NodeInfo, Packet ByteString) (SockAddr, ByteString) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (SockAddr
addr, ByteString
bs)