module Net.TFTP where

-- TFTP - Trivial File Transfer Protocol, RFC 1350, STD 33
-- See http://www.networksorcery.com/enp/protocol/tftp.htm
--     http://www.networksorcery.com/enp/rfc/rfc1350.txt

import Net.Bits
import Net.Packet
import Net.PacketParsing

data Packet
  = RRQ Filename Mode
  | WRQ Filename Mode
  | Data BlockNr Data
  | Ack BlockNr
  | Error ErrorCode ErrMsg
  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)

type Filename = String
type Mode = String
type BlockNr = Word16
type Data = UArray Int Word8 -- could be changed
newtype ErrorCode = E Word16 deriving (ErrorCode -> ErrorCode -> Bool
(ErrorCode -> ErrorCode -> Bool)
-> (ErrorCode -> ErrorCode -> Bool) -> Eq ErrorCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ErrorCode -> ErrorCode -> Bool
== :: ErrorCode -> ErrorCode -> Bool
$c/= :: ErrorCode -> ErrorCode -> Bool
/= :: ErrorCode -> ErrorCode -> Bool
Eq,Int -> ErrorCode -> ShowS
[ErrorCode] -> ShowS
ErrorCode -> String
(Int -> ErrorCode -> ShowS)
-> (ErrorCode -> String)
-> ([ErrorCode] -> ShowS)
-> Show ErrorCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ErrorCode -> ShowS
showsPrec :: Int -> ErrorCode -> ShowS
$cshow :: ErrorCode -> String
show :: ErrorCode -> String
$cshowList :: [ErrorCode] -> ShowS
showList :: [ErrorCode] -> ShowS
Show)
type ErrMsg = String

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

instance Parse Packet where
  parse :: PacketParser Packet
parse =
    do BlockNr
opcode <- PacketParser BlockNr
word16
       case BlockNr
opcode of
         BlockNr
1 -> String -> String -> Packet
RRQ (String -> String -> Packet)
-> PacketParser String -> PacketParser (String -> Packet)
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# PacketParser String
string PacketParser (String -> Packet)
-> PacketParser String -> PacketParser Packet
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser String
string
	 BlockNr
2 -> String -> String -> Packet
WRQ (String -> String -> Packet)
-> PacketParser String -> PacketParser (String -> Packet)
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# PacketParser String
string PacketParser (String -> Packet)
-> PacketParser String -> PacketParser Packet
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser String
string
	 BlockNr
3 -> BlockNr -> Data -> Packet
Data (BlockNr -> Data -> Packet)
-> PacketParser BlockNr -> PacketParser (Data -> Packet)
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# PacketParser BlockNr
forall a. Parse a => PacketParser a
parse PacketParser (Data -> Packet)
-> PacketParser Data -> PacketParser Packet
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Data
forall a. Parse a => PacketParser a
parse
	 BlockNr
4 -> BlockNr -> Packet
Ack (BlockNr -> Packet) -> PacketParser BlockNr -> PacketParser Packet
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# PacketParser BlockNr
forall a. Parse a => PacketParser a
parse
	 BlockNr
5 -> ErrorCode -> String -> Packet
Error (ErrorCode -> String -> Packet)
-> PacketParser ErrorCode -> PacketParser (String -> Packet)
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# PacketParser ErrorCode
forall a. Parse a => PacketParser a
parse PacketParser (String -> Packet)
-> PacketParser String -> PacketParser Packet
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser String
string
	 BlockNr
_ -> String -> PacketParser Packet
forall a. String -> PacketParser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"bad TFTP opcode"

instance Parse ErrorCode where parse :: PacketParser ErrorCode
parse = BlockNr -> ErrorCode
E (BlockNr -> ErrorCode)
-> PacketParser BlockNr -> PacketParser ErrorCode
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# PacketParser BlockNr
forall a. Parse a => PacketParser a
parse

string :: PacketParser String
string = do Word8
b <- PacketParser Word8
word8
	    if Word8
bWord8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
==Word8
0
	      then String -> PacketParser String
forall a. a -> PacketParser a
forall (m :: * -> *) a. Monad m => a -> m a
return []
	      else (Word8 -> Char
char Word8
bChar -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> PacketParser String -> PacketParser String
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# PacketParser String
string
  where char :: Word8 -> Char
	char :: Word8 -> Char
char = 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. Enum a => a -> Int
fromEnum

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

instance Unparse Packet where
  unparse :: Packet -> UnparseS
unparse Packet
p =
    case Packet
p of
      RRQ String
f String
m -> BlockNr -> UnparseS
w BlockNr
1 UnparseS -> UnparseS -> UnparseS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> UnparseS
forall {a}. Unparse a => a -> UnparseS
unstring String
f UnparseS -> UnparseS -> UnparseS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> UnparseS
forall {a}. Unparse a => a -> UnparseS
unstring String
m
      WRQ String
f String
m -> BlockNr -> UnparseS
w BlockNr
2 UnparseS -> UnparseS -> UnparseS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> UnparseS
forall {a}. Unparse a => a -> UnparseS
unstring String
f UnparseS -> UnparseS -> UnparseS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> UnparseS
forall {a}. Unparse a => a -> UnparseS
unstring String
m
      Data BlockNr
n Data
d -> BlockNr -> UnparseS
w BlockNr
3 UnparseS -> UnparseS -> UnparseS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BlockNr, Data) -> UnparseS
forall {a}. Unparse a => a -> UnparseS
unparse (BlockNr
n,Data
d)
      Ack BlockNr
n -> BlockNr -> UnparseS
w BlockNr
4 UnparseS -> UnparseS -> UnparseS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockNr -> UnparseS
forall {a}. Unparse a => a -> UnparseS
unparse BlockNr
n
      Error ErrorCode
n String
s -> BlockNr -> UnparseS
w BlockNr
5 UnparseS -> UnparseS -> UnparseS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorCode -> UnparseS
forall {a}. Unparse a => a -> UnparseS
unparse ErrorCode
n UnparseS -> UnparseS -> UnparseS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> UnparseS
forall {a}. Unparse a => a -> UnparseS
unstring String
s
    where w :: BlockNr -> UnparseS
w BlockNr
n = BlockNr -> UnparseS
forall {a}. Unparse a => a -> UnparseS
unparse (BlockNr
n::Word16)

instance Unparse ErrorCode where unparse :: ErrorCode -> UnparseS
unparse (E BlockNr
w) = BlockNr -> UnparseS
forall {a}. Unparse a => a -> UnparseS
unparse BlockNr
w

unstring :: a -> UnparseS
unstring a
s = (a, Char) -> UnparseS
forall {a}. Unparse a => a -> UnparseS
unparse (a
s,Char
'\0')