-----------------------------------------------------------------------------
-- |
-- Module      :  Etherbunny.Ethernet
-- Copyright   :  (c) Nicholas Burlett 2007
-- License     :  GPL (see the file LICENSE)
--
-- Maintainer  :  nickburlett@mac.com
-- Stability   :  experimental
-- Portability :  ghc
--
-- Ethernet Packet access for Etherbunny.
--
-----------------------------------------------------------------------------

{-# LANGUAGE GeneralizedNewtypeDeriving  #-}

module Network.Etherbunny.Ethernet (
    -- * Types
    MACAddr,
    EthType,
    EtherPkt,

    -- * Functions
    getEtherPacket -- :: ByteString -> EthPkt
) where

import Network.Etherbunny.Ip
import Network.Etherbunny.Packet

import Data.Word
import qualified Data.ByteString as B
import Data.Binary.Get
import Numeric
import Bits

-- |
--   The MACAddr type gives a useful interface to MAC Addresses
--

newtype MACAddr = MACAddr Word64
    deriving (Eq, Ord, Bits, Num, Integral, Enum, Real)

instance Show MACAddr where
    showsPrec _ (MACAddr m) =
        foldr (\i a -> showsHexByte (getWord m i)  ":" . a) (showsHexByte (getWord m 0)  "") $ [5,4..1]
        where
            getWord x i = (x `shiftR` (i*8)) .&. 0xff
--            showsHexByte :: forall t. (Integral t) => t -> String -> String -> String
            showsHexByte x a = showString $ tail $ showHex (16^(2 :: Int)+x) a

macFromList :: [Word8] -> MACAddr
macFromList  = wordsToInt 6


-- |
--   The EthType type is designed to show the type of payload in an Ethernet packet
--

newtype EthType = EthType Word16
    deriving (Num, Eq)

instance Show EthType where
    showsPrec _ (EthType e) =
        showString $ tail $ showHex ((16 :: Int)^(4 :: Int)+ 0x0800) $ " " ++ etherTypeName e

etherTypeName :: (Num a) => a -> [Char]
etherTypeName e
    | e == 0x0800   = "IP"
    | otherwise     = "Unknown"

-- ethTypeFromList :: [Word8] -> EthType
-- ethTypeFromList [f, f2] = EthType $ (fromIntegral f) `shiftL` 8 .|. (fromIntegral f2)


data EtherPayload = IPPkt IPPkt
    deriving (Show)

-- |
--   The EthPkt type defines an Ethernet II packet with another Packet payload
--

data EtherPkt = EtherPkt {
                 ethDestination :: !MACAddr,    -- ^ destination MAC address
                 ethSource      :: !MACAddr,    -- ^ source MAC address
                 ethType        :: !EthType,    -- ^ payload type
                 ethPayload     :: !(Maybe EtherPayload),      -- ^ payload
                 ethRemainder   :: !([Word8])     -- ^ anything remaining
               }

instance Show EtherPkt where
   showsPrec p pkt =
       showString "Ethernet II dest: " . showsPrec p (ethDestination pkt)
           . showString " src: " . showsPrec p (ethSource pkt)
           . showString " type: " . showsPrec p (ethType pkt)
           . showsPrec p (ethPayload pkt)
           . showsPrec p (ethRemainder pkt)

getMacAddress :: Get MACAddr
getMacAddress = do
    mac <- getByteString 6
    return $ macFromList $ B.unpack mac

getEtherPacket :: Get EtherPkt
getEtherPacket = do
    dst <- getMacAddress
    src <- getMacAddress
    typ <- getWord16be
    payload <- do
        case typ of
            0x0800    -> do
                payload <- getIPPacket
                return $ Just $ IPPkt payload
            _ -> return Nothing
    numRemain <- remaining
    remain <- getByteString $ fromIntegral numRemain
    return $ EtherPkt dst src (EthType typ) payload (B.unpack remain)