{-# Options_GHC -Wno-unused-do-bind #-}
{-# Language OverloadedStrings #-}
module Client.Network.Async
( NetworkConnection
, NetworkEvent(..)
, createConnection
, Client.Network.Async.send
, Client.Network.Async.recv
, upgrade
, abortConnection
, TerminationReason(..)
) where
import Client.Configuration.ServerSettings
import Client.Network.Connect (withConnection, tlsParams)
import Control.Concurrent (MVar, swapMVar, threadDelay, forkIO, newEmptyMVar, putMVar)
import Control.Concurrent.Async (Async, async, cancel, cancelWith, race_, waitCatch, withAsync, AsyncCancelled(AsyncCancelled))
import Control.Concurrent.STM
import Control.Exception (SomeException, Exception(fromException, displayException), throwIO)
import Control.Lens (view)
import Control.Monad (join, when, forever, unless)
import Data.ByteString (ByteString)
import Data.ByteString qualified as B
import Data.Foldable (for_)
import Data.List (intercalate)
import Data.List.Split (chunksOf)
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Time (ZonedTime, getZonedTime)
import Data.Traversable (for)
import Data.Word (Word8)
import Hookup
import Hookup.OpenSSL (getPubKeyDer)
import Irc.RateLimit (RateLimit, newRateLimit, tickRateLimit)
import Numeric (showHex)
import OpenSSL.EVP.Digest qualified as Digest
import OpenSSL.X509 (X509, printX509, writeDerX509)
data NetworkConnection = NetworkConnection
{ NetworkConnection -> TQueue ByteString
connOutQueue :: TQueue ByteString
, NetworkConnection -> TQueue NetworkEvent
connInQueue :: TQueue NetworkEvent
, NetworkConnection -> Async ()
connAsync :: Async ()
, NetworkConnection -> MVar (IO ())
connUpgrade :: MVar (IO ())
}
upgrade :: NetworkConnection -> IO ()
upgrade :: NetworkConnection -> IO ()
upgrade NetworkConnection
c = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (forall a. MVar a -> a -> IO a
swapMVar (NetworkConnection -> MVar (IO ())
connUpgrade NetworkConnection
c) (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()))
data NetworkEvent
= NetworkOpen !ZonedTime
| NetworkTLS [Text]
| NetworkLine !ZonedTime !ByteString
| NetworkError !ZonedTime !SomeException
| NetworkClose !ZonedTime
instance Show NetworkConnection where
showsPrec :: Int -> NetworkConnection -> ShowS
showsPrec Int
p NetworkConnection
_ = Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10)
forall a b. (a -> b) -> a -> b
$ [Char] -> ShowS
showString [Char]
"NetworkConnection _"
data TerminationReason
= PingTimeout
| ForcedDisconnect
| StsUpgrade
| StartTLSFailed
| BadCertFingerprint ByteString (Maybe ByteString)
| BadPubkeyFingerprint ByteString (Maybe ByteString)
deriving Int -> TerminationReason -> ShowS
[TerminationReason] -> ShowS
TerminationReason -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [TerminationReason] -> ShowS
$cshowList :: [TerminationReason] -> ShowS
show :: TerminationReason -> [Char]
$cshow :: TerminationReason -> [Char]
showsPrec :: Int -> TerminationReason -> ShowS
$cshowsPrec :: Int -> TerminationReason -> ShowS
Show
instance Exception TerminationReason where
displayException :: TerminationReason -> [Char]
displayException TerminationReason
PingTimeout = [Char]
"connection killed due to ping timeout"
displayException TerminationReason
ForcedDisconnect = [Char]
"connection killed by client command"
displayException TerminationReason
StsUpgrade = [Char]
"connection killed by sts policy"
displayException TerminationReason
StartTLSFailed = [Char]
"connection killed due to failed STARTTLS"
displayException (BadCertFingerprint ByteString
expect Maybe ByteString
got) =
[Char]
"Expected certificate fingerprint: " forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
formatDigest ByteString
expect forall a. [a] -> [a] -> [a]
++
[Char]
"; got: " forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"none" ByteString -> [Char]
formatDigest Maybe ByteString
got
displayException (BadPubkeyFingerprint ByteString
expect Maybe ByteString
got) =
[Char]
"Expected public key fingerprint: " forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
formatDigest ByteString
expect forall a. [a] -> [a] -> [a]
++
[Char]
"; got: " forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"none" ByteString -> [Char]
formatDigest Maybe ByteString
got
send :: NetworkConnection -> ByteString -> IO ()
send :: NetworkConnection -> ByteString -> IO ()
send NetworkConnection
c ByteString
msg = forall a. STM a -> IO a
atomically (forall a. TQueue a -> a -> STM ()
writeTQueue (NetworkConnection -> TQueue ByteString
connOutQueue NetworkConnection
c) ByteString
msg)
recv :: NetworkConnection -> STM [NetworkEvent]
recv :: NetworkConnection -> STM [NetworkEvent]
recv = forall a. TQueue a -> STM [a]
flushTQueue forall b c a. (b -> c) -> (a -> b) -> a -> c
. NetworkConnection -> TQueue NetworkEvent
connInQueue
abortConnection :: TerminationReason -> NetworkConnection -> IO ()
abortConnection :: TerminationReason -> NetworkConnection -> IO ()
abortConnection TerminationReason
reason NetworkConnection
c = forall e a. Exception e => Async a -> e -> IO ()
cancelWith (NetworkConnection -> Async ()
connAsync NetworkConnection
c) TerminationReason
reason
createConnection ::
Int ->
ServerSettings ->
IO NetworkConnection
createConnection :: Int -> ServerSettings -> IO NetworkConnection
createConnection Int
delay ServerSettings
settings =
do TQueue ByteString
outQueue <- forall a. IO (TQueue a)
newTQueueIO
TQueue NetworkEvent
inQueue <- forall a. IO (TQueue a)
newTQueueIO
MVar (IO ())
upgradeMVar <- forall a. IO (MVar a)
newEmptyMVar
Async ()
supervisor <- forall a. IO a -> IO (Async a)
async forall a b. (a -> b) -> a -> b
$
Int -> IO ()
threadDelay (Int
delay forall a. Num a => a -> a -> a
* Int
1000000) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
forall a. ServerSettings -> (Connection -> IO a) -> IO a
withConnection ServerSettings
settings
(ServerSettings
-> TQueue NetworkEvent
-> TQueue ByteString
-> MVar (IO ())
-> Connection
-> IO ()
startConnection ServerSettings
settings TQueue NetworkEvent
inQueue TQueue ByteString
outQueue MVar (IO ())
upgradeMVar)
let recordFailure :: SomeException -> IO ()
recordFailure :: SomeException -> IO ()
recordFailure SomeException
ex =
do ZonedTime
now <- IO ZonedTime
getZonedTime
forall a. STM a -> IO a
atomically (forall a. TQueue a -> a -> STM ()
writeTQueue TQueue NetworkEvent
inQueue (ZonedTime -> SomeException -> NetworkEvent
NetworkError ZonedTime
now SomeException
ex))
recordNormalExit :: IO ()
recordNormalExit :: IO ()
recordNormalExit =
do ZonedTime
now <- IO ZonedTime
getZonedTime
forall a. STM a -> IO a
atomically (forall a. TQueue a -> a -> STM ()
writeTQueue TQueue NetworkEvent
inQueue (ZonedTime -> NetworkEvent
NetworkClose ZonedTime
now))
IO () -> IO ThreadId
forkIO forall a b. (a -> b) -> a -> b
$ do Either SomeException ()
outcome <- forall a. Async a -> IO (Either SomeException a)
waitCatch Async ()
supervisor
case Either SomeException ()
outcome of
Right{} -> IO ()
recordNormalExit
Left SomeException
e -> SomeException -> IO ()
recordFailure SomeException
e
forall (m :: * -> *) a. Monad m => a -> m a
return NetworkConnection
{ connOutQueue :: TQueue ByteString
connOutQueue = TQueue ByteString
outQueue
, connInQueue :: TQueue NetworkEvent
connInQueue = TQueue NetworkEvent
inQueue
, connAsync :: Async ()
connAsync = Async ()
supervisor
, connUpgrade :: MVar (IO ())
connUpgrade = MVar (IO ())
upgradeMVar
}
startConnection ::
ServerSettings ->
TQueue NetworkEvent ->
TQueue ByteString ->
MVar (IO ()) ->
Connection ->
IO ()
startConnection :: ServerSettings
-> TQueue NetworkEvent
-> TQueue ByteString
-> MVar (IO ())
-> Connection
-> IO ()
startConnection ServerSettings
settings TQueue NetworkEvent
inQueue TQueue ByteString
outQueue MVar (IO ())
upgradeMVar Connection
h =
do TQueue NetworkEvent -> IO ()
reportNetworkOpen TQueue NetworkEvent
inQueue
Bool
ready <- IO Bool
presend
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
ready forall a b. (a -> b) -> a -> b
$
do IO ()
checkFingerprints
forall a b. IO a -> IO b -> IO ()
race_ IO ()
receiveMain forall {b}. IO b
sendMain
where
receiveMain :: IO ()
receiveMain = Connection -> TQueue NetworkEvent -> IO ()
receiveLoop Connection
h TQueue NetworkEvent
inQueue
sendMain :: IO b
sendMain =
do RateLimit
rate <- Rational -> Rational -> IO RateLimit
newRateLimit (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ServerSettings Rational
ssFloodPenalty ServerSettings
settings)
(forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ServerSettings Rational
ssFloodThreshold ServerSettings
settings)
forall a. Connection -> TQueue ByteString -> RateLimit -> IO a
sendLoop Connection
h TQueue ByteString
outQueue RateLimit
rate
presend :: IO Bool
presend =
case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ServerSettings TlsMode
ssTls ServerSettings
settings of
TlsMode
TlsNo -> Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall a. MVar a -> a -> IO ()
putMVar MVar (IO ())
upgradeMVar (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
TlsMode
TlsYes ->
do [Text]
txts <- Connection -> IO [Text]
describeCertificates Connection
h
forall a. MVar a -> a -> IO ()
putMVar MVar (IO ())
upgradeMVar (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
forall a. STM a -> IO a
atomically (forall a. TQueue a -> a -> STM ()
writeTQueue TQueue NetworkEvent
inQueue ([Text] -> NetworkEvent
NetworkTLS [Text]
txts))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
TlsMode
TlsStart ->
do Connection -> ByteString -> IO ()
Hookup.send Connection
h ByteString
"STARTTLS\n"
Either SomeException ()
r <- forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync IO ()
receiveMain forall a b. (a -> b) -> a -> b
$ \Async ()
t ->
do forall a. MVar a -> a -> IO ()
putMVar MVar (IO ())
upgradeMVar (forall a. Async a -> IO ()
cancel Async ()
t)
forall a. Async a -> IO (Either SomeException a)
waitCatch Async ()
t
case Either SomeException ()
r of
Right () -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
Left SomeException
e | Just AsyncCancelled
AsyncCancelled <- forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e ->
do TlsParams -> [Char] -> Connection -> IO ()
Hookup.upgradeTls (ServerSettings -> TlsParams
tlsParams ServerSettings
settings) (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ServerSettings [Char]
ssHostName ServerSettings
settings) Connection
h
[Text]
txts <- Connection -> IO [Text]
describeCertificates Connection
h
forall a. STM a -> IO a
atomically (forall a. TQueue a -> a -> STM ()
writeTQueue TQueue NetworkEvent
inQueue ([Text] -> NetworkEvent
NetworkTLS [Text]
txts))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
Left SomeException
e -> forall e a. Exception e => e -> IO a
throwIO SomeException
e
checkFingerprints :: IO ()
checkFingerprints =
case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ServerSettings TlsMode
ssTls ServerSettings
settings of
TlsMode
TlsNo -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
TlsMode
_ ->
do forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ServerSettings (Maybe Fingerprint)
ssTlsCertFingerprint ServerSettings
settings) (Connection -> Fingerprint -> IO ()
checkCertFingerprint Connection
h)
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ServerSettings (Maybe Fingerprint)
ssTlsPubkeyFingerprint ServerSettings
settings) (Connection -> Fingerprint -> IO ()
checkPubkeyFingerprint Connection
h)
checkCertFingerprint :: Connection -> Fingerprint -> IO ()
checkCertFingerprint :: Connection -> Fingerprint -> IO ()
checkCertFingerprint Connection
h Fingerprint
fp =
do (ByteString
expect, Maybe ByteString
got) <-
case Fingerprint
fp of
FingerprintSha1 ByteString
expect -> (,) ByteString
expect forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> IO (Maybe ByteString)
getPeerCertFingerprintSha1 Connection
h
FingerprintSha256 ByteString
expect -> (,) ByteString
expect forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> IO (Maybe ByteString)
getPeerCertFingerprintSha256 Connection
h
FingerprintSha512 ByteString
expect -> (,) ByteString
expect forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> IO (Maybe ByteString)
getPeerCertFingerprintSha512 Connection
h
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. a -> Maybe a
Just ByteString
expect forall a. Eq a => a -> a -> Bool
== Maybe ByteString
got)
(forall e a. Exception e => e -> IO a
throwIO (ByteString -> Maybe ByteString -> TerminationReason
BadCertFingerprint ByteString
expect Maybe ByteString
got))
checkPubkeyFingerprint :: Connection -> Fingerprint -> IO ()
checkPubkeyFingerprint :: Connection -> Fingerprint -> IO ()
checkPubkeyFingerprint Connection
h Fingerprint
fp =
do (ByteString
expect, Maybe ByteString
got) <-
case Fingerprint
fp of
FingerprintSha1 ByteString
expect -> (,) ByteString
expect forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> IO (Maybe ByteString)
getPeerPubkeyFingerprintSha1 Connection
h
FingerprintSha256 ByteString
expect -> (,) ByteString
expect forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> IO (Maybe ByteString)
getPeerPubkeyFingerprintSha256 Connection
h
FingerprintSha512 ByteString
expect -> (,) ByteString
expect forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> IO (Maybe ByteString)
getPeerPubkeyFingerprintSha512 Connection
h
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. a -> Maybe a
Just ByteString
expect forall a. Eq a => a -> a -> Bool
== Maybe ByteString
got)
(forall e a. Exception e => e -> IO a
throwIO (ByteString -> Maybe ByteString -> TerminationReason
BadPubkeyFingerprint ByteString
expect Maybe ByteString
got))
reportNetworkOpen :: TQueue NetworkEvent -> IO ()
reportNetworkOpen :: TQueue NetworkEvent -> IO ()
reportNetworkOpen TQueue NetworkEvent
inQueue =
do ZonedTime
now <- IO ZonedTime
getZonedTime
forall a. STM a -> IO a
atomically (forall a. TQueue a -> a -> STM ()
writeTQueue TQueue NetworkEvent
inQueue (ZonedTime -> NetworkEvent
NetworkOpen ZonedTime
now))
describeCertificates :: Connection -> IO [Text]
describeCertificates :: Connection -> IO [Text]
describeCertificates Connection
h =
do Maybe X509
mbServer <- Connection -> IO (Maybe X509)
getPeerCertificate Connection
h
Maybe X509
mbClient <- Connection -> IO (Maybe X509)
getClientCertificate Connection
h
[Text]
cTxts <- [Char] -> Maybe X509 -> IO [Text]
certText [Char]
"Server" Maybe X509
mbServer
[Text]
sTxts <- [Char] -> Maybe X509 -> IO [Text]
certText [Char]
"Client" Maybe X509
mbClient
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. [a] -> [a]
reverse ([Text]
cTxts forall a. [a] -> [a] -> [a]
++ [Text]
sTxts))
certText :: String -> Maybe X509 -> IO [Text]
certText :: [Char] -> Maybe X509 -> IO [Text]
certText [Char]
label Maybe X509
mbX509 =
case Maybe X509
mbX509 of
Maybe X509
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
Just X509
x509 ->
do [Char]
str <- X509 -> IO [Char]
printX509 X509
x509
[[Char]]
fps <- X509 -> IO [[Char]]
getFingerprints X509
x509
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Text
Text.pack
forall a b. (a -> b) -> a -> b
$ (Char
'\^B' forall a. a -> [a] -> [a]
: [Char]
label)
forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map ShowS
colorize ([Char] -> [[Char]]
lines [Char]
str forall a. [a] -> [a] -> [a]
++ [[Char]]
fps)
where
colorize :: ShowS
colorize x :: [Char]
x@(Char
' ':[Char]
_) = [Char]
x
colorize [Char]
xs = [Char]
"\^C07" forall a. [a] -> [a] -> [a]
++ [Char]
xs
getFingerprints :: X509 -> IO [String]
getFingerprints :: X509 -> IO [[Char]]
getFingerprints X509
x509 =
do ByteString
certDer <- X509 -> IO ByteString
writeDerX509 X509
x509
ByteString
spkiDer <- X509 -> IO ByteString
getPubKeyDer X509
x509
[[[Char]]]
xss <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [[Char]
"sha1", [Char]
"sha256", [Char]
"sha512"] forall a b. (a -> b) -> a -> b
$ \[Char]
alg ->
do Maybe Digest
mb <- [Char] -> IO (Maybe Digest)
Digest.getDigestByName [Char]
alg
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case Maybe Digest
mb of
Maybe Digest
Nothing -> []
Just Digest
d ->
([Char]
"Certificate " forall a. [a] -> [a] -> [a]
++ [Char]
alg forall a. [a] -> [a] -> [a]
++ [Char]
" fingerprint:")
forall a. a -> [a] -> [a]
: ByteString -> [[Char]]
fingerprintLines (Digest -> ByteString -> ByteString
Digest.digestLBS Digest
d ByteString
certDer)
forall a. [a] -> [a] -> [a]
++ ([Char]
"SPKI " forall a. [a] -> [a] -> [a]
++ [Char]
alg forall a. [a] -> [a] -> [a]
++ [Char]
" fingerprint:")
forall a. a -> [a] -> [a]
: ByteString -> [[Char]]
fingerprintLines (Digest -> ByteString -> ByteString
Digest.digestBS Digest
d ByteString
spkiDer)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[Char]]]
xss)
fingerprintLines :: ByteString -> [String]
fingerprintLines :: ByteString -> [[Char]]
fingerprintLines
= forall a b. (a -> b) -> [a] -> [b]
map ([Char]
" "forall a. [a] -> [a] -> [a]
++)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Int -> [e] -> [[e]]
chunksOf (Int
16forall a. Num a => a -> a -> a
*Int
3)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
formatDigest
formatDigest :: ByteString -> String
formatDigest :: ByteString -> [Char]
formatDigest
= forall a. [a] -> [[a]] -> [a]
intercalate [Char]
":"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Word8 -> [Char]
showByte
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
B.unpack
showByte :: Word8 -> String
showByte :: Word8 -> [Char]
showByte Word8
x
| Word8
x forall a. Ord a => a -> a -> Bool
< Word8
0x10 = Char
'0' forall a. a -> [a] -> [a]
: forall a. (Integral a, Show a) => a -> ShowS
showHex Word8
x [Char]
""
| Bool
otherwise = forall a. (Integral a, Show a) => a -> ShowS
showHex Word8
x [Char]
""
sendLoop :: Connection -> TQueue ByteString -> RateLimit -> IO a
sendLoop :: forall a. Connection -> TQueue ByteString -> RateLimit -> IO a
sendLoop Connection
h TQueue ByteString
outQueue RateLimit
rate =
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$
do ByteString
msg <- forall a. STM a -> IO a
atomically (forall a. TQueue a -> STM a
readTQueue TQueue ByteString
outQueue)
RateLimit -> IO ()
tickRateLimit RateLimit
rate
Connection -> ByteString -> IO ()
Hookup.send Connection
h ByteString
msg
ircMaxMessageLength :: Int
ircMaxMessageLength :: Int
ircMaxMessageLength = Int
512
receiveLoop :: Connection -> TQueue NetworkEvent -> IO ()
receiveLoop :: Connection -> TQueue NetworkEvent -> IO ()
receiveLoop Connection
h TQueue NetworkEvent
inQueue =
do Maybe ByteString
mb <- Connection -> Int -> IO (Maybe ByteString)
recvLine Connection
h (Int
4forall a. Num a => a -> a -> a
*Int
ircMaxMessageLength)
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe ByteString
mb forall a b. (a -> b) -> a -> b
$ \ByteString
msg ->
do forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
B.null ByteString
msg) forall a b. (a -> b) -> a -> b
$
do ZonedTime
now <- IO ZonedTime
getZonedTime
forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TQueue a -> a -> STM ()
writeTQueue TQueue NetworkEvent
inQueue
forall a b. (a -> b) -> a -> b
$ ZonedTime -> ByteString -> NetworkEvent
NetworkLine ZonedTime
now ByteString
msg
Connection -> TQueue NetworkEvent -> IO ()
receiveLoop Connection
h TQueue NetworkEvent
inQueue