module Net.DHCP where

-- Dynamic Host Configuration Protocol, RFC 2131
-- See http://www.networksorcery.com/enp/protocol/dhcp.htm
--     http://rfc.sunsite.dk/rfc/rfc2131.html
--     http://rfc.sunsite.dk/rfc/rfc1533.html (DHCP/BOOTP options)

import Net.Bits(Word8,Word16,Word32,testBit)
import qualified Net.IPv4 as IP
import qualified Net.Ethernet as Eth
import Net.PacketParsing
import Net.PortNumber

serverPort :: Port
serverPort = Port
bootps
clientPort :: Port
clientPort = Port
bootpc

data Packet = Packet
            { Packet -> Operation
opcode::Operation, -- 1 byte
	      --hwType::Word8, -- always 0x01 (Ethernet)
	      --hLen::Word8, -- always 6
              --hOps::Word8, -- 0 except when booting via relay agents
	      Packet -> Word32
xid::Word32, -- Transaction ID, randomly chosen by the client
	      Packet -> Word16
secs::Word16,
	      Packet -> Flags
flags::Flags, -- 2 bytes
	      Packet -> Addr
ciaddr,Packet -> Addr
yiaddr,Packet -> Addr
siaddr,Packet -> Addr
giaddr::IP.Addr,
	      Packet -> Addr
chaddr::Eth.Addr, -- 16 bytes!
	      Packet -> String
sname::String, -- null terminated, 64 bytes
	      Packet -> String
file::String, -- null terminated, 128 bytes
	      Packet -> Options
options::Options -- upto 312 bytes for options
	    }
	    deriving (Int -> Packet -> ShowS
[Packet] -> ShowS
Packet -> String
(Int -> Packet -> ShowS)
-> (Packet -> String) -> ([Packet] -> ShowS) -> Show Packet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Packet -> ShowS
showsPrec :: Int -> Packet -> ShowS
$cshow :: Packet -> String
show :: Packet -> String
$cshowList :: [Packet] -> ShowS
showList :: [Packet] -> ShowS
Show)

data Operation = BootRequest | BootReply deriving (Operation -> Operation -> Bool
(Operation -> Operation -> Bool)
-> (Operation -> Operation -> Bool) -> Eq Operation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Operation -> Operation -> Bool
== :: Operation -> Operation -> Bool
$c/= :: Operation -> Operation -> Bool
/= :: Operation -> Operation -> Bool
Eq,Operation
Operation -> Operation -> Bounded Operation
forall a. a -> a -> Bounded a
$cminBound :: Operation
minBound :: Operation
$cmaxBound :: Operation
maxBound :: Operation
Bounded,Int -> Operation
Operation -> Int
Operation -> [Operation]
Operation -> Operation
Operation -> Operation -> [Operation]
Operation -> Operation -> Operation -> [Operation]
(Operation -> Operation)
-> (Operation -> Operation)
-> (Int -> Operation)
-> (Operation -> Int)
-> (Operation -> [Operation])
-> (Operation -> Operation -> [Operation])
-> (Operation -> Operation -> [Operation])
-> (Operation -> Operation -> Operation -> [Operation])
-> Enum Operation
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Operation -> Operation
succ :: Operation -> Operation
$cpred :: Operation -> Operation
pred :: Operation -> Operation
$ctoEnum :: Int -> Operation
toEnum :: Int -> Operation
$cfromEnum :: Operation -> Int
fromEnum :: Operation -> Int
$cenumFrom :: Operation -> [Operation]
enumFrom :: Operation -> [Operation]
$cenumFromThen :: Operation -> Operation -> [Operation]
enumFromThen :: Operation -> Operation -> [Operation]
$cenumFromTo :: Operation -> Operation -> [Operation]
enumFromTo :: Operation -> Operation -> [Operation]
$cenumFromThenTo :: Operation -> Operation -> Operation -> [Operation]
enumFromThenTo :: Operation -> Operation -> Operation -> [Operation]
Enum,Int -> Operation -> ShowS
[Operation] -> ShowS
Operation -> String
(Int -> Operation -> ShowS)
-> (Operation -> String)
-> ([Operation] -> ShowS)
-> Show Operation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Operation -> ShowS
showsPrec :: Int -> Operation -> ShowS
$cshow :: Operation -> String
show :: Operation -> String
$cshowList :: [Operation] -> ShowS
showList :: [Operation] -> ShowS
Show)
data Flags = Flags {Flags -> Bool
broadcast::Bool} deriving (Flags -> Flags -> Bool
(Flags -> Flags -> Bool) -> (Flags -> Flags -> Bool) -> Eq Flags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Flags -> Flags -> Bool
== :: Flags -> Flags -> Bool
$c/= :: Flags -> Flags -> Bool
/= :: Flags -> Flags -> Bool
Eq,Int -> Flags -> ShowS
[Flags] -> ShowS
Flags -> String
(Int -> Flags -> ShowS)
-> (Flags -> String) -> ([Flags] -> ShowS) -> Show Flags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Flags -> ShowS
showsPrec :: Int -> Flags -> ShowS
$cshow :: Flags -> String
show :: Flags -> String
$cshowList :: [Flags] -> ShowS
showList :: [Flags] -> ShowS
Show)

newtype Options = Options [Option] deriving (Options -> Options -> Bool
(Options -> Options -> Bool)
-> (Options -> Options -> Bool) -> Eq Options
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Options -> Options -> Bool
== :: Options -> Options -> Bool
$c/= :: Options -> Options -> Bool
/= :: Options -> Options -> Bool
Eq,Int -> Options -> ShowS
[Options] -> ShowS
Options -> String
(Int -> Options -> ShowS)
-> (Options -> String) -> ([Options] -> ShowS) -> Show Options
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Options -> ShowS
showsPrec :: Int -> Options -> ShowS
$cshow :: Options -> String
show :: Options -> String
$cshowList :: [Options] -> ShowS
showList :: [Options] -> ShowS
Show)

data Option
  = Pad -- 0
  | End -- 255
  | SubnetMask IP.Addr -- 1
  | TimeOffset -- 2
  | Routers [IP.Addr] -- 3
  | DNS_Servers [IP.Addr] -- 6
  | HostName String -- 12
  | DomainName String -- 15
  | BroadcastAddress IP.Addr -- 28
  | NTP_Servers [IP.Addr] -- 42
  | RequestedIPAddress IP.Addr -- 50
  | LeaseTime Word32 -- 51
  | OptionOverload Word8 -- 52
  | MessageType MessageType -- 53
  | ServerIdentifier IP.Addr -- 54
  | Unknown Word8 [Word8] -- unimplemented/unsupported option
  deriving (Option -> Option -> Bool
(Option -> Option -> Bool)
-> (Option -> Option -> Bool) -> Eq Option
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Option -> Option -> Bool
== :: Option -> Option -> Bool
$c/= :: Option -> Option -> Bool
/= :: Option -> Option -> Bool
Eq,Int -> Option -> ShowS
[Option] -> ShowS
Option -> String
(Int -> Option -> ShowS)
-> (Option -> String) -> ([Option] -> ShowS) -> Show Option
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Option -> ShowS
showsPrec :: Int -> Option -> ShowS
$cshow :: Option -> String
show :: Option -> String
$cshowList :: [Option] -> ShowS
showList :: [Option] -> ShowS
Show)

data MessageType
  = Discover -- 1
  | Offer
  | Request
  | Decline
  | Ack
  | Nak
  | Release
  | Inform -- 8
  deriving (MessageType -> MessageType -> Bool
(MessageType -> MessageType -> Bool)
-> (MessageType -> MessageType -> Bool) -> Eq MessageType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MessageType -> MessageType -> Bool
== :: MessageType -> MessageType -> Bool
$c/= :: MessageType -> MessageType -> Bool
/= :: MessageType -> MessageType -> Bool
Eq,MessageType
MessageType -> MessageType -> Bounded MessageType
forall a. a -> a -> Bounded a
$cminBound :: MessageType
minBound :: MessageType
$cmaxBound :: MessageType
maxBound :: MessageType
Bounded,Int -> MessageType
MessageType -> Int
MessageType -> [MessageType]
MessageType -> MessageType
MessageType -> MessageType -> [MessageType]
MessageType -> MessageType -> MessageType -> [MessageType]
(MessageType -> MessageType)
-> (MessageType -> MessageType)
-> (Int -> MessageType)
-> (MessageType -> Int)
-> (MessageType -> [MessageType])
-> (MessageType -> MessageType -> [MessageType])
-> (MessageType -> MessageType -> [MessageType])
-> (MessageType -> MessageType -> MessageType -> [MessageType])
-> Enum MessageType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: MessageType -> MessageType
succ :: MessageType -> MessageType
$cpred :: MessageType -> MessageType
pred :: MessageType -> MessageType
$ctoEnum :: Int -> MessageType
toEnum :: Int -> MessageType
$cfromEnum :: MessageType -> Int
fromEnum :: MessageType -> Int
$cenumFrom :: MessageType -> [MessageType]
enumFrom :: MessageType -> [MessageType]
$cenumFromThen :: MessageType -> MessageType -> [MessageType]
enumFromThen :: MessageType -> MessageType -> [MessageType]
$cenumFromTo :: MessageType -> MessageType -> [MessageType]
enumFromTo :: MessageType -> MessageType -> [MessageType]
$cenumFromThenTo :: MessageType -> MessageType -> MessageType -> [MessageType]
enumFromThenTo :: MessageType -> MessageType -> MessageType -> [MessageType]
Enum,Int -> MessageType -> ShowS
[MessageType] -> ShowS
MessageType -> String
(Int -> MessageType -> ShowS)
-> (MessageType -> String)
-> ([MessageType] -> ShowS)
-> Show MessageType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageType -> ShowS
showsPrec :: Int -> MessageType -> ShowS
$cshow :: MessageType -> String
show :: MessageType -> String
$cshowList :: [MessageType] -> ShowS
showList :: [MessageType] -> ShowS
Show)

--------------------------------------------------------------------------------

template :: Addr -> Packet
template Addr
mac =
     Packet { opcode :: Operation
opcode=Operation
BootRequest,
	      xid :: Word32
xid=Word32
0,
	      secs :: Word16
secs=Word16
0,
	      flags :: Flags
flags=Flags{broadcast :: Bool
broadcast=Bool
False},
	      ciaddr :: Addr
ciaddr=Addr
z,yiaddr :: Addr
yiaddr=Addr
z,siaddr :: Addr
siaddr=Addr
z,giaddr :: Addr
giaddr=Addr
z,
	      chaddr :: Addr
chaddr=Addr
mac,
	      sname :: String
sname=String
"",
	      file :: String
file=String
"",
	      options :: Options
options=[Option] -> Options
Options []
	    }
  where
    z :: Addr
z = Word8 -> Word8 -> Word8 -> Word8 -> Addr
IP.Addr Word8
0 Word8
0 Word8
0 Word8
0

--------------------------------------------------------------------------------

instance Parse Operation where parse :: PacketParser Operation
parse = Int -> Word8 -> PacketParser Operation
forall {a} {a}.
(Bounded a, Integral a, Enum a) =>
Int -> a -> PacketParser a
bounded Int
1 (Word8 -> PacketParser Operation)
-> PacketParser Word8 -> PacketParser Operation
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< PacketParser Word8
word8
instance Parse MessageType where parse :: PacketParser MessageType
parse = Int -> Word8 -> PacketParser MessageType
forall {a} {a}.
(Bounded a, Integral a, Enum a) =>
Int -> a -> PacketParser a
bounded Int
1 (Word8 -> PacketParser MessageType)
-> PacketParser Word8 -> PacketParser MessageType
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< PacketParser Word8
word8
instance Unparse MessageType where unparse :: MessageType -> UnparseS
unparse MessageType
t = Word8 -> UnparseS
forall a. Unparse a => a -> UnparseS
unparse (Int -> MessageType -> Word8
forall {b} {a}. (Num b, Enum a) => Int -> a -> b
unEnum Int
1 MessageType
t::Word8)
instance Unparse Operation where unparse :: Operation -> UnparseS
unparse Operation
t = Word8 -> UnparseS
forall a. Unparse a => a -> UnparseS
unparse (Int -> Operation -> Word8
forall {b} {a}. (Num b, Enum a) => Int -> a -> b
unEnum Int
1 Operation
t::Word8)

instance Parse Flags where
  parse :: PacketParser Flags
parse = do Word16
w <- PacketParser Word16
word16
	     Flags -> PacketParser Flags
forall a. a -> PacketParser a
forall (m :: * -> *) a. Monad m => a -> m a
return Flags{broadcast :: Bool
broadcast=Word16 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word16
w Int
15}

instance Unparse Flags where
  unparse :: Flags -> UnparseS
unparse Flags{broadcast :: Flags -> Bool
broadcast=Bool
b} = Word16 -> UnparseS
forall a. Unparse a => a -> UnparseS
unparse (if Bool
b then Word16
0x8000 else Word16
0::Word16)

magic :: [Word8]
magic = [Word8
99,Word8
130,Word8
83,Word8
99::Word8]

instance Parse Options where
  parse :: PacketParser Options
parse = do [Word8]
bs <- Integer -> PacketParser [Word8]
forall {t}. (Eq t, Num t) => t -> PacketParser [Word8]
bytes Integer
4
	     if [Word8]
bs[Word8] -> [Word8] -> Bool
forall a. Eq a => a -> a -> Bool
==[Word8]
magic
		then [Option] -> Options
Options ([Option] -> Options)
-> PacketParser [Option] -> PacketParser Options
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# PacketParser [Option]
po
		else Options -> PacketParser Options
forall a. a -> PacketParser a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Option] -> Options
Options [])
    where
      po :: PacketParser [Option]
po = do Option
o <- PacketParser Option
forall a. Parse a => PacketParser a
parse
	      case Option
o of
	        Option
End -> [Option] -> PacketParser [Option]
forall a. a -> PacketParser a
forall (m :: * -> *) a. Monad m => a -> m a
return []
		Option
_ -> (Option
oOption -> [Option] -> [Option]
forall a. a -> [a] -> [a]
:) ([Option] -> [Option])
-> PacketParser [Option] -> PacketParser [Option]
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# PacketParser [Option]
po

instance Unparse Options where
  unparse :: Options -> UnparseS
unparse (Options []) = () -> UnparseS
forall a. Unparse a => a -> UnparseS
unparse ()
  unparse (Options [Option]
os) = ([Word8], [Option], Option) -> UnparseS
forall a. Unparse a => a -> UnparseS
unparse ([Word8]
magic,[Option]
os,Option
End) -- pad to 312 bytes?

instance Unparse Option where
  unparse :: Option -> UnparseS
unparse Option
End = Word8 -> UnparseS
forall a. Unparse a => a -> UnparseS
unparse (Word8
255::Word8)
  unparse Option
Pad = Word8 -> UnparseS
forall a. Unparse a => a -> UnparseS
unparse (Word8
0::Word8)
  unparse (RequestedIPAddress Addr
ip) = ([Word8], Addr) -> UnparseS
forall a. Unparse a => a -> UnparseS
unparse  ([Word8
50,Word8
4::Word8],Addr
ip)
  unparse (MessageType MessageType
t) = ([Word8], MessageType) -> UnparseS
forall a. Unparse a => a -> UnparseS
unparse ([Word8
53,Word8
1::Word8],MessageType
t)
  unparse (ServerIdentifier Addr
ip) = ([Word8], Addr) -> UnparseS
forall a. Unparse a => a -> UnparseS
unparse  ([Word8
54,Word8
4::Word8],Addr
ip)
  unparse (Unknown Word8
b [Word8]
bs) = (Word8, Word8, [Word8]) -> UnparseS
forall a. Unparse a => a -> UnparseS
unparse (Word8
b,Word8
n,[Word8]
bs)
    where n :: Word8
n = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Word8] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
bs)::Word8

instance Parse Option where
  parse :: PacketParser Option
parse = do Word8
b <- PacketParser Word8
word8
	     case Word8
b of
	       Word8
0   -> Option -> PacketParser Option
forall a. a -> PacketParser a
forall (m :: * -> *) a. Monad m => a -> m a
return Option
Pad
	       Word8
1   -> do Word8 -> PacketParser ()
check8 Word8
4
		         Addr -> Option
SubnetMask (Addr -> Option) -> PacketParser Addr -> PacketParser Option
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# PacketParser Addr
forall a. Parse a => PacketParser a
parse
	       Word8
3   -> [Addr] -> Option
Routers ([Addr] -> Option) -> PacketParser [Addr] -> PacketParser Option
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# PacketParser [Addr]
ips
	       Word8
6   -> [Addr] -> Option
DNS_Servers ([Addr] -> Option) -> PacketParser [Addr] -> PacketParser Option
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# PacketParser [Addr]
ips
	       Word8
255 -> Option -> PacketParser Option
forall a. a -> PacketParser a
forall (m :: * -> *) a. Monad m => a -> m a
return Option
End
	       Word8
51  -> (Word32 -> Option) -> PacketParser (Word32 -> Option)
forall a. a -> PacketParser a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32 -> Option
LeaseTime        PacketParser (Word32 -> Option)
-> PacketParser () -> PacketParser (Word32 -> Option)
forall {m :: * -> *} {b} {a}. Monad m => m b -> m a -> m b
#! Word8 -> PacketParser ()
check8 Word8
4 PacketParser (Word32 -> Option)
-> PacketParser Word32 -> PacketParser Option
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Word32
forall a. Parse a => PacketParser a
parse
	       Word8
53  -> (MessageType -> Option) -> PacketParser (MessageType -> Option)
forall a. a -> PacketParser a
forall (m :: * -> *) a. Monad m => a -> m a
return MessageType -> Option
MessageType      PacketParser (MessageType -> Option)
-> PacketParser () -> PacketParser (MessageType -> Option)
forall {m :: * -> *} {b} {a}. Monad m => m b -> m a -> m b
#! Word8 -> PacketParser ()
check8 Word8
1 PacketParser (MessageType -> Option)
-> PacketParser MessageType -> PacketParser Option
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser MessageType
forall a. Parse a => PacketParser a
parse
	       Word8
54  -> (Addr -> Option) -> PacketParser (Addr -> Option)
forall a. a -> PacketParser a
forall (m :: * -> *) a. Monad m => a -> m a
return Addr -> Option
ServerIdentifier PacketParser (Addr -> Option)
-> PacketParser () -> PacketParser (Addr -> Option)
forall {m :: * -> *} {b} {a}. Monad m => m b -> m a -> m b
#! Word8 -> PacketParser ()
check8 Word8
4 PacketParser (Addr -> Option)
-> PacketParser Addr -> PacketParser Option
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Addr
forall a. Parse a => PacketParser a
parse
	       Word8
_   -> do Integer
n <- Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Integer) -> PacketParser Word8 -> PacketParser Integer
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# PacketParser Word8
word8
		         [Word8]
bs <- Integer -> PacketParser [Word8]
forall {t}. (Eq t, Num t) => t -> PacketParser [Word8]
bytes Integer
n
		         Option -> PacketParser Option
forall a. a -> PacketParser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> [Word8] -> Option
Unknown Word8
b [Word8]
bs)
    where
      ips :: PacketParser [Addr]
ips = do Int
n <- Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> PacketParser Word8 -> PacketParser Int
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# PacketParser Word8
word8
               Int -> PacketParser [Addr]
forall {a}. Parse a => Int -> PacketParser [a]
parses (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4)

parses :: Int -> PacketParser [a]
parses Int
n = [PacketParser a] -> PacketParser [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence (Int -> PacketParser a -> [PacketParser a]
forall a. Int -> a -> [a]
replicate Int
n PacketParser a
forall a. Parse a => PacketParser a
parse)

instance Parse Packet where
  parse :: PacketParser Packet
parse = Operation
-> Word32
-> Word16
-> Flags
-> Addr
-> Addr
-> Addr
-> Addr
-> Addr
-> String
-> String
-> Options
-> Packet
Packet (Operation
 -> Word32
 -> Word16
 -> Flags
 -> Addr
 -> Addr
 -> Addr
 -> Addr
 -> Addr
 -> String
 -> String
 -> Options
 -> Packet)
-> PacketParser Operation
-> PacketParser
     (Word32
      -> Word16
      -> Flags
      -> Addr
      -> Addr
      -> Addr
      -> Addr
      -> Addr
      -> String
      -> String
      -> Options
      -> Packet)
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
#  PacketParser Operation
forall a. Parse a => PacketParser a
parse PacketParser
  (Word32
   -> Word16
   -> Flags
   -> Addr
   -> Addr
   -> Addr
   -> Addr
   -> Addr
   -> String
   -> String
   -> Options
   -> Packet)
-> PacketParser ()
-> PacketParser
     (Word32
      -> Word16
      -> Flags
      -> Addr
      -> Addr
      -> Addr
      -> Addr
      -> Addr
      -> String
      -> String
      -> Options
      -> Packet)
forall {m :: * -> *} {b} {a}. Monad m => m b -> m a -> m b
#! Word8 -> PacketParser ()
check8 Word8
1 PacketParser
  (Word32
   -> Word16
   -> Flags
   -> Addr
   -> Addr
   -> Addr
   -> Addr
   -> Addr
   -> String
   -> String
   -> Options
   -> Packet)
-> PacketParser ()
-> PacketParser
     (Word32
      -> Word16
      -> Flags
      -> Addr
      -> Addr
      -> Addr
      -> Addr
      -> Addr
      -> String
      -> String
      -> Options
      -> Packet)
forall {m :: * -> *} {b} {a}. Monad m => m b -> m a -> m b
#! Word8 -> PacketParser ()
check8 Word8
6 PacketParser
  (Word32
   -> Word16
   -> Flags
   -> Addr
   -> Addr
   -> Addr
   -> Addr
   -> Addr
   -> String
   -> String
   -> Options
   -> Packet)
-> PacketParser Word8
-> PacketParser
     (Word32
      -> Word16
      -> Flags
      -> Addr
      -> Addr
      -> Addr
      -> Addr
      -> Addr
      -> String
      -> String
      -> Options
      -> Packet)
forall {m :: * -> *} {b} {a}. Monad m => m b -> m a -> m b
#! PacketParser Word8
word8
		 PacketParser
  (Word32
   -> Word16
   -> Flags
   -> Addr
   -> Addr
   -> Addr
   -> Addr
   -> Addr
   -> String
   -> String
   -> Options
   -> Packet)
-> PacketParser Word32
-> PacketParser
     (Word16
      -> Flags
      -> Addr
      -> Addr
      -> Addr
      -> Addr
      -> Addr
      -> String
      -> String
      -> Options
      -> Packet)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Word32
forall a. Parse a => PacketParser a
parse PacketParser
  (Word16
   -> Flags
   -> Addr
   -> Addr
   -> Addr
   -> Addr
   -> Addr
   -> String
   -> String
   -> Options
   -> Packet)
-> PacketParser Word16
-> PacketParser
     (Flags
      -> Addr
      -> Addr
      -> Addr
      -> Addr
      -> Addr
      -> String
      -> String
      -> Options
      -> Packet)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Word16
forall a. Parse a => PacketParser a
parse PacketParser
  (Flags
   -> Addr
   -> Addr
   -> Addr
   -> Addr
   -> Addr
   -> String
   -> String
   -> Options
   -> Packet)
-> PacketParser Flags
-> PacketParser
     (Addr
      -> Addr
      -> Addr
      -> Addr
      -> Addr
      -> String
      -> String
      -> Options
      -> Packet)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Flags
forall a. Parse a => PacketParser a
parse
		 PacketParser
  (Addr
   -> Addr
   -> Addr
   -> Addr
   -> Addr
   -> String
   -> String
   -> Options
   -> Packet)
-> PacketParser Addr
-> PacketParser
     (Addr
      -> Addr -> Addr -> Addr -> String -> String -> Options -> Packet)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Addr
forall a. Parse a => PacketParser a
parse PacketParser
  (Addr
   -> Addr -> Addr -> Addr -> String -> String -> Options -> Packet)
-> PacketParser Addr
-> PacketParser
     (Addr -> Addr -> Addr -> String -> String -> Options -> Packet)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Addr
forall a. Parse a => PacketParser a
parse PacketParser
  (Addr -> Addr -> Addr -> String -> String -> Options -> Packet)
-> PacketParser Addr
-> PacketParser
     (Addr -> Addr -> String -> String -> Options -> Packet)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Addr
forall a. Parse a => PacketParser a
parse PacketParser
  (Addr -> Addr -> String -> String -> Options -> Packet)
-> PacketParser Addr
-> PacketParser (Addr -> String -> String -> Options -> Packet)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Addr
forall a. Parse a => PacketParser a
parse
		 PacketParser (Addr -> String -> String -> Options -> Packet)
-> PacketParser Addr
-> PacketParser (String -> String -> Options -> Packet)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Addr
forall a. Parse a => PacketParser a
parse
		 #! bytes 10
		 PacketParser (String -> String -> Options -> Packet)
-> PacketParser String
-> PacketParser (String -> Options -> Packet)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# Int -> PacketParser String
zstring Int
64
		 PacketParser (String -> Options -> Packet)
-> PacketParser String -> PacketParser (Options -> Packet)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# Int -> PacketParser String
zstring Int
128
		 PacketParser (Options -> Packet)
-> PacketParser Options -> PacketParser Packet
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Options
forall a. Parse a => PacketParser a
parse
		 #! therest

instance Unparse Packet where
  unparse :: Packet -> UnparseS
unparse (Packet Operation
op Word32
xid Word16
secs Flags
flags Addr
ci Addr
yi Addr
si Addr
gi Addr
ch String
sname String
file Options
options) =
      ((Operation, [Word8], Word32, Word16, Flags),
 (Addr, Addr, Addr, Addr, Addr), [Word8], (String, String), Options)
-> UnparseS
forall a. Unparse a => a -> UnparseS
unparse ((Operation
op,[Word8
1,Word8
6,Word8
0::Word8],Word32
xid,Word16
secs,Flags
flags),(Addr
ci,Addr
yi,Addr
si,Addr
gi,Addr
ch),
	       Int -> Word8 -> [Word8]
forall a. Int -> a -> [a]
replicate Int
10 (Word8
0::Word8),
	       (Int -> ShowS
zstring Int
64 String
sname,Int -> ShowS
zstring Int
128 String
file),
	       Options
options)
   where
     zstring :: Int -> ShowS
zstring Int
n String
s = Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
n (String
sString -> ShowS
forall a. [a] -> [a] -> [a]
++Char -> String
forall a. a -> [a]
repeat Char
'\0')

--------------------------------------------------------------------------------

zstring :: Int -> PacketParser String
zstring :: Int -> PacketParser String
zstring Int
n = (Word8 -> Char) -> [Word8] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
forall a. Enum a => Int -> a
toEnum(Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ([Word8] -> String) -> ([Word8] -> [Word8]) -> [Word8] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> [Word8] -> [Word8]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/=Word8
0) ([Word8] -> String) -> PacketParser [Word8] -> PacketParser String
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# Int -> PacketParser [Word8]
forall {t}. (Eq t, Num t) => t -> PacketParser [Word8]
bytes Int
n

bounded :: Int -> a -> PacketParser a
bounded Int
z a
n = a -> Int -> PacketParser a
forall a. (Bounded a, Enum a) => a -> Int -> PacketParser a
bounded' a
forall a. HasCallStack => a
undefined (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
z)
  where
    bounded' :: (Bounded a,Enum a) => a -> Int -> PacketParser a
    bounded' :: forall a. (Bounded a, Enum a) => a -> Int -> PacketParser a
bounded' a
r Int
i =
	     if Int
0Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
i Bool -> Bool -> Bool
&& Int
iInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=a -> Int
forall a. Enum a => a -> Int
fromEnum (a
forall a. Bounded a => a
maxBound a -> a -> a
forall a. a -> a -> a
`asTypeOf` a
r)
		then a -> PacketParser a
forall a. a -> PacketParser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> a
forall a. Enum a => Int -> a
toEnum Int
i)
		else String -> PacketParser a
forall a. String -> PacketParser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"out of range"

unEnum :: Int -> a -> b
unEnum Int
z a
t = Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Int
forall a. Enum a => a -> Int
fromEnum a
tInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
z)