module Erebos.Network.Protocol (
    TransportPacket(..),
    transportToObject,
    TransportHeader(..),
    TransportHeaderItem(..),
    SecurityRequirement(..),

    WaitingRef(..),
    WaitingRefCallback,
    wrDigest,

    ChannelState(..),

    ControlRequest(..),
    ControlMessage(..),
    erebosNetworkProtocol,

    Connection,
    connAddress,
    connData,
    connGetChannel,
    connSetChannel,
    connClose,

    RawStreamReader, RawStreamWriter,
    connAddWriteStream,
    connAddReadStream,
    readStreamToList,
    readObjectsFromStream,
    writeByteStringToStream,

    module Erebos.Flow,
) where

import Control.Applicative
import Control.Concurrent
import Control.Concurrent.Async
import Control.Concurrent.STM
import Control.Monad
import Control.Monad.Except
import Control.Monad.Trans

import Crypto.Cipher.ChaChaPoly1305 qualified as C
import Crypto.MAC.Poly1305 qualified as C (Auth(..), authTag)
import Crypto.Error
import Crypto.Random

import Data.Binary
import Data.Binary.Get
import Data.Binary.Put
import Data.Bits
import Data.ByteArray (Bytes, ScrubbedBytes)
import Data.ByteArray qualified as BA
import Data.ByteString (ByteString)
import Data.ByteString qualified as B
import Data.ByteString.Char8 qualified as BC
import Data.ByteString.Lazy qualified as BL
import Data.Function
import Data.List
import Data.Maybe
import Data.Text (Text)
import Data.Text qualified as T
import Data.Void

import System.Clock

import Erebos.Channel
import Erebos.Flow
import Erebos.Identity
import Erebos.Service
import Erebos.Storage


protocolVersion :: Text
protocolVersion :: Text
protocolVersion = String -> Text
T.pack String
"0.1"

protocolVersions :: [Text]
protocolVersions :: [Text]
protocolVersions = [Text
protocolVersion]

keepAliveInternal :: TimeSpec
keepAliveInternal :: TimeSpec
keepAliveInternal = Integer -> TimeSpec
fromNanoSecs (Integer -> TimeSpec) -> Integer -> TimeSpec
forall a b. (a -> b) -> a -> b
$ Integer
30 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
9 :: Int)


data TransportPacket a = TransportPacket TransportHeader [a]

data TransportHeader = TransportHeader [TransportHeaderItem]
    deriving (Int -> TransportHeader -> ShowS
[TransportHeader] -> ShowS
TransportHeader -> String
(Int -> TransportHeader -> ShowS)
-> (TransportHeader -> String)
-> ([TransportHeader] -> ShowS)
-> Show TransportHeader
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TransportHeader -> ShowS
showsPrec :: Int -> TransportHeader -> ShowS
$cshow :: TransportHeader -> String
show :: TransportHeader -> String
$cshowList :: [TransportHeader] -> ShowS
showList :: [TransportHeader] -> ShowS
Show)

data TransportHeaderItem
    = Acknowledged RefDigest
    | AcknowledgedSingle Integer
    | Rejected RefDigest
    | ProtocolVersion Text
    | Initiation RefDigest
    | CookieSet Cookie
    | CookieEcho Cookie
    | DataRequest RefDigest
    | DataResponse RefDigest
    | AnnounceSelf RefDigest
    | AnnounceUpdate RefDigest
    | TrChannelRequest RefDigest
    | TrChannelAccept RefDigest
    | ServiceType ServiceID
    | ServiceRef RefDigest
    | StreamOpen Word8
    deriving (TransportHeaderItem -> TransportHeaderItem -> Bool
(TransportHeaderItem -> TransportHeaderItem -> Bool)
-> (TransportHeaderItem -> TransportHeaderItem -> Bool)
-> Eq TransportHeaderItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TransportHeaderItem -> TransportHeaderItem -> Bool
== :: TransportHeaderItem -> TransportHeaderItem -> Bool
$c/= :: TransportHeaderItem -> TransportHeaderItem -> Bool
/= :: TransportHeaderItem -> TransportHeaderItem -> Bool
Eq, Int -> TransportHeaderItem -> ShowS
[TransportHeaderItem] -> ShowS
TransportHeaderItem -> String
(Int -> TransportHeaderItem -> ShowS)
-> (TransportHeaderItem -> String)
-> ([TransportHeaderItem] -> ShowS)
-> Show TransportHeaderItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TransportHeaderItem -> ShowS
showsPrec :: Int -> TransportHeaderItem -> ShowS
$cshow :: TransportHeaderItem -> String
show :: TransportHeaderItem -> String
$cshowList :: [TransportHeaderItem] -> ShowS
showList :: [TransportHeaderItem] -> ShowS
Show)

newtype Cookie = Cookie ByteString
    deriving (Cookie -> Cookie -> Bool
(Cookie -> Cookie -> Bool)
-> (Cookie -> Cookie -> Bool) -> Eq Cookie
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cookie -> Cookie -> Bool
== :: Cookie -> Cookie -> Bool
$c/= :: Cookie -> Cookie -> Bool
/= :: Cookie -> Cookie -> Bool
Eq, Int -> Cookie -> ShowS
[Cookie] -> ShowS
Cookie -> String
(Int -> Cookie -> ShowS)
-> (Cookie -> String) -> ([Cookie] -> ShowS) -> Show Cookie
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cookie -> ShowS
showsPrec :: Int -> Cookie -> ShowS
$cshow :: Cookie -> String
show :: Cookie -> String
$cshowList :: [Cookie] -> ShowS
showList :: [Cookie] -> ShowS
Show)

data SecurityRequirement = PlaintextOnly
                         | PlaintextAllowed
                         | EncryptedOnly
    deriving (SecurityRequirement -> SecurityRequirement -> Bool
(SecurityRequirement -> SecurityRequirement -> Bool)
-> (SecurityRequirement -> SecurityRequirement -> Bool)
-> Eq SecurityRequirement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SecurityRequirement -> SecurityRequirement -> Bool
== :: SecurityRequirement -> SecurityRequirement -> Bool
$c/= :: SecurityRequirement -> SecurityRequirement -> Bool
/= :: SecurityRequirement -> SecurityRequirement -> Bool
Eq, Eq SecurityRequirement
Eq SecurityRequirement =>
(SecurityRequirement -> SecurityRequirement -> Ordering)
-> (SecurityRequirement -> SecurityRequirement -> Bool)
-> (SecurityRequirement -> SecurityRequirement -> Bool)
-> (SecurityRequirement -> SecurityRequirement -> Bool)
-> (SecurityRequirement -> SecurityRequirement -> Bool)
-> (SecurityRequirement
    -> SecurityRequirement -> SecurityRequirement)
-> (SecurityRequirement
    -> SecurityRequirement -> SecurityRequirement)
-> Ord SecurityRequirement
SecurityRequirement -> SecurityRequirement -> Bool
SecurityRequirement -> SecurityRequirement -> Ordering
SecurityRequirement -> SecurityRequirement -> SecurityRequirement
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
$ccompare :: SecurityRequirement -> SecurityRequirement -> Ordering
compare :: SecurityRequirement -> SecurityRequirement -> Ordering
$c< :: SecurityRequirement -> SecurityRequirement -> Bool
< :: SecurityRequirement -> SecurityRequirement -> Bool
$c<= :: SecurityRequirement -> SecurityRequirement -> Bool
<= :: SecurityRequirement -> SecurityRequirement -> Bool
$c> :: SecurityRequirement -> SecurityRequirement -> Bool
> :: SecurityRequirement -> SecurityRequirement -> Bool
$c>= :: SecurityRequirement -> SecurityRequirement -> Bool
>= :: SecurityRequirement -> SecurityRequirement -> Bool
$cmax :: SecurityRequirement -> SecurityRequirement -> SecurityRequirement
max :: SecurityRequirement -> SecurityRequirement -> SecurityRequirement
$cmin :: SecurityRequirement -> SecurityRequirement -> SecurityRequirement
min :: SecurityRequirement -> SecurityRequirement -> SecurityRequirement
Ord)

data ParsedCookie = ParsedCookie
    { ParsedCookie -> Nonce
cookieNonce :: C.Nonce
    , ParsedCookie -> Word32
cookieValidity :: Word32
    , ParsedCookie -> ByteString
cookieContent :: ByteString
    , ParsedCookie -> Auth
cookieMac :: C.Auth
    }

instance Eq ParsedCookie where
    == :: ParsedCookie -> ParsedCookie -> Bool
(==) = (ByteString, Word32, ByteString, Auth)
-> (ByteString, Word32, ByteString, Auth) -> Bool
forall a. Eq a => a -> a -> Bool
(==) ((ByteString, Word32, ByteString, Auth)
 -> (ByteString, Word32, ByteString, Auth) -> Bool)
-> (ParsedCookie -> (ByteString, Word32, ByteString, Auth))
-> ParsedCookie
-> ParsedCookie
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (\ParsedCookie
c -> ( Nonce -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ParsedCookie -> Nonce
cookieNonce ParsedCookie
c) :: ByteString, ParsedCookie -> Word32
cookieValidity ParsedCookie
c, ParsedCookie -> ByteString
cookieContent ParsedCookie
c, ParsedCookie -> Auth
cookieMac ParsedCookie
c ))

instance Show ParsedCookie where
    show :: ParsedCookie -> String
show ParsedCookie {Word32
ByteString
Auth
Nonce
cookieNonce :: ParsedCookie -> Nonce
cookieValidity :: ParsedCookie -> Word32
cookieContent :: ParsedCookie -> ByteString
cookieMac :: ParsedCookie -> Auth
cookieNonce :: Nonce
cookieValidity :: Word32
cookieContent :: ByteString
cookieMac :: Auth
..} = (ByteString, Word32, ByteString, Bytes) -> String
forall a. Show a => a -> String
show (ByteString
nonce, Word32
cookieValidity, ByteString
cookieContent, Bytes
mac)
      where C.Auth Bytes
mac = Auth
cookieMac
            nonce :: ByteString
nonce = Nonce -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert Nonce
cookieNonce :: ByteString

instance Binary ParsedCookie where
    put :: ParsedCookie -> Put
put ParsedCookie {Word32
ByteString
Auth
Nonce
cookieNonce :: ParsedCookie -> Nonce
cookieValidity :: ParsedCookie -> Word32
cookieContent :: ParsedCookie -> ByteString
cookieMac :: ParsedCookie -> Auth
cookieNonce :: Nonce
cookieValidity :: Word32
cookieContent :: ByteString
cookieMac :: Auth
..} = do
        ByteString -> Put
putByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ Nonce -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert Nonce
cookieNonce
        Word32 -> Put
putWord32be Word32
cookieValidity
        ByteString -> Put
putByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ Auth -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert Auth
cookieMac
        ByteString -> Put
putByteString ByteString
cookieContent

    get :: Get ParsedCookie
get = do
        Just Nonce
cookieNonce <- CryptoFailable Nonce -> Maybe Nonce
forall a. CryptoFailable a -> Maybe a
maybeCryptoError (CryptoFailable Nonce -> Maybe Nonce)
-> (ByteString -> CryptoFailable Nonce)
-> ByteString
-> Maybe Nonce
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> CryptoFailable Nonce
forall iv. ByteArrayAccess iv => iv -> CryptoFailable Nonce
C.nonce12 (ByteString -> Maybe Nonce) -> Get ByteString -> Get (Maybe Nonce)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
12
        Word32
cookieValidity <- Get Word32
getWord32be
        Just Auth
cookieMac <- CryptoFailable Auth -> Maybe Auth
forall a. CryptoFailable a -> Maybe a
maybeCryptoError (CryptoFailable Auth -> Maybe Auth)
-> (ByteString -> CryptoFailable Auth) -> ByteString -> Maybe Auth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> CryptoFailable Auth
forall b. ByteArrayAccess b => b -> CryptoFailable Auth
C.authTag (ByteString -> Maybe Auth) -> Get ByteString -> Get (Maybe Auth)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
16
        ByteString
cookieContent <- ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> Get ByteString -> Get ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getRemainingLazyByteString
        ParsedCookie -> Get ParsedCookie
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return ParsedCookie {Word32
ByteString
Auth
Nonce
cookieNonce :: Nonce
cookieValidity :: Word32
cookieContent :: ByteString
cookieMac :: Auth
cookieNonce :: Nonce
cookieValidity :: Word32
cookieMac :: Auth
cookieContent :: ByteString
..}

isHeaderItemAcknowledged :: TransportHeaderItem -> Bool
isHeaderItemAcknowledged :: TransportHeaderItem -> Bool
isHeaderItemAcknowledged = \case
    Acknowledged {} -> Bool
False
    AcknowledgedSingle {} -> Bool
False
    Rejected {} -> Bool
False
    ProtocolVersion {} -> Bool
False
    Initiation {} -> Bool
False
    CookieSet {} -> Bool
False
    CookieEcho {} -> Bool
False
    TransportHeaderItem
_ -> Bool
True

transportToObject :: PartialStorage -> TransportHeader -> PartialObject
transportToObject :: PartialStorage -> TransportHeader -> PartialObject
transportToObject PartialStorage
st (TransportHeader [TransportHeaderItem]
items) = [(ByteString, RecItem' Partial)] -> PartialObject
forall (c :: * -> *). [(ByteString, RecItem' c)] -> Object' c
Rec ([(ByteString, RecItem' Partial)] -> PartialObject)
-> [(ByteString, RecItem' Partial)] -> PartialObject
forall a b. (a -> b) -> a -> b
$ (TransportHeaderItem -> (ByteString, RecItem' Partial))
-> [TransportHeaderItem] -> [(ByteString, RecItem' Partial)]
forall a b. (a -> b) -> [a] -> [b]
map TransportHeaderItem -> (ByteString, RecItem' Partial)
single [TransportHeaderItem]
items
    where single :: TransportHeaderItem -> (ByteString, RecItem' Partial)
single = \case
              Acknowledged RefDigest
dgst -> (String -> ByteString
BC.pack String
"ACK", Ref' Partial -> RecItem' Partial
forall (c :: * -> *). Ref' c -> RecItem' c
RecRef (Ref' Partial -> RecItem' Partial)
-> Ref' Partial -> RecItem' Partial
forall a b. (a -> b) -> a -> b
$ PartialStorage -> RefDigest -> Ref' Partial
partialRefFromDigest PartialStorage
st RefDigest
dgst)
              AcknowledgedSingle Integer
num -> (String -> ByteString
BC.pack String
"ACK", Integer -> RecItem' Partial
forall (c :: * -> *). Integer -> RecItem' c
RecInt Integer
num)
              Rejected RefDigest
dgst -> (String -> ByteString
BC.pack String
"REJ", Ref' Partial -> RecItem' Partial
forall (c :: * -> *). Ref' c -> RecItem' c
RecRef (Ref' Partial -> RecItem' Partial)
-> Ref' Partial -> RecItem' Partial
forall a b. (a -> b) -> a -> b
$ PartialStorage -> RefDigest -> Ref' Partial
partialRefFromDigest PartialStorage
st RefDigest
dgst)
              ProtocolVersion Text
ver -> (String -> ByteString
BC.pack String
"VER", Text -> RecItem' Partial
forall (c :: * -> *). Text -> RecItem' c
RecText Text
ver)
              Initiation RefDigest
dgst -> (String -> ByteString
BC.pack String
"INI", Ref' Partial -> RecItem' Partial
forall (c :: * -> *). Ref' c -> RecItem' c
RecRef (Ref' Partial -> RecItem' Partial)
-> Ref' Partial -> RecItem' Partial
forall a b. (a -> b) -> a -> b
$ PartialStorage -> RefDigest -> Ref' Partial
partialRefFromDigest PartialStorage
st RefDigest
dgst)
              CookieSet (Cookie ByteString
bytes) -> (String -> ByteString
BC.pack String
"CKS", ByteString -> RecItem' Partial
forall (c :: * -> *). ByteString -> RecItem' c
RecBinary ByteString
bytes)
              CookieEcho (Cookie ByteString
bytes) -> (String -> ByteString
BC.pack String
"CKE", ByteString -> RecItem' Partial
forall (c :: * -> *). ByteString -> RecItem' c
RecBinary ByteString
bytes)
              DataRequest RefDigest
dgst -> (String -> ByteString
BC.pack String
"REQ", Ref' Partial -> RecItem' Partial
forall (c :: * -> *). Ref' c -> RecItem' c
RecRef (Ref' Partial -> RecItem' Partial)
-> Ref' Partial -> RecItem' Partial
forall a b. (a -> b) -> a -> b
$ PartialStorage -> RefDigest -> Ref' Partial
partialRefFromDigest PartialStorage
st RefDigest
dgst)
              DataResponse RefDigest
dgst -> (String -> ByteString
BC.pack String
"RSP", Ref' Partial -> RecItem' Partial
forall (c :: * -> *). Ref' c -> RecItem' c
RecRef (Ref' Partial -> RecItem' Partial)
-> Ref' Partial -> RecItem' Partial
forall a b. (a -> b) -> a -> b
$ PartialStorage -> RefDigest -> Ref' Partial
partialRefFromDigest PartialStorage
st RefDigest
dgst)
              AnnounceSelf RefDigest
dgst -> (String -> ByteString
BC.pack String
"ANN", Ref' Partial -> RecItem' Partial
forall (c :: * -> *). Ref' c -> RecItem' c
RecRef (Ref' Partial -> RecItem' Partial)
-> Ref' Partial -> RecItem' Partial
forall a b. (a -> b) -> a -> b
$ PartialStorage -> RefDigest -> Ref' Partial
partialRefFromDigest PartialStorage
st RefDigest
dgst)
              AnnounceUpdate RefDigest
dgst -> (String -> ByteString
BC.pack String
"ANU", Ref' Partial -> RecItem' Partial
forall (c :: * -> *). Ref' c -> RecItem' c
RecRef (Ref' Partial -> RecItem' Partial)
-> Ref' Partial -> RecItem' Partial
forall a b. (a -> b) -> a -> b
$ PartialStorage -> RefDigest -> Ref' Partial
partialRefFromDigest PartialStorage
st RefDigest
dgst)
              TrChannelRequest RefDigest
dgst -> (String -> ByteString
BC.pack String
"CRQ", Ref' Partial -> RecItem' Partial
forall (c :: * -> *). Ref' c -> RecItem' c
RecRef (Ref' Partial -> RecItem' Partial)
-> Ref' Partial -> RecItem' Partial
forall a b. (a -> b) -> a -> b
$ PartialStorage -> RefDigest -> Ref' Partial
partialRefFromDigest PartialStorage
st RefDigest
dgst)
              TrChannelAccept RefDigest
dgst -> (String -> ByteString
BC.pack String
"CAC", Ref' Partial -> RecItem' Partial
forall (c :: * -> *). Ref' c -> RecItem' c
RecRef (Ref' Partial -> RecItem' Partial)
-> Ref' Partial -> RecItem' Partial
forall a b. (a -> b) -> a -> b
$ PartialStorage -> RefDigest -> Ref' Partial
partialRefFromDigest PartialStorage
st RefDigest
dgst)
              ServiceType ServiceID
stype -> (String -> ByteString
BC.pack String
"SVT", UUID -> RecItem' Partial
forall (c :: * -> *). UUID -> RecItem' c
RecUUID (UUID -> RecItem' Partial) -> UUID -> RecItem' Partial
forall a b. (a -> b) -> a -> b
$ ServiceID -> UUID
forall a. StorableUUID a => a -> UUID
toUUID ServiceID
stype)
              ServiceRef RefDigest
dgst -> (String -> ByteString
BC.pack String
"SVR", Ref' Partial -> RecItem' Partial
forall (c :: * -> *). Ref' c -> RecItem' c
RecRef (Ref' Partial -> RecItem' Partial)
-> Ref' Partial -> RecItem' Partial
forall a b. (a -> b) -> a -> b
$ PartialStorage -> RefDigest -> Ref' Partial
partialRefFromDigest PartialStorage
st RefDigest
dgst)
              StreamOpen Word8
num -> (String -> ByteString
BC.pack String
"STO", Integer -> RecItem' Partial
forall (c :: * -> *). Integer -> RecItem' c
RecInt (Integer -> RecItem' Partial) -> Integer -> RecItem' Partial
forall a b. (a -> b) -> a -> b
$ Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
num)

transportFromObject :: PartialObject -> Maybe TransportHeader
transportFromObject :: PartialObject -> Maybe TransportHeader
transportFromObject (Rec [(ByteString, RecItem' Partial)]
items) = case [Maybe TransportHeaderItem] -> [TransportHeaderItem]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe TransportHeaderItem] -> [TransportHeaderItem])
-> [Maybe TransportHeaderItem] -> [TransportHeaderItem]
forall a b. (a -> b) -> a -> b
$ ((ByteString, RecItem' Partial) -> Maybe TransportHeaderItem)
-> [(ByteString, RecItem' Partial)] -> [Maybe TransportHeaderItem]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString, RecItem' Partial) -> Maybe TransportHeaderItem
forall {c :: * -> *}.
(ByteString, RecItem' c) -> Maybe TransportHeaderItem
single [(ByteString, RecItem' Partial)]
items of
                                       [] -> Maybe TransportHeader
forall a. Maybe a
Nothing
                                       [TransportHeaderItem]
titems -> TransportHeader -> Maybe TransportHeader
forall a. a -> Maybe a
Just (TransportHeader -> Maybe TransportHeader)
-> TransportHeader -> Maybe TransportHeader
forall a b. (a -> b) -> a -> b
$ [TransportHeaderItem] -> TransportHeader
TransportHeader [TransportHeaderItem]
titems
    where single :: (ByteString, RecItem' c) -> Maybe TransportHeaderItem
single (ByteString
name, RecItem' c
content) = if
              | ByteString
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
BC.pack String
"ACK", RecRef Ref' c
ref <- RecItem' c
content -> TransportHeaderItem -> Maybe TransportHeaderItem
forall a. a -> Maybe a
Just (TransportHeaderItem -> Maybe TransportHeaderItem)
-> TransportHeaderItem -> Maybe TransportHeaderItem
forall a b. (a -> b) -> a -> b
$ RefDigest -> TransportHeaderItem
Acknowledged (RefDigest -> TransportHeaderItem)
-> RefDigest -> TransportHeaderItem
forall a b. (a -> b) -> a -> b
$ Ref' c -> RefDigest
forall (c :: * -> *). Ref' c -> RefDigest
refDigest Ref' c
ref
              | ByteString
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
BC.pack String
"ACK", RecInt Integer
num <- RecItem' c
content -> TransportHeaderItem -> Maybe TransportHeaderItem
forall a. a -> Maybe a
Just (TransportHeaderItem -> Maybe TransportHeaderItem)
-> TransportHeaderItem -> Maybe TransportHeaderItem
forall a b. (a -> b) -> a -> b
$ Integer -> TransportHeaderItem
AcknowledgedSingle Integer
num
              | ByteString
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
BC.pack String
"REJ", RecRef Ref' c
ref <- RecItem' c
content -> TransportHeaderItem -> Maybe TransportHeaderItem
forall a. a -> Maybe a
Just (TransportHeaderItem -> Maybe TransportHeaderItem)
-> TransportHeaderItem -> Maybe TransportHeaderItem
forall a b. (a -> b) -> a -> b
$ RefDigest -> TransportHeaderItem
Rejected (RefDigest -> TransportHeaderItem)
-> RefDigest -> TransportHeaderItem
forall a b. (a -> b) -> a -> b
$ Ref' c -> RefDigest
forall (c :: * -> *). Ref' c -> RefDigest
refDigest Ref' c
ref
              | ByteString
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
BC.pack String
"VER", RecText Text
ver <- RecItem' c
content -> TransportHeaderItem -> Maybe TransportHeaderItem
forall a. a -> Maybe a
Just (TransportHeaderItem -> Maybe TransportHeaderItem)
-> TransportHeaderItem -> Maybe TransportHeaderItem
forall a b. (a -> b) -> a -> b
$ Text -> TransportHeaderItem
ProtocolVersion Text
ver
              | ByteString
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
BC.pack String
"INI", RecRef Ref' c
ref <- RecItem' c
content -> TransportHeaderItem -> Maybe TransportHeaderItem
forall a. a -> Maybe a
Just (TransportHeaderItem -> Maybe TransportHeaderItem)
-> TransportHeaderItem -> Maybe TransportHeaderItem
forall a b. (a -> b) -> a -> b
$ RefDigest -> TransportHeaderItem
Initiation (RefDigest -> TransportHeaderItem)
-> RefDigest -> TransportHeaderItem
forall a b. (a -> b) -> a -> b
$ Ref' c -> RefDigest
forall (c :: * -> *). Ref' c -> RefDigest
refDigest Ref' c
ref
              | ByteString
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
BC.pack String
"CKS", RecBinary ByteString
bytes <- RecItem' c
content -> TransportHeaderItem -> Maybe TransportHeaderItem
forall a. a -> Maybe a
Just (TransportHeaderItem -> Maybe TransportHeaderItem)
-> TransportHeaderItem -> Maybe TransportHeaderItem
forall a b. (a -> b) -> a -> b
$ Cookie -> TransportHeaderItem
CookieSet (ByteString -> Cookie
Cookie ByteString
bytes)
              | ByteString
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
BC.pack String
"CKE", RecBinary ByteString
bytes <- RecItem' c
content -> TransportHeaderItem -> Maybe TransportHeaderItem
forall a. a -> Maybe a
Just (TransportHeaderItem -> Maybe TransportHeaderItem)
-> TransportHeaderItem -> Maybe TransportHeaderItem
forall a b. (a -> b) -> a -> b
$ Cookie -> TransportHeaderItem
CookieEcho (ByteString -> Cookie
Cookie ByteString
bytes)
              | ByteString
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
BC.pack String
"REQ", RecRef Ref' c
ref <- RecItem' c
content -> TransportHeaderItem -> Maybe TransportHeaderItem
forall a. a -> Maybe a
Just (TransportHeaderItem -> Maybe TransportHeaderItem)
-> TransportHeaderItem -> Maybe TransportHeaderItem
forall a b. (a -> b) -> a -> b
$ RefDigest -> TransportHeaderItem
DataRequest (RefDigest -> TransportHeaderItem)
-> RefDigest -> TransportHeaderItem
forall a b. (a -> b) -> a -> b
$ Ref' c -> RefDigest
forall (c :: * -> *). Ref' c -> RefDigest
refDigest Ref' c
ref
              | ByteString
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
BC.pack String
"RSP", RecRef Ref' c
ref <- RecItem' c
content -> TransportHeaderItem -> Maybe TransportHeaderItem
forall a. a -> Maybe a
Just (TransportHeaderItem -> Maybe TransportHeaderItem)
-> TransportHeaderItem -> Maybe TransportHeaderItem
forall a b. (a -> b) -> a -> b
$ RefDigest -> TransportHeaderItem
DataResponse (RefDigest -> TransportHeaderItem)
-> RefDigest -> TransportHeaderItem
forall a b. (a -> b) -> a -> b
$ Ref' c -> RefDigest
forall (c :: * -> *). Ref' c -> RefDigest
refDigest Ref' c
ref
              | ByteString
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
BC.pack String
"ANN", RecRef Ref' c
ref <- RecItem' c
content -> TransportHeaderItem -> Maybe TransportHeaderItem
forall a. a -> Maybe a
Just (TransportHeaderItem -> Maybe TransportHeaderItem)
-> TransportHeaderItem -> Maybe TransportHeaderItem
forall a b. (a -> b) -> a -> b
$ RefDigest -> TransportHeaderItem
AnnounceSelf (RefDigest -> TransportHeaderItem)
-> RefDigest -> TransportHeaderItem
forall a b. (a -> b) -> a -> b
$ Ref' c -> RefDigest
forall (c :: * -> *). Ref' c -> RefDigest
refDigest Ref' c
ref
              | ByteString
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
BC.pack String
"ANU", RecRef Ref' c
ref <- RecItem' c
content -> TransportHeaderItem -> Maybe TransportHeaderItem
forall a. a -> Maybe a
Just (TransportHeaderItem -> Maybe TransportHeaderItem)
-> TransportHeaderItem -> Maybe TransportHeaderItem
forall a b. (a -> b) -> a -> b
$ RefDigest -> TransportHeaderItem
AnnounceUpdate (RefDigest -> TransportHeaderItem)
-> RefDigest -> TransportHeaderItem
forall a b. (a -> b) -> a -> b
$ Ref' c -> RefDigest
forall (c :: * -> *). Ref' c -> RefDigest
refDigest Ref' c
ref
              | ByteString
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
BC.pack String
"CRQ", RecRef Ref' c
ref <- RecItem' c
content -> TransportHeaderItem -> Maybe TransportHeaderItem
forall a. a -> Maybe a
Just (TransportHeaderItem -> Maybe TransportHeaderItem)
-> TransportHeaderItem -> Maybe TransportHeaderItem
forall a b. (a -> b) -> a -> b
$ RefDigest -> TransportHeaderItem
TrChannelRequest (RefDigest -> TransportHeaderItem)
-> RefDigest -> TransportHeaderItem
forall a b. (a -> b) -> a -> b
$ Ref' c -> RefDigest
forall (c :: * -> *). Ref' c -> RefDigest
refDigest Ref' c
ref
              | ByteString
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
BC.pack String
"CAC", RecRef Ref' c
ref <- RecItem' c
content -> TransportHeaderItem -> Maybe TransportHeaderItem
forall a. a -> Maybe a
Just (TransportHeaderItem -> Maybe TransportHeaderItem)
-> TransportHeaderItem -> Maybe TransportHeaderItem
forall a b. (a -> b) -> a -> b
$ RefDigest -> TransportHeaderItem
TrChannelAccept (RefDigest -> TransportHeaderItem)
-> RefDigest -> TransportHeaderItem
forall a b. (a -> b) -> a -> b
$ Ref' c -> RefDigest
forall (c :: * -> *). Ref' c -> RefDigest
refDigest Ref' c
ref
              | ByteString
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
BC.pack String
"SVT", RecUUID UUID
uuid <- RecItem' c
content -> TransportHeaderItem -> Maybe TransportHeaderItem
forall a. a -> Maybe a
Just (TransportHeaderItem -> Maybe TransportHeaderItem)
-> TransportHeaderItem -> Maybe TransportHeaderItem
forall a b. (a -> b) -> a -> b
$ ServiceID -> TransportHeaderItem
ServiceType (ServiceID -> TransportHeaderItem)
-> ServiceID -> TransportHeaderItem
forall a b. (a -> b) -> a -> b
$ UUID -> ServiceID
forall a. StorableUUID a => UUID -> a
fromUUID UUID
uuid
              | ByteString
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
BC.pack String
"SVR", RecRef Ref' c
ref <- RecItem' c
content -> TransportHeaderItem -> Maybe TransportHeaderItem
forall a. a -> Maybe a
Just (TransportHeaderItem -> Maybe TransportHeaderItem)
-> TransportHeaderItem -> Maybe TransportHeaderItem
forall a b. (a -> b) -> a -> b
$ RefDigest -> TransportHeaderItem
ServiceRef (RefDigest -> TransportHeaderItem)
-> RefDigest -> TransportHeaderItem
forall a b. (a -> b) -> a -> b
$ Ref' c -> RefDigest
forall (c :: * -> *). Ref' c -> RefDigest
refDigest Ref' c
ref
              | ByteString
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
BC.pack String
"STO", RecInt Integer
num <- RecItem' c
content -> TransportHeaderItem -> Maybe TransportHeaderItem
forall a. a -> Maybe a
Just (TransportHeaderItem -> Maybe TransportHeaderItem)
-> TransportHeaderItem -> Maybe TransportHeaderItem
forall a b. (a -> b) -> a -> b
$ Word8 -> TransportHeaderItem
StreamOpen (Word8 -> TransportHeaderItem) -> Word8 -> TransportHeaderItem
forall a b. (a -> b) -> a -> b
$ Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
num
              | Bool
otherwise -> Maybe TransportHeaderItem
forall a. Maybe a
Nothing
transportFromObject PartialObject
_ = Maybe TransportHeader
forall a. Maybe a
Nothing


data GlobalState addr = (Eq addr, Show addr) => GlobalState
    { forall addr.
GlobalState addr -> TVar (UnifiedIdentity, [UnifiedIdentity])
gIdentity :: TVar (UnifiedIdentity, [UnifiedIdentity])
    , forall addr. GlobalState addr -> TVar [Connection addr]
gConnections :: TVar [Connection addr]
    , forall addr. GlobalState addr -> SymFlow (addr, ByteString)
gDataFlow :: SymFlow (addr, ByteString)
    , forall addr.
GlobalState addr
-> Flow (ControlRequest addr) (ControlMessage addr)
gControlFlow :: Flow (ControlRequest addr) (ControlMessage addr)
    , forall addr.
GlobalState addr
-> TMVar (Connection addr, (Bool, TransportPacket PartialObject))
gNextUp :: TMVar (Connection addr, (Bool, TransportPacket PartialObject))
    , forall addr. GlobalState addr -> String -> STM ()
gLog :: String -> STM ()
    , forall addr. GlobalState addr -> PartialStorage
gStorage :: PartialStorage
    , forall addr. GlobalState addr -> TimeSpec
gStartTime :: TimeSpec
    , forall addr. GlobalState addr -> TVar TimeSpec
gNowVar :: TVar TimeSpec
    , forall addr. GlobalState addr -> TVar TimeSpec
gNextTimeout :: TVar TimeSpec
    , forall addr. GlobalState addr -> Ref
gInitConfig :: Ref
    , forall addr. GlobalState addr -> ScrubbedBytes
gCookieKey :: ScrubbedBytes
    , forall addr. GlobalState addr -> Word32
gCookieStartTime :: Word32
    }

data Connection addr = Connection
    { forall addr. Connection addr -> GlobalState addr
cGlobalState :: GlobalState addr
    , forall addr. Connection addr -> addr
cAddress :: addr
    , forall addr.
Connection addr
-> Flow
     (Maybe (Bool, TransportPacket PartialObject))
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataUp :: Flow
        (Maybe (Bool, TransportPacket PartialObject))
        (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
    , forall addr.
Connection addr
-> Flow
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
     (Maybe (Bool, TransportPacket PartialObject))
cDataInternal :: Flow
        (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
        (Maybe (Bool, TransportPacket PartialObject))
    , forall addr. Connection addr -> TVar ChannelState
cChannel :: TVar ChannelState
    , forall addr. Connection addr -> TVar (Maybe Cookie)
cCookie :: TVar (Maybe Cookie)
    , forall addr.
Connection addr
-> TQueue
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cSecureOutQueue :: TQueue (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
    , forall addr. Connection addr -> TVar Int
cMaxInFlightPackets :: TVar Int
    , forall addr. Connection addr -> TVar Int
cReservedPackets :: TVar Int
    , forall addr. Connection addr -> TVar [SentPacket]
cSentPackets :: TVar [SentPacket]
    , forall addr. Connection addr -> TVar [Integer]
cToAcknowledge :: TVar [Integer]
    , forall addr. Connection addr -> TVar (Maybe TimeSpec)
cNextKeepAlive :: TVar (Maybe TimeSpec)
    , forall addr. Connection addr -> TVar [(Word8, Stream)]
cInStreams :: TVar [(Word8, Stream)]
    , forall addr. Connection addr -> TVar [(Word8, Stream)]
cOutStreams :: TVar [(Word8, Stream)]
    }

instance Eq (Connection addr) where
    == :: Connection addr -> Connection addr -> Bool
(==) = TVar ChannelState -> TVar ChannelState -> Bool
forall a. Eq a => a -> a -> Bool
(==) (TVar ChannelState -> TVar ChannelState -> Bool)
-> (Connection addr -> TVar ChannelState)
-> Connection addr
-> Connection addr
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Connection addr -> TVar ChannelState
forall addr. Connection addr -> TVar ChannelState
cChannel

connAddress :: Connection addr -> addr
connAddress :: forall addr. Connection addr -> addr
connAddress = Connection addr -> addr
forall addr. Connection addr -> addr
cAddress

connData :: Connection addr -> Flow
    (Maybe (Bool, TransportPacket PartialObject))
    (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
connData :: forall addr.
Connection addr
-> Flow
     (Maybe (Bool, TransportPacket PartialObject))
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
connData = Connection addr
-> Flow
     (Maybe (Bool, TransportPacket PartialObject))
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
forall addr.
Connection addr
-> Flow
     (Maybe (Bool, TransportPacket PartialObject))
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataUp

connGetChannel :: Connection addr -> STM ChannelState
connGetChannel :: forall addr. Connection addr -> STM ChannelState
connGetChannel Connection {addr
TVar Int
TVar [Integer]
TVar [(Word8, Stream)]
TVar [SentPacket]
TVar (Maybe TimeSpec)
TVar (Maybe Cookie)
TVar ChannelState
TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
GlobalState addr
cGlobalState :: forall addr. Connection addr -> GlobalState addr
cAddress :: forall addr. Connection addr -> addr
cDataUp :: forall addr.
Connection addr
-> Flow
     (Maybe (Bool, TransportPacket PartialObject))
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: forall addr.
Connection addr
-> Flow
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
     (Maybe (Bool, TransportPacket PartialObject))
cChannel :: forall addr. Connection addr -> TVar ChannelState
cCookie :: forall addr. Connection addr -> TVar (Maybe Cookie)
cSecureOutQueue :: forall addr.
Connection addr
-> TQueue
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: forall addr. Connection addr -> TVar Int
cReservedPackets :: forall addr. Connection addr -> TVar Int
cSentPackets :: forall addr. Connection addr -> TVar [SentPacket]
cToAcknowledge :: forall addr. Connection addr -> TVar [Integer]
cNextKeepAlive :: forall addr. Connection addr -> TVar (Maybe TimeSpec)
cInStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cOutStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cGlobalState :: GlobalState addr
cAddress :: addr
cDataUp :: Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
cChannel :: TVar ChannelState
cCookie :: TVar (Maybe Cookie)
cSecureOutQueue :: TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: TVar Int
cReservedPackets :: TVar Int
cSentPackets :: TVar [SentPacket]
cToAcknowledge :: TVar [Integer]
cNextKeepAlive :: TVar (Maybe TimeSpec)
cInStreams :: TVar [(Word8, Stream)]
cOutStreams :: TVar [(Word8, Stream)]
..} = TVar ChannelState -> STM ChannelState
forall a. TVar a -> STM a
readTVar TVar ChannelState
cChannel

connSetChannel :: Connection addr -> ChannelState -> STM ()
connSetChannel :: forall addr. Connection addr -> ChannelState -> STM ()
connSetChannel Connection {addr
TVar Int
TVar [Integer]
TVar [(Word8, Stream)]
TVar [SentPacket]
TVar (Maybe TimeSpec)
TVar (Maybe Cookie)
TVar ChannelState
TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
GlobalState addr
cGlobalState :: forall addr. Connection addr -> GlobalState addr
cAddress :: forall addr. Connection addr -> addr
cDataUp :: forall addr.
Connection addr
-> Flow
     (Maybe (Bool, TransportPacket PartialObject))
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: forall addr.
Connection addr
-> Flow
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
     (Maybe (Bool, TransportPacket PartialObject))
cChannel :: forall addr. Connection addr -> TVar ChannelState
cCookie :: forall addr. Connection addr -> TVar (Maybe Cookie)
cSecureOutQueue :: forall addr.
Connection addr
-> TQueue
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: forall addr. Connection addr -> TVar Int
cReservedPackets :: forall addr. Connection addr -> TVar Int
cSentPackets :: forall addr. Connection addr -> TVar [SentPacket]
cToAcknowledge :: forall addr. Connection addr -> TVar [Integer]
cNextKeepAlive :: forall addr. Connection addr -> TVar (Maybe TimeSpec)
cInStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cOutStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cGlobalState :: GlobalState addr
cAddress :: addr
cDataUp :: Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
cChannel :: TVar ChannelState
cCookie :: TVar (Maybe Cookie)
cSecureOutQueue :: TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: TVar Int
cReservedPackets :: TVar Int
cSentPackets :: TVar [SentPacket]
cToAcknowledge :: TVar [Integer]
cNextKeepAlive :: TVar (Maybe TimeSpec)
cInStreams :: TVar [(Word8, Stream)]
cOutStreams :: TVar [(Word8, Stream)]
..} ChannelState
ch = do
    TVar ChannelState -> ChannelState -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar ChannelState
cChannel ChannelState
ch

connClose :: Connection addr -> STM ()
connClose :: forall addr. Connection addr -> STM ()
connClose conn :: Connection addr
conn@Connection {addr
TVar Int
TVar [Integer]
TVar [(Word8, Stream)]
TVar [SentPacket]
TVar (Maybe TimeSpec)
TVar (Maybe Cookie)
TVar ChannelState
TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
GlobalState addr
cGlobalState :: forall addr. Connection addr -> GlobalState addr
cAddress :: forall addr. Connection addr -> addr
cDataUp :: forall addr.
Connection addr
-> Flow
     (Maybe (Bool, TransportPacket PartialObject))
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: forall addr.
Connection addr
-> Flow
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
     (Maybe (Bool, TransportPacket PartialObject))
cChannel :: forall addr. Connection addr -> TVar ChannelState
cCookie :: forall addr. Connection addr -> TVar (Maybe Cookie)
cSecureOutQueue :: forall addr.
Connection addr
-> TQueue
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: forall addr. Connection addr -> TVar Int
cReservedPackets :: forall addr. Connection addr -> TVar Int
cSentPackets :: forall addr. Connection addr -> TVar [SentPacket]
cToAcknowledge :: forall addr. Connection addr -> TVar [Integer]
cNextKeepAlive :: forall addr. Connection addr -> TVar (Maybe TimeSpec)
cInStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cOutStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cGlobalState :: GlobalState addr
cAddress :: addr
cDataUp :: Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
cChannel :: TVar ChannelState
cCookie :: TVar (Maybe Cookie)
cSecureOutQueue :: TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: TVar Int
cReservedPackets :: TVar Int
cSentPackets :: TVar [SentPacket]
cToAcknowledge :: TVar [Integer]
cNextKeepAlive :: TVar (Maybe TimeSpec)
cInStreams :: TVar [(Word8, Stream)]
cOutStreams :: TVar [(Word8, Stream)]
..} = do
    let GlobalState {Word32
TVar [Connection addr]
TVar (UnifiedIdentity, [UnifiedIdentity])
TVar TimeSpec
TimeSpec
ScrubbedBytes
TMVar (Connection addr, (Bool, TransportPacket PartialObject))
Flow (addr, ByteString) (addr, ByteString)
Flow (ControlRequest addr) (ControlMessage addr)
Ref
PartialStorage
String -> STM ()
gIdentity :: forall addr.
GlobalState addr -> TVar (UnifiedIdentity, [UnifiedIdentity])
gConnections :: forall addr. GlobalState addr -> TVar [Connection addr]
gDataFlow :: forall addr. GlobalState addr -> SymFlow (addr, ByteString)
gControlFlow :: forall addr.
GlobalState addr
-> Flow (ControlRequest addr) (ControlMessage addr)
gNextUp :: forall addr.
GlobalState addr
-> TMVar (Connection addr, (Bool, TransportPacket PartialObject))
gLog :: forall addr. GlobalState addr -> String -> STM ()
gStorage :: forall addr. GlobalState addr -> PartialStorage
gStartTime :: forall addr. GlobalState addr -> TimeSpec
gNowVar :: forall addr. GlobalState addr -> TVar TimeSpec
gNextTimeout :: forall addr. GlobalState addr -> TVar TimeSpec
gInitConfig :: forall addr. GlobalState addr -> Ref
gCookieKey :: forall addr. GlobalState addr -> ScrubbedBytes
gCookieStartTime :: forall addr. GlobalState addr -> Word32
gIdentity :: TVar (UnifiedIdentity, [UnifiedIdentity])
gConnections :: TVar [Connection addr]
gDataFlow :: Flow (addr, ByteString) (addr, ByteString)
gControlFlow :: Flow (ControlRequest addr) (ControlMessage addr)
gNextUp :: TMVar (Connection addr, (Bool, TransportPacket PartialObject))
gLog :: String -> STM ()
gStorage :: PartialStorage
gStartTime :: TimeSpec
gNowVar :: TVar TimeSpec
gNextTimeout :: TVar TimeSpec
gInitConfig :: Ref
gCookieKey :: ScrubbedBytes
gCookieStartTime :: Word32
..} = GlobalState addr
cGlobalState
    TVar ChannelState -> STM ChannelState
forall a. TVar a -> STM a
readTVar TVar ChannelState
cChannel STM ChannelState -> (ChannelState -> STM ()) -> STM ()
forall a b. STM a -> (a -> STM b) -> STM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        ChannelState
ChannelClosed -> () -> STM ()
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        ChannelState
_ -> do
            TVar ChannelState -> ChannelState -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar ChannelState
cChannel ChannelState
ChannelClosed
            TVar [Connection addr] -> [Connection addr] -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar [Connection addr]
gConnections ([Connection addr] -> STM ())
-> ([Connection addr] -> [Connection addr])
-> [Connection addr]
-> STM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Connection addr -> Bool) -> [Connection addr] -> [Connection addr]
forall a. (a -> Bool) -> [a] -> [a]
filter (Connection addr -> Connection addr -> Bool
forall a. Eq a => a -> a -> Bool
/=Connection addr
conn) ([Connection addr] -> STM ()) -> STM [Connection addr] -> STM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TVar [Connection addr] -> STM [Connection addr]
forall a. TVar a -> STM a
readTVar TVar [Connection addr]
gConnections
            Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
-> Maybe (Bool, TransportPacket PartialObject) -> STM ()
forall r w. Flow r w -> w -> STM ()
writeFlow Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
cDataInternal Maybe (Bool, TransportPacket PartialObject)
forall a. Maybe a
Nothing

connAddWriteStream :: Connection addr -> STM (Either String (TransportHeaderItem, RawStreamWriter, IO ()))
connAddWriteStream :: forall addr.
Connection addr
-> STM
     (Either String (TransportHeaderItem, RawStreamWriter, IO ()))
connAddWriteStream conn :: Connection addr
conn@Connection {addr
TVar Int
TVar [Integer]
TVar [(Word8, Stream)]
TVar [SentPacket]
TVar (Maybe TimeSpec)
TVar (Maybe Cookie)
TVar ChannelState
TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
GlobalState addr
cGlobalState :: forall addr. Connection addr -> GlobalState addr
cAddress :: forall addr. Connection addr -> addr
cDataUp :: forall addr.
Connection addr
-> Flow
     (Maybe (Bool, TransportPacket PartialObject))
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: forall addr.
Connection addr
-> Flow
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
     (Maybe (Bool, TransportPacket PartialObject))
cChannel :: forall addr. Connection addr -> TVar ChannelState
cCookie :: forall addr. Connection addr -> TVar (Maybe Cookie)
cSecureOutQueue :: forall addr.
Connection addr
-> TQueue
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: forall addr. Connection addr -> TVar Int
cReservedPackets :: forall addr. Connection addr -> TVar Int
cSentPackets :: forall addr. Connection addr -> TVar [SentPacket]
cToAcknowledge :: forall addr. Connection addr -> TVar [Integer]
cNextKeepAlive :: forall addr. Connection addr -> TVar (Maybe TimeSpec)
cInStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cOutStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cGlobalState :: GlobalState addr
cAddress :: addr
cDataUp :: Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
cChannel :: TVar ChannelState
cCookie :: TVar (Maybe Cookie)
cSecureOutQueue :: TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: TVar Int
cReservedPackets :: TVar Int
cSentPackets :: TVar [SentPacket]
cToAcknowledge :: TVar [Integer]
cNextKeepAlive :: TVar (Maybe TimeSpec)
cInStreams :: TVar [(Word8, Stream)]
cOutStreams :: TVar [(Word8, Stream)]
..} = do
    [(Word8, Stream)]
outStreams <- TVar [(Word8, Stream)] -> STM [(Word8, Stream)]
forall a. TVar a -> STM a
readTVar TVar [(Word8, Stream)]
cOutStreams
    let doInsert :: Word8 -> [(Word8, Stream)] -> ExceptT String STM ((Word8, Stream), [(Word8, Stream)])
        doInsert :: Word8
-> [(Word8, Stream)]
-> ExceptT String STM ((Word8, Stream), [(Word8, Stream)])
doInsert Word8
n (s :: (Word8, Stream)
s@(Word8
n', Stream
_) : [(Word8, Stream)]
rest) | Word8
n Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
n' =
            ([(Word8, Stream)] -> [(Word8, Stream)])
-> ((Word8, Stream), [(Word8, Stream)])
-> ((Word8, Stream), [(Word8, Stream)])
forall a b.
(a -> b) -> ((Word8, Stream), a) -> ((Word8, Stream), b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Word8, Stream)
s(Word8, Stream) -> [(Word8, Stream)] -> [(Word8, Stream)]
forall a. a -> [a] -> [a]
:) (((Word8, Stream), [(Word8, Stream)])
 -> ((Word8, Stream), [(Word8, Stream)]))
-> ExceptT String STM ((Word8, Stream), [(Word8, Stream)])
-> ExceptT String STM ((Word8, Stream), [(Word8, Stream)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word8
-> [(Word8, Stream)]
-> ExceptT String STM ((Word8, Stream), [(Word8, Stream)])
doInsert (Word8
n Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
1) [(Word8, Stream)]
rest
        doInsert Word8
n [(Word8, Stream)]
streams | Word8
n Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
63 = STM ((Word8, Stream), [(Word8, Stream)])
-> ExceptT String STM ((Word8, Stream), [(Word8, Stream)])
forall (m :: * -> *) a. Monad m => m a -> ExceptT String m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM ((Word8, Stream), [(Word8, Stream)])
 -> ExceptT String STM ((Word8, Stream), [(Word8, Stream)]))
-> STM ((Word8, Stream), [(Word8, Stream)])
-> ExceptT String STM ((Word8, Stream), [(Word8, Stream)])
forall a b. (a -> b) -> a -> b
$ do
            TVar StreamState
sState <- StreamState -> STM (TVar StreamState)
forall a. a -> STM (TVar a)
newTVar StreamState
StreamOpening
            (RawStreamWriter
sFlowIn, Flow StreamPacket Void
sFlowOut) <- STM (RawStreamWriter, Flow StreamPacket Void)
forall a b. STM (Flow a b, Flow b a)
newFlow
            TVar Word64
sNextSequence <- Word64 -> STM (TVar Word64)
forall a. a -> STM (TVar a)
newTVar Word64
0
            TVar Word64
sWaitingForAck <- Word64 -> STM (TVar Word64)
forall a. a -> STM (TVar a)
newTVar Word64
0
            let info :: (Word8, Stream)
info = (Word8
n, Stream {TVar Word64
TVar StreamState
RawStreamWriter
Flow StreamPacket Void
sState :: TVar StreamState
sFlowIn :: RawStreamWriter
sFlowOut :: Flow StreamPacket Void
sNextSequence :: TVar Word64
sWaitingForAck :: TVar Word64
sState :: TVar StreamState
sFlowIn :: RawStreamWriter
sFlowOut :: Flow StreamPacket Void
sNextSequence :: TVar Word64
sWaitingForAck :: TVar Word64
..})
            ((Word8, Stream), [(Word8, Stream)])
-> STM ((Word8, Stream), [(Word8, Stream)])
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Word8, Stream)
info, (Word8, Stream)
info (Word8, Stream) -> [(Word8, Stream)] -> [(Word8, Stream)]
forall a. a -> [a] -> [a]
: [(Word8, Stream)]
streams)
        doInsert Word8
_ [(Word8, Stream)]
_ = String -> ExceptT String STM ((Word8, Stream), [(Word8, Stream)])
forall a. String -> ExceptT String STM a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"all outbound streams in use"

    ExceptT String STM (TransportHeaderItem, RawStreamWriter, IO ())
-> STM
     (Either String (TransportHeaderItem, RawStreamWriter, IO ()))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String STM (TransportHeaderItem, RawStreamWriter, IO ())
 -> STM
      (Either String (TransportHeaderItem, RawStreamWriter, IO ())))
-> ExceptT String STM (TransportHeaderItem, RawStreamWriter, IO ())
-> STM
     (Either String (TransportHeaderItem, RawStreamWriter, IO ()))
forall a b. (a -> b) -> a -> b
$ do
        ((Word8
streamNumber, Stream
stream), [(Word8, Stream)]
outStreams') <- Word8
-> [(Word8, Stream)]
-> ExceptT String STM ((Word8, Stream), [(Word8, Stream)])
doInsert Word8
1 [(Word8, Stream)]
outStreams
        STM () -> ExceptT String STM ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT String m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM () -> ExceptT String STM ())
-> STM () -> ExceptT String STM ()
forall a b. (a -> b) -> a -> b
$ TVar [(Word8, Stream)] -> [(Word8, Stream)] -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar [(Word8, Stream)]
cOutStreams [(Word8, Stream)]
outStreams'
        (TransportHeaderItem, RawStreamWriter, IO ())
-> ExceptT String STM (TransportHeaderItem, RawStreamWriter, IO ())
forall a. a -> ExceptT String STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> TransportHeaderItem
StreamOpen Word8
streamNumber, Stream -> RawStreamWriter
sFlowIn Stream
stream, GlobalState addr -> Word8 -> Stream -> IO ()
go GlobalState addr
cGlobalState Word8
streamNumber Stream
stream)

  where
    go :: GlobalState addr -> Word8 -> Stream -> IO ()
go gs :: GlobalState addr
gs@GlobalState {Word32
TVar [Connection addr]
TVar (UnifiedIdentity, [UnifiedIdentity])
TVar TimeSpec
TimeSpec
ScrubbedBytes
TMVar (Connection addr, (Bool, TransportPacket PartialObject))
SymFlow (addr, ByteString)
Flow (ControlRequest addr) (ControlMessage addr)
Ref
PartialStorage
String -> STM ()
gIdentity :: forall addr.
GlobalState addr -> TVar (UnifiedIdentity, [UnifiedIdentity])
gConnections :: forall addr. GlobalState addr -> TVar [Connection addr]
gDataFlow :: forall addr. GlobalState addr -> SymFlow (addr, ByteString)
gControlFlow :: forall addr.
GlobalState addr
-> Flow (ControlRequest addr) (ControlMessage addr)
gNextUp :: forall addr.
GlobalState addr
-> TMVar (Connection addr, (Bool, TransportPacket PartialObject))
gLog :: forall addr. GlobalState addr -> String -> STM ()
gStorage :: forall addr. GlobalState addr -> PartialStorage
gStartTime :: forall addr. GlobalState addr -> TimeSpec
gNowVar :: forall addr. GlobalState addr -> TVar TimeSpec
gNextTimeout :: forall addr. GlobalState addr -> TVar TimeSpec
gInitConfig :: forall addr. GlobalState addr -> Ref
gCookieKey :: forall addr. GlobalState addr -> ScrubbedBytes
gCookieStartTime :: forall addr. GlobalState addr -> Word32
gIdentity :: TVar (UnifiedIdentity, [UnifiedIdentity])
gConnections :: TVar [Connection addr]
gDataFlow :: SymFlow (addr, ByteString)
gControlFlow :: Flow (ControlRequest addr) (ControlMessage addr)
gNextUp :: TMVar (Connection addr, (Bool, TransportPacket PartialObject))
gLog :: String -> STM ()
gStorage :: PartialStorage
gStartTime :: TimeSpec
gNowVar :: TVar TimeSpec
gNextTimeout :: TVar TimeSpec
gInitConfig :: Ref
gCookieKey :: ScrubbedBytes
gCookieStartTime :: Word32
..} Word8
streamNumber Stream
stream = do
            (ReservedToSend
reserved, StreamPacket
msg) <- STM (ReservedToSend, StreamPacket)
-> IO (ReservedToSend, StreamPacket)
forall a. STM a -> IO a
atomically (STM (ReservedToSend, StreamPacket)
 -> IO (ReservedToSend, StreamPacket))
-> STM (ReservedToSend, StreamPacket)
-> IO (ReservedToSend, StreamPacket)
forall a b. (a -> b) -> a -> b
$ do
                TVar StreamState -> STM StreamState
forall a. TVar a -> STM a
readTVar (Stream -> TVar StreamState
sState Stream
stream) STM StreamState -> (StreamState -> STM ()) -> STM ()
forall a b. STM a -> (a -> STM b) -> STM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    StreamState
StreamRunning -> () -> STM ()
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    StreamState
_             -> STM ()
forall a. STM a
retry
                (,) (ReservedToSend -> StreamPacket -> (ReservedToSend, StreamPacket))
-> STM ReservedToSend
-> STM (StreamPacket -> (ReservedToSend, StreamPacket))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection addr -> STM ReservedToSend
forall addr. Connection addr -> STM ReservedToSend
reservePacket Connection addr
conn
                    STM (StreamPacket -> (ReservedToSend, StreamPacket))
-> STM StreamPacket -> STM (ReservedToSend, StreamPacket)
forall a b. STM (a -> b) -> STM a -> STM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Flow StreamPacket Void -> STM StreamPacket
forall r w. Flow r w -> STM r
readFlow (Stream -> Flow StreamPacket Void
sFlowOut Stream
stream)

            (ByteString
plain, Bool
cont, IO ()
onAck) <- case StreamPacket
msg of
                StreamData {Word64
ByteString
stpSequence :: Word64
stpData :: ByteString
stpSequence :: StreamPacket -> Word64
stpData :: StreamPacket -> ByteString
..} -> do
                    (ByteString, Bool, IO ()) -> IO (ByteString, Bool, IO ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
stpData, Bool
True, () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                StreamClosed {} -> do
                    STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                        -- wait for ack on all sent stream data
                        Word64
waits <- TVar Word64 -> STM Word64
forall a. TVar a -> STM a
readTVar (Stream -> TVar Word64
sWaitingForAck Stream
stream)
                        Bool -> STM () -> STM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word64
waits Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
0) STM ()
forall a. STM a
retry
                    (ByteString, Bool, IO ()) -> IO (ByteString, Bool, IO ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
BC.empty, Bool
False, Connection addr -> Word8 -> IO ()
forall addr. Connection addr -> Word8 -> IO ()
streamClosed Connection addr
conn Word8
streamNumber)

            let secure :: Bool
secure = Bool
True
                plainAckedBy :: [a]
plainAckedBy = []
                mbReserved :: Maybe ReservedToSend
mbReserved = ReservedToSend -> Maybe ReservedToSend
forall a. a -> Maybe a
Just ReservedToSend
reserved

            Maybe Channel
mbch <- STM ChannelState -> IO ChannelState
forall a. STM a -> IO a
atomically (TVar ChannelState -> STM ChannelState
forall a. TVar a -> STM a
readTVar TVar ChannelState
cChannel) IO ChannelState
-> (ChannelState -> IO (Maybe Channel)) -> IO (Maybe Channel)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe Channel -> IO (Maybe Channel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Channel -> IO (Maybe Channel))
-> (ChannelState -> Maybe Channel)
-> ChannelState
-> IO (Maybe Channel)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
                ChannelEstablished Channel
ch -> Channel -> Maybe Channel
forall a. a -> Maybe a
Just Channel
ch
                ChannelOurAccept Stored ChannelAccept
_ Channel
ch -> Channel -> Maybe Channel
forall a. a -> Maybe a
Just Channel
ch
                ChannelState
_                     -> Maybe Channel
forall a. Maybe a
Nothing

            Maybe (ByteString, [TransportHeaderItem])
mbs <- case Maybe Channel
mbch of
                Just Channel
ch -> do
                    ExceptT String IO (ByteString, Word64)
-> IO (Either String (ByteString, Word64))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (Channel -> ByteString -> ExceptT String IO (ByteString, Word64)
forall ba (m :: * -> *).
(ByteArray ba, MonadIO m, MonadError String m) =>
Channel -> ba -> m (ba, Word64)
channelEncrypt Channel
ch (ByteString -> ExceptT String IO (ByteString, Word64))
-> ByteString -> ExceptT String IO (ByteString, Word64)
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.concat
                            [ Word8 -> ByteString
B.singleton Word8
streamNumber
                            , Word8 -> ByteString
B.singleton (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (StreamPacket -> Word64
stpSequence StreamPacket
msg) :: Word8)
                            , ByteString
plain
                            ] ) IO (Either String (ByteString, Word64))
-> (Either String (ByteString, Word64)
    -> IO (Maybe (ByteString, [TransportHeaderItem])))
-> IO (Maybe (ByteString, [TransportHeaderItem]))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                        Right (ByteString
ctext, Word64
counter) -> do
                            let isAcked :: Bool
isAcked = Bool
True
                            Maybe (ByteString, [TransportHeaderItem])
-> IO (Maybe (ByteString, [TransportHeaderItem]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ByteString, [TransportHeaderItem])
 -> IO (Maybe (ByteString, [TransportHeaderItem])))
-> Maybe (ByteString, [TransportHeaderItem])
-> IO (Maybe (ByteString, [TransportHeaderItem]))
forall a b. (a -> b) -> a -> b
$ (ByteString, [TransportHeaderItem])
-> Maybe (ByteString, [TransportHeaderItem])
forall a. a -> Maybe a
Just (Word8
0x80 Word8 -> ByteString -> ByteString
`B.cons` ByteString
ctext, if Bool
isAcked then [ Integer -> TransportHeaderItem
AcknowledgedSingle (Integer -> TransportHeaderItem) -> Integer -> TransportHeaderItem
forall a b. (a -> b) -> a -> b
$ Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
counter ] else [])
                        Left String
err -> do STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> STM ()
gLog (String -> STM ()) -> String -> STM ()
forall a b. (a -> b) -> a -> b
$ String
"Failed to encrypt data: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err
                                       Maybe (ByteString, [TransportHeaderItem])
-> IO (Maybe (ByteString, [TransportHeaderItem]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ByteString, [TransportHeaderItem])
forall a. Maybe a
Nothing
                Maybe Channel
Nothing | Bool
secure    -> Maybe (ByteString, [TransportHeaderItem])
-> IO (Maybe (ByteString, [TransportHeaderItem]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ByteString, [TransportHeaderItem])
forall a. Maybe a
Nothing
                        | Bool
otherwise -> Maybe (ByteString, [TransportHeaderItem])
-> IO (Maybe (ByteString, [TransportHeaderItem]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ByteString, [TransportHeaderItem])
 -> IO (Maybe (ByteString, [TransportHeaderItem])))
-> Maybe (ByteString, [TransportHeaderItem])
-> IO (Maybe (ByteString, [TransportHeaderItem]))
forall a b. (a -> b) -> a -> b
$ (ByteString, [TransportHeaderItem])
-> Maybe (ByteString, [TransportHeaderItem])
forall a. a -> Maybe a
Just (ByteString
plain, [TransportHeaderItem]
forall a. [a]
plainAckedBy)

            case Maybe (ByteString, [TransportHeaderItem])
mbs of
                Just (ByteString
bs, [TransportHeaderItem]
ackedBy) -> do
                    STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                        TVar Word64 -> (Word64 -> Word64) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' (Stream -> TVar Word64
sWaitingForAck Stream
stream) (Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1)
                    let mbReserved' :: Maybe ReservedToSend
mbReserved' = (\ReservedToSend
rs -> ReservedToSend
rs
                            { rsAckedBy = guard (not $ null ackedBy) >> Just (`elem` ackedBy)
                            , rsOnAck = do
                                rsOnAck rs
                                onAck
                                atomically $ modifyTVar' (sWaitingForAck stream) (subtract 1)
                            }) (ReservedToSend -> ReservedToSend)
-> Maybe ReservedToSend -> Maybe ReservedToSend
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ReservedToSend
mbReserved
                    Connection addr -> Maybe ReservedToSend -> ByteString -> IO ()
forall addr.
Connection addr -> Maybe ReservedToSend -> ByteString -> IO ()
sendBytes Connection addr
conn Maybe ReservedToSend
mbReserved' ByteString
bs
                Maybe (ByteString, [TransportHeaderItem])
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
cont (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ GlobalState addr -> Word8 -> Stream -> IO ()
go GlobalState addr
gs Word8
streamNumber Stream
stream

connAddReadStream :: Connection addr -> Word8 -> STM RawStreamReader
connAddReadStream :: forall addr.
Connection addr -> Word8 -> STM (Flow StreamPacket Void)
connAddReadStream Connection {addr
TVar Int
TVar [Integer]
TVar [(Word8, Stream)]
TVar [SentPacket]
TVar (Maybe TimeSpec)
TVar (Maybe Cookie)
TVar ChannelState
TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
GlobalState addr
cGlobalState :: forall addr. Connection addr -> GlobalState addr
cAddress :: forall addr. Connection addr -> addr
cDataUp :: forall addr.
Connection addr
-> Flow
     (Maybe (Bool, TransportPacket PartialObject))
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: forall addr.
Connection addr
-> Flow
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
     (Maybe (Bool, TransportPacket PartialObject))
cChannel :: forall addr. Connection addr -> TVar ChannelState
cCookie :: forall addr. Connection addr -> TVar (Maybe Cookie)
cSecureOutQueue :: forall addr.
Connection addr
-> TQueue
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: forall addr. Connection addr -> TVar Int
cReservedPackets :: forall addr. Connection addr -> TVar Int
cSentPackets :: forall addr. Connection addr -> TVar [SentPacket]
cToAcknowledge :: forall addr. Connection addr -> TVar [Integer]
cNextKeepAlive :: forall addr. Connection addr -> TVar (Maybe TimeSpec)
cInStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cOutStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cGlobalState :: GlobalState addr
cAddress :: addr
cDataUp :: Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
cChannel :: TVar ChannelState
cCookie :: TVar (Maybe Cookie)
cSecureOutQueue :: TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: TVar Int
cReservedPackets :: TVar Int
cSentPackets :: TVar [SentPacket]
cToAcknowledge :: TVar [Integer]
cNextKeepAlive :: TVar (Maybe TimeSpec)
cInStreams :: TVar [(Word8, Stream)]
cOutStreams :: TVar [(Word8, Stream)]
..} Word8
streamNumber = do
    [(Word8, Stream)]
inStreams <- TVar [(Word8, Stream)] -> STM [(Word8, Stream)]
forall a. TVar a -> STM a
readTVar TVar [(Word8, Stream)]
cInStreams
    let doInsert :: [(Word8, Stream)] -> STM (Stream, [(Word8, Stream)])
doInsert (s :: (Word8, Stream)
s@(Word8
n, Stream
_) : [(Word8, Stream)]
rest)
            | Word8
streamNumber Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<  Word8
n = ([(Word8, Stream)] -> [(Word8, Stream)])
-> (Stream, [(Word8, Stream)]) -> (Stream, [(Word8, Stream)])
forall a b. (a -> b) -> (Stream, a) -> (Stream, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Word8, Stream)
s(Word8, Stream) -> [(Word8, Stream)] -> [(Word8, Stream)]
forall a. a -> [a] -> [a]
:) ((Stream, [(Word8, Stream)]) -> (Stream, [(Word8, Stream)]))
-> STM (Stream, [(Word8, Stream)])
-> STM (Stream, [(Word8, Stream)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Word8, Stream)] -> STM (Stream, [(Word8, Stream)])
doInsert [(Word8, Stream)]
rest
            | Word8
streamNumber Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
n = [(Word8, Stream)] -> STM (Stream, [(Word8, Stream)])
doInsert [(Word8, Stream)]
rest
        doInsert [(Word8, Stream)]
streams = do
            TVar StreamState
sState <- StreamState -> STM (TVar StreamState)
forall a. a -> STM (TVar a)
newTVar StreamState
StreamRunning
            (RawStreamWriter
sFlowIn, Flow StreamPacket Void
sFlowOut) <- STM (RawStreamWriter, Flow StreamPacket Void)
forall a b. STM (Flow a b, Flow b a)
newFlow
            TVar Word64
sNextSequence <- Word64 -> STM (TVar Word64)
forall a. a -> STM (TVar a)
newTVar Word64
0
            TVar Word64
sWaitingForAck <- Word64 -> STM (TVar Word64)
forall a. a -> STM (TVar a)
newTVar Word64
0
            let stream :: Stream
stream = Stream {TVar Word64
TVar StreamState
RawStreamWriter
Flow StreamPacket Void
sState :: TVar StreamState
sFlowIn :: RawStreamWriter
sFlowOut :: Flow StreamPacket Void
sNextSequence :: TVar Word64
sWaitingForAck :: TVar Word64
sState :: TVar StreamState
sFlowIn :: RawStreamWriter
sFlowOut :: Flow StreamPacket Void
sNextSequence :: TVar Word64
sWaitingForAck :: TVar Word64
..}
            (Stream, [(Word8, Stream)]) -> STM (Stream, [(Word8, Stream)])
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Stream
stream, (Word8
streamNumber, Stream
stream) (Word8, Stream) -> [(Word8, Stream)] -> [(Word8, Stream)]
forall a. a -> [a] -> [a]
: [(Word8, Stream)]
streams)
    (Stream
stream, [(Word8, Stream)]
inStreams') <- [(Word8, Stream)] -> STM (Stream, [(Word8, Stream)])
doInsert [(Word8, Stream)]
inStreams
    TVar [(Word8, Stream)] -> [(Word8, Stream)] -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar [(Word8, Stream)]
cInStreams [(Word8, Stream)]
inStreams'
    Flow StreamPacket Void -> STM (Flow StreamPacket Void)
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Flow StreamPacket Void -> STM (Flow StreamPacket Void))
-> Flow StreamPacket Void -> STM (Flow StreamPacket Void)
forall a b. (a -> b) -> a -> b
$ Stream -> Flow StreamPacket Void
sFlowOut Stream
stream


type RawStreamReader = Flow StreamPacket Void
type RawStreamWriter = Flow Void StreamPacket

data Stream = Stream
    { Stream -> TVar StreamState
sState :: TVar StreamState
    , Stream -> RawStreamWriter
sFlowIn :: Flow Void StreamPacket
    , Stream -> Flow StreamPacket Void
sFlowOut :: Flow StreamPacket Void
    , Stream -> TVar Word64
sNextSequence :: TVar Word64
    , Stream -> TVar Word64
sWaitingForAck :: TVar Word64
    }

data StreamState = StreamOpening | StreamRunning

data StreamPacket
    = StreamData
        { StreamPacket -> Word64
stpSequence :: Word64
        , StreamPacket -> ByteString
stpData :: BC.ByteString
        }
    | StreamClosed
        { stpSequence :: Word64
        }

streamAccepted :: Connection addr -> Word8 -> IO ()
streamAccepted :: forall addr. Connection addr -> Word8 -> IO ()
streamAccepted Connection {addr
TVar Int
TVar [Integer]
TVar [(Word8, Stream)]
TVar [SentPacket]
TVar (Maybe TimeSpec)
TVar (Maybe Cookie)
TVar ChannelState
TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
GlobalState addr
cGlobalState :: forall addr. Connection addr -> GlobalState addr
cAddress :: forall addr. Connection addr -> addr
cDataUp :: forall addr.
Connection addr
-> Flow
     (Maybe (Bool, TransportPacket PartialObject))
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: forall addr.
Connection addr
-> Flow
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
     (Maybe (Bool, TransportPacket PartialObject))
cChannel :: forall addr. Connection addr -> TVar ChannelState
cCookie :: forall addr. Connection addr -> TVar (Maybe Cookie)
cSecureOutQueue :: forall addr.
Connection addr
-> TQueue
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: forall addr. Connection addr -> TVar Int
cReservedPackets :: forall addr. Connection addr -> TVar Int
cSentPackets :: forall addr. Connection addr -> TVar [SentPacket]
cToAcknowledge :: forall addr. Connection addr -> TVar [Integer]
cNextKeepAlive :: forall addr. Connection addr -> TVar (Maybe TimeSpec)
cInStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cOutStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cGlobalState :: GlobalState addr
cAddress :: addr
cDataUp :: Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
cChannel :: TVar ChannelState
cCookie :: TVar (Maybe Cookie)
cSecureOutQueue :: TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: TVar Int
cReservedPackets :: TVar Int
cSentPackets :: TVar [SentPacket]
cToAcknowledge :: TVar [Integer]
cNextKeepAlive :: TVar (Maybe TimeSpec)
cInStreams :: TVar [(Word8, Stream)]
cOutStreams :: TVar [(Word8, Stream)]
..} Word8
snum = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    (Word8 -> [(Word8, Stream)] -> Maybe Stream
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Word8
snum ([(Word8, Stream)] -> Maybe Stream)
-> STM [(Word8, Stream)] -> STM (Maybe Stream)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar [(Word8, Stream)] -> STM [(Word8, Stream)]
forall a. TVar a -> STM a
readTVar TVar [(Word8, Stream)]
cOutStreams) STM (Maybe Stream) -> (Maybe Stream -> STM ()) -> STM ()
forall a b. STM a -> (a -> STM b) -> STM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just Stream {TVar Word64
TVar StreamState
RawStreamWriter
Flow StreamPacket Void
sState :: Stream -> TVar StreamState
sFlowIn :: Stream -> RawStreamWriter
sFlowOut :: Stream -> Flow StreamPacket Void
sNextSequence :: Stream -> TVar Word64
sWaitingForAck :: Stream -> TVar Word64
sState :: TVar StreamState
sFlowIn :: RawStreamWriter
sFlowOut :: Flow StreamPacket Void
sNextSequence :: TVar Word64
sWaitingForAck :: TVar Word64
..} -> do
            TVar StreamState -> (StreamState -> StreamState) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar StreamState
sState ((StreamState -> StreamState) -> STM ())
-> (StreamState -> StreamState) -> STM ()
forall a b. (a -> b) -> a -> b
$ \case
                StreamState
StreamOpening -> StreamState
StreamRunning
                StreamState
x             -> StreamState
x
        Maybe Stream
Nothing -> () -> STM ()
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

streamClosed :: Connection addr -> Word8 -> IO ()
streamClosed :: forall addr. Connection addr -> Word8 -> IO ()
streamClosed Connection {addr
TVar Int
TVar [Integer]
TVar [(Word8, Stream)]
TVar [SentPacket]
TVar (Maybe TimeSpec)
TVar (Maybe Cookie)
TVar ChannelState
TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
GlobalState addr
cGlobalState :: forall addr. Connection addr -> GlobalState addr
cAddress :: forall addr. Connection addr -> addr
cDataUp :: forall addr.
Connection addr
-> Flow
     (Maybe (Bool, TransportPacket PartialObject))
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: forall addr.
Connection addr
-> Flow
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
     (Maybe (Bool, TransportPacket PartialObject))
cChannel :: forall addr. Connection addr -> TVar ChannelState
cCookie :: forall addr. Connection addr -> TVar (Maybe Cookie)
cSecureOutQueue :: forall addr.
Connection addr
-> TQueue
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: forall addr. Connection addr -> TVar Int
cReservedPackets :: forall addr. Connection addr -> TVar Int
cSentPackets :: forall addr. Connection addr -> TVar [SentPacket]
cToAcknowledge :: forall addr. Connection addr -> TVar [Integer]
cNextKeepAlive :: forall addr. Connection addr -> TVar (Maybe TimeSpec)
cInStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cOutStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cGlobalState :: GlobalState addr
cAddress :: addr
cDataUp :: Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
cChannel :: TVar ChannelState
cCookie :: TVar (Maybe Cookie)
cSecureOutQueue :: TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: TVar Int
cReservedPackets :: TVar Int
cSentPackets :: TVar [SentPacket]
cToAcknowledge :: TVar [Integer]
cNextKeepAlive :: TVar (Maybe TimeSpec)
cInStreams :: TVar [(Word8, Stream)]
cOutStreams :: TVar [(Word8, Stream)]
..} Word8
snum = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    TVar [(Word8, Stream)]
-> ([(Word8, Stream)] -> [(Word8, Stream)]) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar [(Word8, Stream)]
cOutStreams (([(Word8, Stream)] -> [(Word8, Stream)]) -> STM ())
-> ([(Word8, Stream)] -> [(Word8, Stream)]) -> STM ()
forall a b. (a -> b) -> a -> b
$ ((Word8, Stream) -> Bool) -> [(Word8, Stream)] -> [(Word8, Stream)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Word8
snum Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/=) (Word8 -> Bool)
-> ((Word8, Stream) -> Word8) -> (Word8, Stream) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8, Stream) -> Word8
forall a b. (a, b) -> a
fst)

readStreamToList :: RawStreamReader -> IO (Word64, [(Word64, BC.ByteString)])
readStreamToList :: Flow StreamPacket Void -> IO (Word64, [(Word64, ByteString)])
readStreamToList Flow StreamPacket Void
stream = Flow StreamPacket Void -> IO StreamPacket
forall r w. Flow r w -> IO r
readFlowIO Flow StreamPacket Void
stream IO StreamPacket
-> (StreamPacket -> IO (Word64, [(Word64, ByteString)]))
-> IO (Word64, [(Word64, ByteString)])
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    StreamData Word64
sq ByteString
bytes -> ([(Word64, ByteString)] -> [(Word64, ByteString)])
-> (Word64, [(Word64, ByteString)])
-> (Word64, [(Word64, ByteString)])
forall a b. (a -> b) -> (Word64, a) -> (Word64, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Word64
sq, ByteString
bytes) (Word64, ByteString)
-> [(Word64, ByteString)] -> [(Word64, ByteString)]
forall a. a -> [a] -> [a]
:) ((Word64, [(Word64, ByteString)])
 -> (Word64, [(Word64, ByteString)]))
-> IO (Word64, [(Word64, ByteString)])
-> IO (Word64, [(Word64, ByteString)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Flow StreamPacket Void -> IO (Word64, [(Word64, ByteString)])
readStreamToList Flow StreamPacket Void
stream
    StreamClosed Word64
sqEnd  -> (Word64, [(Word64, ByteString)])
-> IO (Word64, [(Word64, ByteString)])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64
sqEnd, [])

readObjectsFromStream :: PartialStorage -> RawStreamReader -> IO (Except String [PartialObject])
readObjectsFromStream :: PartialStorage
-> Flow StreamPacket Void -> IO (Except String [PartialObject])
readObjectsFromStream PartialStorage
st Flow StreamPacket Void
stream = do
    (Word64
seqEnd, [(Word64, ByteString)]
list) <- Flow StreamPacket Void -> IO (Word64, [(Word64, ByteString)])
readStreamToList Flow StreamPacket Void
stream
    let validate :: Word64
-> [(Word64, ByteString)] -> ExceptT String Identity [ByteString]
validate Word64
s ((Word64
s', ByteString
bytes) : [(Word64, ByteString)]
rest)
            | Word64
s Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
s'   = (ByteString
bytes ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ) ([ByteString] -> [ByteString])
-> ExceptT String Identity [ByteString]
-> ExceptT String Identity [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word64
-> [(Word64, ByteString)] -> ExceptT String Identity [ByteString]
validate (Word64
s Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1) [(Word64, ByteString)]
rest
            | Word64
s Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>  Word64
s'   = Word64
-> [(Word64, ByteString)] -> ExceptT String Identity [ByteString]
validate Word64
s [(Word64, ByteString)]
rest
            | Bool
otherwise = String -> ExceptT String Identity [ByteString]
forall a. String -> ExceptT String Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"missing object chunk"
        validate Word64
s []
            | Word64
s Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
seqEnd = [ByteString] -> ExceptT String Identity [ByteString]
forall a. a -> ExceptT String Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return []
            | Bool
otherwise = String -> ExceptT String Identity [ByteString]
forall a. String -> ExceptT String Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"content length mismatch"
    Except String [PartialObject] -> IO (Except String [PartialObject])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Except String [PartialObject]
 -> IO (Except String [PartialObject]))
-> Except String [PartialObject]
-> IO (Except String [PartialObject])
forall a b. (a -> b) -> a -> b
$ do
        ByteString
content <- [ByteString] -> ByteString
BL.fromChunks ([ByteString] -> ByteString)
-> ExceptT String Identity [ByteString]
-> ExceptT String Identity ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word64
-> [(Word64, ByteString)] -> ExceptT String Identity [ByteString]
validate Word64
0 [(Word64, ByteString)]
list
        PartialStorage -> ByteString -> Except String [PartialObject]
deserializeObjects PartialStorage
st ByteString
content

writeByteStringToStream :: RawStreamWriter -> BL.ByteString -> IO ()
writeByteStringToStream :: RawStreamWriter -> ByteString -> IO ()
writeByteStringToStream RawStreamWriter
stream = Word64 -> ByteString -> IO ()
go Word64
0
  where
    go :: Word64 -> ByteString -> IO ()
go Word64
seqNum ByteString
bstr
        | ByteString -> Bool
BL.null ByteString
bstr = RawStreamWriter -> StreamPacket -> IO ()
forall r w. Flow r w -> w -> IO ()
writeFlowIO RawStreamWriter
stream (StreamPacket -> IO ()) -> StreamPacket -> IO ()
forall a b. (a -> b) -> a -> b
$ Word64 -> StreamPacket
StreamClosed Word64
seqNum
        | Bool
otherwise    = do
            let (ByteString
cur, ByteString
rest) = Int64 -> ByteString -> (ByteString, ByteString)
BL.splitAt Int64
500 ByteString
bstr -- TODO: MTU
            RawStreamWriter -> StreamPacket -> IO ()
forall r w. Flow r w -> w -> IO ()
writeFlowIO RawStreamWriter
stream (StreamPacket -> IO ()) -> StreamPacket -> IO ()
forall a b. (a -> b) -> a -> b
$ Word64 -> ByteString -> StreamPacket
StreamData Word64
seqNum (ByteString -> ByteString
BL.toStrict ByteString
cur)
            Word64 -> ByteString -> IO ()
go (Word64
seqNum Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1) ByteString
rest


data WaitingRef = WaitingRef
    { WaitingRef -> Storage
wrefStorage :: Storage
    , WaitingRef -> Ref' Partial
wrefPartial :: PartialRef
    , WaitingRef -> Ref -> WaitingRefCallback
wrefAction :: Ref -> WaitingRefCallback
    , WaitingRef -> TVar (Either [RefDigest] Ref)
wrefStatus :: TVar (Either [RefDigest] Ref)
    }

type WaitingRefCallback = ExceptT String IO ()

wrDigest :: WaitingRef -> RefDigest
wrDigest :: WaitingRef -> RefDigest
wrDigest = Ref' Partial -> RefDigest
forall (c :: * -> *). Ref' c -> RefDigest
refDigest (Ref' Partial -> RefDigest)
-> (WaitingRef -> Ref' Partial) -> WaitingRef -> RefDigest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WaitingRef -> Ref' Partial
wrefPartial


data ChannelState = ChannelNone
                  | ChannelCookieWait -- sent initiation, waiting for response
                  | ChannelCookieReceived -- received cookie, but no cookie echo yet
                  | ChannelCookieConfirmed -- received cookie echo, no need to send from our side
                  | ChannelOurRequest (Stored ChannelRequest)
                  | ChannelPeerRequest WaitingRef
                  | ChannelOurAccept (Stored ChannelAccept) Channel
                  | ChannelEstablished Channel
                  | ChannelClosed

data ReservedToSend = ReservedToSend
    { ReservedToSend -> Maybe (TransportHeaderItem -> Bool)
rsAckedBy :: Maybe (TransportHeaderItem -> Bool)
    , ReservedToSend -> IO ()
rsOnAck :: IO ()
    , ReservedToSend -> IO ()
rsOnFail :: IO ()
    }

data SentPacket = SentPacket
    { SentPacket -> TimeSpec
spTime :: TimeSpec
    , SentPacket -> Int
spRetryCount :: Int
    , SentPacket -> Maybe (TransportHeaderItem -> Bool)
spAckedBy :: Maybe (TransportHeaderItem -> Bool)
    , SentPacket -> IO ()
spOnAck :: IO ()
    , SentPacket -> IO ()
spOnFail :: IO ()
    , SentPacket -> ByteString
spData :: BC.ByteString
    }


data ControlRequest addr = RequestConnection addr
                         | SendAnnounce addr
                         | UpdateSelfIdentity UnifiedIdentity

data ControlMessage addr = NewConnection (Connection addr) (Maybe RefDigest)
                         | ReceivedAnnounce addr RefDigest


erebosNetworkProtocol :: (Eq addr, Ord addr, Show addr)
                      => UnifiedIdentity
                      -> (String -> STM ())
                      -> SymFlow (addr, ByteString)
                      -> Flow (ControlRequest addr) (ControlMessage addr)
                      -> IO ()
erebosNetworkProtocol :: forall addr.
(Eq addr, Ord addr, Show addr) =>
UnifiedIdentity
-> (String -> STM ())
-> SymFlow (addr, ByteString)
-> Flow (ControlRequest addr) (ControlMessage addr)
-> IO ()
erebosNetworkProtocol UnifiedIdentity
initialIdentity String -> STM ()
gLog SymFlow (addr, ByteString)
gDataFlow Flow (ControlRequest addr) (ControlMessage addr)
gControlFlow = do
    TVar (UnifiedIdentity, [UnifiedIdentity])
gIdentity <- (UnifiedIdentity, [UnifiedIdentity])
-> IO (TVar (UnifiedIdentity, [UnifiedIdentity]))
forall a. a -> IO (TVar a)
newTVarIO (UnifiedIdentity
initialIdentity, [])
    TVar [Connection addr]
gConnections <- [Connection addr] -> IO (TVar [Connection addr])
forall a. a -> IO (TVar a)
newTVarIO []
    TMVar (Connection addr, (Bool, TransportPacket PartialObject))
gNextUp <- IO (TMVar (Connection addr, (Bool, TransportPacket PartialObject)))
forall a. IO (TMVar a)
newEmptyTMVarIO
    Storage
mStorage <- IO Storage
memoryStorage
    PartialStorage
gStorage <- Storage -> IO PartialStorage
derivePartialStorage Storage
mStorage

    TimeSpec
gStartTime <- Clock -> IO TimeSpec
getTime Clock
Monotonic
    TVar TimeSpec
gNowVar <- TimeSpec -> IO (TVar TimeSpec)
forall a. a -> IO (TVar a)
newTVarIO TimeSpec
gStartTime
    TVar TimeSpec
gNextTimeout <- TimeSpec -> IO (TVar TimeSpec)
forall a. a -> IO (TVar a)
newTVarIO TimeSpec
gStartTime
    Ref
gInitConfig <- Storage -> Object -> IO Ref
forall a (c :: * -> *).
(Storable a, StorageCompleteness c) =>
Storage' c -> a -> IO (Ref' c)
forall (c :: * -> *).
StorageCompleteness c =>
Storage' c -> Object -> IO (Ref' c)
store Storage
mStorage (Object -> IO Ref) -> Object -> IO Ref
forall a b. (a -> b) -> a -> b
$ ([(ByteString, RecItem' Identity)] -> Object
forall (c :: * -> *). [(ByteString, RecItem' c)] -> Object' c
Rec [] :: Object)

    ScrubbedBytes
gCookieKey <- Int -> IO ScrubbedBytes
forall byteArray. ByteArray byteArray => Int -> IO byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
32
    Word32
gCookieStartTime <- Get Word32 -> ByteString -> Word32
forall a. Get a -> ByteString -> a
runGet Get Word32
getWord32host (ByteString -> Word32)
-> (ScrubbedBytes -> ByteString) -> ScrubbedBytes -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BL.pack ([Word8] -> ByteString)
-> (ScrubbedBytes -> [Word8]) -> ScrubbedBytes -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ByteArrayAccess a => a -> [Word8]
BA.unpack @ScrubbedBytes (ScrubbedBytes -> Word32) -> IO ScrubbedBytes -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO ScrubbedBytes
forall byteArray. ByteArray byteArray => Int -> IO byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
4

    let gs :: GlobalState addr
gs = GlobalState {Word32
TVar [Connection addr]
TVar (UnifiedIdentity, [UnifiedIdentity])
TVar TimeSpec
TimeSpec
ScrubbedBytes
TMVar (Connection addr, (Bool, TransportPacket PartialObject))
SymFlow (addr, ByteString)
Flow (ControlRequest addr) (ControlMessage addr)
Ref
PartialStorage
String -> STM ()
gIdentity :: TVar (UnifiedIdentity, [UnifiedIdentity])
gConnections :: TVar [Connection addr]
gDataFlow :: SymFlow (addr, ByteString)
gControlFlow :: Flow (ControlRequest addr) (ControlMessage addr)
gNextUp :: TMVar (Connection addr, (Bool, TransportPacket PartialObject))
gLog :: String -> STM ()
gStorage :: PartialStorage
gStartTime :: TimeSpec
gNowVar :: TVar TimeSpec
gNextTimeout :: TVar TimeSpec
gInitConfig :: Ref
gCookieKey :: ScrubbedBytes
gCookieStartTime :: Word32
gLog :: String -> STM ()
gDataFlow :: SymFlow (addr, ByteString)
gControlFlow :: Flow (ControlRequest addr) (ControlMessage addr)
gIdentity :: TVar (UnifiedIdentity, [UnifiedIdentity])
gConnections :: TVar [Connection addr]
gNextUp :: TMVar (Connection addr, (Bool, TransportPacket PartialObject))
gStorage :: PartialStorage
gStartTime :: TimeSpec
gNowVar :: TVar TimeSpec
gNextTimeout :: TVar TimeSpec
gInitConfig :: Ref
gCookieKey :: ScrubbedBytes
gCookieStartTime :: Word32
..}

    let signalTimeouts :: IO Any
signalTimeouts = IO () -> IO Any
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO Any) -> IO () -> IO Any
forall a b. (a -> b) -> a -> b
$ do
            TimeSpec
now <- Clock -> IO TimeSpec
getTime Clock
Monotonic
            TimeSpec
next <- STM TimeSpec -> IO TimeSpec
forall a. STM a -> IO a
atomically (STM TimeSpec -> IO TimeSpec) -> STM TimeSpec -> IO TimeSpec
forall a b. (a -> b) -> a -> b
$ do
                TVar TimeSpec -> TimeSpec -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar TimeSpec
gNowVar TimeSpec
now
                TVar TimeSpec -> STM TimeSpec
forall a. TVar a -> STM a
readTVar TVar TimeSpec
gNextTimeout

            let waitTill :: TimeSpec -> IO ()
waitTill TimeSpec
time
                    | TimeSpec
time TimeSpec -> TimeSpec -> Bool
forall a. Ord a => a -> a -> Bool
> TimeSpec
now = Int -> IO ()
threadDelay (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a. Num a => Integer -> a
fromInteger (TimeSpec -> Integer
toNanoSecs (TimeSpec
time TimeSpec -> TimeSpec -> TimeSpec
forall a. Num a => a -> a -> a
- TimeSpec
now)) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
1000
                    | Bool
otherwise = Int -> IO ()
threadDelay Int
forall a. Bounded a => a
maxBound
                waitForUpdate :: IO ()
waitForUpdate = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                    TimeSpec
next' <- TVar TimeSpec -> STM TimeSpec
forall a. TVar a -> STM a
readTVar TVar TimeSpec
gNextTimeout
                    Bool -> STM () -> STM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TimeSpec
next' TimeSpec -> TimeSpec -> Bool
forall a. Eq a => a -> a -> Bool
== TimeSpec
next) STM ()
forall a. STM a
retry

            IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO ()
race_ (TimeSpec -> IO ()
waitTill TimeSpec
next) IO ()
waitForUpdate

    IO Any -> IO Any -> IO ()
forall a b. IO a -> IO b -> IO ()
race_ IO Any
signalTimeouts (IO Any -> IO ()) -> IO Any -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO Any
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO Any) -> IO () -> IO Any
forall a b. (a -> b) -> a -> b
$ IO (IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (IO ()) -> IO ()) -> IO (IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ STM (IO ()) -> IO (IO ())
forall a. STM a -> IO a
atomically (STM (IO ()) -> IO (IO ())) -> STM (IO ()) -> IO (IO ())
forall a b. (a -> b) -> a -> b
$
        GlobalState addr -> STM (IO ())
forall addr. GlobalState addr -> STM (IO ())
passUpIncoming GlobalState addr
gs STM (IO ()) -> STM (IO ()) -> STM (IO ())
forall a. STM a -> STM a -> STM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> GlobalState addr -> STM (IO ())
forall addr. GlobalState addr -> STM (IO ())
processIncoming GlobalState addr
gs STM (IO ()) -> STM (IO ()) -> STM (IO ())
forall a. STM a -> STM a -> STM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> GlobalState addr -> STM (IO ())
forall addr. GlobalState addr -> STM (IO ())
processOutgoing GlobalState addr
gs


getConnection :: GlobalState addr -> addr -> STM (Connection addr)
getConnection :: forall addr. GlobalState addr -> addr -> STM (Connection addr)
getConnection GlobalState addr
gs addr
addr = do
    STM (Connection addr)
-> (Connection addr -> STM (Connection addr))
-> Maybe (Connection addr)
-> STM (Connection addr)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (GlobalState addr -> addr -> STM (Connection addr)
forall addr. GlobalState addr -> addr -> STM (Connection addr)
newConnection GlobalState addr
gs addr
addr) Connection addr -> STM (Connection addr)
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Connection addr) -> STM (Connection addr))
-> STM (Maybe (Connection addr)) -> STM (Connection addr)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GlobalState addr -> addr -> STM (Maybe (Connection addr))
forall addr.
GlobalState addr -> addr -> STM (Maybe (Connection addr))
findConnection GlobalState addr
gs addr
addr

findConnection :: GlobalState addr -> addr -> STM (Maybe (Connection addr))
findConnection :: forall addr.
GlobalState addr -> addr -> STM (Maybe (Connection addr))
findConnection GlobalState {Word32
TVar [Connection addr]
TVar (UnifiedIdentity, [UnifiedIdentity])
TVar TimeSpec
TimeSpec
ScrubbedBytes
TMVar (Connection addr, (Bool, TransportPacket PartialObject))
SymFlow (addr, ByteString)
Flow (ControlRequest addr) (ControlMessage addr)
Ref
PartialStorage
String -> STM ()
gIdentity :: forall addr.
GlobalState addr -> TVar (UnifiedIdentity, [UnifiedIdentity])
gConnections :: forall addr. GlobalState addr -> TVar [Connection addr]
gDataFlow :: forall addr. GlobalState addr -> SymFlow (addr, ByteString)
gControlFlow :: forall addr.
GlobalState addr
-> Flow (ControlRequest addr) (ControlMessage addr)
gNextUp :: forall addr.
GlobalState addr
-> TMVar (Connection addr, (Bool, TransportPacket PartialObject))
gLog :: forall addr. GlobalState addr -> String -> STM ()
gStorage :: forall addr. GlobalState addr -> PartialStorage
gStartTime :: forall addr. GlobalState addr -> TimeSpec
gNowVar :: forall addr. GlobalState addr -> TVar TimeSpec
gNextTimeout :: forall addr. GlobalState addr -> TVar TimeSpec
gInitConfig :: forall addr. GlobalState addr -> Ref
gCookieKey :: forall addr. GlobalState addr -> ScrubbedBytes
gCookieStartTime :: forall addr. GlobalState addr -> Word32
gIdentity :: TVar (UnifiedIdentity, [UnifiedIdentity])
gConnections :: TVar [Connection addr]
gDataFlow :: SymFlow (addr, ByteString)
gControlFlow :: Flow (ControlRequest addr) (ControlMessage addr)
gNextUp :: TMVar (Connection addr, (Bool, TransportPacket PartialObject))
gLog :: String -> STM ()
gStorage :: PartialStorage
gStartTime :: TimeSpec
gNowVar :: TVar TimeSpec
gNextTimeout :: TVar TimeSpec
gInitConfig :: Ref
gCookieKey :: ScrubbedBytes
gCookieStartTime :: Word32
..} addr
addr = do
    (Connection addr -> Bool)
-> [Connection addr] -> Maybe (Connection addr)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((addr
addraddr -> addr -> Bool
forall a. Eq a => a -> a -> Bool
==) (addr -> Bool)
-> (Connection addr -> addr) -> Connection addr -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection addr -> addr
forall addr. Connection addr -> addr
cAddress) ([Connection addr] -> Maybe (Connection addr))
-> STM [Connection addr] -> STM (Maybe (Connection addr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar [Connection addr] -> STM [Connection addr]
forall a. TVar a -> STM a
readTVar TVar [Connection addr]
gConnections

newConnection :: GlobalState addr -> addr -> STM (Connection addr)
newConnection :: forall addr. GlobalState addr -> addr -> STM (Connection addr)
newConnection cGlobalState :: GlobalState addr
cGlobalState@GlobalState {Word32
TVar [Connection addr]
TVar (UnifiedIdentity, [UnifiedIdentity])
TVar TimeSpec
TimeSpec
ScrubbedBytes
TMVar (Connection addr, (Bool, TransportPacket PartialObject))
SymFlow (addr, ByteString)
Flow (ControlRequest addr) (ControlMessage addr)
Ref
PartialStorage
String -> STM ()
gIdentity :: forall addr.
GlobalState addr -> TVar (UnifiedIdentity, [UnifiedIdentity])
gConnections :: forall addr. GlobalState addr -> TVar [Connection addr]
gDataFlow :: forall addr. GlobalState addr -> SymFlow (addr, ByteString)
gControlFlow :: forall addr.
GlobalState addr
-> Flow (ControlRequest addr) (ControlMessage addr)
gNextUp :: forall addr.
GlobalState addr
-> TMVar (Connection addr, (Bool, TransportPacket PartialObject))
gLog :: forall addr. GlobalState addr -> String -> STM ()
gStorage :: forall addr. GlobalState addr -> PartialStorage
gStartTime :: forall addr. GlobalState addr -> TimeSpec
gNowVar :: forall addr. GlobalState addr -> TVar TimeSpec
gNextTimeout :: forall addr. GlobalState addr -> TVar TimeSpec
gInitConfig :: forall addr. GlobalState addr -> Ref
gCookieKey :: forall addr. GlobalState addr -> ScrubbedBytes
gCookieStartTime :: forall addr. GlobalState addr -> Word32
gIdentity :: TVar (UnifiedIdentity, [UnifiedIdentity])
gConnections :: TVar [Connection addr]
gDataFlow :: SymFlow (addr, ByteString)
gControlFlow :: Flow (ControlRequest addr) (ControlMessage addr)
gNextUp :: TMVar (Connection addr, (Bool, TransportPacket PartialObject))
gLog :: String -> STM ()
gStorage :: PartialStorage
gStartTime :: TimeSpec
gNowVar :: TVar TimeSpec
gNextTimeout :: TVar TimeSpec
gInitConfig :: Ref
gCookieKey :: ScrubbedBytes
gCookieStartTime :: Word32
..} addr
addr = do
    [Connection addr]
conns <- TVar [Connection addr] -> STM [Connection addr]
forall a. TVar a -> STM a
readTVar TVar [Connection addr]
gConnections

    let cAddress :: addr
cAddress = addr
addr
    (Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataUp, Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
cDataInternal) <- STM
  (Flow
     (Maybe (Bool, TransportPacket PartialObject))
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem]),
   Flow
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
     (Maybe (Bool, TransportPacket PartialObject)))
forall a b. STM (Flow a b, Flow b a)
newFlow
    TVar ChannelState
cChannel <- ChannelState -> STM (TVar ChannelState)
forall a. a -> STM (TVar a)
newTVar ChannelState
ChannelNone
    TVar (Maybe Cookie)
cCookie <- Maybe Cookie -> STM (TVar (Maybe Cookie))
forall a. a -> STM (TVar a)
newTVar Maybe Cookie
forall a. Maybe a
Nothing
    TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cSecureOutQueue <- STM
  (TQueue
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem]))
forall a. STM (TQueue a)
newTQueue
    TVar Int
cMaxInFlightPackets <- Int -> STM (TVar Int)
forall a. a -> STM (TVar a)
newTVar Int
4
    TVar Int
cReservedPackets <- Int -> STM (TVar Int)
forall a. a -> STM (TVar a)
newTVar Int
0
    TVar [SentPacket]
cSentPackets <- [SentPacket] -> STM (TVar [SentPacket])
forall a. a -> STM (TVar a)
newTVar []
    TVar [Integer]
cToAcknowledge <- [Integer] -> STM (TVar [Integer])
forall a. a -> STM (TVar a)
newTVar []
    TVar (Maybe TimeSpec)
cNextKeepAlive <- Maybe TimeSpec -> STM (TVar (Maybe TimeSpec))
forall a. a -> STM (TVar a)
newTVar Maybe TimeSpec
forall a. Maybe a
Nothing
    TVar [(Word8, Stream)]
cInStreams <- [(Word8, Stream)] -> STM (TVar [(Word8, Stream)])
forall a. a -> STM (TVar a)
newTVar []
    TVar [(Word8, Stream)]
cOutStreams <- [(Word8, Stream)] -> STM (TVar [(Word8, Stream)])
forall a. a -> STM (TVar a)
newTVar []
    let conn :: Connection addr
conn = Connection {addr
TVar Int
TVar [Integer]
TVar [(Word8, Stream)]
TVar [SentPacket]
TVar (Maybe TimeSpec)
TVar (Maybe Cookie)
TVar ChannelState
TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
GlobalState addr
cGlobalState :: GlobalState addr
cAddress :: addr
cDataUp :: Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
cChannel :: TVar ChannelState
cCookie :: TVar (Maybe Cookie)
cSecureOutQueue :: TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: TVar Int
cReservedPackets :: TVar Int
cSentPackets :: TVar [SentPacket]
cToAcknowledge :: TVar [Integer]
cNextKeepAlive :: TVar (Maybe TimeSpec)
cInStreams :: TVar [(Word8, Stream)]
cOutStreams :: TVar [(Word8, Stream)]
cGlobalState :: GlobalState addr
cAddress :: addr
cDataUp :: Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
cChannel :: TVar ChannelState
cCookie :: TVar (Maybe Cookie)
cSecureOutQueue :: TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: TVar Int
cReservedPackets :: TVar Int
cSentPackets :: TVar [SentPacket]
cToAcknowledge :: TVar [Integer]
cNextKeepAlive :: TVar (Maybe TimeSpec)
cInStreams :: TVar [(Word8, Stream)]
cOutStreams :: TVar [(Word8, Stream)]
..}

    TVar [Connection addr] -> [Connection addr] -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar [Connection addr]
gConnections (Connection addr
conn Connection addr -> [Connection addr] -> [Connection addr]
forall a. a -> [a] -> [a]
: [Connection addr]
conns)
    Connection addr -> STM (Connection addr)
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return Connection addr
conn

passUpIncoming :: GlobalState addr -> STM (IO ())
passUpIncoming :: forall addr. GlobalState addr -> STM (IO ())
passUpIncoming GlobalState {Word32
TVar [Connection addr]
TVar (UnifiedIdentity, [UnifiedIdentity])
TVar TimeSpec
TimeSpec
ScrubbedBytes
TMVar (Connection addr, (Bool, TransportPacket PartialObject))
SymFlow (addr, ByteString)
Flow (ControlRequest addr) (ControlMessage addr)
Ref
PartialStorage
String -> STM ()
gIdentity :: forall addr.
GlobalState addr -> TVar (UnifiedIdentity, [UnifiedIdentity])
gConnections :: forall addr. GlobalState addr -> TVar [Connection addr]
gDataFlow :: forall addr. GlobalState addr -> SymFlow (addr, ByteString)
gControlFlow :: forall addr.
GlobalState addr
-> Flow (ControlRequest addr) (ControlMessage addr)
gNextUp :: forall addr.
GlobalState addr
-> TMVar (Connection addr, (Bool, TransportPacket PartialObject))
gLog :: forall addr. GlobalState addr -> String -> STM ()
gStorage :: forall addr. GlobalState addr -> PartialStorage
gStartTime :: forall addr. GlobalState addr -> TimeSpec
gNowVar :: forall addr. GlobalState addr -> TVar TimeSpec
gNextTimeout :: forall addr. GlobalState addr -> TVar TimeSpec
gInitConfig :: forall addr. GlobalState addr -> Ref
gCookieKey :: forall addr. GlobalState addr -> ScrubbedBytes
gCookieStartTime :: forall addr. GlobalState addr -> Word32
gIdentity :: TVar (UnifiedIdentity, [UnifiedIdentity])
gConnections :: TVar [Connection addr]
gDataFlow :: SymFlow (addr, ByteString)
gControlFlow :: Flow (ControlRequest addr) (ControlMessage addr)
gNextUp :: TMVar (Connection addr, (Bool, TransportPacket PartialObject))
gLog :: String -> STM ()
gStorage :: PartialStorage
gStartTime :: TimeSpec
gNowVar :: TVar TimeSpec
gNextTimeout :: TVar TimeSpec
gInitConfig :: Ref
gCookieKey :: ScrubbedBytes
gCookieStartTime :: Word32
..} = do
    (Connection {addr
TVar Int
TVar [Integer]
TVar [(Word8, Stream)]
TVar [SentPacket]
TVar (Maybe TimeSpec)
TVar (Maybe Cookie)
TVar ChannelState
TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
GlobalState addr
cGlobalState :: forall addr. Connection addr -> GlobalState addr
cAddress :: forall addr. Connection addr -> addr
cDataUp :: forall addr.
Connection addr
-> Flow
     (Maybe (Bool, TransportPacket PartialObject))
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: forall addr.
Connection addr
-> Flow
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
     (Maybe (Bool, TransportPacket PartialObject))
cChannel :: forall addr. Connection addr -> TVar ChannelState
cCookie :: forall addr. Connection addr -> TVar (Maybe Cookie)
cSecureOutQueue :: forall addr.
Connection addr
-> TQueue
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: forall addr. Connection addr -> TVar Int
cReservedPackets :: forall addr. Connection addr -> TVar Int
cSentPackets :: forall addr. Connection addr -> TVar [SentPacket]
cToAcknowledge :: forall addr. Connection addr -> TVar [Integer]
cNextKeepAlive :: forall addr. Connection addr -> TVar (Maybe TimeSpec)
cInStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cOutStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cGlobalState :: GlobalState addr
cAddress :: addr
cDataUp :: Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
cChannel :: TVar ChannelState
cCookie :: TVar (Maybe Cookie)
cSecureOutQueue :: TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: TVar Int
cReservedPackets :: TVar Int
cSentPackets :: TVar [SentPacket]
cToAcknowledge :: TVar [Integer]
cNextKeepAlive :: TVar (Maybe TimeSpec)
cInStreams :: TVar [(Word8, Stream)]
cOutStreams :: TVar [(Word8, Stream)]
..}, (Bool, TransportPacket PartialObject)
up) <- TMVar (Connection addr, (Bool, TransportPacket PartialObject))
-> STM (Connection addr, (Bool, TransportPacket PartialObject))
forall a. TMVar a -> STM a
takeTMVar TMVar (Connection addr, (Bool, TransportPacket PartialObject))
gNextUp
    Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
-> Maybe (Bool, TransportPacket PartialObject) -> STM ()
forall r w. Flow r w -> w -> STM ()
writeFlow Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
cDataInternal ((Bool, TransportPacket PartialObject)
-> Maybe (Bool, TransportPacket PartialObject)
forall a. a -> Maybe a
Just (Bool, TransportPacket PartialObject)
up)
    IO () -> STM (IO ())
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> STM (IO ())) -> IO () -> STM (IO ())
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

processIncoming :: GlobalState addr -> STM (IO ())
processIncoming :: forall addr. GlobalState addr -> STM (IO ())
processIncoming gs :: GlobalState addr
gs@GlobalState {Word32
TVar [Connection addr]
TVar (UnifiedIdentity, [UnifiedIdentity])
TVar TimeSpec
TimeSpec
ScrubbedBytes
TMVar (Connection addr, (Bool, TransportPacket PartialObject))
SymFlow (addr, ByteString)
Flow (ControlRequest addr) (ControlMessage addr)
Ref
PartialStorage
String -> STM ()
gIdentity :: forall addr.
GlobalState addr -> TVar (UnifiedIdentity, [UnifiedIdentity])
gConnections :: forall addr. GlobalState addr -> TVar [Connection addr]
gDataFlow :: forall addr. GlobalState addr -> SymFlow (addr, ByteString)
gControlFlow :: forall addr.
GlobalState addr
-> Flow (ControlRequest addr) (ControlMessage addr)
gNextUp :: forall addr.
GlobalState addr
-> TMVar (Connection addr, (Bool, TransportPacket PartialObject))
gLog :: forall addr. GlobalState addr -> String -> STM ()
gStorage :: forall addr. GlobalState addr -> PartialStorage
gStartTime :: forall addr. GlobalState addr -> TimeSpec
gNowVar :: forall addr. GlobalState addr -> TVar TimeSpec
gNextTimeout :: forall addr. GlobalState addr -> TVar TimeSpec
gInitConfig :: forall addr. GlobalState addr -> Ref
gCookieKey :: forall addr. GlobalState addr -> ScrubbedBytes
gCookieStartTime :: forall addr. GlobalState addr -> Word32
gIdentity :: TVar (UnifiedIdentity, [UnifiedIdentity])
gConnections :: TVar [Connection addr]
gDataFlow :: SymFlow (addr, ByteString)
gControlFlow :: Flow (ControlRequest addr) (ControlMessage addr)
gNextUp :: TMVar (Connection addr, (Bool, TransportPacket PartialObject))
gLog :: String -> STM ()
gStorage :: PartialStorage
gStartTime :: TimeSpec
gNowVar :: TVar TimeSpec
gNextTimeout :: TVar TimeSpec
gInitConfig :: Ref
gCookieKey :: ScrubbedBytes
gCookieStartTime :: Word32
..} = do
    Bool -> STM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> STM ()) -> STM Bool -> STM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TMVar (Connection addr, (Bool, TransportPacket PartialObject))
-> STM Bool
forall a. TMVar a -> STM Bool
isEmptyTMVar TMVar (Connection addr, (Bool, TransportPacket PartialObject))
gNextUp
    Bool -> STM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> STM ()) -> STM Bool -> STM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Flow (ControlRequest addr) (ControlMessage addr) -> STM Bool
forall r w. Flow r w -> STM Bool
canWriteFlow Flow (ControlRequest addr) (ControlMessage addr)
gControlFlow

    (addr
addr, ByteString
msg) <- SymFlow (addr, ByteString) -> STM (addr, ByteString)
forall r w. Flow r w -> STM r
readFlow SymFlow (addr, ByteString)
gDataFlow
    Maybe (Connection addr)
mbconn <- GlobalState addr -> addr -> STM (Maybe (Connection addr))
forall addr.
GlobalState addr -> addr -> STM (Maybe (Connection addr))
findConnection GlobalState addr
gs addr
addr

    Maybe Channel
mbch <- case Maybe (Connection addr)
mbconn of
        Maybe (Connection addr)
Nothing -> Maybe Channel -> STM (Maybe Channel)
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Channel
forall a. Maybe a
Nothing
        Just Connection addr
conn -> TVar ChannelState -> STM ChannelState
forall a. TVar a -> STM a
readTVar (Connection addr -> TVar ChannelState
forall addr. Connection addr -> TVar ChannelState
cChannel Connection addr
conn) STM ChannelState
-> (ChannelState -> STM (Maybe Channel)) -> STM (Maybe Channel)
forall a b. STM a -> (a -> STM b) -> STM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe Channel -> STM (Maybe Channel)
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Channel -> STM (Maybe Channel))
-> (ChannelState -> Maybe Channel)
-> ChannelState
-> STM (Maybe Channel)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
            ChannelEstablished Channel
ch -> Channel -> Maybe Channel
forall a. a -> Maybe a
Just Channel
ch
            ChannelOurAccept Stored ChannelAccept
_ Channel
ch -> Channel -> Maybe Channel
forall a. a -> Maybe a
Just Channel
ch
            ChannelState
_                     -> Maybe Channel
forall a. Maybe a
Nothing

    IO () -> STM (IO ())
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> STM (IO ())) -> IO () -> STM (IO ())
forall a b. (a -> b) -> a -> b
$ do
        let deserialize :: ByteString -> ExceptT String IO [PartialObject]
deserialize = Either String [PartialObject] -> ExceptT String IO [PartialObject]
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either String [PartialObject]
 -> ExceptT String IO [PartialObject])
-> (ByteString -> Either String [PartialObject])
-> ByteString
-> ExceptT String IO [PartialObject]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Except String [PartialObject] -> Either String [PartialObject]
forall e a. Except e a -> Either e a
runExcept (Except String [PartialObject] -> Either String [PartialObject])
-> (ByteString -> Except String [PartialObject])
-> ByteString
-> Either String [PartialObject]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PartialStorage -> ByteString -> Except String [PartialObject]
deserializeObjects PartialStorage
gStorage (ByteString -> Except String [PartialObject])
-> (ByteString -> ByteString)
-> ByteString
-> Except String [PartialObject]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.fromStrict
        let parse :: ExceptT
  String
  IO
  (Either
     (Bool, [PartialObject], Maybe Word64)
     (Word8, Word8, ByteString, Word64))
parse = case ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
msg of
                Just (Word8
b, ByteString
enc)
                    | Word8
b Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xE0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x80 -> do
                        Channel
ch <- ExceptT String IO Channel
-> (Channel -> ExceptT String IO Channel)
-> Maybe Channel
-> ExceptT String IO Channel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> ExceptT String IO Channel
forall a. String -> ExceptT String IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"unexpected encrypted packet") Channel -> ExceptT String IO Channel
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Channel
mbch
                        (ByteString
dec, Word64
counter) <- Channel -> ByteString -> ExceptT String IO (ByteString, Word64)
forall ba (m :: * -> *).
(ByteArray ba, MonadIO m, MonadError String m) =>
Channel -> ba -> m (ba, Word64)
channelDecrypt Channel
ch ByteString
enc

                        case ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
dec of
                            Just (Word8
0x00, ByteString
content) -> do
                                [PartialObject]
objs <- ByteString -> ExceptT String IO [PartialObject]
deserialize ByteString
content
                                Either
  (Bool, [PartialObject], Maybe Word64)
  (Word8, Word8, ByteString, Word64)
-> ExceptT
     String
     IO
     (Either
        (Bool, [PartialObject], Maybe Word64)
        (Word8, Word8, ByteString, Word64))
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
   (Bool, [PartialObject], Maybe Word64)
   (Word8, Word8, ByteString, Word64)
 -> ExceptT
      String
      IO
      (Either
         (Bool, [PartialObject], Maybe Word64)
         (Word8, Word8, ByteString, Word64)))
-> Either
     (Bool, [PartialObject], Maybe Word64)
     (Word8, Word8, ByteString, Word64)
-> ExceptT
     String
     IO
     (Either
        (Bool, [PartialObject], Maybe Word64)
        (Word8, Word8, ByteString, Word64))
forall a b. (a -> b) -> a -> b
$ (Bool, [PartialObject], Maybe Word64)
-> Either
     (Bool, [PartialObject], Maybe Word64)
     (Word8, Word8, ByteString, Word64)
forall a b. a -> Either a b
Left (Bool
True, [PartialObject]
objs, Word64 -> Maybe Word64
forall a. a -> Maybe a
Just Word64
counter)

                            Just (Word8
snum, ByteString
dec')
                                | Word8
snum Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
64
                                , Just (Word8
seq8, ByteString
content) <- ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
dec'
                                -> do
                                    Either
  (Bool, [PartialObject], Maybe Word64)
  (Word8, Word8, ByteString, Word64)
-> ExceptT
     String
     IO
     (Either
        (Bool, [PartialObject], Maybe Word64)
        (Word8, Word8, ByteString, Word64))
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
   (Bool, [PartialObject], Maybe Word64)
   (Word8, Word8, ByteString, Word64)
 -> ExceptT
      String
      IO
      (Either
         (Bool, [PartialObject], Maybe Word64)
         (Word8, Word8, ByteString, Word64)))
-> Either
     (Bool, [PartialObject], Maybe Word64)
     (Word8, Word8, ByteString, Word64)
-> ExceptT
     String
     IO
     (Either
        (Bool, [PartialObject], Maybe Word64)
        (Word8, Word8, ByteString, Word64))
forall a b. (a -> b) -> a -> b
$ (Word8, Word8, ByteString, Word64)
-> Either
     (Bool, [PartialObject], Maybe Word64)
     (Word8, Word8, ByteString, Word64)
forall a b. b -> Either a b
Right (Word8
snum, Word8
seq8, ByteString
content, Word64
counter)

                            Just (Word8
_, ByteString
_) -> do
                                String
-> ExceptT
     String
     IO
     (Either
        (Bool, [PartialObject], Maybe Word64)
        (Word8, Word8, ByteString, Word64))
forall a. String -> ExceptT String IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"unexpected stream header"

                            Maybe (Word8, ByteString)
Nothing -> do
                                String
-> ExceptT
     String
     IO
     (Either
        (Bool, [PartialObject], Maybe Word64)
        (Word8, Word8, ByteString, Word64))
forall a. String -> ExceptT String IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"empty decrypted content"

                    | Word8
b Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xE0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x60 -> do
                        [PartialObject]
objs <- ByteString -> ExceptT String IO [PartialObject]
deserialize ByteString
msg
                        Either
  (Bool, [PartialObject], Maybe Word64)
  (Word8, Word8, ByteString, Word64)
-> ExceptT
     String
     IO
     (Either
        (Bool, [PartialObject], Maybe Word64)
        (Word8, Word8, ByteString, Word64))
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
   (Bool, [PartialObject], Maybe Word64)
   (Word8, Word8, ByteString, Word64)
 -> ExceptT
      String
      IO
      (Either
         (Bool, [PartialObject], Maybe Word64)
         (Word8, Word8, ByteString, Word64)))
-> Either
     (Bool, [PartialObject], Maybe Word64)
     (Word8, Word8, ByteString, Word64)
-> ExceptT
     String
     IO
     (Either
        (Bool, [PartialObject], Maybe Word64)
        (Word8, Word8, ByteString, Word64))
forall a b. (a -> b) -> a -> b
$ (Bool, [PartialObject], Maybe Word64)
-> Either
     (Bool, [PartialObject], Maybe Word64)
     (Word8, Word8, ByteString, Word64)
forall a b. a -> Either a b
Left (Bool
False, [PartialObject]
objs, Maybe Word64
forall a. Maybe a
Nothing)

                    | Bool
otherwise -> String
-> ExceptT
     String
     IO
     (Either
        (Bool, [PartialObject], Maybe Word64)
        (Word8, Word8, ByteString, Word64))
forall a. String -> ExceptT String IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"invalid packet"

                Maybe (Word8, ByteString)
Nothing -> String
-> ExceptT
     String
     IO
     (Either
        (Bool, [PartialObject], Maybe Word64)
        (Word8, Word8, ByteString, Word64))
forall a. String -> ExceptT String IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"empty packet"

        TimeSpec
now <- Clock -> IO TimeSpec
getTime Clock
Monotonic
        ExceptT
  String
  IO
  (Either
     (Bool, [PartialObject], Maybe Word64)
     (Word8, Word8, ByteString, Word64))
-> IO
     (Either
        String
        (Either
           (Bool, [PartialObject], Maybe Word64)
           (Word8, Word8, ByteString, Word64)))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT
  String
  IO
  (Either
     (Bool, [PartialObject], Maybe Word64)
     (Word8, Word8, ByteString, Word64))
parse IO
  (Either
     String
     (Either
        (Bool, [PartialObject], Maybe Word64)
        (Word8, Word8, ByteString, Word64)))
-> (Either
      String
      (Either
         (Bool, [PartialObject], Maybe Word64)
         (Word8, Word8, ByteString, Word64))
    -> IO ())
-> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Right (Left (Bool
secure, [PartialObject]
objs, Maybe Word64
mbcounter))
                | PartialObject
hobj:[PartialObject]
content <- [PartialObject]
objs
                , Just header :: TransportHeader
header@(TransportHeader [TransportHeaderItem]
items) <- PartialObject -> Maybe TransportHeader
transportFromObject PartialObject
hobj
                -> GlobalState addr
-> Either addr (Connection addr)
-> Bool
-> TransportPacket PartialObject
-> IO
     (Maybe (Connection addr, Maybe (TransportPacket PartialObject)))
forall addr a.
GlobalState addr
-> Either addr (Connection addr)
-> Bool
-> TransportPacket a
-> IO (Maybe (Connection addr, Maybe (TransportPacket a)))
processPacket GlobalState addr
gs (Either addr (Connection addr)
-> (Connection addr -> Either addr (Connection addr))
-> Maybe (Connection addr)
-> Either addr (Connection addr)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (addr -> Either addr (Connection addr)
forall a b. a -> Either a b
Left addr
addr) Connection addr -> Either addr (Connection addr)
forall a b. b -> Either a b
Right Maybe (Connection addr)
mbconn) Bool
secure (TransportHeader -> [PartialObject] -> TransportPacket PartialObject
forall a. TransportHeader -> [a] -> TransportPacket a
TransportPacket TransportHeader
header [PartialObject]
content) IO (Maybe (Connection addr, Maybe (TransportPacket PartialObject)))
-> (Maybe (Connection addr, Maybe (TransportPacket PartialObject))
    -> IO ())
-> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    Just (conn :: Connection addr
conn@Connection {addr
TVar Int
TVar [Integer]
TVar [(Word8, Stream)]
TVar [SentPacket]
TVar (Maybe TimeSpec)
TVar (Maybe Cookie)
TVar ChannelState
TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
GlobalState addr
cGlobalState :: forall addr. Connection addr -> GlobalState addr
cAddress :: forall addr. Connection addr -> addr
cDataUp :: forall addr.
Connection addr
-> Flow
     (Maybe (Bool, TransportPacket PartialObject))
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: forall addr.
Connection addr
-> Flow
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
     (Maybe (Bool, TransportPacket PartialObject))
cChannel :: forall addr. Connection addr -> TVar ChannelState
cCookie :: forall addr. Connection addr -> TVar (Maybe Cookie)
cSecureOutQueue :: forall addr.
Connection addr
-> TQueue
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: forall addr. Connection addr -> TVar Int
cReservedPackets :: forall addr. Connection addr -> TVar Int
cSentPackets :: forall addr. Connection addr -> TVar [SentPacket]
cToAcknowledge :: forall addr. Connection addr -> TVar [Integer]
cNextKeepAlive :: forall addr. Connection addr -> TVar (Maybe TimeSpec)
cInStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cOutStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cGlobalState :: GlobalState addr
cAddress :: addr
cDataUp :: Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
cChannel :: TVar ChannelState
cCookie :: TVar (Maybe Cookie)
cSecureOutQueue :: TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: TVar Int
cReservedPackets :: TVar Int
cSentPackets :: TVar [SentPacket]
cToAcknowledge :: TVar [Integer]
cNextKeepAlive :: TVar (Maybe TimeSpec)
cInStreams :: TVar [(Word8, Stream)]
cOutStreams :: TVar [(Word8, Stream)]
..}, Maybe (TransportPacket PartialObject)
mbup) -> do
                        IO ()
ioAfter <- STM (IO ()) -> IO (IO ())
forall a. STM a -> IO a
atomically (STM (IO ()) -> IO (IO ())) -> STM (IO ()) -> IO (IO ())
forall a b. (a -> b) -> a -> b
$ do
                            case Maybe Word64
mbcounter of
                                Just Word64
counter | (TransportHeaderItem -> Bool) -> [TransportHeaderItem] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TransportHeaderItem -> Bool
isHeaderItemAcknowledged [TransportHeaderItem]
items ->
                                    TVar [Integer] -> ([Integer] -> [Integer]) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar [Integer]
cToAcknowledge (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
counter Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
:)
                                Maybe Word64
_ -> () -> STM ()
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                            case Maybe (TransportPacket PartialObject)
mbup of
                                Just TransportPacket PartialObject
up -> TMVar (Connection addr, (Bool, TransportPacket PartialObject))
-> (Connection addr, (Bool, TransportPacket PartialObject))
-> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar (Connection addr, (Bool, TransportPacket PartialObject))
gNextUp (Connection addr
conn, (Bool
secure, TransportPacket PartialObject
up))
                                Maybe (TransportPacket PartialObject)
Nothing -> () -> STM ()
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                            Connection addr -> TimeSpec -> STM ()
forall addr. Connection addr -> TimeSpec -> STM ()
updateKeepAlive Connection addr
conn TimeSpec
now
                            GlobalState addr
-> Connection addr -> [TransportHeaderItem] -> STM (IO ())
forall addr.
GlobalState addr
-> Connection addr -> [TransportHeaderItem] -> STM (IO ())
processAcknowledgements GlobalState addr
gs Connection addr
conn [TransportHeaderItem]
items
                        IO ()
ioAfter
                    Maybe (Connection addr, Maybe (TransportPacket PartialObject))
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

                | Bool
otherwise -> STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                      String -> STM ()
gLog (String -> STM ()) -> String -> STM ()
forall a b. (a -> b) -> a -> b
$ addr -> String
forall a. Show a => a -> String
show addr
addr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": invalid objects"
                      String -> STM ()
gLog (String -> STM ()) -> String -> STM ()
forall a b. (a -> b) -> a -> b
$ [PartialObject] -> String
forall a. Show a => a -> String
show [PartialObject]
objs

            Right (Right (Word8
snum, Word8
seq8, ByteString
content, Word64
counter))
                | Just conn :: Connection addr
conn@Connection {addr
TVar Int
TVar [Integer]
TVar [(Word8, Stream)]
TVar [SentPacket]
TVar (Maybe TimeSpec)
TVar (Maybe Cookie)
TVar ChannelState
TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
GlobalState addr
cGlobalState :: forall addr. Connection addr -> GlobalState addr
cAddress :: forall addr. Connection addr -> addr
cDataUp :: forall addr.
Connection addr
-> Flow
     (Maybe (Bool, TransportPacket PartialObject))
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: forall addr.
Connection addr
-> Flow
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
     (Maybe (Bool, TransportPacket PartialObject))
cChannel :: forall addr. Connection addr -> TVar ChannelState
cCookie :: forall addr. Connection addr -> TVar (Maybe Cookie)
cSecureOutQueue :: forall addr.
Connection addr
-> TQueue
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: forall addr. Connection addr -> TVar Int
cReservedPackets :: forall addr. Connection addr -> TVar Int
cSentPackets :: forall addr. Connection addr -> TVar [SentPacket]
cToAcknowledge :: forall addr. Connection addr -> TVar [Integer]
cNextKeepAlive :: forall addr. Connection addr -> TVar (Maybe TimeSpec)
cInStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cOutStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cGlobalState :: GlobalState addr
cAddress :: addr
cDataUp :: Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
cChannel :: TVar ChannelState
cCookie :: TVar (Maybe Cookie)
cSecureOutQueue :: TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: TVar Int
cReservedPackets :: TVar Int
cSentPackets :: TVar [SentPacket]
cToAcknowledge :: TVar [Integer]
cNextKeepAlive :: TVar (Maybe TimeSpec)
cInStreams :: TVar [(Word8, Stream)]
cOutStreams :: TVar [(Word8, Stream)]
..} <- Maybe (Connection addr)
mbconn
                -> STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                    Connection addr -> TimeSpec -> STM ()
forall addr. Connection addr -> TimeSpec -> STM ()
updateKeepAlive Connection addr
conn TimeSpec
now
                    (Word8 -> [(Word8, Stream)] -> Maybe Stream
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Word8
snum ([(Word8, Stream)] -> Maybe Stream)
-> STM [(Word8, Stream)] -> STM (Maybe Stream)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar [(Word8, Stream)] -> STM [(Word8, Stream)]
forall a. TVar a -> STM a
readTVar TVar [(Word8, Stream)]
cInStreams) STM (Maybe Stream) -> (Maybe Stream -> STM ()) -> STM ()
forall a b. STM a -> (a -> STM b) -> STM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                        Maybe Stream
Nothing ->
                            String -> STM ()
gLog (String -> STM ()) -> String -> STM ()
forall a b. (a -> b) -> a -> b
$ String
"unexpected stream number " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
snum

                        Just Stream {TVar Word64
TVar StreamState
RawStreamWriter
Flow StreamPacket Void
sState :: Stream -> TVar StreamState
sFlowIn :: Stream -> RawStreamWriter
sFlowOut :: Stream -> Flow StreamPacket Void
sNextSequence :: Stream -> TVar Word64
sWaitingForAck :: Stream -> TVar Word64
sState :: TVar StreamState
sFlowIn :: RawStreamWriter
sFlowOut :: Flow StreamPacket Void
sNextSequence :: TVar Word64
sWaitingForAck :: TVar Word64
..} -> do
                            Word64
expectedSequence <- TVar Word64 -> STM Word64
forall a. TVar a -> STM a
readTVar TVar Word64
sNextSequence
                            let seqFull :: Word64
seqFull = Word64
expectedSequence Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
0x80 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
seq8 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
expectedSequence Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
0x80 :: Word8)
                            StreamPacket
sdata <- if
                                | ByteString -> Bool
B.null ByteString
content -> do
                                    TVar [(Word8, Stream)]
-> ([(Word8, Stream)] -> [(Word8, Stream)]) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar [(Word8, Stream)]
cInStreams (([(Word8, Stream)] -> [(Word8, Stream)]) -> STM ())
-> ([(Word8, Stream)] -> [(Word8, Stream)]) -> STM ()
forall a b. (a -> b) -> a -> b
$ ((Word8, Stream) -> Bool) -> [(Word8, Stream)] -> [(Word8, Stream)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/=Word8
snum) (Word8 -> Bool)
-> ((Word8, Stream) -> Word8) -> (Word8, Stream) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8, Stream) -> Word8
forall a b. (a, b) -> a
fst)
                                    StreamPacket -> STM StreamPacket
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (StreamPacket -> STM StreamPacket)
-> StreamPacket -> STM StreamPacket
forall a b. (a -> b) -> a -> b
$ Word64 -> StreamPacket
StreamClosed Word64
seqFull
                                | Bool
otherwise -> do
                                    TVar Word64 -> Word64 -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar Word64
sNextSequence (Word64 -> STM ()) -> Word64 -> STM ()
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> Word64
forall a. Ord a => a -> a -> a
max Word64
expectedSequence (Word64
seqFull Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1)
                                    StreamPacket -> STM StreamPacket
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (StreamPacket -> STM StreamPacket)
-> StreamPacket -> STM StreamPacket
forall a b. (a -> b) -> a -> b
$ Word64 -> ByteString -> StreamPacket
StreamData Word64
seqFull ByteString
content
                            RawStreamWriter -> StreamPacket -> STM ()
forall r w. Flow r w -> w -> STM ()
writeFlow RawStreamWriter
sFlowIn StreamPacket
sdata
                            TVar [Integer] -> ([Integer] -> [Integer]) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar [Integer]
cToAcknowledge (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
counter Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
:)

                | Bool
otherwise -> do
                    STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> STM ()
gLog (String -> STM ()) -> String -> STM ()
forall a b. (a -> b) -> a -> b
$ addr -> String
forall a. Show a => a -> String
show addr
addr String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": stream packet without connection"

            Left String
err -> do
                STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> STM ()
gLog (String -> STM ()) -> String -> STM ()
forall a b. (a -> b) -> a -> b
$ addr -> String
forall a. Show a => a -> String
show addr
addr String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": failed to parse packet: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
err

processPacket :: GlobalState addr -> Either addr (Connection addr) -> Bool -> TransportPacket a -> IO (Maybe (Connection addr, Maybe (TransportPacket a)))
processPacket :: forall addr a.
GlobalState addr
-> Either addr (Connection addr)
-> Bool
-> TransportPacket a
-> IO (Maybe (Connection addr, Maybe (TransportPacket a)))
processPacket gs :: GlobalState addr
gs@GlobalState {Word32
TVar [Connection addr]
TVar (UnifiedIdentity, [UnifiedIdentity])
TVar TimeSpec
TimeSpec
ScrubbedBytes
TMVar (Connection addr, (Bool, TransportPacket PartialObject))
SymFlow (addr, ByteString)
Flow (ControlRequest addr) (ControlMessage addr)
Ref
PartialStorage
String -> STM ()
gIdentity :: forall addr.
GlobalState addr -> TVar (UnifiedIdentity, [UnifiedIdentity])
gConnections :: forall addr. GlobalState addr -> TVar [Connection addr]
gDataFlow :: forall addr. GlobalState addr -> SymFlow (addr, ByteString)
gControlFlow :: forall addr.
GlobalState addr
-> Flow (ControlRequest addr) (ControlMessage addr)
gNextUp :: forall addr.
GlobalState addr
-> TMVar (Connection addr, (Bool, TransportPacket PartialObject))
gLog :: forall addr. GlobalState addr -> String -> STM ()
gStorage :: forall addr. GlobalState addr -> PartialStorage
gStartTime :: forall addr. GlobalState addr -> TimeSpec
gNowVar :: forall addr. GlobalState addr -> TVar TimeSpec
gNextTimeout :: forall addr. GlobalState addr -> TVar TimeSpec
gInitConfig :: forall addr. GlobalState addr -> Ref
gCookieKey :: forall addr. GlobalState addr -> ScrubbedBytes
gCookieStartTime :: forall addr. GlobalState addr -> Word32
gIdentity :: TVar (UnifiedIdentity, [UnifiedIdentity])
gConnections :: TVar [Connection addr]
gDataFlow :: SymFlow (addr, ByteString)
gControlFlow :: Flow (ControlRequest addr) (ControlMessage addr)
gNextUp :: TMVar (Connection addr, (Bool, TransportPacket PartialObject))
gLog :: String -> STM ()
gStorage :: PartialStorage
gStartTime :: TimeSpec
gNowVar :: TVar TimeSpec
gNextTimeout :: TVar TimeSpec
gInitConfig :: Ref
gCookieKey :: ScrubbedBytes
gCookieStartTime :: Word32
..} Either addr (Connection addr)
econn Bool
secure packet :: TransportPacket a
packet@(TransportPacket (TransportHeader [TransportHeaderItem]
header) [a]
_) = if
    -- Established secure communication
    | Right Connection addr
conn <- Either addr (Connection addr)
econn, Bool
secure
    -> Maybe (Connection addr, Maybe (TransportPacket a))
-> IO (Maybe (Connection addr, Maybe (TransportPacket a)))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Connection addr, Maybe (TransportPacket a))
 -> IO (Maybe (Connection addr, Maybe (TransportPacket a))))
-> Maybe (Connection addr, Maybe (TransportPacket a))
-> IO (Maybe (Connection addr, Maybe (TransportPacket a)))
forall a b. (a -> b) -> a -> b
$ (Connection addr, Maybe (TransportPacket a))
-> Maybe (Connection addr, Maybe (TransportPacket a))
forall a. a -> Maybe a
Just (Connection addr
conn, TransportPacket a -> Maybe (TransportPacket a)
forall a. a -> Maybe a
Just TransportPacket a
packet)

    -- Plaintext communication with cookies to prove origin
    | Cookie
cookie:[Cookie]
_ <- (TransportHeaderItem -> Maybe Cookie)
-> [TransportHeaderItem] -> [Cookie]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\case CookieEcho Cookie
x -> Cookie -> Maybe Cookie
forall a. a -> Maybe a
Just Cookie
x; TransportHeaderItem
_ -> Maybe Cookie
forall a. Maybe a
Nothing) [TransportHeaderItem]
header
    -> GlobalState addr -> addr -> Cookie -> IO Bool
forall addr. GlobalState addr -> addr -> Cookie -> IO Bool
verifyCookie GlobalState addr
gs addr
addr Cookie
cookie IO Bool
-> (Bool
    -> IO (Maybe (Connection addr, Maybe (TransportPacket a))))
-> IO (Maybe (Connection addr, Maybe (TransportPacket a)))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Bool
True -> do
            STM (Maybe (Connection addr, Maybe (TransportPacket a)))
-> IO (Maybe (Connection addr, Maybe (TransportPacket a)))
forall a. STM a -> IO a
atomically (STM (Maybe (Connection addr, Maybe (TransportPacket a)))
 -> IO (Maybe (Connection addr, Maybe (TransportPacket a))))
-> STM (Maybe (Connection addr, Maybe (TransportPacket a)))
-> IO (Maybe (Connection addr, Maybe (TransportPacket a)))
forall a b. (a -> b) -> a -> b
$ do
                conn :: Connection addr
conn@Connection {addr
TVar Int
TVar [Integer]
TVar [(Word8, Stream)]
TVar [SentPacket]
TVar (Maybe TimeSpec)
TVar (Maybe Cookie)
TVar ChannelState
TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
GlobalState addr
cGlobalState :: forall addr. Connection addr -> GlobalState addr
cAddress :: forall addr. Connection addr -> addr
cDataUp :: forall addr.
Connection addr
-> Flow
     (Maybe (Bool, TransportPacket PartialObject))
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: forall addr.
Connection addr
-> Flow
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
     (Maybe (Bool, TransportPacket PartialObject))
cChannel :: forall addr. Connection addr -> TVar ChannelState
cCookie :: forall addr. Connection addr -> TVar (Maybe Cookie)
cSecureOutQueue :: forall addr.
Connection addr
-> TQueue
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: forall addr. Connection addr -> TVar Int
cReservedPackets :: forall addr. Connection addr -> TVar Int
cSentPackets :: forall addr. Connection addr -> TVar [SentPacket]
cToAcknowledge :: forall addr. Connection addr -> TVar [Integer]
cNextKeepAlive :: forall addr. Connection addr -> TVar (Maybe TimeSpec)
cInStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cOutStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cGlobalState :: GlobalState addr
cAddress :: addr
cDataUp :: Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
cChannel :: TVar ChannelState
cCookie :: TVar (Maybe Cookie)
cSecureOutQueue :: TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: TVar Int
cReservedPackets :: TVar Int
cSentPackets :: TVar [SentPacket]
cToAcknowledge :: TVar [Integer]
cNextKeepAlive :: TVar (Maybe TimeSpec)
cInStreams :: TVar [(Word8, Stream)]
cOutStreams :: TVar [(Word8, Stream)]
..} <- GlobalState addr -> addr -> STM (Connection addr)
forall addr. GlobalState addr -> addr -> STM (Connection addr)
getConnection GlobalState addr
gs addr
addr
                Maybe Cookie
oldCookie <- TVar (Maybe Cookie) -> STM (Maybe Cookie)
forall a. TVar a -> STM a
readTVar TVar (Maybe Cookie)
cCookie
                let received :: Maybe Cookie
received = [Cookie] -> Maybe Cookie
forall a. [a] -> Maybe a
listToMaybe ([Cookie] -> Maybe Cookie) -> [Cookie] -> Maybe Cookie
forall a b. (a -> b) -> a -> b
$ (TransportHeaderItem -> Maybe Cookie)
-> [TransportHeaderItem] -> [Cookie]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\case CookieSet Cookie
x -> Cookie -> Maybe Cookie
forall a. a -> Maybe a
Just Cookie
x; TransportHeaderItem
_ -> Maybe Cookie
forall a. Maybe a
Nothing) [TransportHeaderItem]
header
                case Maybe Cookie
received Maybe Cookie -> Maybe Cookie -> Maybe Cookie
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe Cookie
oldCookie of
                    Just Cookie
current -> do
                        TVar (Maybe Cookie) -> Maybe Cookie -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe Cookie)
cCookie (Cookie -> Maybe Cookie
forall a. a -> Maybe a
Just Cookie
current)
                        GlobalState addr -> Connection addr -> Maybe RefDigest -> STM ()
forall addr.
GlobalState addr -> Connection addr -> Maybe RefDigest -> STM ()
cookieEchoReceived GlobalState addr
gs Connection addr
conn Maybe RefDigest
mbpid
                        Maybe (Connection addr, Maybe (TransportPacket a))
-> STM (Maybe (Connection addr, Maybe (TransportPacket a)))
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Connection addr, Maybe (TransportPacket a))
 -> STM (Maybe (Connection addr, Maybe (TransportPacket a))))
-> Maybe (Connection addr, Maybe (TransportPacket a))
-> STM (Maybe (Connection addr, Maybe (TransportPacket a)))
forall a b. (a -> b) -> a -> b
$ (Connection addr, Maybe (TransportPacket a))
-> Maybe (Connection addr, Maybe (TransportPacket a))
forall a. a -> Maybe a
Just (Connection addr
conn, TransportPacket a -> Maybe (TransportPacket a)
forall a. a -> Maybe a
Just TransportPacket a
packet)
                    Maybe Cookie
Nothing -> do
                        String -> STM ()
gLog (String -> STM ()) -> String -> STM ()
forall a b. (a -> b) -> a -> b
$ addr -> String
forall a. Show a => a -> String
show addr
addr String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": missing cookie set, dropping " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [TransportHeaderItem] -> String
forall a. Show a => a -> String
show [TransportHeaderItem]
header
                        Maybe (Connection addr, Maybe (TransportPacket a))
-> STM (Maybe (Connection addr, Maybe (TransportPacket a)))
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Connection addr, Maybe (TransportPacket a))
 -> STM (Maybe (Connection addr, Maybe (TransportPacket a))))
-> Maybe (Connection addr, Maybe (TransportPacket a))
-> STM (Maybe (Connection addr, Maybe (TransportPacket a)))
forall a b. (a -> b) -> a -> b
$ Maybe (Connection addr, Maybe (TransportPacket a))
forall a. Maybe a
Nothing

        Bool
False -> do
            STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> STM ()
gLog (String -> STM ()) -> String -> STM ()
forall a b. (a -> b) -> a -> b
$ addr -> String
forall a. Show a => a -> String
show addr
addr String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": cookie verification failed, dropping " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [TransportHeaderItem] -> String
forall a. Show a => a -> String
show [TransportHeaderItem]
header
            Maybe (Connection addr, Maybe (TransportPacket a))
-> IO (Maybe (Connection addr, Maybe (TransportPacket a)))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Connection addr, Maybe (TransportPacket a))
forall a. Maybe a
Nothing

    -- Response to initiation packet
    | Cookie
cookie:[Cookie]
_ <- (TransportHeaderItem -> Maybe Cookie)
-> [TransportHeaderItem] -> [Cookie]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\case CookieSet Cookie
x -> Cookie -> Maybe Cookie
forall a. a -> Maybe a
Just Cookie
x; TransportHeaderItem
_ -> Maybe Cookie
forall a. Maybe a
Nothing) [TransportHeaderItem]
header
    , Just Text
_ <- Maybe Text
version
    , Right conn :: Connection addr
conn@Connection {addr
TVar Int
TVar [Integer]
TVar [(Word8, Stream)]
TVar [SentPacket]
TVar (Maybe TimeSpec)
TVar (Maybe Cookie)
TVar ChannelState
TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
GlobalState addr
cGlobalState :: forall addr. Connection addr -> GlobalState addr
cAddress :: forall addr. Connection addr -> addr
cDataUp :: forall addr.
Connection addr
-> Flow
     (Maybe (Bool, TransportPacket PartialObject))
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: forall addr.
Connection addr
-> Flow
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
     (Maybe (Bool, TransportPacket PartialObject))
cChannel :: forall addr. Connection addr -> TVar ChannelState
cCookie :: forall addr. Connection addr -> TVar (Maybe Cookie)
cSecureOutQueue :: forall addr.
Connection addr
-> TQueue
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: forall addr. Connection addr -> TVar Int
cReservedPackets :: forall addr. Connection addr -> TVar Int
cSentPackets :: forall addr. Connection addr -> TVar [SentPacket]
cToAcknowledge :: forall addr. Connection addr -> TVar [Integer]
cNextKeepAlive :: forall addr. Connection addr -> TVar (Maybe TimeSpec)
cInStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cOutStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cGlobalState :: GlobalState addr
cAddress :: addr
cDataUp :: Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
cChannel :: TVar ChannelState
cCookie :: TVar (Maybe Cookie)
cSecureOutQueue :: TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: TVar Int
cReservedPackets :: TVar Int
cSentPackets :: TVar [SentPacket]
cToAcknowledge :: TVar [Integer]
cNextKeepAlive :: TVar (Maybe TimeSpec)
cInStreams :: TVar [(Word8, Stream)]
cOutStreams :: TVar [(Word8, Stream)]
..} <- Either addr (Connection addr)
econn
    -> do
        STM (Maybe (Connection addr, Maybe (TransportPacket a)))
-> IO (Maybe (Connection addr, Maybe (TransportPacket a)))
forall a. STM a -> IO a
atomically (STM (Maybe (Connection addr, Maybe (TransportPacket a)))
 -> IO (Maybe (Connection addr, Maybe (TransportPacket a))))
-> STM (Maybe (Connection addr, Maybe (TransportPacket a)))
-> IO (Maybe (Connection addr, Maybe (TransportPacket a)))
forall a b. (a -> b) -> a -> b
$ TVar ChannelState -> STM ChannelState
forall a. TVar a -> STM a
readTVar TVar ChannelState
cChannel STM ChannelState
-> (ChannelState
    -> STM (Maybe (Connection addr, Maybe (TransportPacket a))))
-> STM (Maybe (Connection addr, Maybe (TransportPacket a)))
forall a b. STM a -> (a -> STM b) -> STM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            ChannelState
ChannelCookieWait -> do
                TVar ChannelState -> ChannelState -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar ChannelState
cChannel (ChannelState -> STM ()) -> ChannelState -> STM ()
forall a b. (a -> b) -> a -> b
$ ChannelState
ChannelCookieReceived
                TVar (Maybe Cookie) -> Maybe Cookie -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe Cookie)
cCookie (Maybe Cookie -> STM ()) -> Maybe Cookie -> STM ()
forall a b. (a -> b) -> a -> b
$ Cookie -> Maybe Cookie
forall a. a -> Maybe a
Just Cookie
cookie
                Flow (ControlRequest addr) (ControlMessage addr)
-> ControlMessage addr -> STM ()
forall r w. Flow r w -> w -> STM ()
writeFlow Flow (ControlRequest addr) (ControlMessage addr)
gControlFlow (Connection addr -> Maybe RefDigest -> ControlMessage addr
forall addr.
Connection addr -> Maybe RefDigest -> ControlMessage addr
NewConnection Connection addr
conn Maybe RefDigest
mbpid)
                Maybe (Connection addr, Maybe (TransportPacket a))
-> STM (Maybe (Connection addr, Maybe (TransportPacket a)))
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Connection addr, Maybe (TransportPacket a))
 -> STM (Maybe (Connection addr, Maybe (TransportPacket a))))
-> Maybe (Connection addr, Maybe (TransportPacket a))
-> STM (Maybe (Connection addr, Maybe (TransportPacket a)))
forall a b. (a -> b) -> a -> b
$ (Connection addr, Maybe (TransportPacket a))
-> Maybe (Connection addr, Maybe (TransportPacket a))
forall a. a -> Maybe a
Just (Connection addr
conn, Maybe (TransportPacket a)
forall a. Maybe a
Nothing)
            ChannelState
_ -> Maybe (Connection addr, Maybe (TransportPacket a))
-> STM (Maybe (Connection addr, Maybe (TransportPacket a)))
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Connection addr, Maybe (TransportPacket a))
forall a. Maybe a
Nothing

    -- Initiation packet
    | RefDigest
_:[RefDigest]
_ <- (TransportHeaderItem -> Maybe RefDigest)
-> [TransportHeaderItem] -> [RefDigest]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\case Initiation RefDigest
x -> RefDigest -> Maybe RefDigest
forall a. a -> Maybe a
Just RefDigest
x; TransportHeaderItem
_ -> Maybe RefDigest
forall a. Maybe a
Nothing) [TransportHeaderItem]
header
    , Just Text
ver <- Maybe Text
version
    -> do
        Cookie
cookie <- GlobalState addr -> addr -> IO Cookie
forall addr. GlobalState addr -> addr -> IO Cookie
createCookie GlobalState addr
gs addr
addr
        STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            UnifiedIdentity
identity <- (UnifiedIdentity, [UnifiedIdentity]) -> UnifiedIdentity
forall a b. (a, b) -> a
fst ((UnifiedIdentity, [UnifiedIdentity]) -> UnifiedIdentity)
-> STM (UnifiedIdentity, [UnifiedIdentity]) -> STM UnifiedIdentity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar (UnifiedIdentity, [UnifiedIdentity])
-> STM (UnifiedIdentity, [UnifiedIdentity])
forall a. TVar a -> STM a
readTVar TVar (UnifiedIdentity, [UnifiedIdentity])
gIdentity
            let reply :: ByteString
reply = ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ PartialObject -> ByteString
forall (c :: * -> *). Object' c -> ByteString
serializeObject (PartialObject -> ByteString) -> PartialObject -> ByteString
forall a b. (a -> b) -> a -> b
$ PartialStorage -> TransportHeader -> PartialObject
transportToObject PartialStorage
gStorage (TransportHeader -> PartialObject)
-> TransportHeader -> PartialObject
forall a b. (a -> b) -> a -> b
$ [TransportHeaderItem] -> TransportHeader
TransportHeader
                    [ Cookie -> TransportHeaderItem
CookieSet Cookie
cookie
                    , RefDigest -> TransportHeaderItem
AnnounceSelf (RefDigest -> TransportHeaderItem)
-> RefDigest -> TransportHeaderItem
forall a b. (a -> b) -> a -> b
$ Ref -> RefDigest
forall (c :: * -> *). Ref' c -> RefDigest
refDigest (Ref -> RefDigest) -> Ref -> RefDigest
forall a b. (a -> b) -> a -> b
$ Stored (Signed IdentityData) -> Ref
forall a. Stored a -> Ref
storedRef (Stored (Signed IdentityData) -> Ref)
-> Stored (Signed IdentityData) -> Ref
forall a b. (a -> b) -> a -> b
$ UnifiedIdentity -> Stored (Signed IdentityData)
idData UnifiedIdentity
identity
                    , Text -> TransportHeaderItem
ProtocolVersion Text
ver
                    ]
            SymFlow (addr, ByteString) -> (addr, ByteString) -> STM ()
forall r w. Flow r w -> w -> STM ()
writeFlow SymFlow (addr, ByteString)
gDataFlow (addr
addr, ByteString
reply)
        Maybe (Connection addr, Maybe (TransportPacket a))
-> IO (Maybe (Connection addr, Maybe (TransportPacket a)))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Connection addr, Maybe (TransportPacket a))
forall a. Maybe a
Nothing

    -- Announce packet outside any connection
    | RefDigest
dgst:[RefDigest]
_ <- (TransportHeaderItem -> Maybe RefDigest)
-> [TransportHeaderItem] -> [RefDigest]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\case AnnounceSelf RefDigest
x -> RefDigest -> Maybe RefDigest
forall a. a -> Maybe a
Just RefDigest
x; TransportHeaderItem
_ -> Maybe RefDigest
forall a. Maybe a
Nothing) [TransportHeaderItem]
header
    , Just Text
_ <- Maybe Text
version
    -> do
        STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            (UnifiedIdentity
cur, [UnifiedIdentity]
past) <- TVar (UnifiedIdentity, [UnifiedIdentity])
-> STM (UnifiedIdentity, [UnifiedIdentity])
forall a. TVar a -> STM a
readTVar TVar (UnifiedIdentity, [UnifiedIdentity])
gIdentity
            Bool -> STM () -> STM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ RefDigest
dgst RefDigest -> [RefDigest] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (UnifiedIdentity -> RefDigest) -> [UnifiedIdentity] -> [RefDigest]
forall a b. (a -> b) -> [a] -> [b]
map (Ref -> RefDigest
forall (c :: * -> *). Ref' c -> RefDigest
refDigest (Ref -> RefDigest)
-> (UnifiedIdentity -> Ref) -> UnifiedIdentity -> RefDigest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stored (Signed IdentityData) -> Ref
forall a. Stored a -> Ref
storedRef (Stored (Signed IdentityData) -> Ref)
-> (UnifiedIdentity -> Stored (Signed IdentityData))
-> UnifiedIdentity
-> Ref
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnifiedIdentity -> Stored (Signed IdentityData)
idData) (UnifiedIdentity
cur UnifiedIdentity -> [UnifiedIdentity] -> [UnifiedIdentity]
forall a. a -> [a] -> [a]
: [UnifiedIdentity]
past)) (STM () -> STM ()) -> STM () -> STM ()
forall a b. (a -> b) -> a -> b
$ do
                Flow (ControlRequest addr) (ControlMessage addr)
-> ControlMessage addr -> STM ()
forall r w. Flow r w -> w -> STM ()
writeFlow Flow (ControlRequest addr) (ControlMessage addr)
gControlFlow (ControlMessage addr -> STM ()) -> ControlMessage addr -> STM ()
forall a b. (a -> b) -> a -> b
$ addr -> RefDigest -> ControlMessage addr
forall addr. addr -> RefDigest -> ControlMessage addr
ReceivedAnnounce addr
addr RefDigest
dgst
        Maybe (Connection addr, Maybe (TransportPacket a))
-> IO (Maybe (Connection addr, Maybe (TransportPacket a)))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Connection addr, Maybe (TransportPacket a))
forall a. Maybe a
Nothing

    | Bool
otherwise -> do
        STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> STM ()
gLog (String -> STM ()) -> String -> STM ()
forall a b. (a -> b) -> a -> b
$ addr -> String
forall a. Show a => a -> String
show addr
addr String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": dropping packet " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [TransportHeaderItem] -> String
forall a. Show a => a -> String
show [TransportHeaderItem]
header
        Maybe (Connection addr, Maybe (TransportPacket a))
-> IO (Maybe (Connection addr, Maybe (TransportPacket a)))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Connection addr, Maybe (TransportPacket a))
forall a. Maybe a
Nothing

  where
    addr :: addr
addr = (addr -> addr)
-> (Connection addr -> addr)
-> Either addr (Connection addr)
-> addr
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either addr -> addr
forall a. a -> a
id Connection addr -> addr
forall addr. Connection addr -> addr
cAddress Either addr (Connection addr)
econn
    mbpid :: Maybe RefDigest
mbpid = [RefDigest] -> Maybe RefDigest
forall a. [a] -> Maybe a
listToMaybe ([RefDigest] -> Maybe RefDigest) -> [RefDigest] -> Maybe RefDigest
forall a b. (a -> b) -> a -> b
$ (TransportHeaderItem -> Maybe RefDigest)
-> [TransportHeaderItem] -> [RefDigest]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\case AnnounceSelf RefDigest
dgst -> RefDigest -> Maybe RefDigest
forall a. a -> Maybe a
Just RefDigest
dgst; TransportHeaderItem
_ -> Maybe RefDigest
forall a. Maybe a
Nothing) [TransportHeaderItem]
header
    version :: Maybe Text
version = [Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe ([Text] -> Maybe Text) -> [Text] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Text
v -> Text -> TransportHeaderItem
ProtocolVersion Text
v TransportHeaderItem -> [TransportHeaderItem] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [TransportHeaderItem]
header) [Text]
protocolVersions

cookieEchoReceived :: GlobalState addr -> Connection addr -> Maybe RefDigest -> STM ()
cookieEchoReceived :: forall addr.
GlobalState addr -> Connection addr -> Maybe RefDigest -> STM ()
cookieEchoReceived GlobalState {Word32
TVar [Connection addr]
TVar (UnifiedIdentity, [UnifiedIdentity])
TVar TimeSpec
TimeSpec
ScrubbedBytes
TMVar (Connection addr, (Bool, TransportPacket PartialObject))
SymFlow (addr, ByteString)
Flow (ControlRequest addr) (ControlMessage addr)
Ref
PartialStorage
String -> STM ()
gIdentity :: forall addr.
GlobalState addr -> TVar (UnifiedIdentity, [UnifiedIdentity])
gConnections :: forall addr. GlobalState addr -> TVar [Connection addr]
gDataFlow :: forall addr. GlobalState addr -> SymFlow (addr, ByteString)
gControlFlow :: forall addr.
GlobalState addr
-> Flow (ControlRequest addr) (ControlMessage addr)
gNextUp :: forall addr.
GlobalState addr
-> TMVar (Connection addr, (Bool, TransportPacket PartialObject))
gLog :: forall addr. GlobalState addr -> String -> STM ()
gStorage :: forall addr. GlobalState addr -> PartialStorage
gStartTime :: forall addr. GlobalState addr -> TimeSpec
gNowVar :: forall addr. GlobalState addr -> TVar TimeSpec
gNextTimeout :: forall addr. GlobalState addr -> TVar TimeSpec
gInitConfig :: forall addr. GlobalState addr -> Ref
gCookieKey :: forall addr. GlobalState addr -> ScrubbedBytes
gCookieStartTime :: forall addr. GlobalState addr -> Word32
gIdentity :: TVar (UnifiedIdentity, [UnifiedIdentity])
gConnections :: TVar [Connection addr]
gDataFlow :: SymFlow (addr, ByteString)
gControlFlow :: Flow (ControlRequest addr) (ControlMessage addr)
gNextUp :: TMVar (Connection addr, (Bool, TransportPacket PartialObject))
gLog :: String -> STM ()
gStorage :: PartialStorage
gStartTime :: TimeSpec
gNowVar :: TVar TimeSpec
gNextTimeout :: TVar TimeSpec
gInitConfig :: Ref
gCookieKey :: ScrubbedBytes
gCookieStartTime :: Word32
..} conn :: Connection addr
conn@Connection {addr
TVar Int
TVar [Integer]
TVar [(Word8, Stream)]
TVar [SentPacket]
TVar (Maybe TimeSpec)
TVar (Maybe Cookie)
TVar ChannelState
TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
GlobalState addr
cGlobalState :: forall addr. Connection addr -> GlobalState addr
cAddress :: forall addr. Connection addr -> addr
cDataUp :: forall addr.
Connection addr
-> Flow
     (Maybe (Bool, TransportPacket PartialObject))
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: forall addr.
Connection addr
-> Flow
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
     (Maybe (Bool, TransportPacket PartialObject))
cChannel :: forall addr. Connection addr -> TVar ChannelState
cCookie :: forall addr. Connection addr -> TVar (Maybe Cookie)
cSecureOutQueue :: forall addr.
Connection addr
-> TQueue
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: forall addr. Connection addr -> TVar Int
cReservedPackets :: forall addr. Connection addr -> TVar Int
cSentPackets :: forall addr. Connection addr -> TVar [SentPacket]
cToAcknowledge :: forall addr. Connection addr -> TVar [Integer]
cNextKeepAlive :: forall addr. Connection addr -> TVar (Maybe TimeSpec)
cInStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cOutStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cGlobalState :: GlobalState addr
cAddress :: addr
cDataUp :: Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
cChannel :: TVar ChannelState
cCookie :: TVar (Maybe Cookie)
cSecureOutQueue :: TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: TVar Int
cReservedPackets :: TVar Int
cSentPackets :: TVar [SentPacket]
cToAcknowledge :: TVar [Integer]
cNextKeepAlive :: TVar (Maybe TimeSpec)
cInStreams :: TVar [(Word8, Stream)]
cOutStreams :: TVar [(Word8, Stream)]
..} Maybe RefDigest
mbpid = do
    TVar ChannelState -> STM ChannelState
forall a. TVar a -> STM a
readTVar TVar ChannelState
cChannel STM ChannelState -> (ChannelState -> STM ()) -> STM ()
forall a b. STM a -> (a -> STM b) -> STM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        ChannelState
ChannelNone -> STM ()
newConn
        ChannelState
ChannelCookieWait -> STM ()
newConn
        ChannelCookieReceived {} -> STM ()
update
        ChannelState
_ -> () -> STM ()
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    update :: STM ()
update = do
        TVar ChannelState -> ChannelState -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar ChannelState
cChannel ChannelState
ChannelCookieConfirmed
    newConn :: STM ()
newConn = do
        STM ()
update
        Flow (ControlRequest addr) (ControlMessage addr)
-> ControlMessage addr -> STM ()
forall r w. Flow r w -> w -> STM ()
writeFlow Flow (ControlRequest addr) (ControlMessage addr)
gControlFlow (Connection addr -> Maybe RefDigest -> ControlMessage addr
forall addr.
Connection addr -> Maybe RefDigest -> ControlMessage addr
NewConnection Connection addr
conn Maybe RefDigest
mbpid)

generateCookieHeaders :: Connection addr -> ChannelState -> IO [TransportHeaderItem]
generateCookieHeaders :: forall addr.
Connection addr -> ChannelState -> IO [TransportHeaderItem]
generateCookieHeaders Connection {addr
TVar Int
TVar [Integer]
TVar [(Word8, Stream)]
TVar [SentPacket]
TVar (Maybe TimeSpec)
TVar (Maybe Cookie)
TVar ChannelState
TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
GlobalState addr
cGlobalState :: forall addr. Connection addr -> GlobalState addr
cAddress :: forall addr. Connection addr -> addr
cDataUp :: forall addr.
Connection addr
-> Flow
     (Maybe (Bool, TransportPacket PartialObject))
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: forall addr.
Connection addr
-> Flow
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
     (Maybe (Bool, TransportPacket PartialObject))
cChannel :: forall addr. Connection addr -> TVar ChannelState
cCookie :: forall addr. Connection addr -> TVar (Maybe Cookie)
cSecureOutQueue :: forall addr.
Connection addr
-> TQueue
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: forall addr. Connection addr -> TVar Int
cReservedPackets :: forall addr. Connection addr -> TVar Int
cSentPackets :: forall addr. Connection addr -> TVar [SentPacket]
cToAcknowledge :: forall addr. Connection addr -> TVar [Integer]
cNextKeepAlive :: forall addr. Connection addr -> TVar (Maybe TimeSpec)
cInStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cOutStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cGlobalState :: GlobalState addr
cAddress :: addr
cDataUp :: Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
cChannel :: TVar ChannelState
cCookie :: TVar (Maybe Cookie)
cSecureOutQueue :: TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: TVar Int
cReservedPackets :: TVar Int
cSentPackets :: TVar [SentPacket]
cToAcknowledge :: TVar [Integer]
cNextKeepAlive :: TVar (Maybe TimeSpec)
cInStreams :: TVar [(Word8, Stream)]
cOutStreams :: TVar [(Word8, Stream)]
..} ChannelState
ch = [Maybe TransportHeaderItem] -> [TransportHeaderItem]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe TransportHeaderItem] -> [TransportHeaderItem])
-> IO [Maybe TransportHeaderItem] -> IO [TransportHeaderItem]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IO (Maybe TransportHeaderItem)] -> IO [Maybe TransportHeaderItem]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [ IO (Maybe TransportHeaderItem)
echoHeader, IO (Maybe TransportHeaderItem)
setHeader ]
  where
    echoHeader :: IO (Maybe TransportHeaderItem)
echoHeader = (Cookie -> TransportHeaderItem)
-> Maybe Cookie -> Maybe TransportHeaderItem
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Cookie -> TransportHeaderItem
CookieEcho (Maybe Cookie -> Maybe TransportHeaderItem)
-> IO (Maybe Cookie) -> IO (Maybe TransportHeaderItem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STM (Maybe Cookie) -> IO (Maybe Cookie)
forall a. STM a -> IO a
atomically (TVar (Maybe Cookie) -> STM (Maybe Cookie)
forall a. TVar a -> STM a
readTVar TVar (Maybe Cookie)
cCookie)
    setHeader :: IO (Maybe TransportHeaderItem)
setHeader = case ChannelState
ch of
        ChannelCookieWait {} -> TransportHeaderItem -> Maybe TransportHeaderItem
forall a. a -> Maybe a
Just (TransportHeaderItem -> Maybe TransportHeaderItem)
-> (Cookie -> TransportHeaderItem)
-> Cookie
-> Maybe TransportHeaderItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cookie -> TransportHeaderItem
CookieSet (Cookie -> Maybe TransportHeaderItem)
-> IO Cookie -> IO (Maybe TransportHeaderItem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GlobalState addr -> addr -> IO Cookie
forall addr. GlobalState addr -> addr -> IO Cookie
createCookie GlobalState addr
cGlobalState addr
cAddress
        ChannelCookieReceived {} -> TransportHeaderItem -> Maybe TransportHeaderItem
forall a. a -> Maybe a
Just (TransportHeaderItem -> Maybe TransportHeaderItem)
-> (Cookie -> TransportHeaderItem)
-> Cookie
-> Maybe TransportHeaderItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cookie -> TransportHeaderItem
CookieSet (Cookie -> Maybe TransportHeaderItem)
-> IO Cookie -> IO (Maybe TransportHeaderItem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GlobalState addr -> addr -> IO Cookie
forall addr. GlobalState addr -> addr -> IO Cookie
createCookie GlobalState addr
cGlobalState addr
cAddress
        ChannelState
_ -> Maybe TransportHeaderItem -> IO (Maybe TransportHeaderItem)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TransportHeaderItem
forall a. Maybe a
Nothing

createCookie :: GlobalState addr -> addr -> IO Cookie
createCookie :: forall addr. GlobalState addr -> addr -> IO Cookie
createCookie GlobalState {Word32
TVar [Connection addr]
TVar (UnifiedIdentity, [UnifiedIdentity])
TVar TimeSpec
TimeSpec
ScrubbedBytes
TMVar (Connection addr, (Bool, TransportPacket PartialObject))
SymFlow (addr, ByteString)
Flow (ControlRequest addr) (ControlMessage addr)
Ref
PartialStorage
String -> STM ()
gIdentity :: forall addr.
GlobalState addr -> TVar (UnifiedIdentity, [UnifiedIdentity])
gConnections :: forall addr. GlobalState addr -> TVar [Connection addr]
gDataFlow :: forall addr. GlobalState addr -> SymFlow (addr, ByteString)
gControlFlow :: forall addr.
GlobalState addr
-> Flow (ControlRequest addr) (ControlMessage addr)
gNextUp :: forall addr.
GlobalState addr
-> TMVar (Connection addr, (Bool, TransportPacket PartialObject))
gLog :: forall addr. GlobalState addr -> String -> STM ()
gStorage :: forall addr. GlobalState addr -> PartialStorage
gStartTime :: forall addr. GlobalState addr -> TimeSpec
gNowVar :: forall addr. GlobalState addr -> TVar TimeSpec
gNextTimeout :: forall addr. GlobalState addr -> TVar TimeSpec
gInitConfig :: forall addr. GlobalState addr -> Ref
gCookieKey :: forall addr. GlobalState addr -> ScrubbedBytes
gCookieStartTime :: forall addr. GlobalState addr -> Word32
gIdentity :: TVar (UnifiedIdentity, [UnifiedIdentity])
gConnections :: TVar [Connection addr]
gDataFlow :: SymFlow (addr, ByteString)
gControlFlow :: Flow (ControlRequest addr) (ControlMessage addr)
gNextUp :: TMVar (Connection addr, (Bool, TransportPacket PartialObject))
gLog :: String -> STM ()
gStorage :: PartialStorage
gStartTime :: TimeSpec
gNowVar :: TVar TimeSpec
gNextTimeout :: TVar TimeSpec
gInitConfig :: Ref
gCookieKey :: ScrubbedBytes
gCookieStartTime :: Word32
..} addr
addr = do
    (Bytes
nonceBytes :: Bytes) <- Int -> IO Bytes
forall byteArray. ByteArray byteArray => Int -> IO byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
12
    TimeSpec
validUntil <- (Integer -> TimeSpec
fromNanoSecs (Integer
60 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
9 :: Int)) TimeSpec -> TimeSpec -> TimeSpec
forall a. Num a => a -> a -> a
+) (TimeSpec -> TimeSpec) -> IO TimeSpec -> IO TimeSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Clock -> IO TimeSpec
getTime Clock
Monotonic
    let validSecondsFromStart :: Word32
validSecondsFromStart = Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word32) -> Integer -> Word32
forall a b. (a -> b) -> a -> b
$ TimeSpec -> Integer
toNanoSecs (TimeSpec
validUntil TimeSpec -> TimeSpec -> TimeSpec
forall a. Num a => a -> a -> a
- TimeSpec
gStartTime) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` (Integer
10Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
9 :: Int))
        cookieValidity :: Word32
cookieValidity = Word32
validSecondsFromStart Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
gCookieStartTime
        plainContent :: ByteString
plainContent = String -> ByteString
BC.pack (addr -> String
forall a. Show a => a -> String
show addr
addr)
    CryptoFailable Cookie -> IO Cookie
forall a. CryptoFailable a -> IO a
throwCryptoErrorIO (CryptoFailable Cookie -> IO Cookie)
-> CryptoFailable Cookie -> IO Cookie
forall a b. (a -> b) -> a -> b
$ do
        Nonce
cookieNonce <- Bytes -> CryptoFailable Nonce
forall iv. ByteArrayAccess iv => iv -> CryptoFailable Nonce
C.nonce12 Bytes
nonceBytes
        State
st1 <- ScrubbedBytes -> Nonce -> CryptoFailable State
forall key.
ByteArrayAccess key =>
key -> Nonce -> CryptoFailable State
C.initialize ScrubbedBytes
gCookieKey Nonce
cookieNonce
        let st2 :: State
st2 = State -> State
C.finalizeAAD (State -> State) -> State -> State
forall a b. (a -> b) -> a -> b
$ ByteString -> State -> State
forall ba. ByteArrayAccess ba => ba -> State -> State
C.appendAAD (ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Word32 -> Put
putWord32be Word32
cookieValidity) State
st1
            (ByteString
cookieContent, State
st3) = ByteString -> State -> (ByteString, State)
forall ba. ByteArray ba => ba -> State -> (ba, State)
C.encrypt ByteString
plainContent State
st2
            cookieMac :: Auth
cookieMac = State -> Auth
C.finalize State
st3
        Cookie -> CryptoFailable Cookie
forall a. a -> CryptoFailable a
forall (m :: * -> *) a. Monad m => a -> m a
return (Cookie -> CryptoFailable Cookie)
-> Cookie -> CryptoFailable Cookie
forall a b. (a -> b) -> a -> b
$ ByteString -> Cookie
Cookie (ByteString -> Cookie) -> ByteString -> Cookie
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ParsedCookie -> ByteString
forall a. Binary a => a -> ByteString
encode (ParsedCookie -> ByteString) -> ParsedCookie -> ByteString
forall a b. (a -> b) -> a -> b
$ ParsedCookie {Word32
ByteString
Auth
Nonce
cookieNonce :: Nonce
cookieValidity :: Word32
cookieContent :: ByteString
cookieMac :: Auth
cookieValidity :: Word32
cookieNonce :: Nonce
cookieContent :: ByteString
cookieMac :: Auth
..}

verifyCookie :: GlobalState addr -> addr -> Cookie -> IO Bool
verifyCookie :: forall addr. GlobalState addr -> addr -> Cookie -> IO Bool
verifyCookie GlobalState {Word32
TVar [Connection addr]
TVar (UnifiedIdentity, [UnifiedIdentity])
TVar TimeSpec
TimeSpec
ScrubbedBytes
TMVar (Connection addr, (Bool, TransportPacket PartialObject))
SymFlow (addr, ByteString)
Flow (ControlRequest addr) (ControlMessage addr)
Ref
PartialStorage
String -> STM ()
gIdentity :: forall addr.
GlobalState addr -> TVar (UnifiedIdentity, [UnifiedIdentity])
gConnections :: forall addr. GlobalState addr -> TVar [Connection addr]
gDataFlow :: forall addr. GlobalState addr -> SymFlow (addr, ByteString)
gControlFlow :: forall addr.
GlobalState addr
-> Flow (ControlRequest addr) (ControlMessage addr)
gNextUp :: forall addr.
GlobalState addr
-> TMVar (Connection addr, (Bool, TransportPacket PartialObject))
gLog :: forall addr. GlobalState addr -> String -> STM ()
gStorage :: forall addr. GlobalState addr -> PartialStorage
gStartTime :: forall addr. GlobalState addr -> TimeSpec
gNowVar :: forall addr. GlobalState addr -> TVar TimeSpec
gNextTimeout :: forall addr. GlobalState addr -> TVar TimeSpec
gInitConfig :: forall addr. GlobalState addr -> Ref
gCookieKey :: forall addr. GlobalState addr -> ScrubbedBytes
gCookieStartTime :: forall addr. GlobalState addr -> Word32
gIdentity :: TVar (UnifiedIdentity, [UnifiedIdentity])
gConnections :: TVar [Connection addr]
gDataFlow :: SymFlow (addr, ByteString)
gControlFlow :: Flow (ControlRequest addr) (ControlMessage addr)
gNextUp :: TMVar (Connection addr, (Bool, TransportPacket PartialObject))
gLog :: String -> STM ()
gStorage :: PartialStorage
gStartTime :: TimeSpec
gNowVar :: TVar TimeSpec
gNextTimeout :: TVar TimeSpec
gInitConfig :: Ref
gCookieKey :: ScrubbedBytes
gCookieStartTime :: Word32
..} addr
addr (Cookie ByteString
cookie) = do
    TimeSpec
ctime <- Clock -> IO TimeSpec
getTime Clock
Monotonic
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
        ( ByteString
_, Int64
_, ParsedCookie {Word32
ByteString
Auth
Nonce
cookieNonce :: ParsedCookie -> Nonce
cookieValidity :: ParsedCookie -> Word32
cookieContent :: ParsedCookie -> ByteString
cookieMac :: ParsedCookie -> Auth
cookieNonce :: Nonce
cookieValidity :: Word32
cookieContent :: ByteString
cookieMac :: Auth
..} ) <- ((ByteString, Int64, String)
 -> Maybe (ByteString, Int64, ParsedCookie))
-> ((ByteString, Int64, ParsedCookie)
    -> Maybe (ByteString, Int64, ParsedCookie))
-> Either
     (ByteString, Int64, String) (ByteString, Int64, ParsedCookie)
-> Maybe (ByteString, Int64, ParsedCookie)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (ByteString, Int64, ParsedCookie)
-> (ByteString, Int64, String)
-> Maybe (ByteString, Int64, ParsedCookie)
forall a b. a -> b -> a
const Maybe (ByteString, Int64, ParsedCookie)
forall a. Maybe a
Nothing) (ByteString, Int64, ParsedCookie)
-> Maybe (ByteString, Int64, ParsedCookie)
forall a. a -> Maybe a
Just (Either
   (ByteString, Int64, String) (ByteString, Int64, ParsedCookie)
 -> Maybe (ByteString, Int64, ParsedCookie))
-> Either
     (ByteString, Int64, String) (ByteString, Int64, ParsedCookie)
-> Maybe (ByteString, Int64, ParsedCookie)
forall a b. (a -> b) -> a -> b
$ ByteString
-> Either
     (ByteString, Int64, String) (ByteString, Int64, ParsedCookie)
forall a.
Binary a =>
ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
decodeOrFail (ByteString
 -> Either
      (ByteString, Int64, String) (ByteString, Int64, ParsedCookie))
-> ByteString
-> Either
     (ByteString, Int64, String) (ByteString, Int64, ParsedCookie)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.fromStrict ByteString
cookie
        CryptoFailable Bool -> Maybe Bool
forall a. CryptoFailable a -> Maybe a
maybeCryptoError (CryptoFailable Bool -> Maybe Bool)
-> CryptoFailable Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ do
            State
st1 <- ScrubbedBytes -> Nonce -> CryptoFailable State
forall key.
ByteArrayAccess key =>
key -> Nonce -> CryptoFailable State
C.initialize ScrubbedBytes
gCookieKey Nonce
cookieNonce
            let st2 :: State
st2 = State -> State
C.finalizeAAD (State -> State) -> State -> State
forall a b. (a -> b) -> a -> b
$ ByteString -> State -> State
forall ba. ByteArrayAccess ba => ba -> State -> State
C.appendAAD (ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Word32 -> Put
putWord32be Word32
cookieValidity) State
st1
                (ByteString
plainContent, State
st3) = ByteString -> State -> (ByteString, State)
forall ba. ByteArray ba => ba -> State -> (ba, State)
C.decrypt ByteString
cookieContent State
st2
                mac :: Auth
mac = State -> Auth
C.finalize State
st3

                validSecondsFromStart :: Integer
validSecondsFromStart = Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Integer) -> Word32 -> Integer
forall a b. (a -> b) -> a -> b
$ Word32
cookieValidity Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
gCookieStartTime
                validUntil :: TimeSpec
validUntil = TimeSpec
gStartTime TimeSpec -> TimeSpec -> TimeSpec
forall a. Num a => a -> a -> a
+ Integer -> TimeSpec
fromNanoSecs (Integer
validSecondsFromStart Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
10Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
9 :: Int)))
            Bool -> CryptoFailable Bool
forall a. a -> CryptoFailable a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> CryptoFailable Bool) -> Bool -> CryptoFailable Bool
forall a b. (a -> b) -> a -> b
$ [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
                [ Auth
mac Auth -> Auth -> Bool
forall a. Eq a => a -> a -> Bool
== Auth
cookieMac
                , TimeSpec
ctime TimeSpec -> TimeSpec -> Bool
forall a. Ord a => a -> a -> Bool
<= TimeSpec
validUntil
                , addr -> String
forall a. Show a => a -> String
show addr
addr String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> String
BC.unpack ByteString
plainContent
                ]

reservePacket :: Connection addr -> STM ReservedToSend
reservePacket :: forall addr. Connection addr -> STM ReservedToSend
reservePacket conn :: Connection addr
conn@Connection {addr
TVar Int
TVar [Integer]
TVar [(Word8, Stream)]
TVar [SentPacket]
TVar (Maybe TimeSpec)
TVar (Maybe Cookie)
TVar ChannelState
TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
GlobalState addr
cGlobalState :: forall addr. Connection addr -> GlobalState addr
cAddress :: forall addr. Connection addr -> addr
cDataUp :: forall addr.
Connection addr
-> Flow
     (Maybe (Bool, TransportPacket PartialObject))
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: forall addr.
Connection addr
-> Flow
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
     (Maybe (Bool, TransportPacket PartialObject))
cChannel :: forall addr. Connection addr -> TVar ChannelState
cCookie :: forall addr. Connection addr -> TVar (Maybe Cookie)
cSecureOutQueue :: forall addr.
Connection addr
-> TQueue
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: forall addr. Connection addr -> TVar Int
cReservedPackets :: forall addr. Connection addr -> TVar Int
cSentPackets :: forall addr. Connection addr -> TVar [SentPacket]
cToAcknowledge :: forall addr. Connection addr -> TVar [Integer]
cNextKeepAlive :: forall addr. Connection addr -> TVar (Maybe TimeSpec)
cInStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cOutStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cGlobalState :: GlobalState addr
cAddress :: addr
cDataUp :: Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
cChannel :: TVar ChannelState
cCookie :: TVar (Maybe Cookie)
cSecureOutQueue :: TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: TVar Int
cReservedPackets :: TVar Int
cSentPackets :: TVar [SentPacket]
cToAcknowledge :: TVar [Integer]
cNextKeepAlive :: TVar (Maybe TimeSpec)
cInStreams :: TVar [(Word8, Stream)]
cOutStreams :: TVar [(Word8, Stream)]
..} = do
    Int
maxPackets <- TVar Int -> STM Int
forall a. TVar a -> STM a
readTVar TVar Int
cMaxInFlightPackets
    Int
reserved <- TVar Int -> STM Int
forall a. TVar a -> STM a
readTVar TVar Int
cReservedPackets
    Int
sent <- [SentPacket] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([SentPacket] -> Int) -> STM [SentPacket] -> STM Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar [SentPacket] -> STM [SentPacket]
forall a. TVar a -> STM a
readTVar TVar [SentPacket]
cSentPackets

    Bool -> STM () -> STM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
sent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
reserved Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxPackets) (STM () -> STM ()) -> STM () -> STM ()
forall a b. (a -> b) -> a -> b
$ do
        STM ()
forall a. STM a
retry

    TVar Int -> Int -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar Int
cReservedPackets (Int -> STM ()) -> Int -> STM ()
forall a b. (a -> b) -> a -> b
$ Int
reserved Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    ReservedToSend -> STM ReservedToSend
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (ReservedToSend -> STM ReservedToSend)
-> ReservedToSend -> STM ReservedToSend
forall a b. (a -> b) -> a -> b
$ Maybe (TransportHeaderItem -> Bool)
-> IO () -> IO () -> ReservedToSend
ReservedToSend Maybe (TransportHeaderItem -> Bool)
forall a. Maybe a
Nothing (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection addr -> STM ()
forall addr. Connection addr -> STM ()
connClose Connection addr
conn)

resendBytes :: Connection addr -> Maybe ReservedToSend -> SentPacket -> IO ()
resendBytes :: forall addr.
Connection addr -> Maybe ReservedToSend -> SentPacket -> IO ()
resendBytes conn :: Connection addr
conn@Connection {addr
TVar Int
TVar [Integer]
TVar [(Word8, Stream)]
TVar [SentPacket]
TVar (Maybe TimeSpec)
TVar (Maybe Cookie)
TVar ChannelState
TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
GlobalState addr
cGlobalState :: forall addr. Connection addr -> GlobalState addr
cAddress :: forall addr. Connection addr -> addr
cDataUp :: forall addr.
Connection addr
-> Flow
     (Maybe (Bool, TransportPacket PartialObject))
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: forall addr.
Connection addr
-> Flow
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
     (Maybe (Bool, TransportPacket PartialObject))
cChannel :: forall addr. Connection addr -> TVar ChannelState
cCookie :: forall addr. Connection addr -> TVar (Maybe Cookie)
cSecureOutQueue :: forall addr.
Connection addr
-> TQueue
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: forall addr. Connection addr -> TVar Int
cReservedPackets :: forall addr. Connection addr -> TVar Int
cSentPackets :: forall addr. Connection addr -> TVar [SentPacket]
cToAcknowledge :: forall addr. Connection addr -> TVar [Integer]
cNextKeepAlive :: forall addr. Connection addr -> TVar (Maybe TimeSpec)
cInStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cOutStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cGlobalState :: GlobalState addr
cAddress :: addr
cDataUp :: Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
cChannel :: TVar ChannelState
cCookie :: TVar (Maybe Cookie)
cSecureOutQueue :: TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: TVar Int
cReservedPackets :: TVar Int
cSentPackets :: TVar [SentPacket]
cToAcknowledge :: TVar [Integer]
cNextKeepAlive :: TVar (Maybe TimeSpec)
cInStreams :: TVar [(Word8, Stream)]
cOutStreams :: TVar [(Word8, Stream)]
..} Maybe ReservedToSend
reserved SentPacket
sp = do
    let GlobalState {Word32
TVar [Connection addr]
TVar (UnifiedIdentity, [UnifiedIdentity])
TVar TimeSpec
TimeSpec
ScrubbedBytes
TMVar (Connection addr, (Bool, TransportPacket PartialObject))
Flow (addr, ByteString) (addr, ByteString)
Flow (ControlRequest addr) (ControlMessage addr)
Ref
PartialStorage
String -> STM ()
gIdentity :: forall addr.
GlobalState addr -> TVar (UnifiedIdentity, [UnifiedIdentity])
gConnections :: forall addr. GlobalState addr -> TVar [Connection addr]
gDataFlow :: forall addr. GlobalState addr -> SymFlow (addr, ByteString)
gControlFlow :: forall addr.
GlobalState addr
-> Flow (ControlRequest addr) (ControlMessage addr)
gNextUp :: forall addr.
GlobalState addr
-> TMVar (Connection addr, (Bool, TransportPacket PartialObject))
gLog :: forall addr. GlobalState addr -> String -> STM ()
gStorage :: forall addr. GlobalState addr -> PartialStorage
gStartTime :: forall addr. GlobalState addr -> TimeSpec
gNowVar :: forall addr. GlobalState addr -> TVar TimeSpec
gNextTimeout :: forall addr. GlobalState addr -> TVar TimeSpec
gInitConfig :: forall addr. GlobalState addr -> Ref
gCookieKey :: forall addr. GlobalState addr -> ScrubbedBytes
gCookieStartTime :: forall addr. GlobalState addr -> Word32
gIdentity :: TVar (UnifiedIdentity, [UnifiedIdentity])
gConnections :: TVar [Connection addr]
gDataFlow :: Flow (addr, ByteString) (addr, ByteString)
gControlFlow :: Flow (ControlRequest addr) (ControlMessage addr)
gNextUp :: TMVar (Connection addr, (Bool, TransportPacket PartialObject))
gLog :: String -> STM ()
gStorage :: PartialStorage
gStartTime :: TimeSpec
gNowVar :: TVar TimeSpec
gNextTimeout :: TVar TimeSpec
gInitConfig :: Ref
gCookieKey :: ScrubbedBytes
gCookieStartTime :: Word32
..} = GlobalState addr
cGlobalState
    TimeSpec
now <- Clock -> IO TimeSpec
getTime Clock
Monotonic
    STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Bool -> STM () -> STM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe ReservedToSend -> Bool
forall a. Maybe a -> Bool
isJust Maybe ReservedToSend
reserved) (STM () -> STM ()) -> STM () -> STM ()
forall a b. (a -> b) -> a -> b
$ do
            TVar Int -> (Int -> Int) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar Int
cReservedPackets (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1)

        Bool -> STM () -> STM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (TransportHeaderItem -> Bool) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (TransportHeaderItem -> Bool) -> Bool)
-> Maybe (TransportHeaderItem -> Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ SentPacket -> Maybe (TransportHeaderItem -> Bool)
spAckedBy SentPacket
sp) (STM () -> STM ()) -> STM () -> STM ()
forall a b. (a -> b) -> a -> b
$ do
            TVar [SentPacket] -> ([SentPacket] -> [SentPacket]) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar [SentPacket]
cSentPackets (([SentPacket] -> [SentPacket]) -> STM ())
-> ([SentPacket] -> [SentPacket]) -> STM ()
forall a b. (a -> b) -> a -> b
$ (:) SentPacket
sp
                { spTime = now
                , spRetryCount = spRetryCount sp + 1
                }
        Flow (addr, ByteString) (addr, ByteString)
-> (addr, ByteString) -> STM ()
forall r w. Flow r w -> w -> STM ()
writeFlow Flow (addr, ByteString) (addr, ByteString)
gDataFlow (addr
cAddress, SentPacket -> ByteString
spData SentPacket
sp)
        Connection addr -> TimeSpec -> STM ()
forall addr. Connection addr -> TimeSpec -> STM ()
updateKeepAlive Connection addr
conn TimeSpec
now

sendBytes :: Connection addr -> Maybe ReservedToSend -> ByteString -> IO ()
sendBytes :: forall addr.
Connection addr -> Maybe ReservedToSend -> ByteString -> IO ()
sendBytes Connection addr
conn Maybe ReservedToSend
reserved ByteString
bs = Connection addr -> Maybe ReservedToSend -> SentPacket -> IO ()
forall addr.
Connection addr -> Maybe ReservedToSend -> SentPacket -> IO ()
resendBytes Connection addr
conn Maybe ReservedToSend
reserved
    SentPacket
        { spTime :: TimeSpec
spTime = TimeSpec
forall a. HasCallStack => a
undefined
        , spRetryCount :: Int
spRetryCount = -Int
1
        , spAckedBy :: Maybe (TransportHeaderItem -> Bool)
spAckedBy = ReservedToSend -> Maybe (TransportHeaderItem -> Bool)
rsAckedBy (ReservedToSend -> Maybe (TransportHeaderItem -> Bool))
-> Maybe ReservedToSend -> Maybe (TransportHeaderItem -> Bool)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe ReservedToSend
reserved
        , spOnAck :: IO ()
spOnAck = IO () -> (ReservedToSend -> IO ()) -> Maybe ReservedToSend -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ReservedToSend -> IO ()
rsOnAck Maybe ReservedToSend
reserved
        , spOnFail :: IO ()
spOnFail = IO () -> (ReservedToSend -> IO ()) -> Maybe ReservedToSend -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ReservedToSend -> IO ()
rsOnFail Maybe ReservedToSend
reserved
        , spData :: ByteString
spData = ByteString
bs
        }

updateKeepAlive :: Connection addr -> TimeSpec -> STM ()
updateKeepAlive :: forall addr. Connection addr -> TimeSpec -> STM ()
updateKeepAlive Connection {addr
TVar Int
TVar [Integer]
TVar [(Word8, Stream)]
TVar [SentPacket]
TVar (Maybe TimeSpec)
TVar (Maybe Cookie)
TVar ChannelState
TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
GlobalState addr
cGlobalState :: forall addr. Connection addr -> GlobalState addr
cAddress :: forall addr. Connection addr -> addr
cDataUp :: forall addr.
Connection addr
-> Flow
     (Maybe (Bool, TransportPacket PartialObject))
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: forall addr.
Connection addr
-> Flow
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
     (Maybe (Bool, TransportPacket PartialObject))
cChannel :: forall addr. Connection addr -> TVar ChannelState
cCookie :: forall addr. Connection addr -> TVar (Maybe Cookie)
cSecureOutQueue :: forall addr.
Connection addr
-> TQueue
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: forall addr. Connection addr -> TVar Int
cReservedPackets :: forall addr. Connection addr -> TVar Int
cSentPackets :: forall addr. Connection addr -> TVar [SentPacket]
cToAcknowledge :: forall addr. Connection addr -> TVar [Integer]
cNextKeepAlive :: forall addr. Connection addr -> TVar (Maybe TimeSpec)
cInStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cOutStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cGlobalState :: GlobalState addr
cAddress :: addr
cDataUp :: Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
cChannel :: TVar ChannelState
cCookie :: TVar (Maybe Cookie)
cSecureOutQueue :: TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: TVar Int
cReservedPackets :: TVar Int
cSentPackets :: TVar [SentPacket]
cToAcknowledge :: TVar [Integer]
cNextKeepAlive :: TVar (Maybe TimeSpec)
cInStreams :: TVar [(Word8, Stream)]
cOutStreams :: TVar [(Word8, Stream)]
..} TimeSpec
now = do
    let next :: TimeSpec
next = TimeSpec
now TimeSpec -> TimeSpec -> TimeSpec
forall a. Num a => a -> a -> a
+ TimeSpec
keepAliveInternal
    TVar (Maybe TimeSpec) -> Maybe TimeSpec -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe TimeSpec)
cNextKeepAlive (Maybe TimeSpec -> STM ()) -> Maybe TimeSpec -> STM ()
forall a b. (a -> b) -> a -> b
$ TimeSpec -> Maybe TimeSpec
forall a. a -> Maybe a
Just TimeSpec
next


processOutgoing :: forall addr. GlobalState addr -> STM (IO ())
processOutgoing :: forall addr. GlobalState addr -> STM (IO ())
processOutgoing gs :: GlobalState addr
gs@GlobalState {Word32
TVar [Connection addr]
TVar (UnifiedIdentity, [UnifiedIdentity])
TVar TimeSpec
TimeSpec
ScrubbedBytes
TMVar (Connection addr, (Bool, TransportPacket PartialObject))
SymFlow (addr, ByteString)
Flow (ControlRequest addr) (ControlMessage addr)
Ref
PartialStorage
String -> STM ()
gIdentity :: forall addr.
GlobalState addr -> TVar (UnifiedIdentity, [UnifiedIdentity])
gConnections :: forall addr. GlobalState addr -> TVar [Connection addr]
gDataFlow :: forall addr. GlobalState addr -> SymFlow (addr, ByteString)
gControlFlow :: forall addr.
GlobalState addr
-> Flow (ControlRequest addr) (ControlMessage addr)
gNextUp :: forall addr.
GlobalState addr
-> TMVar (Connection addr, (Bool, TransportPacket PartialObject))
gLog :: forall addr. GlobalState addr -> String -> STM ()
gStorage :: forall addr. GlobalState addr -> PartialStorage
gStartTime :: forall addr. GlobalState addr -> TimeSpec
gNowVar :: forall addr. GlobalState addr -> TVar TimeSpec
gNextTimeout :: forall addr. GlobalState addr -> TVar TimeSpec
gInitConfig :: forall addr. GlobalState addr -> Ref
gCookieKey :: forall addr. GlobalState addr -> ScrubbedBytes
gCookieStartTime :: forall addr. GlobalState addr -> Word32
gIdentity :: TVar (UnifiedIdentity, [UnifiedIdentity])
gConnections :: TVar [Connection addr]
gDataFlow :: SymFlow (addr, ByteString)
gControlFlow :: Flow (ControlRequest addr) (ControlMessage addr)
gNextUp :: TMVar (Connection addr, (Bool, TransportPacket PartialObject))
gLog :: String -> STM ()
gStorage :: PartialStorage
gStartTime :: TimeSpec
gNowVar :: TVar TimeSpec
gNextTimeout :: TVar TimeSpec
gInitConfig :: Ref
gCookieKey :: ScrubbedBytes
gCookieStartTime :: Word32
..} = do

    let sendNextPacket :: Connection addr -> STM (IO ())
        sendNextPacket :: Connection addr -> STM (IO ())
sendNextPacket conn :: Connection addr
conn@Connection {addr
TVar Int
TVar [Integer]
TVar [(Word8, Stream)]
TVar [SentPacket]
TVar (Maybe TimeSpec)
TVar (Maybe Cookie)
TVar ChannelState
TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
GlobalState addr
cGlobalState :: forall addr. Connection addr -> GlobalState addr
cAddress :: forall addr. Connection addr -> addr
cDataUp :: forall addr.
Connection addr
-> Flow
     (Maybe (Bool, TransportPacket PartialObject))
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: forall addr.
Connection addr
-> Flow
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
     (Maybe (Bool, TransportPacket PartialObject))
cChannel :: forall addr. Connection addr -> TVar ChannelState
cCookie :: forall addr. Connection addr -> TVar (Maybe Cookie)
cSecureOutQueue :: forall addr.
Connection addr
-> TQueue
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: forall addr. Connection addr -> TVar Int
cReservedPackets :: forall addr. Connection addr -> TVar Int
cSentPackets :: forall addr. Connection addr -> TVar [SentPacket]
cToAcknowledge :: forall addr. Connection addr -> TVar [Integer]
cNextKeepAlive :: forall addr. Connection addr -> TVar (Maybe TimeSpec)
cInStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cOutStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cGlobalState :: GlobalState addr
cAddress :: addr
cDataUp :: Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
cChannel :: TVar ChannelState
cCookie :: TVar (Maybe Cookie)
cSecureOutQueue :: TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: TVar Int
cReservedPackets :: TVar Int
cSentPackets :: TVar [SentPacket]
cToAcknowledge :: TVar [Integer]
cNextKeepAlive :: TVar (Maybe TimeSpec)
cInStreams :: TVar [(Word8, Stream)]
cOutStreams :: TVar [(Word8, Stream)]
..} = do
            ChannelState
channel <- TVar ChannelState -> STM ChannelState
forall a. TVar a -> STM a
readTVar TVar ChannelState
cChannel
            let mbch :: Maybe Channel
mbch = case ChannelState
channel of
                    ChannelEstablished Channel
ch -> Channel -> Maybe Channel
forall a. a -> Maybe a
Just Channel
ch
                    ChannelState
_                     -> Maybe Channel
forall a. Maybe a
Nothing

            let checkOutstanding :: STM
  ((SecurityRequirement, TransportPacket Ref, [TransportHeaderItem]),
   Maybe ReservedToSend)
checkOutstanding
                    | Maybe Channel -> Bool
forall a. Maybe a -> Bool
isJust Maybe Channel
mbch = do
                        (,) ((SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
 -> Maybe ReservedToSend
 -> ((SecurityRequirement, TransportPacket Ref,
      [TransportHeaderItem]),
     Maybe ReservedToSend))
-> STM
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
-> STM
     (Maybe ReservedToSend
      -> ((SecurityRequirement, TransportPacket Ref,
           [TransportHeaderItem]),
          Maybe ReservedToSend))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
-> STM
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
forall a. TQueue a -> STM a
readTQueue TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cSecureOutQueue STM
  (Maybe ReservedToSend
   -> ((SecurityRequirement, TransportPacket Ref,
        [TransportHeaderItem]),
       Maybe ReservedToSend))
-> STM (Maybe ReservedToSend)
-> STM
     ((SecurityRequirement, TransportPacket Ref, [TransportHeaderItem]),
      Maybe ReservedToSend)
forall a b. STM (a -> b) -> STM a -> STM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ReservedToSend -> Maybe ReservedToSend
forall a. a -> Maybe a
Just (ReservedToSend -> Maybe ReservedToSend)
-> STM ReservedToSend -> STM (Maybe ReservedToSend)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection addr -> STM ReservedToSend
forall addr. Connection addr -> STM ReservedToSend
reservePacket Connection addr
conn)
                    | Bool
otherwise = STM
  ((SecurityRequirement, TransportPacket Ref, [TransportHeaderItem]),
   Maybe ReservedToSend)
forall a. STM a
retry

                checkDataInternal :: STM
  ((SecurityRequirement, TransportPacket Ref, [TransportHeaderItem]),
   Maybe ReservedToSend)
checkDataInternal = do
                    (,) ((SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
 -> Maybe ReservedToSend
 -> ((SecurityRequirement, TransportPacket Ref,
      [TransportHeaderItem]),
     Maybe ReservedToSend))
-> STM
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
-> STM
     (Maybe ReservedToSend
      -> ((SecurityRequirement, TransportPacket Ref,
           [TransportHeaderItem]),
          Maybe ReservedToSend))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
-> STM
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
forall r w. Flow r w -> STM r
readFlow Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
cDataInternal STM
  (Maybe ReservedToSend
   -> ((SecurityRequirement, TransportPacket Ref,
        [TransportHeaderItem]),
       Maybe ReservedToSend))
-> STM (Maybe ReservedToSend)
-> STM
     ((SecurityRequirement, TransportPacket Ref, [TransportHeaderItem]),
      Maybe ReservedToSend)
forall a b. STM (a -> b) -> STM a -> STM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ReservedToSend -> Maybe ReservedToSend
forall a. a -> Maybe a
Just (ReservedToSend -> Maybe ReservedToSend)
-> STM ReservedToSend -> STM (Maybe ReservedToSend)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection addr -> STM ReservedToSend
forall addr. Connection addr -> STM ReservedToSend
reservePacket Connection addr
conn)

                checkAcknowledgements :: STM
  ((SecurityRequirement, TransportPacket Ref, [TransportHeaderItem]),
   Maybe ReservedToSend)
checkAcknowledgements
                    | Maybe Channel -> Bool
forall a. Maybe a -> Bool
isJust Maybe Channel
mbch = do
                        [Integer]
acks <- TVar [Integer] -> STM [Integer]
forall a. TVar a -> STM a
readTVar TVar [Integer]
cToAcknowledge
                        if [Integer] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Integer]
acks then STM
  ((SecurityRequirement, TransportPacket Ref, [TransportHeaderItem]),
   Maybe ReservedToSend)
forall a. STM a
retry
                                     else ((SecurityRequirement, TransportPacket Ref, [TransportHeaderItem]),
 Maybe ReservedToSend)
-> STM
     ((SecurityRequirement, TransportPacket Ref, [TransportHeaderItem]),
      Maybe ReservedToSend)
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return ((SecurityRequirement
EncryptedOnly, TransportHeader -> [Ref] -> TransportPacket Ref
forall a. TransportHeader -> [a] -> TransportPacket a
TransportPacket ([TransportHeaderItem] -> TransportHeader
TransportHeader []) [], []), Maybe ReservedToSend
forall a. Maybe a
Nothing)
                    | Bool
otherwise = STM
  ((SecurityRequirement, TransportPacket Ref, [TransportHeaderItem]),
   Maybe ReservedToSend)
forall a. STM a
retry

            ((SecurityRequirement
secure, packet :: TransportPacket Ref
packet@(TransportPacket (TransportHeader [TransportHeaderItem]
hitems) [Ref]
content), [TransportHeaderItem]
plainAckedBy), Maybe ReservedToSend
mbReserved) <-
                STM
  ((SecurityRequirement, TransportPacket Ref, [TransportHeaderItem]),
   Maybe ReservedToSend)
checkOutstanding STM
  ((SecurityRequirement, TransportPacket Ref, [TransportHeaderItem]),
   Maybe ReservedToSend)
-> STM
     ((SecurityRequirement, TransportPacket Ref, [TransportHeaderItem]),
      Maybe ReservedToSend)
-> STM
     ((SecurityRequirement, TransportPacket Ref, [TransportHeaderItem]),
      Maybe ReservedToSend)
forall a. STM a -> STM a -> STM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> STM
  ((SecurityRequirement, TransportPacket Ref, [TransportHeaderItem]),
   Maybe ReservedToSend)
checkDataInternal STM
  ((SecurityRequirement, TransportPacket Ref, [TransportHeaderItem]),
   Maybe ReservedToSend)
-> STM
     ((SecurityRequirement, TransportPacket Ref, [TransportHeaderItem]),
      Maybe ReservedToSend)
-> STM
     ((SecurityRequirement, TransportPacket Ref, [TransportHeaderItem]),
      Maybe ReservedToSend)
forall a. STM a -> STM a -> STM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> STM
  ((SecurityRequirement, TransportPacket Ref, [TransportHeaderItem]),
   Maybe ReservedToSend)
checkAcknowledgements

            Bool -> STM () -> STM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Channel -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Channel
mbch Bool -> Bool -> Bool
&& SecurityRequirement
secure SecurityRequirement -> SecurityRequirement -> Bool
forall a. Ord a => a -> a -> Bool
>= SecurityRequirement
EncryptedOnly) (STM () -> STM ()) -> STM () -> STM ()
forall a b. (a -> b) -> a -> b
$ do
                TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
-> (SecurityRequirement, TransportPacket Ref,
    [TransportHeaderItem])
-> STM ()
forall a. TQueue a -> a -> STM ()
writeTQueue TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cSecureOutQueue (SecurityRequirement
secure, TransportPacket Ref
packet, [TransportHeaderItem]
plainAckedBy)

            [Integer]
acknowledge <- case Maybe Channel
mbch of
                Maybe Channel
Nothing -> [Integer] -> STM [Integer]
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return []
                Just Channel
_ -> TVar [Integer] -> [Integer] -> STM [Integer]
forall a. TVar a -> a -> STM a
swapTVar TVar [Integer]
cToAcknowledge []

            IO () -> STM (IO ())
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> STM (IO ())) -> IO () -> STM (IO ())
forall a b. (a -> b) -> a -> b
$ do
                let onAck :: IO ()
onAck = [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([IO ()] -> IO ()) -> [IO ()] -> IO ()
forall a b. (a -> b) -> a -> b
$ (Word8 -> IO ()) -> [Word8] -> [IO ()]
forall a b. (a -> b) -> [a] -> [b]
map (Connection addr -> Word8 -> IO ()
forall addr. Connection addr -> Word8 -> IO ()
streamAccepted Connection addr
conn) ([Word8] -> [IO ()]) -> [Word8] -> [IO ()]
forall a b. (a -> b) -> a -> b
$
                        [Maybe Word8] -> [Word8]
forall a. [Maybe a] -> [a]
catMaybes ((TransportHeaderItem -> Maybe Word8)
-> [TransportHeaderItem] -> [Maybe Word8]
forall a b. (a -> b) -> [a] -> [b]
map (\case StreamOpen Word8
n -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
n; TransportHeaderItem
_ -> Maybe Word8
forall a. Maybe a
Nothing) [TransportHeaderItem]
hitems)

                let mkPlain :: [TransportHeaderItem] -> ByteString
mkPlain [TransportHeaderItem]
extraHeaders
                        | combinedHeaderItems :: [TransportHeaderItem]
combinedHeaderItems@(TransportHeaderItem
_:[TransportHeaderItem]
_) <- (Integer -> TransportHeaderItem)
-> [Integer] -> [TransportHeaderItem]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> TransportHeaderItem
AcknowledgedSingle [Integer]
acknowledge [TransportHeaderItem]
-> [TransportHeaderItem] -> [TransportHeaderItem]
forall a. [a] -> [a] -> [a]
++ [TransportHeaderItem]
extraHeaders [TransportHeaderItem]
-> [TransportHeaderItem] -> [TransportHeaderItem]
forall a. [a] -> [a] -> [a]
++ [TransportHeaderItem]
hitems =
                             [ByteString] -> ByteString
BL.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$
                                (PartialObject -> ByteString
forall (c :: * -> *). Object' c -> ByteString
serializeObject (PartialObject -> ByteString) -> PartialObject -> ByteString
forall a b. (a -> b) -> a -> b
$ PartialStorage -> TransportHeader -> PartialObject
transportToObject PartialStorage
gStorage (TransportHeader -> PartialObject)
-> TransportHeader -> PartialObject
forall a b. (a -> b) -> a -> b
$ [TransportHeaderItem] -> TransportHeader
TransportHeader [TransportHeaderItem]
combinedHeaderItems)
                                ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: (Ref -> ByteString) -> [Ref] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Ref -> ByteString
Ref -> LoadResult Identity ByteString
forall (c :: * -> *).
StorageCompleteness c =>
Ref' c -> LoadResult c ByteString
lazyLoadBytes [Ref]
content
                        | Bool
otherwise = ByteString
BL.empty

                let usePlaintext :: IO (Maybe (ByteString, [TransportHeaderItem]))
usePlaintext = do
                        ByteString
plain <- [TransportHeaderItem] -> ByteString
mkPlain ([TransportHeaderItem] -> ByteString)
-> IO [TransportHeaderItem] -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection addr -> ChannelState -> IO [TransportHeaderItem]
forall addr.
Connection addr -> ChannelState -> IO [TransportHeaderItem]
generateCookieHeaders Connection addr
conn ChannelState
channel
                        Maybe (ByteString, [TransportHeaderItem])
-> IO (Maybe (ByteString, [TransportHeaderItem]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ByteString, [TransportHeaderItem])
 -> IO (Maybe (ByteString, [TransportHeaderItem])))
-> Maybe (ByteString, [TransportHeaderItem])
-> IO (Maybe (ByteString, [TransportHeaderItem]))
forall a b. (a -> b) -> a -> b
$ (ByteString, [TransportHeaderItem])
-> Maybe (ByteString, [TransportHeaderItem])
forall a. a -> Maybe a
Just (ByteString -> ByteString
BL.toStrict ByteString
plain, [TransportHeaderItem]
plainAckedBy)

                let useEncryption :: Channel -> IO (Maybe (ByteString, [TransportHeaderItem]))
useEncryption Channel
ch = do
                        ByteString
plain <- [TransportHeaderItem] -> ByteString
mkPlain ([TransportHeaderItem] -> ByteString)
-> IO [TransportHeaderItem] -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TransportHeaderItem] -> IO [TransportHeaderItem]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
                        ExceptT String IO (ByteString, Word64)
-> IO (Either String (ByteString, Word64))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (Channel -> ByteString -> ExceptT String IO (ByteString, Word64)
forall ba (m :: * -> *).
(ByteArray ba, MonadIO m, MonadError String m) =>
Channel -> ba -> m (ba, Word64)
channelEncrypt Channel
ch (ByteString -> ExceptT String IO (ByteString, Word64))
-> ByteString -> ExceptT String IO (ByteString, Word64)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Word8
0x00 Word8 -> ByteString -> ByteString
`BL.cons` ByteString
plain) IO (Either String (ByteString, Word64))
-> (Either String (ByteString, Word64)
    -> IO (Maybe (ByteString, [TransportHeaderItem])))
-> IO (Maybe (ByteString, [TransportHeaderItem]))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                            Right (ByteString
ctext, Word64
counter) -> do
                                let isAcked :: Bool
isAcked = (TransportHeaderItem -> Bool) -> [TransportHeaderItem] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TransportHeaderItem -> Bool
isHeaderItemAcknowledged [TransportHeaderItem]
hitems
                                Maybe (ByteString, [TransportHeaderItem])
-> IO (Maybe (ByteString, [TransportHeaderItem]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ByteString, [TransportHeaderItem])
 -> IO (Maybe (ByteString, [TransportHeaderItem])))
-> Maybe (ByteString, [TransportHeaderItem])
-> IO (Maybe (ByteString, [TransportHeaderItem]))
forall a b. (a -> b) -> a -> b
$ (ByteString, [TransportHeaderItem])
-> Maybe (ByteString, [TransportHeaderItem])
forall a. a -> Maybe a
Just (Word8
0x80 Word8 -> ByteString -> ByteString
`B.cons` ByteString
ctext, if Bool
isAcked then [ Integer -> TransportHeaderItem
AcknowledgedSingle (Integer -> TransportHeaderItem) -> Integer -> TransportHeaderItem
forall a b. (a -> b) -> a -> b
$ Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
counter ] else [])
                            Left String
err -> do STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> STM ()
gLog (String -> STM ()) -> String -> STM ()
forall a b. (a -> b) -> a -> b
$ String
"Failed to encrypt data: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err
                                           Maybe (ByteString, [TransportHeaderItem])
-> IO (Maybe (ByteString, [TransportHeaderItem]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ByteString, [TransportHeaderItem])
forall a. Maybe a
Nothing

                Maybe (ByteString, [TransportHeaderItem])
mbs <- case (SecurityRequirement
secure, Maybe Channel
mbch) of
                    (SecurityRequirement
PlaintextOnly, Maybe Channel
_)          -> IO (Maybe (ByteString, [TransportHeaderItem]))
usePlaintext
                    (SecurityRequirement
PlaintextAllowed, Maybe Channel
Nothing) -> IO (Maybe (ByteString, [TransportHeaderItem]))
usePlaintext
                    (SecurityRequirement
_, Just Channel
ch)                -> Channel -> IO (Maybe (ByteString, [TransportHeaderItem]))
useEncryption Channel
ch
                    (SecurityRequirement
EncryptedOnly, Maybe Channel
Nothing)    -> Maybe (ByteString, [TransportHeaderItem])
-> IO (Maybe (ByteString, [TransportHeaderItem]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ByteString, [TransportHeaderItem])
forall a. Maybe a
Nothing

                case Maybe (ByteString, [TransportHeaderItem])
mbs of
                    Just (ByteString
bs, [TransportHeaderItem]
ackedBy) -> do
                        let mbReserved' :: Maybe ReservedToSend
mbReserved' = (\ReservedToSend
rs -> ReservedToSend
rs
                                { rsAckedBy = guard (not $ null ackedBy) >> Just (`elem` ackedBy)
                                , rsOnAck = rsOnAck rs >> onAck
                                }) (ReservedToSend -> ReservedToSend)
-> Maybe ReservedToSend -> Maybe ReservedToSend
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ReservedToSend
mbReserved
                        Connection addr -> Maybe ReservedToSend -> ByteString -> IO ()
forall addr.
Connection addr -> Maybe ReservedToSend -> ByteString -> IO ()
sendBytes Connection addr
conn Maybe ReservedToSend
mbReserved' ByteString
bs
                    Maybe (ByteString, [TransportHeaderItem])
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    let waitUntil :: TimeSpec -> TimeSpec -> STM ()
        waitUntil :: TimeSpec -> TimeSpec -> STM ()
waitUntil TimeSpec
now TimeSpec
till = do
            TimeSpec
nextTimeout <- TVar TimeSpec -> STM TimeSpec
forall a. TVar a -> STM a
readTVar TVar TimeSpec
gNextTimeout
            if TimeSpec
nextTimeout TimeSpec -> TimeSpec -> Bool
forall a. Ord a => a -> a -> Bool
<= TimeSpec
now Bool -> Bool -> Bool
|| TimeSpec
till TimeSpec -> TimeSpec -> Bool
forall a. Ord a => a -> a -> Bool
< TimeSpec
nextTimeout
               then TVar TimeSpec -> TimeSpec -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar TimeSpec
gNextTimeout TimeSpec
till
               else STM ()
forall a. STM a
retry

    let retransmitPacket :: Connection addr -> STM (IO ())
        retransmitPacket :: Connection addr -> STM (IO ())
retransmitPacket conn :: Connection addr
conn@Connection {addr
TVar Int
TVar [Integer]
TVar [(Word8, Stream)]
TVar [SentPacket]
TVar (Maybe TimeSpec)
TVar (Maybe Cookie)
TVar ChannelState
TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
GlobalState addr
cGlobalState :: forall addr. Connection addr -> GlobalState addr
cAddress :: forall addr. Connection addr -> addr
cDataUp :: forall addr.
Connection addr
-> Flow
     (Maybe (Bool, TransportPacket PartialObject))
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: forall addr.
Connection addr
-> Flow
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
     (Maybe (Bool, TransportPacket PartialObject))
cChannel :: forall addr. Connection addr -> TVar ChannelState
cCookie :: forall addr. Connection addr -> TVar (Maybe Cookie)
cSecureOutQueue :: forall addr.
Connection addr
-> TQueue
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: forall addr. Connection addr -> TVar Int
cReservedPackets :: forall addr. Connection addr -> TVar Int
cSentPackets :: forall addr. Connection addr -> TVar [SentPacket]
cToAcknowledge :: forall addr. Connection addr -> TVar [Integer]
cNextKeepAlive :: forall addr. Connection addr -> TVar (Maybe TimeSpec)
cInStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cOutStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cGlobalState :: GlobalState addr
cAddress :: addr
cDataUp :: Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
cChannel :: TVar ChannelState
cCookie :: TVar (Maybe Cookie)
cSecureOutQueue :: TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: TVar Int
cReservedPackets :: TVar Int
cSentPackets :: TVar [SentPacket]
cToAcknowledge :: TVar [Integer]
cNextKeepAlive :: TVar (Maybe TimeSpec)
cInStreams :: TVar [(Word8, Stream)]
cOutStreams :: TVar [(Word8, Stream)]
..} = do
            TimeSpec
now <- TVar TimeSpec -> STM TimeSpec
forall a. TVar a -> STM a
readTVar TVar TimeSpec
gNowVar
            (SentPacket
sp, [SentPacket]
rest) <- TVar [SentPacket] -> STM [SentPacket]
forall a. TVar a -> STM a
readTVar TVar [SentPacket]
cSentPackets STM [SentPacket]
-> ([SentPacket] -> STM (SentPacket, [SentPacket]))
-> STM (SentPacket, [SentPacket])
forall a b. STM a -> (a -> STM b) -> STM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                sps :: [SentPacket]
sps@(SentPacket
_:[SentPacket]
_) -> (SentPacket, [SentPacket]) -> STM (SentPacket, [SentPacket])
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([SentPacket] -> SentPacket
forall a. HasCallStack => [a] -> a
last [SentPacket]
sps, [SentPacket] -> [SentPacket]
forall a. HasCallStack => [a] -> [a]
init [SentPacket]
sps)
                [SentPacket]
_         -> STM (SentPacket, [SentPacket])
forall a. STM a
retry
            let nextTry :: TimeSpec
nextTry = SentPacket -> TimeSpec
spTime SentPacket
sp TimeSpec -> TimeSpec -> TimeSpec
forall a. Num a => a -> a -> a
+ Integer -> TimeSpec
fromNanoSecs Integer
1000000000
            if | TimeSpec
now TimeSpec -> TimeSpec -> Bool
forall a. Ord a => a -> a -> Bool
< TimeSpec
nextTry -> do
                    TimeSpec -> TimeSpec -> STM ()
waitUntil TimeSpec
now TimeSpec
nextTry
                    IO () -> STM (IO ())
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> STM (IO ())) -> IO () -> STM (IO ())
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
               | SentPacket -> Int
spRetryCount SentPacket
sp Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 -> do
                    ReservedToSend
reserved <- Connection addr -> STM ReservedToSend
forall addr. Connection addr -> STM ReservedToSend
reservePacket Connection addr
conn
                    TVar [SentPacket] -> [SentPacket] -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar [SentPacket]
cSentPackets [SentPacket]
rest
                    IO () -> STM (IO ())
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> STM (IO ())) -> IO () -> STM (IO ())
forall a b. (a -> b) -> a -> b
$ Connection addr -> Maybe ReservedToSend -> SentPacket -> IO ()
forall addr.
Connection addr -> Maybe ReservedToSend -> SentPacket -> IO ()
resendBytes Connection addr
conn (ReservedToSend -> Maybe ReservedToSend
forall a. a -> Maybe a
Just ReservedToSend
reserved) SentPacket
sp
               | Bool
otherwise -> do
                    IO () -> STM (IO ())
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> STM (IO ())) -> IO () -> STM (IO ())
forall a b. (a -> b) -> a -> b
$ SentPacket -> IO ()
spOnFail SentPacket
sp

    let handleControlRequests :: STM (IO ())
handleControlRequests = Flow (ControlRequest addr) (ControlMessage addr)
-> STM (ControlRequest addr)
forall r w. Flow r w -> STM r
readFlow Flow (ControlRequest addr) (ControlMessage addr)
gControlFlow STM (ControlRequest addr)
-> (ControlRequest addr -> STM (IO ())) -> STM (IO ())
forall a b. STM a -> (a -> STM b) -> STM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            RequestConnection addr
addr -> do
                conn :: Connection addr
conn@Connection {addr
TVar Int
TVar [Integer]
TVar [(Word8, Stream)]
TVar [SentPacket]
TVar (Maybe TimeSpec)
TVar (Maybe Cookie)
TVar ChannelState
TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
GlobalState addr
cGlobalState :: forall addr. Connection addr -> GlobalState addr
cAddress :: forall addr. Connection addr -> addr
cDataUp :: forall addr.
Connection addr
-> Flow
     (Maybe (Bool, TransportPacket PartialObject))
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: forall addr.
Connection addr
-> Flow
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
     (Maybe (Bool, TransportPacket PartialObject))
cChannel :: forall addr. Connection addr -> TVar ChannelState
cCookie :: forall addr. Connection addr -> TVar (Maybe Cookie)
cSecureOutQueue :: forall addr.
Connection addr
-> TQueue
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: forall addr. Connection addr -> TVar Int
cReservedPackets :: forall addr. Connection addr -> TVar Int
cSentPackets :: forall addr. Connection addr -> TVar [SentPacket]
cToAcknowledge :: forall addr. Connection addr -> TVar [Integer]
cNextKeepAlive :: forall addr. Connection addr -> TVar (Maybe TimeSpec)
cInStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cOutStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cGlobalState :: GlobalState addr
cAddress :: addr
cDataUp :: Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
cChannel :: TVar ChannelState
cCookie :: TVar (Maybe Cookie)
cSecureOutQueue :: TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: TVar Int
cReservedPackets :: TVar Int
cSentPackets :: TVar [SentPacket]
cToAcknowledge :: TVar [Integer]
cNextKeepAlive :: TVar (Maybe TimeSpec)
cInStreams :: TVar [(Word8, Stream)]
cOutStreams :: TVar [(Word8, Stream)]
..} <- GlobalState addr -> addr -> STM (Connection addr)
forall addr. GlobalState addr -> addr -> STM (Connection addr)
getConnection GlobalState addr
gs addr
addr
                UnifiedIdentity
identity <- (UnifiedIdentity, [UnifiedIdentity]) -> UnifiedIdentity
forall a b. (a, b) -> a
fst ((UnifiedIdentity, [UnifiedIdentity]) -> UnifiedIdentity)
-> STM (UnifiedIdentity, [UnifiedIdentity]) -> STM UnifiedIdentity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar (UnifiedIdentity, [UnifiedIdentity])
-> STM (UnifiedIdentity, [UnifiedIdentity])
forall a. TVar a -> STM a
readTVar TVar (UnifiedIdentity, [UnifiedIdentity])
gIdentity
                TVar ChannelState -> STM ChannelState
forall a. TVar a -> STM a
readTVar TVar ChannelState
cChannel STM ChannelState -> (ChannelState -> STM (IO ())) -> STM (IO ())
forall a b. STM a -> (a -> STM b) -> STM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    ChannelState
ChannelNone -> do
                        ReservedToSend
reserved <- Connection addr -> STM ReservedToSend
forall addr. Connection addr -> STM ReservedToSend
reservePacket Connection addr
conn
                        let packet :: ByteString
packet = ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BL.concat
                                [ PartialObject -> ByteString
forall (c :: * -> *). Object' c -> ByteString
serializeObject (PartialObject -> ByteString) -> PartialObject -> ByteString
forall a b. (a -> b) -> a -> b
$ PartialStorage -> TransportHeader -> PartialObject
transportToObject PartialStorage
gStorage (TransportHeader -> PartialObject)
-> TransportHeader -> PartialObject
forall a b. (a -> b) -> a -> b
$ [TransportHeaderItem] -> TransportHeader
TransportHeader ([TransportHeaderItem] -> TransportHeader)
-> [TransportHeaderItem] -> TransportHeader
forall a b. (a -> b) -> a -> b
$
                                    [ RefDigest -> TransportHeaderItem
Initiation (RefDigest -> TransportHeaderItem)
-> RefDigest -> TransportHeaderItem
forall a b. (a -> b) -> a -> b
$ Ref -> RefDigest
forall (c :: * -> *). Ref' c -> RefDigest
refDigest Ref
gInitConfig
                                    , RefDigest -> TransportHeaderItem
AnnounceSelf (RefDigest -> TransportHeaderItem)
-> RefDigest -> TransportHeaderItem
forall a b. (a -> b) -> a -> b
$ Ref -> RefDigest
forall (c :: * -> *). Ref' c -> RefDigest
refDigest (Ref -> RefDigest) -> Ref -> RefDigest
forall a b. (a -> b) -> a -> b
$ Stored (Signed IdentityData) -> Ref
forall a. Stored a -> Ref
storedRef (Stored (Signed IdentityData) -> Ref)
-> Stored (Signed IdentityData) -> Ref
forall a b. (a -> b) -> a -> b
$ UnifiedIdentity -> Stored (Signed IdentityData)
idData UnifiedIdentity
identity
                                    ] [TransportHeaderItem]
-> [TransportHeaderItem] -> [TransportHeaderItem]
forall a. [a] -> [a] -> [a]
++ (Text -> TransportHeaderItem) -> [Text] -> [TransportHeaderItem]
forall a b. (a -> b) -> [a] -> [b]
map Text -> TransportHeaderItem
ProtocolVersion [Text]
protocolVersions
                                , Ref -> LoadResult Identity ByteString
forall (c :: * -> *).
StorageCompleteness c =>
Ref' c -> LoadResult c ByteString
lazyLoadBytes Ref
gInitConfig
                                ]
                        TVar ChannelState -> ChannelState -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar ChannelState
cChannel ChannelState
ChannelCookieWait
                        let reserved' :: ReservedToSend
reserved' = ReservedToSend
reserved { rsAckedBy = Just $ \case CookieSet {} -> Bool
True; TransportHeaderItem
_ -> Bool
False }
                        IO () -> STM (IO ())
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> STM (IO ())) -> IO () -> STM (IO ())
forall a b. (a -> b) -> a -> b
$ Connection addr -> Maybe ReservedToSend -> ByteString -> IO ()
forall addr.
Connection addr -> Maybe ReservedToSend -> ByteString -> IO ()
sendBytes Connection addr
conn (ReservedToSend -> Maybe ReservedToSend
forall a. a -> Maybe a
Just ReservedToSend
reserved') ByteString
packet
                    ChannelState
_ -> IO () -> STM (IO ())
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> STM (IO ())) -> IO () -> STM (IO ())
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

            SendAnnounce addr
addr -> do
                UnifiedIdentity
identity <- (UnifiedIdentity, [UnifiedIdentity]) -> UnifiedIdentity
forall a b. (a, b) -> a
fst ((UnifiedIdentity, [UnifiedIdentity]) -> UnifiedIdentity)
-> STM (UnifiedIdentity, [UnifiedIdentity]) -> STM UnifiedIdentity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar (UnifiedIdentity, [UnifiedIdentity])
-> STM (UnifiedIdentity, [UnifiedIdentity])
forall a. TVar a -> STM a
readTVar TVar (UnifiedIdentity, [UnifiedIdentity])
gIdentity
                let packet :: ByteString
packet = ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ PartialObject -> ByteString
forall (c :: * -> *). Object' c -> ByteString
serializeObject (PartialObject -> ByteString) -> PartialObject -> ByteString
forall a b. (a -> b) -> a -> b
$ PartialStorage -> TransportHeader -> PartialObject
transportToObject PartialStorage
gStorage (TransportHeader -> PartialObject)
-> TransportHeader -> PartialObject
forall a b. (a -> b) -> a -> b
$ [TransportHeaderItem] -> TransportHeader
TransportHeader ([TransportHeaderItem] -> TransportHeader)
-> [TransportHeaderItem] -> TransportHeader
forall a b. (a -> b) -> a -> b
$
                        [ RefDigest -> TransportHeaderItem
AnnounceSelf (RefDigest -> TransportHeaderItem)
-> RefDigest -> TransportHeaderItem
forall a b. (a -> b) -> a -> b
$ Ref -> RefDigest
forall (c :: * -> *). Ref' c -> RefDigest
refDigest (Ref -> RefDigest) -> Ref -> RefDigest
forall a b. (a -> b) -> a -> b
$ Stored (Signed IdentityData) -> Ref
forall a. Stored a -> Ref
storedRef (Stored (Signed IdentityData) -> Ref)
-> Stored (Signed IdentityData) -> Ref
forall a b. (a -> b) -> a -> b
$ UnifiedIdentity -> Stored (Signed IdentityData)
idData UnifiedIdentity
identity
                        ] [TransportHeaderItem]
-> [TransportHeaderItem] -> [TransportHeaderItem]
forall a. [a] -> [a] -> [a]
++ (Text -> TransportHeaderItem) -> [Text] -> [TransportHeaderItem]
forall a b. (a -> b) -> [a] -> [b]
map Text -> TransportHeaderItem
ProtocolVersion [Text]
protocolVersions
                SymFlow (addr, ByteString) -> (addr, ByteString) -> STM ()
forall r w. Flow r w -> w -> STM ()
writeFlow SymFlow (addr, ByteString)
gDataFlow (addr
addr, ByteString
packet)
                IO () -> STM (IO ())
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> STM (IO ())) -> IO () -> STM (IO ())
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

            UpdateSelfIdentity UnifiedIdentity
nid -> do
                (UnifiedIdentity
cur, [UnifiedIdentity]
past) <- TVar (UnifiedIdentity, [UnifiedIdentity])
-> STM (UnifiedIdentity, [UnifiedIdentity])
forall a. TVar a -> STM a
readTVar TVar (UnifiedIdentity, [UnifiedIdentity])
gIdentity
                TVar (UnifiedIdentity, [UnifiedIdentity])
-> (UnifiedIdentity, [UnifiedIdentity]) -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (UnifiedIdentity, [UnifiedIdentity])
gIdentity (UnifiedIdentity
nid, UnifiedIdentity
cur UnifiedIdentity -> [UnifiedIdentity] -> [UnifiedIdentity]
forall a. a -> [a] -> [a]
: [UnifiedIdentity]
past)
                IO () -> STM (IO ())
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> STM (IO ())) -> IO () -> STM (IO ())
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    let sendKeepAlive :: Connection addr -> STM (IO ())
        sendKeepAlive :: Connection addr -> STM (IO ())
sendKeepAlive Connection {addr
TVar Int
TVar [Integer]
TVar [(Word8, Stream)]
TVar [SentPacket]
TVar (Maybe TimeSpec)
TVar (Maybe Cookie)
TVar ChannelState
TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
GlobalState addr
cGlobalState :: forall addr. Connection addr -> GlobalState addr
cAddress :: forall addr. Connection addr -> addr
cDataUp :: forall addr.
Connection addr
-> Flow
     (Maybe (Bool, TransportPacket PartialObject))
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: forall addr.
Connection addr
-> Flow
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
     (Maybe (Bool, TransportPacket PartialObject))
cChannel :: forall addr. Connection addr -> TVar ChannelState
cCookie :: forall addr. Connection addr -> TVar (Maybe Cookie)
cSecureOutQueue :: forall addr.
Connection addr
-> TQueue
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: forall addr. Connection addr -> TVar Int
cReservedPackets :: forall addr. Connection addr -> TVar Int
cSentPackets :: forall addr. Connection addr -> TVar [SentPacket]
cToAcknowledge :: forall addr. Connection addr -> TVar [Integer]
cNextKeepAlive :: forall addr. Connection addr -> TVar (Maybe TimeSpec)
cInStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cOutStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cGlobalState :: GlobalState addr
cAddress :: addr
cDataUp :: Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
cChannel :: TVar ChannelState
cCookie :: TVar (Maybe Cookie)
cSecureOutQueue :: TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: TVar Int
cReservedPackets :: TVar Int
cSentPackets :: TVar [SentPacket]
cToAcknowledge :: TVar [Integer]
cNextKeepAlive :: TVar (Maybe TimeSpec)
cInStreams :: TVar [(Word8, Stream)]
cOutStreams :: TVar [(Word8, Stream)]
..} = do
            TVar (Maybe TimeSpec) -> STM (Maybe TimeSpec)
forall a. TVar a -> STM a
readTVar TVar (Maybe TimeSpec)
cNextKeepAlive STM (Maybe TimeSpec)
-> (Maybe TimeSpec -> STM (IO ())) -> STM (IO ())
forall a b. STM a -> (a -> STM b) -> STM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Maybe TimeSpec
Nothing -> STM (IO ())
forall a. STM a
retry
                Just TimeSpec
next -> do
                    TimeSpec
now <- TVar TimeSpec -> STM TimeSpec
forall a. TVar a -> STM a
readTVar TVar TimeSpec
gNowVar
                    if TimeSpec
next TimeSpec -> TimeSpec -> Bool
forall a. Ord a => a -> a -> Bool
<= TimeSpec
now
                      then do
                        TVar (Maybe TimeSpec) -> Maybe TimeSpec -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe TimeSpec)
cNextKeepAlive Maybe TimeSpec
forall a. Maybe a
Nothing
                        UnifiedIdentity
identity <- (UnifiedIdentity, [UnifiedIdentity]) -> UnifiedIdentity
forall a b. (a, b) -> a
fst ((UnifiedIdentity, [UnifiedIdentity]) -> UnifiedIdentity)
-> STM (UnifiedIdentity, [UnifiedIdentity]) -> STM UnifiedIdentity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar (UnifiedIdentity, [UnifiedIdentity])
-> STM (UnifiedIdentity, [UnifiedIdentity])
forall a. TVar a -> STM a
readTVar TVar (UnifiedIdentity, [UnifiedIdentity])
gIdentity
                        let header :: TransportHeader
header = [TransportHeaderItem] -> TransportHeader
TransportHeader [ RefDigest -> TransportHeaderItem
AnnounceSelf (RefDigest -> TransportHeaderItem)
-> RefDigest -> TransportHeaderItem
forall a b. (a -> b) -> a -> b
$ Ref -> RefDigest
forall (c :: * -> *). Ref' c -> RefDigest
refDigest (Ref -> RefDigest) -> Ref -> RefDigest
forall a b. (a -> b) -> a -> b
$ Stored (Signed IdentityData) -> Ref
forall a. Stored a -> Ref
storedRef (Stored (Signed IdentityData) -> Ref)
-> Stored (Signed IdentityData) -> Ref
forall a b. (a -> b) -> a -> b
$ UnifiedIdentity -> Stored (Signed IdentityData)
idData UnifiedIdentity
identity ]
                        TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
-> (SecurityRequirement, TransportPacket Ref,
    [TransportHeaderItem])
-> STM ()
forall a. TQueue a -> a -> STM ()
writeTQueue TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cSecureOutQueue (SecurityRequirement
EncryptedOnly, TransportHeader -> [Ref] -> TransportPacket Ref
forall a. TransportHeader -> [a] -> TransportPacket a
TransportPacket TransportHeader
header [], [])
                      else do
                        TimeSpec -> TimeSpec -> STM ()
waitUntil TimeSpec
now TimeSpec
next
                    IO () -> STM (IO ())
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> STM (IO ())) -> IO () -> STM (IO ())
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    [Connection addr]
conns <- TVar [Connection addr] -> STM [Connection addr]
forall a. TVar a -> STM a
readTVar TVar [Connection addr]
gConnections
    [STM (IO ())] -> STM (IO ())
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([STM (IO ())] -> STM (IO ())) -> [STM (IO ())] -> STM (IO ())
forall a b. (a -> b) -> a -> b
$ [[STM (IO ())]] -> [STM (IO ())]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[STM (IO ())]] -> [STM (IO ())])
-> [[STM (IO ())]] -> [STM (IO ())]
forall a b. (a -> b) -> a -> b
$
        [ (Connection addr -> STM (IO ()))
-> [Connection addr] -> [STM (IO ())]
forall a b. (a -> b) -> [a] -> [b]
map Connection addr -> STM (IO ())
retransmitPacket [Connection addr]
conns
        , (Connection addr -> STM (IO ()))
-> [Connection addr] -> [STM (IO ())]
forall a b. (a -> b) -> [a] -> [b]
map Connection addr -> STM (IO ())
sendNextPacket [Connection addr]
conns
        , [ STM (IO ())
handleControlRequests ]
        , (Connection addr -> STM (IO ()))
-> [Connection addr] -> [STM (IO ())]
forall a b. (a -> b) -> [a] -> [b]
map Connection addr -> STM (IO ())
sendKeepAlive [Connection addr]
conns
        ]

processAcknowledgements :: GlobalState addr -> Connection addr -> [TransportHeaderItem] -> STM (IO ())
processAcknowledgements :: forall addr.
GlobalState addr
-> Connection addr -> [TransportHeaderItem] -> STM (IO ())
processAcknowledgements GlobalState {} Connection {addr
TVar Int
TVar [Integer]
TVar [(Word8, Stream)]
TVar [SentPacket]
TVar (Maybe TimeSpec)
TVar (Maybe Cookie)
TVar ChannelState
TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
GlobalState addr
cGlobalState :: forall addr. Connection addr -> GlobalState addr
cAddress :: forall addr. Connection addr -> addr
cDataUp :: forall addr.
Connection addr
-> Flow
     (Maybe (Bool, TransportPacket PartialObject))
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: forall addr.
Connection addr
-> Flow
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
     (Maybe (Bool, TransportPacket PartialObject))
cChannel :: forall addr. Connection addr -> TVar ChannelState
cCookie :: forall addr. Connection addr -> TVar (Maybe Cookie)
cSecureOutQueue :: forall addr.
Connection addr
-> TQueue
     (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: forall addr. Connection addr -> TVar Int
cReservedPackets :: forall addr. Connection addr -> TVar Int
cSentPackets :: forall addr. Connection addr -> TVar [SentPacket]
cToAcknowledge :: forall addr. Connection addr -> TVar [Integer]
cNextKeepAlive :: forall addr. Connection addr -> TVar (Maybe TimeSpec)
cInStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cOutStreams :: forall addr. Connection addr -> TVar [(Word8, Stream)]
cGlobalState :: GlobalState addr
cAddress :: addr
cDataUp :: Flow
  (Maybe (Bool, TransportPacket PartialObject))
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cDataInternal :: Flow
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
  (Maybe (Bool, TransportPacket PartialObject))
cChannel :: TVar ChannelState
cCookie :: TVar (Maybe Cookie)
cSecureOutQueue :: TQueue
  (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem])
cMaxInFlightPackets :: TVar Int
cReservedPackets :: TVar Int
cSentPackets :: TVar [SentPacket]
cToAcknowledge :: TVar [Integer]
cNextKeepAlive :: TVar (Maybe TimeSpec)
cInStreams :: TVar [(Word8, Stream)]
cOutStreams :: TVar [(Word8, Stream)]
..} [TransportHeaderItem]
header = do
    ([SentPacket]
acked, [SentPacket]
notAcked) <- (SentPacket -> Bool)
-> [SentPacket] -> ([SentPacket], [SentPacket])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\SentPacket
sp -> (TransportHeaderItem -> Bool) -> [TransportHeaderItem] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Maybe (TransportHeaderItem -> Bool) -> TransportHeaderItem -> Bool
forall a. HasCallStack => Maybe a -> a
fromJust (SentPacket -> Maybe (TransportHeaderItem -> Bool)
spAckedBy SentPacket
sp)) [TransportHeaderItem]
header) ([SentPacket] -> ([SentPacket], [SentPacket]))
-> STM [SentPacket] -> STM ([SentPacket], [SentPacket])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar [SentPacket] -> STM [SentPacket]
forall a. TVar a -> STM a
readTVar TVar [SentPacket]
cSentPackets
    TVar [SentPacket] -> [SentPacket] -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar [SentPacket]
cSentPackets [SentPacket]
notAcked
    IO () -> STM (IO ())
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> STM (IO ())) -> IO () -> STM (IO ())
forall a b. (a -> b) -> a -> b
$ [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([IO ()] -> IO ()) -> [IO ()] -> IO ()
forall a b. (a -> b) -> a -> b
$ (SentPacket -> IO ()) -> [SentPacket] -> [IO ()]
forall a b. (a -> b) -> [a] -> [b]
map SentPacket -> IO ()
spOnAck [SentPacket]
acked