Encoding.hs

{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-|
Module      : Network.EAP.Encoding
Description : Provides on the wire de/coding of EAP packets as per RFC 3748
Copyright   : (c) Erick Gonzalez, 2017
License     : BSD3
Maintainer  : erick@codemonkeylabs.de
Stability   : experimental
Portability : POSIX

This basically provides Binary instances for the EAP Packet type and the embedded messages it
encapsulates. So you basically decode a (lazy) bytestring and get an EAP Packet back or you can
encode an EAP packet to ByteString you can send on the wire as is. Simple as that.

-}
module Network.EAP.Encoding where

import Data.Binary                     (Binary(..), encode, decode)
import Data.Binary.Get                 (Get,
                                        getRemainingLazyByteString,
                                        getLazyByteString,
                                        getWord8,
                                        getWord16be)
import Data.Binary.Put                 (putLazyByteString, putWord8, putWord16be)
import Data.Word                       (Word16)
import Network.EAP.Types

import qualified Data.ByteString.Lazy.Char8 as LB

instance Binary Packet where
    put Packet{..} = do
      let packetData   = encode getPacketMessage
          packetLength = fromIntegral $ 4 + LB.length packetData -- EAP header length is 4 bytes
      put getPacketType
      putWord8 getPacketId
      putWord16be packetLength
      putLazyByteString packetData

    get = do
      packetType   <- get
      packetId     <- getWord8
      packetLength <- getWord16be
      let dataLength = packetLength - 4
      packetMessage <- getMessage $ fromIntegral dataLength
      return $ Packet packetType packetId packetMessage

-- | Given the length of data to decode, decode an EAP message in the Get Monad. Used internally
-- so you probably don't need to use this.
getMessage :: Word16 -> Get (Maybe Message)
getMessage 0 = return Nothing
getMessage dataLength = do
  packetData <- getLazyByteString $ fromIntegral dataLength
  return . Just . decode $ packetData

instance Binary Message where
    put (IdentityMessage str)     = putLazyByteString str
    put (NotificationMessage str) = putLazyByteString str
    put (NakMessage value)        = putWord8 value
    put MD5ChallengeMessage{..}   = do
      putWord8 . fromIntegral . LB.length $ getMD5ChallengeValue
      putLazyByteString getMD5ChallengeValue
      putLazyByteString getMD5ChallengeName
    put (OTPMessage str)              = putLazyByteString str
    put (GenericTokenCardMessage str) = putLazyByteString str

    get = do
      messageType <- getWord8
      getMessage' messageType
        where getMessage' 1 = getRemainingLazyByteString >>= return . IdentityMessage
              getMessage' 2 = getRemainingLazyByteString >>= return . NotificationMessage
              getMessage' 3 = getWord8 >>= return . NakMessage
              getMessage' 4 = do
                valueSize <- getWord8
                value     <- getLazyByteString $ fromIntegral valueSize
                name      <- getRemainingLazyByteString
                return $ MD5ChallengeMessage value name
              getMessage' 5 = getRemainingLazyByteString >>= return . OTPMessage
              getMessage' 6 = getRemainingLazyByteString >>= return . GenericTokenCardMessage
              getMessage' n = fail $ "Invalid EAP Message Type " ++ show n

instance Binary PacketType where
    put = putWord8 . fromIntegral . fromEnum
    get = getWord8 >>= return . toEnum . fromIntegral