content: {-# LANGUAGE RecordWildCards #-}
  {-# LANGUAGE PatternSynonyms #-}
  
  module Hans.Network (
      module Hans.Network,
      module Hans.Network.Types
    ) where
  
  import           Hans.Addr (NetworkAddr)
  import           Hans.Addr.Types (Addr(..))
  import           Hans.Checksum (PartialChecksum)
  import           Hans.Device.Types (Device)
  import qualified Hans.IP4        as IP4
  import qualified Hans.IP4.State  as IP4
  import           Hans.Lens
  import           Hans.Network.Types
  import           Hans.Types
  
  import qualified Data.ByteString.Lazy as L
  
  
  -- | Interaction with routing and message delivery for a network layer.
  class NetworkAddr addr => Network addr where
    -- | Calculate the pseudo-header for checksumming a packet at this layer of
    -- the network.
    pseudoHeader :: addr -> addr -> NetworkProtocol -> Int -> PartialChecksum
  
    -- | Lookup a route to reach this destination address.
    lookupRoute :: HasNetworkStack ns => ns -> addr -> IO (Maybe (RouteInfo addr))
  
    -- | Send a single datagram to a destination.
    sendDatagram' :: HasNetworkStack ns
                  => ns
                  -> Device
                  -> addr -- ^ Source
                  -> addr -- ^ Destination
                  -> addr -- ^ Next-hop
                  -> Bool -- ^ Don't fragment
                  -> NetworkProtocol
                  -> L.ByteString
                  -> IO ()
  
  
  sendDatagram :: (HasNetworkStack ns, Network addr)
               => ns -> RouteInfo addr -> addr
               -> Bool -> NetworkProtocol -> L.ByteString
               -> IO ()
  sendDatagram ns RouteInfo { .. } = \ dst ->
    sendDatagram' ns riDev riSource dst riNext
  {-# INLINE sendDatagram #-}
  
  
  
  -- | Send a datagram and lookup routing information at the same time. Returns
  -- 'False' if no route to the destination was known.
  routeDatagram :: (HasNetworkStack ns, Network addr)
                => ns -> addr -> Bool -> NetworkProtocol -> L.ByteString -> IO Bool
  routeDatagram ns dst df prot bytes =
    do mbRoute <- lookupRoute ns dst
       case mbRoute of
         Just route -> do sendDatagram ns route dst df prot bytes
                          return True
  
         Nothing    -> return False
  
  
  findNextHop :: (HasNetworkStack ns, Network addr)
              => ns
              -> Maybe Device -- ^ Desired output device
              -> Maybe addr   -- ^ Desired source address
              -> addr         -- ^ Destination
              -> IO (Maybe (RouteInfo addr))
  findNextHop ns mbDev mbSrc dst =
  
    -- XXX it might be nice to have lookupRoute return a list of possible routes.
    -- is it unreasonable to think that there may be multiple valid routes for a
    -- datagram?
    do mbRoute <- lookupRoute ns dst
       case mbRoute of
         Just ri | maybe True (== riDev    ri) mbDev
                && maybe True (== riSource ri) mbSrc -> return (Just ri)
  
         _ -> return Nothing
  
  
  -- Generic ---------------------------------------------------------------------
  
  instance Network Addr where
    pseudoHeader (Addr4 src) (Addr4 dst) = \ prot len -> pseudoHeader src dst prot len
    {-# INLINE pseudoHeader #-}
  
    lookupRoute ns (Addr4 dst) =
      do ri <- lookupRoute ns dst
         return (fmap (fmap Addr4) ri)
    {-# INLINE lookupRoute #-}
  
    sendDatagram' ns dev (Addr4 src) (Addr4 dst) (Addr4 next) =
      sendDatagram' ns dev src dst next
    {-# INLINE sendDatagram' #-}
  
  
  
  -- IP4 -------------------------------------------------------------------------
  
  instance Network IP4.IP4 where
    pseudoHeader = IP4.ip4PseudoHeader
    {-# INLINE pseudoHeader #-}
  
    lookupRoute ns ip4 =
      do mb <- IP4.lookupRoute4 (view networkStack ns) ip4
         case mb of
           Just (riSource,riNext,riDev) -> return $! Just RouteInfo { .. }
           Nothing                      -> return Nothing
    {-# INLINE lookupRoute #-}
  
    sendDatagram' ns dev src dst df next =
      IP4.primSendIP4 (view networkStack ns) dev src dst df next
    {-# INLINE sendDatagram' #-}
  