Add initial node to server hello packet

This commit is contained in:
Joscha 2020-02-08 15:12:42 +00:00
parent c8dbebaa98
commit cde21038cb

View file

@ -101,22 +101,22 @@ instance FromJSON ClientPacket where
{- Server -} {- Server -}
data ServerPacket data ServerPacket
= ServerHello ![T.Text] = ServerHello ![T.Text] !Node
| ServerUpdate !Path !Node | ServerUpdate !Path !Node
deriving (Show) deriving (Show)
instance ToJSON ServerPacket where instance ToJSON ServerPacket where
toJSON (ServerHello extensions) = toJSON (ServerHello extensions node) =
object ["type" .= ("hello" :: T.Text), "extensions" .= extensions] object ["type" .= ("hello" :: T.Text), "extensions" .= extensions, "node" .= node]
toJSON (ServerUpdate path node) = toJSON (ServerUpdate path node) =
object ["type" .= ("update" :: T.Text), "path" .= path, "node" .= node] object ["type" .= ("update" :: T.Text), "path" .= path, "node" .= node]
toEncoding (ServerHello extensions) = toEncoding (ServerHello extensions node) =
pairs ("type" .= ("hello" :: T.Text) <> "extensions" .= extensions) pairs ("type" .= ("hello" :: T.Text) <> "extensions" .= extensions <> "node" .= node)
toEncoding (ServerUpdate path node) = toEncoding (ServerUpdate path node) =
pairs ("type" .= ("update" :: T.Text) <> "path" .= path <> "node" .= node) pairs ("type" .= ("update" :: T.Text) <> "path" .= path <> "node" .= node)
instance FromJSON ServerPacket where instance FromJSON ServerPacket where
parseJSON v = parseJSON v =
parsePacket v "hello" (\o -> ServerHello <$> o .: "extensions") <|> parsePacket v "hello" (\o -> ServerHello <$> o .: "extensions" <*> o .: "node") <|>
parsePacket v "update" (\o -> ServerUpdate <$> o .: "path" <*> o .: "node") parsePacket v "update" (\o -> ServerUpdate <$> o .: "path" <*> o .: "node")