{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Ouroboros.Network.Protocol.Handshake.Codec
( codecHandshake
, byteLimitsHandshake
, timeLimitsHandshake
, noTimeLimitsHandshake
, encodeRefuseReason
, decodeRefuseReason
, VersionDataCodec (..)
, cborTermVersionDataCodec
, nodeToNodeHandshakeCodec
, nodeToClientHandshakeCodec
) where
import Control.Monad (replicateM, unless)
import Control.Monad.Class.MonadST
import Control.Monad.Class.MonadTime.SI
import Data.ByteString.Lazy (ByteString)
import Data.ByteString.Lazy qualified as BL
import Data.Either (partitionEithers)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe (mapMaybe)
import Data.Text (Text)
import Text.Printf
import Network.TypedProtocol.Codec.CBOR
import Codec.CBOR.Decoding qualified as CBOR
import Codec.CBOR.Encoding qualified as CBOR
import Codec.CBOR.Read qualified as CBOR
import Codec.CBOR.Term qualified as CBOR
import Ouroboros.Network.CodecCBORTerm
import Ouroboros.Network.Driver.Limits
import Ouroboros.Network.Protocol.Handshake.Type
import Ouroboros.Network.Protocol.Limits
import Ouroboros.Network.NodeToClient.Version (NodeToClientVersion,
nodeToClientVersionCodec)
import Ouroboros.Network.NodeToNode.Version (NodeToNodeVersion,
nodeToNodeVersionCodec)
data VersionDataCodec bytes vNumber vData = VersionDataCodec {
forall bytes vNumber vData.
VersionDataCodec bytes vNumber vData -> vNumber -> vData -> bytes
encodeData :: vNumber -> vData -> bytes,
forall bytes vNumber vData.
VersionDataCodec bytes vNumber vData
-> vNumber -> bytes -> Either Text vData
decodeData :: vNumber -> bytes -> Either Text vData
}
cborTermVersionDataCodec :: (vNumber -> CodecCBORTerm Text vData)
-> VersionDataCodec CBOR.Term vNumber vData
cborTermVersionDataCodec :: forall vNumber vData.
(vNumber -> CodecCBORTerm Text vData)
-> VersionDataCodec Term vNumber vData
cborTermVersionDataCodec vNumber -> CodecCBORTerm Text vData
codec = VersionDataCodec {
encodeData :: vNumber -> vData -> Term
encodeData = CodecCBORTerm Text vData -> vData -> Term
forall fail a. CodecCBORTerm fail a -> a -> Term
encodeTerm (CodecCBORTerm Text vData -> vData -> Term)
-> (vNumber -> CodecCBORTerm Text vData)
-> vNumber
-> vData
-> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. vNumber -> CodecCBORTerm Text vData
codec,
decodeData :: vNumber -> Term -> Either Text vData
decodeData = CodecCBORTerm Text vData -> Term -> Either Text vData
forall fail a. CodecCBORTerm fail a -> Term -> Either fail a
decodeTerm (CodecCBORTerm Text vData -> Term -> Either Text vData)
-> (vNumber -> CodecCBORTerm Text vData)
-> vNumber
-> Term
-> Either Text vData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. vNumber -> CodecCBORTerm Text vData
codec
}
maxTransmissionUnit :: Word
maxTransmissionUnit :: Word
maxTransmissionUnit = Word
4 Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
1440
byteLimitsHandshake :: forall vNumber. ProtocolSizeLimits (Handshake vNumber CBOR.Term) ByteString
byteLimitsHandshake :: forall {k} (vNumber :: k).
ProtocolSizeLimits (Handshake vNumber Term) ByteString
byteLimitsHandshake = (forall (pr :: PeerRole) (st :: Handshake vNumber Term).
PeerHasAgency pr st -> Word)
-> (ByteString -> Word)
-> ProtocolSizeLimits (Handshake vNumber Term) ByteString
forall ps bytes.
(forall (pr :: PeerRole) (st :: ps). PeerHasAgency pr st -> Word)
-> (bytes -> Word) -> ProtocolSizeLimits ps bytes
ProtocolSizeLimits PeerHasAgency pr st -> Word
forall (pr :: PeerRole) (st :: Handshake vNumber Term).
PeerHasAgency pr st -> Word
stateToLimit (Int64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word) -> (ByteString -> Int64) -> ByteString -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BL.length)
where
stateToLimit :: forall (pr :: PeerRole) (st :: Handshake vNumber CBOR.Term).
PeerHasAgency pr st -> Word
stateToLimit :: forall (pr :: PeerRole) (st :: Handshake vNumber Term).
PeerHasAgency pr st -> Word
stateToLimit (ClientAgency ClientHasAgency st
R:ClientHasAgencyHandshakest k (*) vNumber Term st
TokPropose) = Word
maxTransmissionUnit
stateToLimit (ServerAgency ServerHasAgency st
R:ServerHasAgencyHandshakest k (*) vNumber Term st
TokConfirm) = Word
maxTransmissionUnit
timeLimitsHandshake :: forall vNumber. ProtocolTimeLimits (Handshake vNumber CBOR.Term)
timeLimitsHandshake :: forall {k} (vNumber :: k).
ProtocolTimeLimits (Handshake vNumber Term)
timeLimitsHandshake = (forall (pr :: PeerRole) (st :: Handshake vNumber Term).
PeerHasAgency pr st -> Maybe DiffTime)
-> ProtocolTimeLimits (Handshake vNumber Term)
forall ps.
(forall (pr :: PeerRole) (st :: ps).
PeerHasAgency pr st -> Maybe DiffTime)
-> ProtocolTimeLimits ps
ProtocolTimeLimits PeerHasAgency pr st -> Maybe DiffTime
forall (pr :: PeerRole) (st :: Handshake vNumber Term).
PeerHasAgency pr st -> Maybe DiffTime
stateToLimit
where
stateToLimit :: forall (pr :: PeerRole) (st :: Handshake vNumber CBOR.Term).
PeerHasAgency pr st -> Maybe DiffTime
stateToLimit :: forall (pr :: PeerRole) (st :: Handshake vNumber Term).
PeerHasAgency pr st -> Maybe DiffTime
stateToLimit (ClientAgency ClientHasAgency st
R:ClientHasAgencyHandshakest k (*) vNumber Term st
TokPropose) = Maybe DiffTime
shortWait
stateToLimit (ServerAgency ServerHasAgency st
R:ServerHasAgencyHandshakest k (*) vNumber Term st
TokConfirm) = Maybe DiffTime
shortWait
noTimeLimitsHandshake :: forall vNumber. ProtocolTimeLimits (Handshake vNumber CBOR.Term)
noTimeLimitsHandshake :: forall {k} (vNumber :: k).
ProtocolTimeLimits (Handshake vNumber Term)
noTimeLimitsHandshake = (forall (pr :: PeerRole) (st :: Handshake vNumber Term).
PeerHasAgency pr st -> Maybe DiffTime)
-> ProtocolTimeLimits (Handshake vNumber Term)
forall ps.
(forall (pr :: PeerRole) (st :: ps).
PeerHasAgency pr st -> Maybe DiffTime)
-> ProtocolTimeLimits ps
ProtocolTimeLimits PeerHasAgency pr st -> Maybe DiffTime
forall (pr :: PeerRole) (st :: Handshake vNumber Term).
PeerHasAgency pr st -> Maybe DiffTime
stateToLimit
where
stateToLimit :: forall (pr :: PeerRole) (st :: Handshake vNumber CBOR.Term).
PeerHasAgency pr st -> Maybe DiffTime
stateToLimit :: forall (pr :: PeerRole) (st :: Handshake vNumber Term).
PeerHasAgency pr st -> Maybe DiffTime
stateToLimit (ClientAgency ClientHasAgency st
R:ClientHasAgencyHandshakest k (*) vNumber Term st
TokPropose) = Maybe DiffTime
forall a. Maybe a
Nothing
stateToLimit (ServerAgency ServerHasAgency st
R:ServerHasAgencyHandshakest k (*) vNumber Term st
TokConfirm) = Maybe DiffTime
forall a. Maybe a
Nothing
codecHandshake
:: forall vNumber m failure.
( MonadST m
, Ord vNumber
, Show failure
)
=> CodecCBORTerm (failure, Maybe Int) vNumber
-> Codec (Handshake vNumber CBOR.Term) CBOR.DeserialiseFailure m ByteString
codecHandshake :: forall vNumber (m :: * -> *) failure.
(MonadST m, Ord vNumber, Show failure) =>
CodecCBORTerm (failure, Maybe Int) vNumber
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
codecHandshake CodecCBORTerm (failure, Maybe Int) vNumber
versionNumberCodec = (forall (pr :: PeerRole) (st :: Handshake vNumber Term)
(st' :: Handshake vNumber Term).
PeerHasAgency pr st
-> Message (Handshake vNumber Term) st st' -> Encoding)
-> (forall (pr :: PeerRole) (st :: Handshake vNumber Term) s.
PeerHasAgency pr st -> Decoder s (SomeMessage st))
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
forall ps (m :: * -> *).
MonadST m =>
(forall (pr :: PeerRole) (st :: ps) (st' :: ps).
PeerHasAgency pr st -> Message ps st st' -> Encoding)
-> (forall (pr :: PeerRole) (st :: ps) s.
PeerHasAgency pr st -> Decoder s (SomeMessage st))
-> Codec ps DeserialiseFailure m ByteString
mkCodecCborLazyBS PeerHasAgency pr st
-> Message (Handshake vNumber Term) st st' -> Encoding
forall (pr :: PeerRole) (st :: Handshake vNumber Term)
(st' :: Handshake vNumber Term).
PeerHasAgency pr st
-> Message (Handshake vNumber Term) st st' -> Encoding
encodeMsg PeerHasAgency pr st -> Decoder s (SomeMessage st)
forall (pr :: PeerRole) s (st :: Handshake vNumber Term).
PeerHasAgency pr st -> Decoder s (SomeMessage st)
forall (pr :: PeerRole) (st :: Handshake vNumber Term) s.
PeerHasAgency pr st -> Decoder s (SomeMessage st)
decodeMsg
where
encodeMsg
:: forall (pr :: PeerRole) st st'.
PeerHasAgency pr st
-> Message (Handshake vNumber CBOR.Term) st st'
-> CBOR.Encoding
encodeMsg :: forall (pr :: PeerRole) (st :: Handshake vNumber Term)
(st' :: Handshake vNumber Term).
PeerHasAgency pr st
-> Message (Handshake vNumber Term) st st' -> Encoding
encodeMsg (ClientAgency ClientHasAgency st
R:ClientHasAgencyHandshakest (*) (*) vNumber Term st
TokPropose) (MsgProposeVersions Map vNumber1 vParams1
vs) =
Word -> Encoding
CBOR.encodeListLen Word
2
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
0
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CodecCBORTerm (failure, Maybe Int) vNumber
-> Map vNumber Term -> Encoding
forall failure vNumber.
CodecCBORTerm (failure, Maybe Int) vNumber
-> Map vNumber Term -> Encoding
encodeVersions CodecCBORTerm (failure, Maybe Int) vNumber
versionNumberCodec Map vNumber Term
Map vNumber1 vParams1
vs
encodeMsg (ServerAgency ServerHasAgency st
R:ServerHasAgencyHandshakest (*) (*) vNumber Term st
TokConfirm) (MsgReplyVersions Map vNumber1 vParams1
vs)
= Word -> Encoding
CBOR.encodeListLen Word
2
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
0
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CodecCBORTerm (failure, Maybe Int) vNumber
-> Map vNumber Term -> Encoding
forall failure vNumber.
CodecCBORTerm (failure, Maybe Int) vNumber
-> Map vNumber Term -> Encoding
encodeVersions CodecCBORTerm (failure, Maybe Int) vNumber
versionNumberCodec Map vNumber Term
Map vNumber1 vParams1
vs
encodeMsg (ServerAgency ServerHasAgency st
R:ServerHasAgencyHandshakest (*) (*) vNumber Term st
TokConfirm) (MsgAcceptVersion vNumber1
vNumber vParams1
vParams) =
Word -> Encoding
CBOR.encodeListLen Word
3
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
1
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Term -> Encoding
CBOR.encodeTerm (CodecCBORTerm (failure, Maybe Int) vNumber -> vNumber -> Term
forall fail a. CodecCBORTerm fail a -> a -> Term
encodeTerm CodecCBORTerm (failure, Maybe Int) vNumber
versionNumberCodec vNumber
vNumber1
vNumber)
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Term -> Encoding
CBOR.encodeTerm vParams1
Term
vParams
encodeMsg (ServerAgency ServerHasAgency st
R:ServerHasAgencyHandshakest (*) (*) vNumber Term st
TokConfirm) (MsgRefuse RefuseReason vNumber1
vReason) =
Word -> Encoding
CBOR.encodeListLen Word
2
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
2
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CodecCBORTerm (failure, Maybe Int) vNumber
-> RefuseReason vNumber -> Encoding
forall fail vNumber.
CodecCBORTerm fail vNumber -> RefuseReason vNumber -> Encoding
encodeRefuseReason CodecCBORTerm (failure, Maybe Int) vNumber
versionNumberCodec RefuseReason vNumber
RefuseReason vNumber1
vReason
encodeMsg (ServerAgency ServerHasAgency st
R:ServerHasAgencyHandshakest (*) (*) vNumber Term st
TokConfirm) (MsgQueryReply Map vNumber1 vParams1
vs)
= Word -> Encoding
CBOR.encodeListLen Word
2
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
3
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CodecCBORTerm (failure, Maybe Int) vNumber
-> Map vNumber Term -> Encoding
forall failure vNumber.
CodecCBORTerm (failure, Maybe Int) vNumber
-> Map vNumber Term -> Encoding
encodeVersions CodecCBORTerm (failure, Maybe Int) vNumber
versionNumberCodec Map vNumber Term
Map vNumber1 vParams1
vs
decodeMsg :: forall (pr :: PeerRole) s (st :: Handshake vNumber CBOR.Term).
PeerHasAgency pr st
-> CBOR.Decoder s (SomeMessage st)
decodeMsg :: forall (pr :: PeerRole) s (st :: Handshake vNumber Term).
PeerHasAgency pr st -> Decoder s (SomeMessage st)
decodeMsg PeerHasAgency pr st
stok = do
len <- Decoder s Int
forall s. Decoder s Int
CBOR.decodeListLen
key <- CBOR.decodeWord
case (stok, key, len) of
(ClientAgency ClientHasAgency st
R:ClientHasAgencyHandshakest (*) (*) vNumber Term st
TokPropose, Word
0, Int
2) -> do
l <- Decoder s Int
forall s. Decoder s Int
CBOR.decodeMapLen
vMap <- decodeVersions versionNumberCodec l
pure $ SomeMessage $ MsgProposeVersions vMap
(ServerAgency ServerHasAgency st
R:ServerHasAgencyHandshakest (*) (*) vNumber Term st
TokConfirm, Word
0, Int
2) -> do
l <- Decoder s Int
forall s. Decoder s Int
CBOR.decodeMapLen
vMap <- decodeVersions versionNumberCodec l
pure $ SomeMessage $ MsgReplyVersions vMap
(ServerAgency ServerHasAgency st
R:ServerHasAgencyHandshakest (*) (*) vNumber Term st
TokConfirm, Word
1, Int
3) -> do
v <- CodecCBORTerm (failure, Maybe Int) vNumber
-> Term -> Either (failure, Maybe Int) vNumber
forall fail a. CodecCBORTerm fail a -> Term -> Either fail a
decodeTerm CodecCBORTerm (failure, Maybe Int) vNumber
versionNumberCodec (Term -> Either (failure, Maybe Int) vNumber)
-> Decoder s Term
-> Decoder s (Either (failure, Maybe Int) vNumber)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Term
forall s. Decoder s Term
CBOR.decodeTerm
case v of
Left (failure, Maybe Int)
e -> String -> Decoder s (SomeMessage st)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"codecHandshake.MsgAcceptVersion: not recognized version: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (failure, Maybe Int) -> String
forall a. Show a => a -> String
show (failure, Maybe Int)
e)
Right vNumber
vNumber ->
Message (Handshake vNumber Term) st 'StDone -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage (Message (Handshake vNumber Term) st 'StDone -> SomeMessage st)
-> (Term -> Message (Handshake vNumber Term) st 'StDone)
-> Term
-> SomeMessage st
forall b c a. (b -> c) -> (a -> b) -> a -> c
. vNumber
-> Term -> Message (Handshake vNumber Term) 'StConfirm 'StDone
forall vNumber1 vParams1.
vNumber1
-> vParams1
-> Message (Handshake vNumber1 vParams1) 'StConfirm 'StDone
MsgAcceptVersion vNumber
vNumber (Term -> SomeMessage st)
-> Decoder s Term -> Decoder s (SomeMessage st)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Term
forall s. Decoder s Term
CBOR.decodeTerm
(ServerAgency ServerHasAgency st
R:ServerHasAgencyHandshakest (*) (*) vNumber Term st
TokConfirm, Word
2, Int
2) ->
Message (Handshake vNumber Term) st 'StDone -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage (Message (Handshake vNumber Term) st 'StDone -> SomeMessage st)
-> (RefuseReason vNumber
-> Message (Handshake vNumber Term) st 'StDone)
-> RefuseReason vNumber
-> SomeMessage st
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RefuseReason vNumber -> Message (Handshake vNumber Term) st 'StDone
RefuseReason vNumber
-> Message (Handshake vNumber Term) 'StConfirm 'StDone
forall {k1} vNumber1 (vParams :: k1).
RefuseReason vNumber1
-> Message (Handshake vNumber1 vParams) 'StConfirm 'StDone
MsgRefuse (RefuseReason vNumber -> SomeMessage st)
-> Decoder s (RefuseReason vNumber) -> Decoder s (SomeMessage st)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodecCBORTerm (failure, Maybe Int) vNumber
-> Decoder s (RefuseReason vNumber)
forall failure vNumber s.
Show failure =>
CodecCBORTerm (failure, Maybe Int) vNumber
-> Decoder s (RefuseReason vNumber)
decodeRefuseReason CodecCBORTerm (failure, Maybe Int) vNumber
versionNumberCodec
(ServerAgency ServerHasAgency st
R:ServerHasAgencyHandshakest (*) (*) vNumber Term st
TokConfirm, Word
3, Int
2) -> do
l <- Decoder s Int
forall s. Decoder s Int
CBOR.decodeMapLen
vMap <- decodeVersions versionNumberCodec l
pure $ SomeMessage $ MsgQueryReply vMap
(ClientAgency ClientHasAgency st
R:ClientHasAgencyHandshakest (*) (*) vNumber Term st
TokPropose, Word
_, Int
_) ->
String -> Decoder s (SomeMessage st)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (SomeMessage st))
-> String -> Decoder s (SomeMessage st)
forall a b. (a -> b) -> a -> b
$ String -> String -> Word -> Int -> String
forall r. PrintfType r => String -> r
printf String
"codecHandshake (%s) unexpected key (%d, %d)" (PeerHasAgency pr st -> String
forall a. Show a => a -> String
show PeerHasAgency pr st
stok) Word
key Int
len
(ServerAgency ServerHasAgency st
R:ServerHasAgencyHandshakest (*) (*) vNumber Term st
TokConfirm, Word
_, Int
_) ->
String -> Decoder s (SomeMessage st)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (SomeMessage st))
-> String -> Decoder s (SomeMessage st)
forall a b. (a -> b) -> a -> b
$ String -> String -> Word -> Int -> String
forall r. PrintfType r => String -> r
printf String
"codecHandshake (%s) unexpected key (%d, %d)" (PeerHasAgency pr st -> String
forall a. Show a => a -> String
show PeerHasAgency pr st
stok) Word
key Int
len
encodeVersions :: CodecCBORTerm (failure, Maybe Int) vNumber
-> Map vNumber CBOR.Term
-> CBOR.Encoding
encodeVersions :: forall failure vNumber.
CodecCBORTerm (failure, Maybe Int) vNumber
-> Map vNumber Term -> Encoding
encodeVersions CodecCBORTerm (failure, Maybe Int) vNumber
versionNumberCodec Map vNumber Term
vs =
Word -> Encoding
CBOR.encodeMapLen (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Map vNumber Term -> Int
forall k a. Map k a -> Int
Map.size Map vNumber Term
vs))
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (vNumber -> Term -> Encoding) -> Map vNumber Term -> Encoding
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey
(\vNumber
vNumber Term
vParams ->
Term -> Encoding
CBOR.encodeTerm (CodecCBORTerm (failure, Maybe Int) vNumber -> vNumber -> Term
forall fail a. CodecCBORTerm fail a -> a -> Term
encodeTerm CodecCBORTerm (failure, Maybe Int) vNumber
versionNumberCodec vNumber
vNumber)
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Term -> Encoding
CBOR.encodeTerm Term
vParams
)
Map vNumber Term
vs
decodeVersions :: forall vNumber failure s.
Ord vNumber
=> CodecCBORTerm (failure, Maybe Int) vNumber
-> Int
-> CBOR.Decoder s (Map vNumber CBOR.Term)
decodeVersions :: forall vNumber failure s.
Ord vNumber =>
CodecCBORTerm (failure, Maybe Int) vNumber
-> Int -> Decoder s (Map vNumber Term)
decodeVersions CodecCBORTerm (failure, Maybe Int) vNumber
versionNumberCodec Int
size = Int
-> Maybe vNumber
-> [(vNumber, Term)]
-> Decoder s (Map vNumber Term)
go Int
size Maybe vNumber
forall a. Maybe a
Nothing []
where
go :: Int
-> Maybe vNumber
-> [(vNumber, CBOR.Term)]
-> CBOR.Decoder s (Map vNumber CBOR.Term)
go :: Int
-> Maybe vNumber
-> [(vNumber, Term)]
-> Decoder s (Map vNumber Term)
go Int
0 Maybe vNumber
_ ![(vNumber, Term)]
vs = Map vNumber Term -> Decoder s (Map vNumber Term)
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map vNumber Term -> Decoder s (Map vNumber Term))
-> Map vNumber Term -> Decoder s (Map vNumber Term)
forall a b. (a -> b) -> a -> b
$ [(vNumber, Term)] -> Map vNumber Term
forall k a. [(k, a)] -> Map k a
Map.fromDistinctAscList ([(vNumber, Term)] -> Map vNumber Term)
-> [(vNumber, Term)] -> Map vNumber Term
forall a b. (a -> b) -> a -> b
$ [(vNumber, Term)] -> [(vNumber, Term)]
forall a. [a] -> [a]
reverse [(vNumber, Term)]
vs
go !Int
l !Maybe vNumber
prev ![(vNumber, Term)]
vs = do
vNumberTerm <- Decoder s Term
forall s. Decoder s Term
CBOR.decodeTerm
vParams <- CBOR.decodeTerm
case decodeTerm versionNumberCodec vNumberTerm of
Left (failure, Maybe Int)
_ -> Int
-> Maybe vNumber
-> [(vNumber, Term)]
-> Decoder s (Map vNumber Term)
go (Int -> Int
forall a. Enum a => a -> a
pred Int
l) Maybe vNumber
prev [(vNumber, Term)]
vs
Right vNumber
vNumber -> do
let next :: Maybe vNumber
next = vNumber -> Maybe vNumber
forall a. a -> Maybe a
Just vNumber
vNumber
Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe vNumber
next Maybe vNumber -> Maybe vNumber -> Bool
forall a. Ord a => a -> a -> Bool
> Maybe vNumber
prev)
(Decoder s () -> Decoder s ()) -> Decoder s () -> Decoder s ()
forall a b. (a -> b) -> a -> b
$ String -> Decoder s ()
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"codecHandshake.Propose: unordered version"
Int
-> Maybe vNumber
-> [(vNumber, Term)]
-> Decoder s (Map vNumber Term)
go (Int -> Int
forall a. Enum a => a -> a
pred Int
l) Maybe vNumber
next ((vNumber
vNumber, Term
vParams) (vNumber, Term) -> [(vNumber, Term)] -> [(vNumber, Term)]
forall a. a -> [a] -> [a]
: [(vNumber, Term)]
vs)
encodeRefuseReason :: CodecCBORTerm fail vNumber
-> RefuseReason vNumber
-> CBOR.Encoding
encodeRefuseReason :: forall fail vNumber.
CodecCBORTerm fail vNumber -> RefuseReason vNumber -> Encoding
encodeRefuseReason CodecCBORTerm fail vNumber
versionNumberCodec (VersionMismatch [vNumber]
vs [Int]
_) =
Word -> Encoding
CBOR.encodeListLen Word
2
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
0
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeListLen (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ [vNumber] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [vNumber]
vs)
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (vNumber -> Encoding) -> [vNumber] -> Encoding
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Term -> Encoding
CBOR.encodeTerm (Term -> Encoding) -> (vNumber -> Term) -> vNumber -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodecCBORTerm fail vNumber -> vNumber -> Term
forall fail a. CodecCBORTerm fail a -> a -> Term
encodeTerm CodecCBORTerm fail vNumber
versionNumberCodec) [vNumber]
vs
encodeRefuseReason CodecCBORTerm fail vNumber
versionNumberCodec (HandshakeDecodeError vNumber
vNumber Text
vError) =
Word -> Encoding
CBOR.encodeListLen Word
3
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
1
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Term -> Encoding
CBOR.encodeTerm (CodecCBORTerm fail vNumber -> vNumber -> Term
forall fail a. CodecCBORTerm fail a -> a -> Term
encodeTerm CodecCBORTerm fail vNumber
versionNumberCodec vNumber
vNumber)
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Text -> Encoding
CBOR.encodeString Text
vError
encodeRefuseReason CodecCBORTerm fail vNumber
versionNumberCodec (Refused vNumber
vNumber Text
vReason) =
Word -> Encoding
CBOR.encodeListLen Word
3
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
2
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Term -> Encoding
CBOR.encodeTerm (CodecCBORTerm fail vNumber -> vNumber -> Term
forall fail a. CodecCBORTerm fail a -> a -> Term
encodeTerm CodecCBORTerm fail vNumber
versionNumberCodec vNumber
vNumber)
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Text -> Encoding
CBOR.encodeString Text
vReason
decodeRefuseReason :: Show failure
=> CodecCBORTerm (failure, Maybe Int) vNumber
-> CBOR.Decoder s (RefuseReason vNumber)
decodeRefuseReason :: forall failure vNumber s.
Show failure =>
CodecCBORTerm (failure, Maybe Int) vNumber
-> Decoder s (RefuseReason vNumber)
decodeRefuseReason CodecCBORTerm (failure, Maybe Int) vNumber
versionNumberCodec = do
_ <- Decoder s Int
forall s. Decoder s Int
CBOR.decodeListLen
tag <- CBOR.decodeWord
case tag of
Word
0 -> do
len <- Decoder s Int
forall s. Decoder s Int
CBOR.decodeListLen
rs <- replicateM len
(decodeTerm versionNumberCodec <$> CBOR.decodeTerm)
case partitionEithers rs of
([(failure, Maybe Int)]
errs, [vNumber]
vNumbers) ->
RefuseReason vNumber -> Decoder s (RefuseReason vNumber)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RefuseReason vNumber -> Decoder s (RefuseReason vNumber))
-> RefuseReason vNumber -> Decoder s (RefuseReason vNumber)
forall a b. (a -> b) -> a -> b
$ [vNumber] -> [Int] -> RefuseReason vNumber
forall vNumber. [vNumber] -> [Int] -> RefuseReason vNumber
VersionMismatch [vNumber]
vNumbers (((failure, Maybe Int) -> Maybe Int)
-> [(failure, Maybe Int)] -> [Int]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (failure, Maybe Int) -> Maybe Int
forall a b. (a, b) -> b
snd [(failure, Maybe Int)]
errs)
Word
1 -> do
v <- CodecCBORTerm (failure, Maybe Int) vNumber
-> Term -> Either (failure, Maybe Int) vNumber
forall fail a. CodecCBORTerm fail a -> Term -> Either fail a
decodeTerm CodecCBORTerm (failure, Maybe Int) vNumber
versionNumberCodec (Term -> Either (failure, Maybe Int) vNumber)
-> Decoder s Term
-> Decoder s (Either (failure, Maybe Int) vNumber)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Term
forall s. Decoder s Term
CBOR.decodeTerm
case v of
Left (failure, Maybe Int)
e -> String -> Decoder s (RefuseReason vNumber)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (RefuseReason vNumber))
-> String -> Decoder s (RefuseReason vNumber)
forall a b. (a -> b) -> a -> b
$ String
"decode HandshakeDecodeError: unknow version: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (failure, Maybe Int) -> String
forall a. Show a => a -> String
show (failure, Maybe Int)
e
Right vNumber
vNumber -> vNumber -> Text -> RefuseReason vNumber
forall vNumber. vNumber -> Text -> RefuseReason vNumber
HandshakeDecodeError vNumber
vNumber (Text -> RefuseReason vNumber)
-> Decoder s Text -> Decoder s (RefuseReason vNumber)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Text
forall s. Decoder s Text
CBOR.decodeString
Word
2 -> do
v <- CodecCBORTerm (failure, Maybe Int) vNumber
-> Term -> Either (failure, Maybe Int) vNumber
forall fail a. CodecCBORTerm fail a -> Term -> Either fail a
decodeTerm CodecCBORTerm (failure, Maybe Int) vNumber
versionNumberCodec (Term -> Either (failure, Maybe Int) vNumber)
-> Decoder s Term
-> Decoder s (Either (failure, Maybe Int) vNumber)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Term
forall s. Decoder s Term
CBOR.decodeTerm
case v of
Left (failure, Maybe Int)
e -> String -> Decoder s (RefuseReason vNumber)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (RefuseReason vNumber))
-> String -> Decoder s (RefuseReason vNumber)
forall a b. (a -> b) -> a -> b
$ String
"decode Refused: unknonwn version: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (failure, Maybe Int) -> String
forall a. Show a => a -> String
show (failure, Maybe Int)
e
Right vNumber
vNumber -> vNumber -> Text -> RefuseReason vNumber
forall vNumber. vNumber -> Text -> RefuseReason vNumber
Refused vNumber
vNumber (Text -> RefuseReason vNumber)
-> Decoder s Text -> Decoder s (RefuseReason vNumber)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Text
forall s. Decoder s Text
CBOR.decodeString
Word
_ -> String -> Decoder s (RefuseReason vNumber)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (RefuseReason vNumber))
-> String -> Decoder s (RefuseReason vNumber)
forall a b. (a -> b) -> a -> b
$ String
"decode RefuseReason: unknown tag " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show Word
tag
nodeToNodeHandshakeCodec :: MonadST m
=> Codec (Handshake NodeToNodeVersion CBOR.Term)
CBOR.DeserialiseFailure m BL.ByteString
nodeToNodeHandshakeCodec :: forall (m :: * -> *).
MonadST m =>
Codec
(Handshake NodeToNodeVersion Term) DeserialiseFailure m ByteString
nodeToNodeHandshakeCodec = CodecCBORTerm (Text, Maybe Int) NodeToNodeVersion
-> Codec
(Handshake NodeToNodeVersion Term) DeserialiseFailure m ByteString
forall vNumber (m :: * -> *) failure.
(MonadST m, Ord vNumber, Show failure) =>
CodecCBORTerm (failure, Maybe Int) vNumber
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
codecHandshake CodecCBORTerm (Text, Maybe Int) NodeToNodeVersion
nodeToNodeVersionCodec
nodeToClientHandshakeCodec :: MonadST m
=> Codec (Handshake NodeToClientVersion CBOR.Term)
CBOR.DeserialiseFailure m BL.ByteString
nodeToClientHandshakeCodec :: forall (m :: * -> *).
MonadST m =>
Codec
(Handshake NodeToClientVersion Term)
DeserialiseFailure
m
ByteString
nodeToClientHandshakeCodec = CodecCBORTerm (Text, Maybe Int) NodeToClientVersion
-> Codec
(Handshake NodeToClientVersion Term)
DeserialiseFailure
m
ByteString
forall vNumber (m :: * -> *) failure.
(MonadST m, Ord vNumber, Show failure) =>
CodecCBORTerm (failure, Maybe Int) vNumber
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
codecHandshake CodecCBORTerm (Text, Maybe Int) NodeToClientVersion
nodeToClientVersionCodec