module Network.Hermes.Protocol where
import Control.Applicative
import Control.Monad
import Control.Exception
import Data.Typeable
import Data.Data
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8
import Network.Hermes.Misc
import Data.Serialize
import Data.Serialize.Put
import Data.Serialize.Get
import Codec.Digest.SHA
import Codec.Crypto.RSA
import Network.Socket(HostName)
import Data.Serialize
data HermesException = HermesIDUnknown HermesID
| AddressUnknown HermesID
| DNSFailure Address
| WrongProtocol
| ProtocolVersionMismatch Word32 Word32
| AuthError String
| DeserializationError String
| ListenerAlreadyExists
| MessageError
| Timeout
| RecvCancelled
deriving (Typeable,Show,Eq)
instance Exception HermesException
data CloseException = EOF
deriving (Typeable,Show,Eq)
instance Exception CloseException
decode' :: Serialize a => B.ByteString -> a
decode' = either (throw . DeserializationError) id . decode
runGet' :: Get a -> B.ByteString -> a
runGet' g = either (throw . DeserializationError) id . runGet g
data Address = IP HostName Int
| IPv4 HostName Int
| IPv6 HostName Int
| Unix FilePath
deriving(Show,Read,Eq,Ord,Typeable,Data)
instance Serialize Address where
put (IP a b) = putWord8 0 >> put a >> put b
put (IPv4 a b) = putWord8 1 >> put a >> put b
put (IPv6 a b) = putWord8 2 >> put a >> put b
put (Unix a) = putWord8 3 >> put a
get = do
tag <- getWord8
case tag of
0 -> IP <$> get <*> get
1 -> IPv4 <$> get <*> get
2 -> IPv6 <$> get <*> get
3 -> Unix <$> get
_ -> error "Corrupted binary data for Address"
aesKeySize :: Int
aesKeySize = 128
evpCipher :: String
evpCipher = "aes-128-cbc"
evpHash :: String
evpHash = "sha256"
rsaKeySize :: Int
rsaKeySize = 1024
dsaKeySize :: Int
dsaKeySize = 1024
magicString :: B.ByteString
magicString = B8.pack "This.. is... HERMES!\n"
protocolVersion :: Word32
protocolVersion = 0
data KeyQuery = KeyOK | RequestKey
deriving(Show)
type HermesID = Integer
data KeyReply = KeyReply { keyReplyKey :: PublicKey
,keyReplySig :: Maybe B.ByteString
} deriving(Show)
data TrustLevel = None | Indirect | Direct
deriving(Eq,Ord,Show)
data SessionSetup = SessionSetup {
setupKey
,setupIV
,setupChallenge :: B.ByteString
,clientAddress :: Maybe Address
}
deriving(Show)
data AnyMessage = AKeyQuery KeyQuery
| AKeyReply KeyReply
| AChallenge B.ByteString
| ASessionSetup B.ByteString
| AHermesID HermesID
deriving(Show)
data RejectedMessage = RejectedMessage
deriving(Typeable)
instance Serialize RejectedMessage where
put _ = return ()
get = return RejectedMessage
instance Serialize PublicKey where
put PublicKey{..} = put public_size >> put public_n >> put public_e
get = do
public_size <- get
public_n <- get
public_e <- get
return PublicKey{..}
instance Serialize PrivateKey where
put PrivateKey{..} = put private_size >> put private_n >> put private_d
get = do
private_size <- get
private_n <- get
private_d <- get
return PrivateKey{..}
instance Serialize KeyQuery where
put x
= case x of
KeyOK -> putWord8 0
RequestKey -> putWord8 1
get
= do i <- getWord8
case i of
0 -> return KeyOK
1 -> return RequestKey
_ -> error "Corrupted binary data for KeyQuery"
instance Serialize KeyReply where
put (KeyReply x1 x2)
= do put x1
put x2
get
= do x1 <- get
x2 <- get
return (KeyReply x1 x2)
instance Serialize TrustLevel where
put x
= case x of
None -> putWord8 0
Indirect -> putWord8 1
Direct -> putWord8 2
get
= do i <- getWord8
case i of
0 -> return None
1 -> return Indirect
2 -> return Direct
_ -> error "Corrupted binary data for TrustLevel"
instance Serialize SessionSetup where
put (SessionSetup x1 x2 x3 x4)
= do put x1
put x2
put x3
put x4
get
= do x1 <- get
x2 <- get
x3 <- get
x4 <- get
return (SessionSetup x1 x2 x3 x4)
instance Serialize AnyMessage where
put x
= case x of
AKeyQuery x1 -> do putWord8 1
put x1
AKeyReply x1 -> do putWord8 2
put x1
AChallenge x1 -> do putWord8 3
put x1
ASessionSetup x1 -> do putWord8 4
put x1
AHermesID x1 -> do putWord8 5
put x1
get
= do i <- getWord8
case i of
1 -> do x1 <- get
return (AKeyQuery x1)
2 -> do x1 <- get
return (AKeyReply x1)
3 -> do x1 <- get
return (AChallenge x1)
4 -> do x1 <- get
return (ASessionSetup x1)
5 -> do x1 <- get
return (AHermesID x1)
_ -> error "Corrupted binary data for AnyMessage"