{-# OPTIONS_HADDOCK hide #-} {-# LANGUAGE RecordWildCards, BangPatterns, ViewPatterns, DeriveDataTypeable #-} 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 -- * Errors -- | Most Hermes functions can throw one of these exceptions, which -- | are mainly triggered when (re)negotiating connections. data HermesException = HermesIDUnknown HermesID -- ^ Hermes has no idea who you're talking about. How did you even get the HermesID? -- HermesID information is never discarded, so this exception should be rather uncommon. | AddressUnknown HermesID -- ^ We don't know where this HermesID is; we never did, or old information proved to be false. | DNSFailure Address -- ^ Failed to resolve the address | WrongProtocol -- ^ The remote server is not speaking Hermes-speak. | ProtocolVersionMismatch Word32 Word32 -- ^ A different protocol version is in use at the remote host. Check library version. | AuthError String -- ^ Something went wrong while authenticating. Have a reason. | DeserializationError String -- ^ Something went wrong while deserializing your data. | ListenerAlreadyExists -- ^ Attempted to create a listener on a port we're already listening to | MessageError -- ^ Message corrupted (connection broken) | Timeout -- ^ Some operation took longer than the user-configured timeout | RecvCancelled -- ^ Receive was explicitly cancelled by the user deriving (Typeable,Show,Eq) instance Exception HermesException -- | Exceptions that are handled by simply closing the connection 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 -- * And some types data Address = IP HostName Int -- ^ Host name and port, IPv4, IPv6, or both | IPv4 HostName Int -- ^ IPv4 only | IPv6 HostName Int -- ^ IPv6 only | Unix FilePath -- ^ Unix domain socket, not available on Windows 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" -- * Cryptographic parameters -- | AES session key size, in bits aesKeySize :: Int aesKeySize = 128 -- | Cipher to use for encrypting the session key evpCipher :: String evpCipher = "aes-128-cbc" -- | Hash used all over the place evpHash :: String evpHash = "sha256" -- | RSA key size, in bits; 512 <= size <= 1024 rsaKeySize :: Int rsaKeySize = 1024 -- | DSA key size, for the signature authorities dsaKeySize :: Int dsaKeySize = 1024 -- * Line protocol -- | Unchangeable bytes telling peers that this.. is... HERMES! magicString :: B.ByteString magicString = B8.pack "This.. is... HERMES!\n" protocolVersion :: Word32 -- Do not change type protocolVersion = 0 data KeyQuery = KeyOK | RequestKey deriving(Show) -- | A hash computed from a public key type HermesID = Integer data KeyReply = KeyReply { keyReplyKey :: PublicKey ,keyReplySig :: Maybe B.ByteString } deriving(Show) -- | If Indirect, require a signature from an authority. -- -- If Direct, require an OK from the library client. -- -- If None, no trust is required. 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) -- | If a message (m :: t) is discarded, then a RejectedMessage is -- sent in reply, with (showType t,encode (original tag)) as the tag. The message body -- is discarded. 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{..} -- GENERATED START 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" -- GENERATED STOP