{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE Strict #-}
module Foreign.Erlang.Handshake
( HandshakeData(..)
, doConnect
, doAccept
, Name(..)
, Status(..)
, Challenge(..)
, ChallengeReply(..)
, ChallengeAck(..)
) where
import Control.Monad ( unless, when )
import Util.IOExtra
import Data.Ix ( inRange )
import qualified Data.ByteString as BS
import Data.Binary
import Data.Binary.Get
import Data.Binary.Put
import Util.Binary
import Foreign.Erlang.Digest
import Foreign.Erlang.NodeData
data HandshakeData = HandshakeData { HandshakeData -> Name
name :: Name
, HandshakeData -> NodeData
nodeData :: NodeData
, HandshakeData -> ByteString
cookie :: BS.ByteString
}
nodeTypeR6, challengeStatus, challengeReply, challengeAck :: Char
nodeTypeR6 :: Char
nodeTypeR6 = Char
'n'
challengeStatus :: Char
challengeStatus = Char
's'
challengeReply :: Char
challengeReply = Char
'r'
challengeAck :: Char
challengeAck = Char
'a'
data Name = Name { Name -> DistributionVersion
n_distVer :: DistributionVersion
, Name -> DistributionFlags
n_distFlags :: DistributionFlags
, Name -> ByteString
n_nodeName :: BS.ByteString
}
deriving (Name -> Name -> Bool
(Name -> Name -> Bool) -> (Name -> Name -> Bool) -> Eq Name
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c== :: Name -> Name -> Bool
Eq, Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
(Int -> Name -> ShowS)
-> (Name -> String) -> ([Name] -> ShowS) -> Show Name
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Name] -> ShowS
$cshowList :: [Name] -> ShowS
show :: Name -> String
$cshow :: Name -> String
showsPrec :: Int -> Name -> ShowS
$cshowsPrec :: Int -> Name -> ShowS
Show)
instance Binary Name where
put :: Name -> Put
put Name{DistributionVersion
n_distVer :: DistributionVersion
n_distVer :: Name -> DistributionVersion
n_distVer,DistributionFlags
n_distFlags :: DistributionFlags
n_distFlags :: Name -> DistributionFlags
n_distFlags,ByteString
n_nodeName :: ByteString
n_nodeName :: Name -> ByteString
n_nodeName} =
HasCallStack => Put -> Put
Put -> Put
putWithLength16be (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ do
HasCallStack => Char -> Put
Char -> Put
putChar8 Char
nodeTypeR6
DistributionVersion -> Put
forall t. Binary t => t -> Put
put DistributionVersion
n_distVer
DistributionFlags -> Put
forall t. Binary t => t -> Put
put DistributionFlags
n_distFlags
ByteString -> Put
putByteString ByteString
n_nodeName
get :: Get Name
get = do
Word16
len <- Get Word16
getWord16be
(((), DistributionVersion
n_distVer, DistributionFlags
n_distFlags), Word16
l) <- Get ((), DistributionVersion, DistributionFlags)
-> Get (((), DistributionVersion, DistributionFlags), Word16)
forall a. HasCallStack => Get a -> Get (a, Word16)
getWithLength16be (Get ((), DistributionVersion, DistributionFlags)
-> Get (((), DistributionVersion, DistributionFlags), Word16))
-> Get ((), DistributionVersion, DistributionFlags)
-> Get (((), DistributionVersion, DistributionFlags), Word16)
forall a b. (a -> b) -> a -> b
$
(,,) (()
-> DistributionVersion
-> DistributionFlags
-> ((), DistributionVersion, DistributionFlags))
-> Get ()
-> Get
(DistributionVersion
-> DistributionFlags
-> ((), DistributionVersion, DistributionFlags))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasCallStack => Char -> Get ()
Char -> Get ()
matchChar8 Char
nodeTypeR6
Get
(DistributionVersion
-> DistributionFlags
-> ((), DistributionVersion, DistributionFlags))
-> Get DistributionVersion
-> Get
(DistributionFlags -> ((), DistributionVersion, DistributionFlags))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get DistributionVersion
forall t. Binary t => Get t
get
Get
(DistributionFlags -> ((), DistributionVersion, DistributionFlags))
-> Get DistributionFlags
-> Get ((), DistributionVersion, DistributionFlags)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get DistributionFlags
forall t. Binary t => Get t
get
ByteString
n_nodeName <- Int -> Get ByteString
getByteString (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
len Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
- Word16
l))
Name -> Get Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name :: DistributionVersion -> DistributionFlags -> ByteString -> Name
Name { DistributionVersion
n_distVer :: DistributionVersion
n_distVer :: DistributionVersion
n_distVer, DistributionFlags
n_distFlags :: DistributionFlags
n_distFlags :: DistributionFlags
n_distFlags, ByteString
n_nodeName :: ByteString
n_nodeName :: ByteString
n_nodeName }
data Status = Ok | OkSimultaneous | Nok | NotAllowed | Alive
deriving (Status -> Status -> Bool
(Status -> Status -> Bool)
-> (Status -> Status -> Bool) -> Eq Status
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Status -> Status -> Bool
$c/= :: Status -> Status -> Bool
== :: Status -> Status -> Bool
$c== :: Status -> Status -> Bool
Eq, Int -> Status -> ShowS
[Status] -> ShowS
Status -> String
(Int -> Status -> ShowS)
-> (Status -> String) -> ([Status] -> ShowS) -> Show Status
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Status] -> ShowS
$cshowList :: [Status] -> ShowS
show :: Status -> String
$cshow :: Status -> String
showsPrec :: Int -> Status -> ShowS
$cshowsPrec :: Int -> Status -> ShowS
Show, Status
Status -> Status -> Bounded Status
forall a. a -> a -> Bounded a
maxBound :: Status
$cmaxBound :: Status
minBound :: Status
$cminBound :: Status
Bounded, Int -> Status
Status -> Int
Status -> [Status]
Status -> Status
Status -> Status -> [Status]
Status -> Status -> Status -> [Status]
(Status -> Status)
-> (Status -> Status)
-> (Int -> Status)
-> (Status -> Int)
-> (Status -> [Status])
-> (Status -> Status -> [Status])
-> (Status -> Status -> [Status])
-> (Status -> Status -> Status -> [Status])
-> Enum Status
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Status -> Status -> Status -> [Status]
$cenumFromThenTo :: Status -> Status -> Status -> [Status]
enumFromTo :: Status -> Status -> [Status]
$cenumFromTo :: Status -> Status -> [Status]
enumFromThen :: Status -> Status -> [Status]
$cenumFromThen :: Status -> Status -> [Status]
enumFrom :: Status -> [Status]
$cenumFrom :: Status -> [Status]
fromEnum :: Status -> Int
$cfromEnum :: Status -> Int
toEnum :: Int -> Status
$ctoEnum :: Int -> Status
pred :: Status -> Status
$cpred :: Status -> Status
succ :: Status -> Status
$csucc :: Status -> Status
Enum)
instance Binary Status where
put :: Status -> Put
put Status
status = HasCallStack => Put -> Put
Put -> Put
putWithLength16be (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ do
HasCallStack => Char -> Put
Char -> Put
putChar8 Char
challengeStatus
case Status
status of
Status
Ok -> ByteString -> Put
putByteString ByteString
"ok"
Status
OkSimultaneous -> ByteString -> Put
putByteString ByteString
"ok_simultaneous"
Status
Nok -> ByteString -> Put
putByteString ByteString
"nok"
Status
NotAllowed -> ByteString -> Put
putByteString ByteString
"not_allowed"
Status
Alive -> ByteString -> Put
putByteString ByteString
"alive"
get :: Get Status
get = do
Word16
len <- Get Word16
getWord16be
((), Word16
l) <- Get () -> Get ((), Word16)
forall a. HasCallStack => Get a -> Get (a, Word16)
getWithLength16be (Get () -> Get ((), Word16)) -> Get () -> Get ((), Word16)
forall a b. (a -> b) -> a -> b
$ HasCallStack => Char -> Get ()
Char -> Get ()
matchChar8 Char
challengeStatus
ByteString
status <- Int -> Get ByteString
getByteString (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
len Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
- Word16
l))
case ByteString
status of
ByteString
"ok" -> Status -> Get Status
forall (m :: * -> *) a. Monad m => a -> m a
return Status
Ok
ByteString
"ok_simultaneous" -> Status -> Get Status
forall (m :: * -> *) a. Monad m => a -> m a
return Status
OkSimultaneous
ByteString
"nok" -> Status -> Get Status
forall (m :: * -> *) a. Monad m => a -> m a
return Status
Nok
ByteString
"not_allowed" -> Status -> Get Status
forall (m :: * -> *) a. Monad m => a -> m a
return Status
NotAllowed
ByteString
"alive" -> Status -> Get Status
forall (m :: * -> *) a. Monad m => a -> m a
return Status
Alive
ByteString
_ -> String -> Get Status
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get Status) -> String -> Get Status
forall a b. (a -> b) -> a -> b
$ String
"Bad status: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
status
data Challenge = Challenge { Challenge -> DistributionVersion
c_distVer :: DistributionVersion
, Challenge -> DistributionFlags
c_distFlags :: DistributionFlags
, Challenge -> Word32
c_challenge :: Word32
, Challenge -> ByteString
c_nodeName :: BS.ByteString
}
deriving (Challenge -> Challenge -> Bool
(Challenge -> Challenge -> Bool)
-> (Challenge -> Challenge -> Bool) -> Eq Challenge
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Challenge -> Challenge -> Bool
$c/= :: Challenge -> Challenge -> Bool
== :: Challenge -> Challenge -> Bool
$c== :: Challenge -> Challenge -> Bool
Eq, Int -> Challenge -> ShowS
[Challenge] -> ShowS
Challenge -> String
(Int -> Challenge -> ShowS)
-> (Challenge -> String)
-> ([Challenge] -> ShowS)
-> Show Challenge
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Challenge] -> ShowS
$cshowList :: [Challenge] -> ShowS
show :: Challenge -> String
$cshow :: Challenge -> String
showsPrec :: Int -> Challenge -> ShowS
$cshowsPrec :: Int -> Challenge -> ShowS
Show)
instance Binary Challenge where
put :: Challenge -> Put
put Challenge{DistributionVersion
c_distVer :: DistributionVersion
c_distVer :: Challenge -> DistributionVersion
c_distVer,DistributionFlags
c_distFlags :: DistributionFlags
c_distFlags :: Challenge -> DistributionFlags
c_distFlags,Word32
c_challenge :: Word32
c_challenge :: Challenge -> Word32
c_challenge,ByteString
c_nodeName :: ByteString
c_nodeName :: Challenge -> ByteString
c_nodeName} =
HasCallStack => Put -> Put
Put -> Put
putWithLength16be (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ do
HasCallStack => Char -> Put
Char -> Put
putChar8 Char
nodeTypeR6
DistributionVersion -> Put
forall t. Binary t => t -> Put
put DistributionVersion
c_distVer
DistributionFlags -> Put
forall t. Binary t => t -> Put
put DistributionFlags
c_distFlags
Word32 -> Put
putWord32be Word32
c_challenge
ByteString -> Put
putByteString ByteString
c_nodeName
get :: Get Challenge
get = do
Word16
len <- Get Word16
getWord16be
(((), DistributionVersion
c_distVer, DistributionFlags
c_distFlags, Word32
c_challenge), Word16
l) <- Get ((), DistributionVersion, DistributionFlags, Word32)
-> Get
(((), DistributionVersion, DistributionFlags, Word32), Word16)
forall a. HasCallStack => Get a -> Get (a, Word16)
getWithLength16be (Get ((), DistributionVersion, DistributionFlags, Word32)
-> Get
(((), DistributionVersion, DistributionFlags, Word32), Word16))
-> Get ((), DistributionVersion, DistributionFlags, Word32)
-> Get
(((), DistributionVersion, DistributionFlags, Word32), Word16)
forall a b. (a -> b) -> a -> b
$
(,,,) (()
-> DistributionVersion
-> DistributionFlags
-> Word32
-> ((), DistributionVersion, DistributionFlags, Word32))
-> Get ()
-> Get
(DistributionVersion
-> DistributionFlags
-> Word32
-> ((), DistributionVersion, DistributionFlags, Word32))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasCallStack => Char -> Get ()
Char -> Get ()
matchChar8 Char
nodeTypeR6
Get
(DistributionVersion
-> DistributionFlags
-> Word32
-> ((), DistributionVersion, DistributionFlags, Word32))
-> Get DistributionVersion
-> Get
(DistributionFlags
-> Word32 -> ((), DistributionVersion, DistributionFlags, Word32))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get DistributionVersion
forall t. Binary t => Get t
get
Get
(DistributionFlags
-> Word32 -> ((), DistributionVersion, DistributionFlags, Word32))
-> Get DistributionFlags
-> Get
(Word32 -> ((), DistributionVersion, DistributionFlags, Word32))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get DistributionFlags
forall t. Binary t => Get t
get
Get
(Word32 -> ((), DistributionVersion, DistributionFlags, Word32))
-> Get Word32
-> Get ((), DistributionVersion, DistributionFlags, Word32)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
getWord32be
ByteString
c_nodeName <- Int -> Get ByteString
getByteString (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
len Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
- Word16
l))
Challenge -> Get Challenge
forall (m :: * -> *) a. Monad m => a -> m a
return Challenge :: DistributionVersion
-> DistributionFlags -> Word32 -> ByteString -> Challenge
Challenge { DistributionVersion
c_distVer :: DistributionVersion
c_distVer :: DistributionVersion
c_distVer, DistributionFlags
c_distFlags :: DistributionFlags
c_distFlags :: DistributionFlags
c_distFlags, Word32
c_challenge :: Word32
c_challenge :: Word32
c_challenge, ByteString
c_nodeName :: ByteString
c_nodeName :: ByteString
c_nodeName }
data ChallengeReply = ChallengeReply { ChallengeReply -> Word32
cr_challenge :: Word32
, ChallengeReply -> ByteString
cr_digest :: BS.ByteString
}
deriving (ChallengeReply -> ChallengeReply -> Bool
(ChallengeReply -> ChallengeReply -> Bool)
-> (ChallengeReply -> ChallengeReply -> Bool) -> Eq ChallengeReply
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChallengeReply -> ChallengeReply -> Bool
$c/= :: ChallengeReply -> ChallengeReply -> Bool
== :: ChallengeReply -> ChallengeReply -> Bool
$c== :: ChallengeReply -> ChallengeReply -> Bool
Eq, Int -> ChallengeReply -> ShowS
[ChallengeReply] -> ShowS
ChallengeReply -> String
(Int -> ChallengeReply -> ShowS)
-> (ChallengeReply -> String)
-> ([ChallengeReply] -> ShowS)
-> Show ChallengeReply
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChallengeReply] -> ShowS
$cshowList :: [ChallengeReply] -> ShowS
show :: ChallengeReply -> String
$cshow :: ChallengeReply -> String
showsPrec :: Int -> ChallengeReply -> ShowS
$cshowsPrec :: Int -> ChallengeReply -> ShowS
Show)
instance Binary ChallengeReply where
put :: ChallengeReply -> Put
put ChallengeReply{Word32
cr_challenge :: Word32
cr_challenge :: ChallengeReply -> Word32
cr_challenge,ByteString
cr_digest :: ByteString
cr_digest :: ChallengeReply -> ByteString
cr_digest} =
HasCallStack => Put -> Put
Put -> Put
putWithLength16be (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ do
HasCallStack => Char -> Put
Char -> Put
putChar8 Char
challengeReply
Word32 -> Put
putWord32be Word32
cr_challenge
ByteString -> Put
putByteString ByteString
cr_digest
get :: Get ChallengeReply
get = do
Word16
len <- Get Word16
getWord16be
(((), Word32
cr_challenge), Word16
l) <- Get ((), Word32) -> Get (((), Word32), Word16)
forall a. HasCallStack => Get a -> Get (a, Word16)
getWithLength16be (Get ((), Word32) -> Get (((), Word32), Word16))
-> Get ((), Word32) -> Get (((), Word32), Word16)
forall a b. (a -> b) -> a -> b
$
(,) (() -> Word32 -> ((), Word32))
-> Get () -> Get (Word32 -> ((), Word32))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasCallStack => Char -> Get ()
Char -> Get ()
matchChar8 Char
challengeReply
Get (Word32 -> ((), Word32)) -> Get Word32 -> Get ((), Word32)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
getWord32be
ByteString
cr_digest <- Int -> Get ByteString
getByteString (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
len Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
- Word16
l))
ChallengeReply -> Get ChallengeReply
forall (m :: * -> *) a. Monad m => a -> m a
return ChallengeReply :: Word32 -> ByteString -> ChallengeReply
ChallengeReply { Word32
cr_challenge :: Word32
cr_challenge :: Word32
cr_challenge, ByteString
cr_digest :: ByteString
cr_digest :: ByteString
cr_digest }
data ChallengeAck = ChallengeAck { ChallengeAck -> ByteString
ca_digest :: BS.ByteString }
deriving (ChallengeAck -> ChallengeAck -> Bool
(ChallengeAck -> ChallengeAck -> Bool)
-> (ChallengeAck -> ChallengeAck -> Bool) -> Eq ChallengeAck
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChallengeAck -> ChallengeAck -> Bool
$c/= :: ChallengeAck -> ChallengeAck -> Bool
== :: ChallengeAck -> ChallengeAck -> Bool
$c== :: ChallengeAck -> ChallengeAck -> Bool
Eq, Int -> ChallengeAck -> ShowS
[ChallengeAck] -> ShowS
ChallengeAck -> String
(Int -> ChallengeAck -> ShowS)
-> (ChallengeAck -> String)
-> ([ChallengeAck] -> ShowS)
-> Show ChallengeAck
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChallengeAck] -> ShowS
$cshowList :: [ChallengeAck] -> ShowS
show :: ChallengeAck -> String
$cshow :: ChallengeAck -> String
showsPrec :: Int -> ChallengeAck -> ShowS
$cshowsPrec :: Int -> ChallengeAck -> ShowS
Show)
instance Binary ChallengeAck where
put :: ChallengeAck -> Put
put ChallengeAck{ByteString
ca_digest :: ByteString
ca_digest :: ChallengeAck -> ByteString
ca_digest} =
HasCallStack => Put -> Put
Put -> Put
putWithLength16be (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ do
HasCallStack => Char -> Put
Char -> Put
putChar8 Char
challengeAck
ByteString -> Put
putByteString ByteString
ca_digest
get :: Get ChallengeAck
get = do
Word16
len <- Get Word16
getWord16be
((), Word16
l) <- Get () -> Get ((), Word16)
forall a. HasCallStack => Get a -> Get (a, Word16)
getWithLength16be (Get () -> Get ((), Word16)) -> Get () -> Get ((), Word16)
forall a b. (a -> b) -> a -> b
$ HasCallStack => Char -> Get ()
Char -> Get ()
matchChar8 Char
challengeAck
ByteString
ca_digest <- Int -> Get ByteString
getByteString (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
len Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
- Word16
l))
ChallengeAck -> Get ChallengeAck
forall (m :: * -> *) a. Monad m => a -> m a
return ChallengeAck :: ByteString -> ChallengeAck
ChallengeAck { ByteString
ca_digest :: ByteString
ca_digest :: ByteString
ca_digest }
doConnect :: (MonadCatch m, MonadIO m)
=> (forall o. Binary o => o -> m ())
-> (forall i. (Binary i) => m i)
-> HandshakeData
-> m ()
doConnect :: (forall o. Binary o => o -> m ())
-> (forall i. Binary i => m i) -> HandshakeData -> m ()
doConnect forall o. Binary o => o -> m ()
send forall i. Binary i => m i
recv HandshakeData{Name
name :: Name
name :: HandshakeData -> Name
name,nodeData :: HandshakeData -> NodeData
nodeData = NodeData{DistributionVersion
loVer :: NodeData -> DistributionVersion
loVer :: DistributionVersion
loVer,DistributionVersion
hiVer :: NodeData -> DistributionVersion
hiVer :: DistributionVersion
hiVer},ByteString
cookie :: ByteString
cookie :: HandshakeData -> ByteString
cookie} = do
Name -> m ()
forall o. Binary o => o -> m ()
send Name
name
do
Status
her_status <- m Status
forall i. Binary i => m i
recv
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Status
her_status Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
/= Status
Ok) (BadHandshakeStatus -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Status -> BadHandshakeStatus
BadHandshakeStatus Status
her_status))
Challenge{c_distVer :: Challenge -> DistributionVersion
c_distVer = DistributionVersion
her_distVer,c_challenge :: Challenge -> Word32
c_challenge = Word32
her_challenge} <- m Challenge
forall i. Binary i => m i
recv
DistributionVersion
-> DistributionVersion -> DistributionVersion -> m ()
forall (m :: * -> *).
MonadThrow m =>
DistributionVersion
-> DistributionVersion -> DistributionVersion -> m ()
checkVersionRange DistributionVersion
her_distVer DistributionVersion
loVer DistributionVersion
hiVer
Word32
our_challenge <- IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Word32
genChallenge
ChallengeReply -> m ()
forall o. Binary o => o -> m ()
send ChallengeReply :: Word32 -> ByteString -> ChallengeReply
ChallengeReply { cr_challenge :: Word32
cr_challenge = Word32
our_challenge
, cr_digest :: ByteString
cr_digest = Word32 -> ByteString -> ByteString
genDigest Word32
her_challenge ByteString
cookie
}
ChallengeAck{ca_digest :: ChallengeAck -> ByteString
ca_digest = ByteString
her_digest} <- m ChallengeAck
forall i. Binary i => m i
recv
ByteString -> Word32 -> ByteString -> m ()
forall (m :: * -> *).
MonadThrow m =>
ByteString -> Word32 -> ByteString -> m ()
checkCookie ByteString
her_digest Word32
our_challenge ByteString
cookie
newtype BadHandshakeStatus = BadHandshakeStatus Status
deriving Int -> BadHandshakeStatus -> ShowS
[BadHandshakeStatus] -> ShowS
BadHandshakeStatus -> String
(Int -> BadHandshakeStatus -> ShowS)
-> (BadHandshakeStatus -> String)
-> ([BadHandshakeStatus] -> ShowS)
-> Show BadHandshakeStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BadHandshakeStatus] -> ShowS
$cshowList :: [BadHandshakeStatus] -> ShowS
show :: BadHandshakeStatus -> String
$cshow :: BadHandshakeStatus -> String
showsPrec :: Int -> BadHandshakeStatus -> ShowS
$cshowsPrec :: Int -> BadHandshakeStatus -> ShowS
Show
instance Exception BadHandshakeStatus
doAccept :: (MonadCatch m, MonadIO m)
=> (forall o. Binary o => o -> m ())
-> (forall i. (Binary i) => m i)
-> HandshakeData
-> m BS.ByteString
doAccept :: (forall o. Binary o => o -> m ())
-> (forall i. Binary i => m i) -> HandshakeData -> m ByteString
doAccept forall o. Binary o => o -> m ()
send forall i. Binary i => m i
recv HandshakeData{name :: HandshakeData -> Name
name = Name{DistributionFlags
n_distFlags :: DistributionFlags
n_distFlags :: Name -> DistributionFlags
n_distFlags,ByteString
n_nodeName :: ByteString
n_nodeName :: Name -> ByteString
n_nodeName},nodeData :: HandshakeData -> NodeData
nodeData = NodeData{DistributionVersion
loVer :: DistributionVersion
loVer :: NodeData -> DistributionVersion
loVer,DistributionVersion
hiVer :: DistributionVersion
hiVer :: NodeData -> DistributionVersion
hiVer},ByteString
cookie :: ByteString
cookie :: HandshakeData -> ByteString
cookie} = do
Name{n_distVer :: Name -> DistributionVersion
n_distVer = DistributionVersion
her_distVer,n_nodeName :: Name -> ByteString
n_nodeName = ByteString
her_nodeName} <- m Name
forall i. Binary i => m i
recv
DistributionVersion
-> DistributionVersion -> DistributionVersion -> m ()
forall (m :: * -> *).
MonadThrow m =>
DistributionVersion
-> DistributionVersion -> DistributionVersion -> m ()
checkVersionRange DistributionVersion
her_distVer DistributionVersion
loVer DistributionVersion
hiVer
Status -> m ()
forall o. Binary o => o -> m ()
send Status
Ok
Word32
our_challenge <- IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Word32
genChallenge
Challenge -> m ()
forall o. Binary o => o -> m ()
send Challenge :: DistributionVersion
-> DistributionFlags -> Word32 -> ByteString -> Challenge
Challenge { c_distVer :: DistributionVersion
c_distVer = DistributionVersion
R6B
, c_distFlags :: DistributionFlags
c_distFlags = DistributionFlags
n_distFlags
, c_challenge :: Word32
c_challenge = Word32
our_challenge
, c_nodeName :: ByteString
c_nodeName = ByteString
n_nodeName
}
ChallengeReply{cr_challenge :: ChallengeReply -> Word32
cr_challenge = Word32
her_challenge,cr_digest :: ChallengeReply -> ByteString
cr_digest = ByteString
her_digest} <- m ChallengeReply
forall i. Binary i => m i
recv
ByteString -> Word32 -> ByteString -> m ()
forall (m :: * -> *).
MonadThrow m =>
ByteString -> Word32 -> ByteString -> m ()
checkCookie ByteString
her_digest Word32
our_challenge ByteString
cookie
ChallengeAck -> m ()
forall o. Binary o => o -> m ()
send ChallengeAck :: ByteString -> ChallengeAck
ChallengeAck { ca_digest :: ByteString
ca_digest = Word32 -> ByteString -> ByteString
genDigest Word32
her_challenge ByteString
cookie }
ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
her_nodeName
checkVersionRange :: MonadThrow m
=> DistributionVersion
-> DistributionVersion
-> DistributionVersion
-> m ()
checkVersionRange :: DistributionVersion
-> DistributionVersion -> DistributionVersion -> m ()
checkVersionRange DistributionVersion
herVersion DistributionVersion
lowVersion DistributionVersion
highVersion =
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((DistributionVersion, DistributionVersion)
-> DistributionVersion -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (DistributionVersion
lowVersion, DistributionVersion
highVersion) DistributionVersion
herVersion)
(DistributionVersionMismatch -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM DistributionVersionMismatch :: DistributionVersion
-> DistributionVersion
-> DistributionVersion
-> DistributionVersionMismatch
DistributionVersionMismatch { DistributionVersion
herVersion :: DistributionVersion
herVersion :: DistributionVersion
herVersion
, DistributionVersion
lowVersion :: DistributionVersion
lowVersion :: DistributionVersion
lowVersion
, DistributionVersion
highVersion :: DistributionVersion
highVersion :: DistributionVersion
highVersion
})
checkCookie :: MonadThrow m => BS.ByteString -> Word32 -> BS.ByteString -> m ()
checkCookie :: ByteString -> Word32 -> ByteString -> m ()
checkCookie ByteString
her_digest Word32
our_challenge ByteString
cookie =
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString
her_digest ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Word32 -> ByteString -> ByteString
genDigest Word32
our_challenge ByteString
cookie)
(CookieMismatch -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM CookieMismatch
CookieMismatch)
data DistributionVersionMismatch =
DistributionVersionMismatch { DistributionVersionMismatch -> DistributionVersion
herVersion :: DistributionVersion
, DistributionVersionMismatch -> DistributionVersion
lowVersion :: DistributionVersion
, DistributionVersionMismatch -> DistributionVersion
highVersion :: DistributionVersion
}
deriving Int -> DistributionVersionMismatch -> ShowS
[DistributionVersionMismatch] -> ShowS
DistributionVersionMismatch -> String
(Int -> DistributionVersionMismatch -> ShowS)
-> (DistributionVersionMismatch -> String)
-> ([DistributionVersionMismatch] -> ShowS)
-> Show DistributionVersionMismatch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DistributionVersionMismatch] -> ShowS
$cshowList :: [DistributionVersionMismatch] -> ShowS
show :: DistributionVersionMismatch -> String
$cshow :: DistributionVersionMismatch -> String
showsPrec :: Int -> DistributionVersionMismatch -> ShowS
$cshowsPrec :: Int -> DistributionVersionMismatch -> ShowS
Show
instance Exception DistributionVersionMismatch
data CookieMismatch = CookieMismatch
deriving Int -> CookieMismatch -> ShowS
[CookieMismatch] -> ShowS
CookieMismatch -> String
(Int -> CookieMismatch -> ShowS)
-> (CookieMismatch -> String)
-> ([CookieMismatch] -> ShowS)
-> Show CookieMismatch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CookieMismatch] -> ShowS
$cshowList :: [CookieMismatch] -> ShowS
show :: CookieMismatch -> String
$cshow :: CookieMismatch -> String
showsPrec :: Int -> CookieMismatch -> ShowS
$cshowsPrec :: Int -> CookieMismatch -> ShowS
Show
instance Exception CookieMismatch