{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
module Data.ZRE (
zreVer
, newZRE
, parseZRE
, encodeZRE
, zreBeacon
, parseBeacon
, Name
, Headers
, Content
, Group
, mkGroup
, unGroup
, Groups
, Seq
, GroupSeq
, ZREMsg(..)
, ZRECmd(..)
, SymbolicGroup
, KnownGroup
, knownToGroup
) where
import Prelude hiding (putStrLn, take)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy as BL
import GHC.Word
import Data.Map (Map)
import Data.Set (Set)
import qualified Data.Set
import Data.UUID
import Data.Time.Clock
import System.ZMQ4.Endpoint
import Data.ZMQParse
import GHC.TypeLits
import Data.Proxy
zreVer :: Int
zreVer :: Int
zreVer = Int
2
zreSig :: Word16
zreSig :: Word16
zreSig = Word16
0xAAA1
type Seq = Int
type GroupSeq = Int
type SymbolicGroup = Symbol
type KnownGroup = KnownSymbol
knownToGroup :: forall n. KnownGroup n => Group
knownToGroup :: Group
knownToGroup = ByteString -> Group
Group (ByteString -> Group) -> ByteString -> Group
forall a b. (a -> b) -> a -> b
$ String -> ByteString
B.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Proxy n -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal @n Proxy n
forall k (t :: k). Proxy t
Proxy
newtype Group = Group ByteString
deriving (Int -> Group -> ShowS
[Group] -> ShowS
Group -> String
(Int -> Group -> ShowS)
-> (Group -> String) -> ([Group] -> ShowS) -> Show Group
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Group] -> ShowS
$cshowList :: [Group] -> ShowS
show :: Group -> String
$cshow :: Group -> String
showsPrec :: Int -> Group -> ShowS
$cshowsPrec :: Int -> Group -> ShowS
Show, Group -> Group -> Bool
(Group -> Group -> Bool) -> (Group -> Group -> Bool) -> Eq Group
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Group -> Group -> Bool
$c/= :: Group -> Group -> Bool
== :: Group -> Group -> Bool
$c== :: Group -> Group -> Bool
Eq, Eq Group
Eq Group
-> (Group -> Group -> Ordering)
-> (Group -> Group -> Bool)
-> (Group -> Group -> Bool)
-> (Group -> Group -> Bool)
-> (Group -> Group -> Bool)
-> (Group -> Group -> Group)
-> (Group -> Group -> Group)
-> Ord Group
Group -> Group -> Bool
Group -> Group -> Ordering
Group -> Group -> Group
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Group -> Group -> Group
$cmin :: Group -> Group -> Group
max :: Group -> Group -> Group
$cmax :: Group -> Group -> Group
>= :: Group -> Group -> Bool
$c>= :: Group -> Group -> Bool
> :: Group -> Group -> Bool
$c> :: Group -> Group -> Bool
<= :: Group -> Group -> Bool
$c<= :: Group -> Group -> Bool
< :: Group -> Group -> Bool
$c< :: Group -> Group -> Bool
compare :: Group -> Group -> Ordering
$ccompare :: Group -> Group -> Ordering
$cp1Ord :: Eq Group
Ord)
mkGroup :: ByteString -> Group
mkGroup :: ByteString -> Group
mkGroup = ByteString -> Group
Group
unGroup :: Group -> ByteString
unGroup :: Group -> ByteString
unGroup (Group ByteString
a) = ByteString
a
type Groups = Set Group
type Name = ByteString
type = Map ByteString ByteString
type Content = [ByteString]
data ZREMsg = ZREMsg {
ZREMsg -> Maybe UUID
msgFrom :: Maybe UUID
, ZREMsg -> Int
msgSeq :: Seq
, ZREMsg -> Maybe UTCTime
msgTime :: Maybe UTCTime
, ZREMsg -> ZRECmd
msgCmd :: ZRECmd
} deriving (Int -> ZREMsg -> ShowS
[ZREMsg] -> ShowS
ZREMsg -> String
(Int -> ZREMsg -> ShowS)
-> (ZREMsg -> String) -> ([ZREMsg] -> ShowS) -> Show ZREMsg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ZREMsg] -> ShowS
$cshowList :: [ZREMsg] -> ShowS
show :: ZREMsg -> String
$cshow :: ZREMsg -> String
showsPrec :: Int -> ZREMsg -> ShowS
$cshowsPrec :: Int -> ZREMsg -> ShowS
Show, ZREMsg -> ZREMsg -> Bool
(ZREMsg -> ZREMsg -> Bool)
-> (ZREMsg -> ZREMsg -> Bool) -> Eq ZREMsg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ZREMsg -> ZREMsg -> Bool
$c/= :: ZREMsg -> ZREMsg -> Bool
== :: ZREMsg -> ZREMsg -> Bool
$c== :: ZREMsg -> ZREMsg -> Bool
Eq, Eq ZREMsg
Eq ZREMsg
-> (ZREMsg -> ZREMsg -> Ordering)
-> (ZREMsg -> ZREMsg -> Bool)
-> (ZREMsg -> ZREMsg -> Bool)
-> (ZREMsg -> ZREMsg -> Bool)
-> (ZREMsg -> ZREMsg -> Bool)
-> (ZREMsg -> ZREMsg -> ZREMsg)
-> (ZREMsg -> ZREMsg -> ZREMsg)
-> Ord ZREMsg
ZREMsg -> ZREMsg -> Bool
ZREMsg -> ZREMsg -> Ordering
ZREMsg -> ZREMsg -> ZREMsg
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ZREMsg -> ZREMsg -> ZREMsg
$cmin :: ZREMsg -> ZREMsg -> ZREMsg
max :: ZREMsg -> ZREMsg -> ZREMsg
$cmax :: ZREMsg -> ZREMsg -> ZREMsg
>= :: ZREMsg -> ZREMsg -> Bool
$c>= :: ZREMsg -> ZREMsg -> Bool
> :: ZREMsg -> ZREMsg -> Bool
$c> :: ZREMsg -> ZREMsg -> Bool
<= :: ZREMsg -> ZREMsg -> Bool
$c<= :: ZREMsg -> ZREMsg -> Bool
< :: ZREMsg -> ZREMsg -> Bool
$c< :: ZREMsg -> ZREMsg -> Bool
compare :: ZREMsg -> ZREMsg -> Ordering
$ccompare :: ZREMsg -> ZREMsg -> Ordering
$cp1Ord :: Eq ZREMsg
Ord)
data ZRECmd =
Hello Endpoint Groups GroupSeq Name Headers
| Whisper Content
| Shout Group Content
| Join Group GroupSeq
| Leave Group GroupSeq
| Ping
| PingOk
deriving (Int -> ZRECmd -> ShowS
[ZRECmd] -> ShowS
ZRECmd -> String
(Int -> ZRECmd -> ShowS)
-> (ZRECmd -> String) -> ([ZRECmd] -> ShowS) -> Show ZRECmd
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ZRECmd] -> ShowS
$cshowList :: [ZRECmd] -> ShowS
show :: ZRECmd -> String
$cshow :: ZRECmd -> String
showsPrec :: Int -> ZRECmd -> ShowS
$cshowsPrec :: Int -> ZRECmd -> ShowS
Show, ZRECmd -> ZRECmd -> Bool
(ZRECmd -> ZRECmd -> Bool)
-> (ZRECmd -> ZRECmd -> Bool) -> Eq ZRECmd
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ZRECmd -> ZRECmd -> Bool
$c/= :: ZRECmd -> ZRECmd -> Bool
== :: ZRECmd -> ZRECmd -> Bool
$c== :: ZRECmd -> ZRECmd -> Bool
Eq, Eq ZRECmd
Eq ZRECmd
-> (ZRECmd -> ZRECmd -> Ordering)
-> (ZRECmd -> ZRECmd -> Bool)
-> (ZRECmd -> ZRECmd -> Bool)
-> (ZRECmd -> ZRECmd -> Bool)
-> (ZRECmd -> ZRECmd -> Bool)
-> (ZRECmd -> ZRECmd -> ZRECmd)
-> (ZRECmd -> ZRECmd -> ZRECmd)
-> Ord ZRECmd
ZRECmd -> ZRECmd -> Bool
ZRECmd -> ZRECmd -> Ordering
ZRECmd -> ZRECmd -> ZRECmd
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ZRECmd -> ZRECmd -> ZRECmd
$cmin :: ZRECmd -> ZRECmd -> ZRECmd
max :: ZRECmd -> ZRECmd -> ZRECmd
$cmax :: ZRECmd -> ZRECmd -> ZRECmd
>= :: ZRECmd -> ZRECmd -> Bool
$c>= :: ZRECmd -> ZRECmd -> Bool
> :: ZRECmd -> ZRECmd -> Bool
$c> :: ZRECmd -> ZRECmd -> Bool
<= :: ZRECmd -> ZRECmd -> Bool
$c<= :: ZRECmd -> ZRECmd -> Bool
< :: ZRECmd -> ZRECmd -> Bool
$c< :: ZRECmd -> ZRECmd -> Bool
compare :: ZRECmd -> ZRECmd -> Ordering
$ccompare :: ZRECmd -> ZRECmd -> Ordering
$cp1Ord :: Eq ZRECmd
Ord)
zreBeacon :: ByteString -> Port -> ByteString
zreBeacon :: ByteString -> Int -> ByteString
zreBeacon ByteString
uuid Int
port = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
ByteString -> Put
putByteString ByteString
"ZRE"
Int8 -> Put
putInt8 (Int8 -> Put) -> Int8 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
0x01 :: Int)
ByteString -> Put
putByteString ByteString
uuid
Int16 -> Put
putInt16be (Int16 -> Put) -> Int16 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
port
parseUUID :: Get UUID
parseUUID :: Get UUID
parseUUID = do
Maybe UUID
muuid <- ByteString -> Maybe UUID
fromByteString (ByteString -> Maybe UUID)
-> (ByteString -> ByteString) -> ByteString -> Maybe UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.fromStrict (ByteString -> Maybe UUID) -> Get ByteString -> Get (Maybe UUID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
16
case Maybe UUID
muuid of
Just UUID
uuid -> UUID -> Get UUID
forall (m :: * -> *) a. Monad m => a -> m a
return UUID
uuid
Maybe UUID
Nothing -> String -> Get UUID
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unable to parse UUID"
parseBeacon :: ByteString
-> (Either String (ByteString, Integer, UUID, Integer))
parseBeacon :: ByteString -> Either String (ByteString, Integer, UUID, Integer)
parseBeacon = Get (ByteString, Integer, UUID, Integer)
-> ByteString -> Either String (ByteString, Integer, UUID, Integer)
forall a. Get a -> ByteString -> Either String a
runGet (Get (ByteString, Integer, UUID, Integer)
-> ByteString
-> Either String (ByteString, Integer, UUID, Integer))
-> Get (ByteString, Integer, UUID, Integer)
-> ByteString
-> Either String (ByteString, Integer, UUID, Integer)
forall a b. (a -> b) -> a -> b
$ do
ByteString
lead <- Int -> Get ByteString
getByteString Int
3
Integer
ver <- Get Integer
forall a. Integral a => Get a
getInt8
UUID
uuid <- Get UUID
parseUUID
Integer
port <- Get Integer
forall a. Integral a => Get a
getInt16
(ByteString, Integer, UUID, Integer)
-> Get (ByteString, Integer, UUID, Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
lead, Integer
ver, UUID
uuid, Integer
port)
cmdCode :: ZRECmd -> Word8
cmdCode :: ZRECmd -> Word8
cmdCode (Hello Endpoint
_ Groups
_ Int
_ ByteString
_ Headers
_) = Word8
0x01
cmdCode (Whisper Content
_) = Word8
0x02
cmdCode (Shout Group
_ Content
_) = Word8
0x03
cmdCode (Join Group
_ Int
_) = Word8
0x04
cmdCode (Leave Group
_ Int
_) = Word8
0x05
cmdCode ZRECmd
Ping = Word8
0x06
cmdCode ZRECmd
PingOk = Word8
0x07
getContent :: ZRECmd -> Content
getContent :: ZRECmd -> Content
getContent (Whisper Content
c) = Content
c
getContent (Shout Group
_ Content
c) = Content
c
getContent ZRECmd
_ = []
newZRE :: Seq -> ZRECmd -> ZREMsg
newZRE :: Int -> ZRECmd -> ZREMsg
newZRE Int
seqNum ZRECmd
cmd = Maybe UUID -> Int -> Maybe UTCTime -> ZRECmd -> ZREMsg
ZREMsg Maybe UUID
forall a. Maybe a
Nothing Int
seqNum Maybe UTCTime
forall a. Maybe a
Nothing ZRECmd
cmd
encodeZRE :: ZREMsg -> [ByteString]
encodeZRE :: ZREMsg -> Content
encodeZRE ZREMsg{Int
Maybe UTCTime
Maybe UUID
ZRECmd
msgCmd :: ZRECmd
msgTime :: Maybe UTCTime
msgSeq :: Int
msgFrom :: Maybe UUID
msgCmd :: ZREMsg -> ZRECmd
msgTime :: ZREMsg -> Maybe UTCTime
msgSeq :: ZREMsg -> Int
msgFrom :: ZREMsg -> Maybe UUID
..} = ByteString
msgByteString -> Content -> Content
forall a. a -> [a] -> [a]
:(ZRECmd -> Content
getContent ZRECmd
msgCmd)
where
msg :: ByteString
msg = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
Word16 -> Put
putWord16be Word16
zreSig
Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ ZRECmd -> Word8
cmdCode ZRECmd
msgCmd
Int8 -> Put
putInt8 (Int8 -> Put) -> Int8 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
zreVer
Int16 -> Put
putInt16be (Int16 -> Put) -> Int16 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
msgSeq
ZRECmd -> Put
encodeCmd ZRECmd
msgCmd
encodeCmd :: ZRECmd -> PutM ()
encodeCmd :: ZRECmd -> Put
encodeCmd (Hello Endpoint
endpoint Groups
groups Int
statusSeq ByteString
name Headers
headers) = do
ByteString -> Put
putByteStringLen (Endpoint -> ByteString
pEndpoint Endpoint
endpoint)
Set ByteString -> Put
forall (t :: * -> *). Foldable t => t ByteString -> Put
putByteStrings (Set ByteString -> Put) -> Set ByteString -> Put
forall a b. (a -> b) -> a -> b
$ ((Group -> ByteString) -> Groups -> Set ByteString
forall b a. Ord b => (a -> b) -> Set a -> Set b
Data.Set.map (\(Group ByteString
g) -> ByteString
g)) Groups
groups
Int8 -> Put
putInt8 (Int8 -> Put) -> Int8 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
statusSeq
ByteString -> Put
putByteStringLen ByteString
name
Headers -> Put
putMap Headers
headers
encodeCmd (Shout Group
group Content
_content) = Group -> Put
putGroup Group
group
encodeCmd (Join Group
group Int
statusSeq) = do
Group -> Put
putGroup Group
group
Int8 -> Put
putInt8 (Int8 -> Put) -> Int8 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
statusSeq
encodeCmd (Leave Group
group Int
statusSeq) = do
Group -> Put
putGroup Group
group
Int8 -> Put
putInt8 (Int8 -> Put) -> Int8 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
statusSeq
encodeCmd ZRECmd
_ = () -> Put
forall (m :: * -> *) a. Monad m => a -> m a
return ()
putGroup :: Group -> PutM ()
putGroup :: Group -> Put
putGroup (Group ByteString
g) = ByteString -> Put
putByteStringLen ByteString
g
parseHello :: Get ZRECmd
parseHello :: Get ZRECmd
parseHello = Endpoint -> Groups -> Int -> ByteString -> Headers -> ZRECmd
Hello
(Endpoint -> Groups -> Int -> ByteString -> Headers -> ZRECmd)
-> Get Endpoint
-> Get (Groups -> Int -> ByteString -> Headers -> ZRECmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Endpoint
parseEndpoint'
Get (Groups -> Int -> ByteString -> Headers -> ZRECmd)
-> Get Groups -> Get (Int -> ByteString -> Headers -> ZRECmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Group] -> Groups
forall a. Ord a => [a] -> Set a
Data.Set.fromList ([Group] -> Groups) -> (Content -> [Group]) -> Content -> Groups
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Group) -> Content -> [Group]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Group
Group (Content -> Groups) -> Get Content -> Get Groups
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Content
parseStrings)
Get (Int -> ByteString -> Headers -> ZRECmd)
-> Get Int -> Get (ByteString -> Headers -> ZRECmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
forall a. Integral a => Get a
getInt8
Get (ByteString -> Headers -> ZRECmd)
-> Get ByteString -> Get (Headers -> ZRECmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ByteString
parseString
Get (Headers -> ZRECmd) -> Get Headers -> Get ZRECmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Headers
parseMap
where
parseEndpoint' :: Get Endpoint
parseEndpoint' = do
ByteString
s <- Get ByteString
parseString
case ByteString -> Either String Endpoint
parseAttoEndpoint ByteString
s of
(Left String
err) -> String -> Get Endpoint
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get Endpoint) -> String -> Get Endpoint
forall a b. (a -> b) -> a -> b
$ String
"Unable to parse endpoint: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err
(Right Endpoint
endpoint) -> Endpoint -> Get Endpoint
forall (m :: * -> *) a. Monad m => a -> m a
return Endpoint
endpoint
parseGroup :: Get Group
parseGroup :: Get Group
parseGroup = ByteString -> Group
Group (ByteString -> Group) -> Get ByteString -> Get Group
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
parseString
parseShout :: Content -> Get ZRECmd
parseShout :: Content -> Get ZRECmd
parseShout Content
frames = Group -> Content -> ZRECmd
Shout (Group -> Content -> ZRECmd)
-> Get Group -> Get (Content -> ZRECmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Group
parseGroup Get (Content -> ZRECmd) -> Get Content -> Get ZRECmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Content -> Get Content
forall (f :: * -> *) a. Applicative f => a -> f a
pure Content
frames
parseJoin :: Get ZRECmd
parseJoin :: Get ZRECmd
parseJoin = Group -> Int -> ZRECmd
Join (Group -> Int -> ZRECmd) -> Get Group -> Get (Int -> ZRECmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Group
parseGroup Get (Int -> ZRECmd) -> Get Int -> Get ZRECmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
forall a. Integral a => Get a
getInt8
parseLeave :: Get ZRECmd
parseLeave :: Get ZRECmd
parseLeave = Group -> Int -> ZRECmd
Leave (Group -> Int -> ZRECmd) -> Get Group -> Get (Int -> ZRECmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Group
parseGroup Get (Int -> ZRECmd) -> Get Int -> Get ZRECmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
forall a. Integral a => Get a
getInt8
parseCmd :: ByteString -> Content -> Get ZREMsg
parseCmd :: ByteString -> Content -> Get ZREMsg
parseCmd ByteString
from Content
frames = do
Int
cmd <- (Get Int
forall a. Integral a => Get a
getInt8 :: Get Int)
Int
ver <- Get Int
forall a. Integral a => Get a
getInt8
Int
sqn <- Get Int
forall a. Integral a => Get a
getInt16
case Get UUID -> ByteString -> Either String UUID
forall a. Get a -> ByteString -> Either String a
runGet Get UUID
parseUUID ByteString
from of
(Left String
err) -> String -> Get ZREMsg
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ZREMsg) -> String -> Get ZREMsg
forall a b. (a -> b) -> a -> b
$ String
"No UUID: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err
(Right UUID
uuid)-> do
if Int
ver Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
zreVer
then String -> Get ZREMsg
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Protocol version mismatch"
else do
ZRECmd
zcmd <- case Int
cmd of
Int
0x01 -> Get ZRECmd
parseHello
Int
0x02 -> ZRECmd -> Get ZRECmd
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ZRECmd -> Get ZRECmd) -> ZRECmd -> Get ZRECmd
forall a b. (a -> b) -> a -> b
$ Content -> ZRECmd
Whisper Content
frames
Int
0x03 -> Content -> Get ZRECmd
parseShout Content
frames
Int
0x04 -> Get ZRECmd
parseJoin
Int
0x05 -> Get ZRECmd
parseLeave
Int
0x06 -> ZRECmd -> Get ZRECmd
forall (f :: * -> *) a. Applicative f => a -> f a
pure ZRECmd
Ping
Int
0x07 -> ZRECmd -> Get ZRECmd
forall (f :: * -> *) a. Applicative f => a -> f a
pure ZRECmd
PingOk
Int
_ -> String -> Get ZRECmd
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unknown command"
ZREMsg -> Get ZREMsg
forall (m :: * -> *) a. Monad m => a -> m a
return (ZREMsg -> Get ZREMsg) -> ZREMsg -> Get ZREMsg
forall a b. (a -> b) -> a -> b
$ Maybe UUID -> Int -> Maybe UTCTime -> ZRECmd -> ZREMsg
ZREMsg (UUID -> Maybe UUID
forall a. a -> Maybe a
Just UUID
uuid) Int
sqn Maybe UTCTime
forall a. Maybe a
Nothing ZRECmd
zcmd
parseZRE :: [ByteString] -> Either String ZREMsg
parseZRE :: Content -> Either String ZREMsg
parseZRE (ByteString
from:ByteString
msg:Content
rest) = ByteString -> ByteString -> Content -> Either String ZREMsg
parseZre ByteString
from ByteString
msg Content
rest
parseZRE Content
_ = String -> Either String ZREMsg
forall a b. a -> Either a b
Left String
"empty message"
parseZre :: ByteString -> ByteString -> Content -> Either String ZREMsg
parseZre :: ByteString -> ByteString -> Content -> Either String ZREMsg
parseZre ByteString
from ByteString
msg Content
frames = (Get ZREMsg -> ByteString -> Either String ZREMsg)
-> ByteString -> Get ZREMsg -> Either String ZREMsg
forall a b c. (a -> b -> c) -> b -> a -> c
flip Get ZREMsg -> ByteString -> Either String ZREMsg
forall a. Get a -> ByteString -> Either String a
runGet ByteString
msg (Get ZREMsg -> Either String ZREMsg)
-> Get ZREMsg -> Either String ZREMsg
forall a b. (a -> b) -> a -> b
$ do
Word16
sig <- Get Word16
forall a. Integral a => Get a
getInt16
if Word16
sig Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word16
zreSig
then String -> Get ZREMsg
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Signature mismatch"
else do
ZREMsg
res <- ByteString -> Content -> Get ZREMsg
parseCmd (ByteString -> ByteString
B.tail ByteString
from) Content
frames
ZREMsg -> Get ZREMsg
forall (m :: * -> *) a. Monad m => a -> m a
return ZREMsg
res