{-# LANGUAGE RecordWildCards #-} module Hans.Types ( module Hans.Types, module Exports ) where import Hans.Config (Config,HasConfig(..)) import Hans.Device.Types (Device) import Hans.IP4.ArpTable as Exports (ArpTable) import Hans.IP4.Packet import Hans.IP4.State as Exports import Hans.IP4.RoutingTable as Exports (RoutingTable) import Hans.Lens import Hans.Nat.State as Exports import Hans.Tcp.State as Exports import Hans.Udp.State as Exports import Control.Concurrent (ThreadId) import Control.Concurrent.BoundedChan (BoundedChan) import qualified Data.ByteString as S import Data.IORef (IORef,atomicModifyIORef',readIORef) data InputPacket = FromDevice !Device !S.ByteString | FromIP4 !Device !IP4Header !S.ByteString data NetworkStack = NetworkStack { nsConfig :: !Config -- ^ The configuration for this instance of -- the network stack. , nsNat :: !NatState -- ^ Nat table/config , nsInput :: !(BoundedChan InputPacket) -- ^ The input packet queue , nsDevices :: {-# UNPACK #-} !(IORef [Device]) -- ^ All registered devices , nsIP4State :: !IP4State -- ^ State for IP4 processing , nsIP4Responder :: !ThreadId -- ^ Internal IP4 responder for messages -- produced in teh fast path. , nsUdpState :: !UdpState -- ^ State for UDP processing , nsUdpResponder :: !ThreadId -- ^ Responder thread for UDP messages -- produced in the fast path. , nsTcpState :: !TcpState -- ^ State for TCP processing , nsTcpResponder :: !ThreadId -- ^ Responder thread for TCP messages -- produced in the fast path. , nsTcpTimers :: !ThreadId -- ^ The TCP timer thread , nsNameServers4 :: !(IORef [IP4]) } instance HasConfig NetworkStack where config = to nsConfig {-# INLINE config #-} instance HasIP4State NetworkStack where ip4State = to nsIP4State {-# INLINE ip4State #-} instance HasUdpState NetworkStack where udpState = to nsUdpState {-# INLINE udpState #-} instance HasTcpState NetworkStack where tcpState = to nsTcpState {-# INLINE tcpState #-} instance HasNatState NetworkStack where natState = to nsNat {-# INLINE natState #-} class HasNetworkStack ns where networkStack :: Getting r ns NetworkStack instance HasNetworkStack NetworkStack where networkStack = id {-# INLINE networkStack #-} addNameServer4 :: HasNetworkStack ns => ns -> IP4 -> IO () addNameServer4 ns addr = atomicModifyIORef' (nsNameServers4 (view networkStack ns)) (\addrs -> (addr:addrs,())) getNameServers4 :: HasNetworkStack ns => ns -> IO [IP4] getNameServers4 ns = readIORef (nsNameServers4 (view networkStack ns))