content: {-# LANGUAGE PatternSynonyms #-}
  
  {- | The 'Hans.Message.Dhcp4' module defines the various messages and
     transitions used in the DHCPv4 protocol. This module provides both
     a high-level view of the message types as well as a low-level
     intermediate form which is closely tied to the binary format.
  
     References:
     RFC 2131 - Dynamic Host Configuration Protocol
     http://www.faqs.org/rfcs/rfc2131.html
  -}
  
  module Hans.IP4.Dhcp.Packet
    (
    -- ** High-level client types
      RequestMessage(..)
    , Request(..)
    , Discover(..)
  
    -- ** High-level server types
    , ServerSettings(..)
    , ReplyMessage(..)
    , Ack(..)
    , Offer(..)
  
    -- ** Low-level message types
    , Dhcp4Message(..)
    , Xid(..)
  
    -- ** Server message transition logic
    , requestToAck
    , discoverToOffer
  
    -- ** Client message transition logic
    , mkDiscover
    , offerToRequest
  
    -- ** Convert high-level message types to low-level format
    , requestToMessage
    , ackToMessage
    , offerToMessage
    , discoverToMessage
  
    -- ** Convert low-level message type to high-level format
    , parseDhcpMessage
  
    -- ** Convert low-level message type to binary format
    , getDhcp4Message
    , putDhcp4Message
  
    ) where
  
  import Hans.Ethernet (Mac)
  import Hans.IP4.Dhcp.Codec
  import Hans.IP4.Dhcp.Options
  import Hans.IP4.Packet (IP4(..),pattern WildcardIP4)
  
  import qualified Control.Applicative as A
  import           Control.Monad (unless)
  import           Data.Bits (testBit,bit)
  import qualified Data.ByteString as BS
  import qualified Data.ByteString.Char8 as BS8
  import           Data.Maybe (mapMaybe)
  import           Data.Serialize.Get
                       (Get,getByteString,isolate,remaining,label,skip)
  import           Data.Serialize.Put (Put,putByteString)
  import           Data.Word (Word8,Word16,Word32)
  import           Numeric (showHex)
  
  
  -- DHCP Static Server Settings ---------------------------------------------
  
  -- |'ServerSettings' define all of the information that would be needed to
  -- act as a DHCP server for one client. The server is defined to be able to
  -- issue a single "lease" whose parameters are defined below.
  data ServerSettings = Settings
    { staticServerAddr :: !IP4 -- ^ The IPv4 address of the DHCP server
    , staticTimeOffset :: !Word32 -- ^ Lease: timezone offset in seconds from UTC
    , staticClientAddr :: !IP4    -- ^ Lease: client IPv4 address on network
    , staticLeaseTime  :: !Word32 -- ^ Lease: duration in seconds
    , staticSubnet     :: !SubnetMask -- ^ Lease: subnet mask on network
    , staticBroadcast  :: !IP4 -- ^ Lease: broadcast address on network
    , staticRouters    :: [IP4] -- ^ Lease: gateway routers on network
    , staticDomainName :: String -- ^ Lease: client's assigned domain name
    , staticDNS        :: [IP4] -- ^ Lease: network DNS servers
    } deriving (Show)
  
  -- Structured DHCP Messages ------------------------------------------------
  
  -- |'RequestMessage' is a sum of the client request messages.
  data RequestMessage = RequestMessage  !Request
                      | DiscoverMessage !Discover
                        deriving (Show)
  
  -- |'ReplyMessage' is a sum of the server response messages.
  data ReplyMessage   = AckMessage   !Ack
                      | OfferMessage !Offer
                        deriving (Show)
  
  -- |'Request' is used by the client to accept an offered lease.
  data Request = Request
    { requestXid :: !Xid
      -- ^ Transaction ID of offer
  
    , requestBroadcast :: Bool
      -- ^ Set 'True' to instruct server to send to broadcast hardware address
  
    , requestServerAddr :: !IP4
  
    , requestClientHardwareAddress :: !Mac
      -- ^ Hardware address of the client
  
    , requestParameters :: [Dhcp4OptionTag]
      -- ^ Used to specify the information that client needs
  
    , requestAddress :: Maybe IP4
      -- ^ Used to specify the address which was accepted
    } deriving (Show)
  
  
  -- |'Discover' is used by the client to discover what servers are available.
  -- This message is sent to the IPv4 broadcast.
  data Discover = Discover
    { discoverXid :: !Xid
      -- ^ Transaction ID of this and subsequent messages
  
    , discoverBroadcast :: Bool
      -- ^ Set 'True' to instruct the server to send to broadcast hardware address
  
    , discoverClientHardwareAddr :: !Mac
      -- ^ Hardware address of the client
  
    , discoverParameters :: [Dhcp4OptionTag]
      -- ^ Used to specify the information that client needs in the offers
    } deriving (Show)
  
  -- |'Ack' is sent by the DHCPv4 server to acknowledge a sucessful 'Request'
  -- message. Upon receiving this message the client has completed the
  -- exchange and has successfully obtained a lease.
  data Ack = Ack
    { ackHops :: !Word8
      -- ^ The maximum number of relays this message can use.
  
    , ackXid  :: !Xid
      -- ^ Transaction ID for this exchange
  
    , ackYourAddr :: !IP4
      -- ^ Lease: assigned client address
  
    , ackServerAddr :: !IP4
      -- ^ DHCP server's IPv4 address
  
    , ackRelayAddr :: !IP4
      -- ^ DHCP relay server's address
  
    , ackClientHardwareAddr :: !Mac
      -- ^ Client's hardware address
  
    , ackLeaseTime :: !Word32
      -- ^ Lease: duration of lease in seconds
  
    , ackOptions :: [Dhcp4Option]
      -- ^ Subset of information requested in previous 'Request'
    } deriving (Show)
  
  -- |'Offer' is sent by the DHCPv4 server in response to a 'Discover'.
  -- This offer is only valid for a short period of time as the client
  -- might receive many offers. The client must next request a lease
  -- from a specific server using the information in that server's offer.
  data Offer = Offer
    { offerHops :: !Word8
      -- ^ The maximum number of relays this message can use.
  
    , offerXid  :: !Xid
      -- ^ Transaction ID of this exchange
  
    , offerYourAddr :: !IP4
      -- ^ The IPv4 address that this server is willing to lease
  
    , offerServerAddr :: !IP4
      -- ^ The IPv4 address of the DHCPv4 server
  
    , offerRelayAddr :: !IP4
      -- ^ The IPv4 address of the DHCPv4 relay server
  
    , offerClientHardwareAddr :: !Mac
      -- ^ The hardware address of the client
  
    , offerOptions :: [Dhcp4Option]
      -- ^ The options that this server would include in a lease
    } deriving (Show)
  
  -- |'requestToAck' creates 'Ack' messages suitable for responding to 'Request'
  -- messages given a static 'ServerSettings' configuration.
  requestToAck :: ServerSettings -- ^ DHCPv4 server settings
               -> Request        -- ^ Client's request message
               -> Ack
  requestToAck settings request = Ack
    { ackHops             = 1
    , ackXid              = requestXid request
    , ackYourAddr         = staticClientAddr settings
    , ackServerAddr       = staticServerAddr settings
    , ackRelayAddr        = staticServerAddr settings
    , ackClientHardwareAddr = requestClientHardwareAddress request
    , ackLeaseTime        = staticLeaseTime settings
    , ackOptions          = mapMaybe lookupOption (requestParameters request)
    }
    where
    lookupOption tag = case tag of
       OptTagSubnetMask
         -> Just (OptSubnetMask (staticSubnet settings))
       OptTagBroadcastAddress
         -> Just (OptBroadcastAddress (staticBroadcast settings))
       OptTagTimeOffset
         -> Just (OptTimeOffset (staticTimeOffset settings))
       OptTagRouters
         -> Just (OptRouters (staticRouters settings))
       OptTagDomainName
         -> Just (OptDomainName (NVTAsciiString (staticDomainName settings)))
       OptTagNameServers
         -> Just (OptNameServers (staticDNS settings))
       _ -> Nothing
  
  -- |'discoverToOffer' creates a suitable 'Offer' in response to a client's
  -- 'Discover' message using the configuration settings specified in the
  -- given 'ServerSettings'.
  discoverToOffer :: ServerSettings -- ^ DHCPv4 server settings
                  -> Discover -- ^ Client's discover message
                  -> Offer
  discoverToOffer settings discover = Offer
    { offerHops             = 1
    , offerXid              = discoverXid discover
    , offerYourAddr         = staticClientAddr settings
    , offerServerAddr       = staticServerAddr settings
    , offerRelayAddr        = staticServerAddr settings
    , offerClientHardwareAddr = discoverClientHardwareAddr discover
    , offerOptions          = mapMaybe lookupOption (discoverParameters discover)
    }
    where
    lookupOption tag = case tag of
       OptTagSubnetMask
         -> Just (OptSubnetMask (staticSubnet settings))
       OptTagBroadcastAddress
         -> Just (OptBroadcastAddress (staticBroadcast settings))
       OptTagTimeOffset
         -> Just (OptTimeOffset (staticTimeOffset settings))
       OptTagRouters
         -> Just (OptRouters (staticRouters settings))
       OptTagDomainName
         -> Just (OptDomainName (NVTAsciiString (staticDomainName settings)))
       OptTagNameServers
         -> Just (OptNameServers (staticDNS settings))
       _ -> Nothing
  
  -- Unstructured DHCP Message -----------------------------------------------
  
  -- |'Dhcp4Message' is a low-level message container that is very close to
  -- the binary representation of DHCPv4 message. It is suitable for containing
  -- any DHCPv4 message. Values of this type should only be created using the
  -- publicly exported functions.
  data Dhcp4Message = Dhcp4Message
    { dhcp4Op :: Dhcp4Op
      -- ^ Message op code / message type. 1 = BOOTREQUEST, 2 = BOOTREPLY
  
    , dhcp4Hops :: !Word8
      -- ^ Client sets to zero, optionally used by relay agents when booting via a
      -- relay agent.
  
    , dhcp4Xid :: !Xid
      -- ^ Transaction ID, a random number chosen by the client, used by the
      -- client and server to associate messages and responses between a client
      -- and a server.
  
    , dhcp4Secs :: !Word16
      -- ^ Filled in by client, seconds elapsed since client began address
      -- acquisition or renewal process.
  
    , dhcp4Broadcast :: Bool
      -- ^ Client requests messages be sent to hardware broadcast address
  
    , dhcp4ClientAddr :: !IP4
      -- ^ Client IP address; only filled in if client is in BOUND, RENEW or
      -- REBINDING state and can respond to ARP requests.
  
    , dhcp4YourAddr :: !IP4
      -- ^ 'your' (client) address
  
    , dhcp4ServerAddr :: !IP4
      -- ^ IP address of next server to use in bootstrap; returned in DHCPOFFER,
      -- DHCPACK by server
  
    , dhcp4RelayAddr :: !IP4
      -- ^ Relay agent IP address, used in booting via a relay agent
  
    , dhcp4ClientHardwareAddr :: !Mac
      -- ^ Client hardware address
  
    , dhcp4ServerHostname :: String
      -- ^ Optional server host name, null terminated string
  
    , dhcp4BootFilename :: String
      -- ^ Boot file name, full terminated string; "generic" name of null in
      -- DHCPDISCOVER, fully qualified directory-path name in DHCPOFFER
  
    , dhcp4Options :: [Dhcp4Option]
      -- ^ Optional parameters field.
    } deriving (Eq,Show)
  
  -- |'getDhcp4Message' is the binary decoder for parsing 'Dhcp4Message' values.
  getDhcp4Message :: Get Dhcp4Message
  getDhcp4Message =
    do op     <- getAtom
       hwtype <- getAtom
       len    <- getAtom
       unless (len == hardwareTypeAddressLength hwtype)
         (fail "Hardware address length does not match hardware type.")
       hops        <- label "hops" getAtom
       xid         <- label "xid" getAtom
       secs        <- label "secs" getAtom
       flags       <- label "flags" getAtom
       ciaddr      <- label "ciaddr" getAtom
       yiaddr      <- label "yiaddr" getAtom
       siaddr      <- label "siaddr" getAtom
       giaddr      <- label "giaddr" getAtom
       chaddr      <- label "chaddr" $ isolate 16 $ getAtom A.<* (skip =<< remaining)
       snameBytes  <- label "sname field" (getByteString 64)
       fileBytes   <- label "file field" (getByteString 128)
       (sname, file, opts) <- getDhcp4Options snameBytes fileBytes
       return $! Dhcp4Message
         { dhcp4Op                         = op
         , dhcp4Hops                       = hops
         , dhcp4Xid                        = xid
         , dhcp4Secs                       = secs
         , dhcp4Broadcast                  = broadcastFlag flags
         , dhcp4ClientAddr                 = ciaddr
         , dhcp4YourAddr                   = yiaddr
         , dhcp4ServerAddr                 = siaddr
         , dhcp4RelayAddr                  = giaddr
         , dhcp4ClientHardwareAddr         = chaddr
         , dhcp4ServerHostname             = sname
         , dhcp4BootFilename               = file
         , dhcp4Options                    = opts
         }
  
  -- |'getDhcp4Message' is the binary encoder for rendering 'Dhcp4Message' values.
  putDhcp4Message :: Dhcp4Message -> Put
  putDhcp4Message dhcp =
    do putAtom (dhcp4Op dhcp)
       let hwType = Ethernet
       putAtom hwType
       putAtom (hardwareTypeAddressLength hwType)
       putAtom (dhcp4Hops dhcp)
       putAtom (dhcp4Xid  dhcp)
       putAtom (dhcp4Secs dhcp)
       putAtom Flags { broadcastFlag = dhcp4Broadcast dhcp }
       putAtom (dhcp4ClientAddr dhcp)
       putAtom (dhcp4YourAddr dhcp)
       putAtom (dhcp4ServerAddr dhcp)
       putAtom (dhcp4RelayAddr dhcp)
       putAtom (dhcp4ClientHardwareAddr dhcp)
       putByteString $ BS.replicate (16 {- chaddr field length -}
                           - fromIntegral (hardwareTypeAddressLength hwType)) 0
       putPaddedByteString 64 (BS8.pack (dhcp4ServerHostname dhcp))
       putPaddedByteString 128 (BS8.pack (dhcp4BootFilename dhcp))
       putDhcp4Options (dhcp4Options dhcp)
  
  -- Transaction ID --------------------------------------------------------------
  
  -- |'Xid' is a Transaction ID, a random number chosen by the client,
  -- used by the client and server to associate messages and responses between a
  -- client and a server.
  newtype Xid = Xid Word32
   deriving (Eq, Show)
  
  instance CodecAtom Xid where
    getAtom =
      do w <- getAtom
         return (Xid w)
  
    putAtom (Xid xid) =
         putAtom xid
  
    atomSize _ =
         atomSize (0 :: Word32)
  
  -- Opcodes ---------------------------------------------------------------------
  
  data Dhcp4Op = BootRequest
               | BootReply
                 deriving (Eq,Show)
  
  instance CodecAtom Dhcp4Op where
    getAtom = do
      b <- getAtom
      case b :: Word8 of
        1 -> return BootRequest
        2 -> return BootReply
        _ -> fail ("Unknown DHCP op 0x" ++ showHex b "")
  
    putAtom BootRequest = putAtom (0x1 :: Word8)
    putAtom BootReply   = putAtom (0x2 :: Word8)
  
    atomSize _ = atomSize (0 :: Word8)
  
  -- | HardwareType is an enumeration of the supported hardware types as assigned
  --   in the ARP RFC http://www.iana.org/assignments/arp-parameters/
  data HardwareType = Ethernet
                      deriving (Eq, Show)
  
  instance CodecAtom HardwareType where
    getAtom =
      do b <- getAtom
         case b :: Word8 of
           1 -> return Ethernet
           _ -> fail ("Unsupported hardware type 0x" ++ showHex b "")
  
    putAtom Ethernet = putAtom (1 :: Word8)
  
    atomSize _ = atomSize (1 :: Word8)
  
  hardwareTypeAddressLength :: HardwareType -> Word8
  hardwareTypeAddressLength Ethernet = 6
  
  -- RFC 2131, Section 2, Page 11:
  --                      1 1 1 1 1 1
  --  0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5
  -- +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  -- |B|              MBZ            |
  -- +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  -- B:   BROADCAST flag
  -- MBZ:   MUST BE ZERO (reserved for future use)
  -- Figure 2: Format of the ’flags’ field
  
  data Flags = Flags { broadcastFlag :: Bool
                     } deriving (Show, Eq)
  
  instance CodecAtom Flags where
    getAtom =
      do b <- getAtom
         return Flags { broadcastFlag = testBit (b :: Word16) 15 }
  
    putAtom flags = putAtom $ if broadcastFlag flags then bit 15 :: Word16
                                                     else 0
  
    atomSize _ = atomSize (0 :: Word16)
  
  putPaddedByteString :: Int -> BS.ByteString -> Put
  putPaddedByteString n bs =
    do putByteString $ BS.take n bs
       putByteString $ BS.replicate (n - BS.length bs) 0
  
  
  selectKnownTags :: [OptionTagOrError] -> [Dhcp4OptionTag]
  selectKnownTags = mapMaybe aux
    where
    aux (KnownTag t) = Just t
    aux _ = Nothing
  
  --
  -- Unstructured to Structured logic
  --
  -- |'parseDhcpMessage' attempts to find a valid high-level message
  -- contained in a low-level message. The 'Dhcp4Message' is a large
  -- type and can encode invalid combinations of options.
  parseDhcpMessage :: Dhcp4Message -> Maybe (Either RequestMessage ReplyMessage)
  parseDhcpMessage msg =
    do messageType <- lookupMessageType (dhcp4Options msg)
       case dhcp4Op msg of
  
         BootRequest -> Left `fmap` case messageType of
  
           Dhcp4Request -> RequestMessage `fmap`
             do params <- lookupParams (dhcp4Options msg)
                let params' = selectKnownTags params
                let addr = lookupRequestAddr (dhcp4Options msg)
                return $! Request
                  { requestXid                          = dhcp4Xid msg
                  , requestBroadcast                    = dhcp4Broadcast msg
                  , requestServerAddr                   = dhcp4ServerAddr msg
                  , requestClientHardwareAddress        = dhcp4ClientHardwareAddr msg
                  , requestParameters                   = params'
                  , requestAddress                      = addr
                  }
  
           Dhcp4Discover -> DiscoverMessage `fmap`
             do params <- lookupParams (dhcp4Options msg)
                let params' = selectKnownTags params
                return $! Discover
                  { discoverXid                         = dhcp4Xid msg
                  , discoverBroadcast                   = dhcp4Broadcast msg
                  , discoverClientHardwareAddr          = dhcp4ClientHardwareAddr msg
                  , discoverParameters                  = params'
                  }
  
           _ -> Nothing
  
         BootReply -> Right `fmap` case messageType of
  
           Dhcp4Ack -> AckMessage `fmap`
             do leaseTime <- lookupLeaseTime (dhcp4Options msg)
                return Ack
                  { ackHops                             = dhcp4Hops msg
                  , ackXid                              = dhcp4Xid msg
                  , ackYourAddr                         = dhcp4YourAddr msg
                  , ackServerAddr                       = dhcp4ServerAddr msg
                  , ackRelayAddr                        = dhcp4RelayAddr msg
                  , ackClientHardwareAddr               = dhcp4ClientHardwareAddr msg
                  , ackLeaseTime                        = leaseTime
                  , ackOptions                          = dhcp4Options msg
                  }
  
           Dhcp4Offer -> return $! OfferMessage Offer
                  { offerHops                           = dhcp4Hops msg
                  , offerXid                            = dhcp4Xid msg
                  , offerYourAddr                       = dhcp4YourAddr msg
                  , offerServerAddr                     = getOfferServerAddr (dhcp4ServerAddr msg) (dhcp4Options msg)
                  , offerRelayAddr                      = dhcp4RelayAddr msg
                  , offerClientHardwareAddr             = dhcp4ClientHardwareAddr msg
                  , offerOptions                        = dhcp4Options msg
                  }
  
           _ -> Nothing
  
  
  getOfferServerAddr :: IP4 -> [Dhcp4Option] -> IP4
  getOfferServerAddr  = foldr check
    where
    check (OptServerIdentifier ip) _   = ip
    check _                        def = def
  
  --
  -- Structured to unstructured logic
  --
  -- |'discoverToMessage' embeds 'Discover' messages in the low-level
  -- 'Dhcp4Message' type, typically for the purpose of serialization.
  discoverToMessage :: Discover -> Dhcp4Message
  discoverToMessage discover = Dhcp4Message
    { dhcp4Op                     = BootRequest
    , dhcp4Hops                   = 0
    , dhcp4Xid                    = discoverXid discover
    , dhcp4Secs                   = 0
    , dhcp4Broadcast              = False
    , dhcp4ClientAddr             = WildcardIP4
    , dhcp4YourAddr               = WildcardIP4
    , dhcp4ServerAddr             = WildcardIP4
    , dhcp4RelayAddr              = WildcardIP4
    , dhcp4ClientHardwareAddr     = discoverClientHardwareAddr discover
    , dhcp4ServerHostname         = ""
    , dhcp4BootFilename           = ""
    , dhcp4Options                = [ OptMessageType Dhcp4Discover
                                    , OptParameterRequestList
                                        $ map KnownTag
                                        $ discoverParameters discover
                                    ]
    }
  
  -- |'ackToMessage' embeds 'Ack' messages in the low-level
  -- 'Dhcp4Message' type, typically for the purpose of serialization.
  ackToMessage :: Ack -> Dhcp4Message
  ackToMessage ack = Dhcp4Message
    { dhcp4Op                     = BootReply
    , dhcp4Hops                   = ackHops ack
    , dhcp4Xid                    = ackXid ack
    , dhcp4Secs                   = 0
    , dhcp4Broadcast              = False
    , dhcp4ClientAddr             = WildcardIP4
    , dhcp4YourAddr               = ackYourAddr ack
    , dhcp4ServerAddr             = ackServerAddr ack
    , dhcp4RelayAddr              = ackRelayAddr ack
    , dhcp4ClientHardwareAddr     = ackClientHardwareAddr ack
    , dhcp4ServerHostname         = ""
    , dhcp4BootFilename           = ""
    , dhcp4Options                = OptMessageType Dhcp4Ack
                                  : OptServerIdentifier (ackServerAddr ack)
                                  : OptIPAddressLeaseTime (ackLeaseTime ack)
                                  : ackOptions ack
    }
  
  -- |'offerToMessage' embeds 'Offer' messages in the low-level
  -- 'Dhcp4Message' type, typically for the purpose of serialization.
  offerToMessage :: Offer -> Dhcp4Message
  offerToMessage offer = Dhcp4Message
    { dhcp4Op                     = BootReply
    , dhcp4Hops                   = offerHops offer
    , dhcp4Xid                    = offerXid offer
    , dhcp4Secs                   = 0
    , dhcp4Broadcast              = False
    , dhcp4ClientAddr             = WildcardIP4
    , dhcp4YourAddr               = offerYourAddr offer
    , dhcp4ServerAddr             = offerServerAddr offer
    , dhcp4RelayAddr              = offerRelayAddr offer
    , dhcp4ClientHardwareAddr     = offerClientHardwareAddr offer
    , dhcp4ServerHostname         = ""
    , dhcp4BootFilename           = ""
    , dhcp4Options                = OptMessageType Dhcp4Offer
                                  : OptServerIdentifier (offerServerAddr offer)
                                  : offerOptions offer
    }
  
  -- |'requestToMessage' embeds 'Request' messages in the low-level
  -- 'Dhcp4Message' type, typically for the purpose of serialization.
  requestToMessage :: Request -> Dhcp4Message
  requestToMessage request = Dhcp4Message
    { dhcp4Op                     = BootRequest
    , dhcp4Hops                   = 0
    , dhcp4Xid                    = requestXid request
    , dhcp4Secs                   = 0
    , dhcp4Broadcast              = requestBroadcast request
    , dhcp4ClientAddr             = WildcardIP4
    , dhcp4YourAddr               = WildcardIP4
    , dhcp4ServerAddr             = WildcardIP4
    , dhcp4RelayAddr              = WildcardIP4
    , dhcp4ClientHardwareAddr     = requestClientHardwareAddress request
    , dhcp4ServerHostname         = ""
    , dhcp4BootFilename           = ""
    , dhcp4Options                = [ OptMessageType Dhcp4Request
                                    , OptServerIdentifier (requestServerAddr request)
                                    , OptParameterRequestList
                                         $ map KnownTag
                                         $ requestParameters request
                                    ] ++ maybe [] (\x -> [OptRequestIPAddress x])
                                          (requestAddress request)
    }
  
  -- |'mkDiscover' creates a new 'Discover' message with a set
  -- of options suitable for configuring a basic network stack.
  mkDiscover :: Xid -- ^ New randomly generated transaction ID
             -> Mac -- ^ The client's hardware address
             -> Discover
  mkDiscover xid mac = Discover
     { discoverXid                = xid
     , discoverBroadcast          = False
     , discoverClientHardwareAddr = mac
     , discoverParameters         = [ OptTagSubnetMask
                                    , OptTagBroadcastAddress
                                    , OptTagTimeOffset
                                    , OptTagRouters
                                    , OptTagDomainName
                                    , OptTagNameServers
                                    , OptTagHostName
                                    ]
     }
  
  -- |'offerToRequest' creates a 'Request' message suitable for accepting
  -- an 'Offer' from the DHCPv4 server.
  offerToRequest :: Offer -- ^ The offer as received from the server
                 -> Request
  offerToRequest offer = Request
    { requestXid                          = offerXid offer
    , requestBroadcast                    = False
    , requestServerAddr                   = offerServerAddr offer
    , requestClientHardwareAddress        = offerClientHardwareAddr offer
    , requestParameters                   = [ OptTagSubnetMask
                                            , OptTagBroadcastAddress
                                            , OptTagTimeOffset
                                            , OptTagRouters
                                            , OptTagDomainName
                                            , OptTagNameServers
                                            , OptTagHostName
                                            ]
    , requestAddress                      = Just (offerYourAddr offer)
    }
  