{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Network.QUIC.Info where

import qualified Data.ByteString.Char8 as C8
import qualified Network.Socket as NS
import Network.TLS hiding (Version, HandshakeFailed)

import Network.QUIC.Connection
import Network.QUIC.Connector
import Network.QUIC.Imports
import Network.QUIC.Types

----------------------------------------------------------------

-- | Information about a connection.
data ConnectionInfo = ConnectionInfo {
    ConnectionInfo -> Version
version :: Version
  , ConnectionInfo -> Cipher
cipher :: Cipher
  , ConnectionInfo -> Maybe ByteString
alpn :: Maybe ByteString
  , ConnectionInfo -> HandshakeMode13
handshakeMode :: HandshakeMode13
  , ConnectionInfo -> Bool
retry :: Bool
  , ConnectionInfo -> SockAddr
localSockAddr :: NS.SockAddr
  , ConnectionInfo -> SockAddr
remoteSockAddr :: NS.SockAddr
  , ConnectionInfo -> CID
localCID :: CID
  , ConnectionInfo -> CID
remoteCID :: CID
  }

-- | Getting information about a connection.
getConnectionInfo :: Connection -> IO ConnectionInfo
getConnectionInfo :: Connection -> IO ConnectionInfo
getConnectionInfo Connection
conn = do
    Socket
s:[Socket]
_    <- Connection -> IO [Socket]
getSockets Connection
conn
    SockAddr
mysa   <- Socket -> IO SockAddr
NS.getSocketName Socket
s
    SockAddr
peersa <- if Connection -> Bool
forall a. Connector a => a -> Bool
isClient Connection
conn then do
                  Maybe SockAddr
msa <- Connection -> IO (Maybe SockAddr)
getServerAddr Connection
conn
                  case Maybe SockAddr
msa of
                    Maybe SockAddr
Nothing -> Socket -> IO SockAddr
NS.getPeerName Socket
s
                    Just SockAddr
sa -> SockAddr -> IO SockAddr
forall (m :: * -> *) a. Monad m => a -> m a
return SockAddr
sa
                else
                  Socket -> IO SockAddr
NS.getPeerName Socket
s
    CID
mycid   <- Connection -> IO CID
getMyCID Connection
conn
    CID
peercid <- Connection -> IO CID
getPeerCID Connection
conn
    Cipher
c <- Connection -> EncryptionLevel -> IO Cipher
getCipher Connection
conn EncryptionLevel
RTT1Level
    Maybe ByteString
mproto <- Connection -> IO (Maybe ByteString)
getApplicationProtocol Connection
conn
    HandshakeMode13
mode <- Connection -> IO HandshakeMode13
getTLSMode Connection
conn
    Bool
r <- Connection -> IO Bool
getRetried Connection
conn
    Version
v <- Connection -> IO Version
getVersion Connection
conn
    ConnectionInfo -> IO ConnectionInfo
forall (m :: * -> *) a. Monad m => a -> m a
return ConnectionInfo :: Version
-> Cipher
-> Maybe ByteString
-> HandshakeMode13
-> Bool
-> SockAddr
-> SockAddr
-> CID
-> CID
-> ConnectionInfo
ConnectionInfo {
        version :: Version
version = Version
v
      , cipher :: Cipher
cipher = Cipher
c
      , alpn :: Maybe ByteString
alpn = Maybe ByteString
mproto
      , handshakeMode :: HandshakeMode13
handshakeMode = HandshakeMode13
mode
      , retry :: Bool
retry = Bool
r
      , localSockAddr :: SockAddr
localSockAddr  = SockAddr
mysa
      , remoteSockAddr :: SockAddr
remoteSockAddr = SockAddr
peersa
      , localCID :: CID
localCID  = CID
mycid
      , remoteCID :: CID
remoteCID = CID
peercid
      }

instance Show ConnectionInfo where
    show :: ConnectionInfo -> String
show ConnectionInfo{Bool
Maybe ByteString
SockAddr
HandshakeMode13
Cipher
CID
Version
remoteCID :: CID
localCID :: CID
remoteSockAddr :: SockAddr
localSockAddr :: SockAddr
retry :: Bool
handshakeMode :: HandshakeMode13
alpn :: Maybe ByteString
cipher :: Cipher
version :: Version
remoteCID :: ConnectionInfo -> CID
localCID :: ConnectionInfo -> CID
remoteSockAddr :: ConnectionInfo -> SockAddr
localSockAddr :: ConnectionInfo -> SockAddr
retry :: ConnectionInfo -> Bool
handshakeMode :: ConnectionInfo -> HandshakeMode13
alpn :: ConnectionInfo -> Maybe ByteString
cipher :: ConnectionInfo -> Cipher
version :: ConnectionInfo -> Version
..} = String
"Version: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Version -> String
forall a. Show a => a -> String
show Version
version String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
                           String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Cipher: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Cipher -> String
forall a. Show a => a -> String
show Cipher
cipher String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
                           String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"ALPN: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> (ByteString -> String) -> Maybe ByteString -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"none" ByteString -> String
C8.unpack Maybe ByteString
alpn String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
                           String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Mode: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ HandshakeMode13 -> String
forall a. Show a => a -> String
show HandshakeMode13
handshakeMode String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
                           String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Local CID: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CID -> String
forall a. Show a => a -> String
show CID
localCID String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
                           String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Remote CID: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CID -> String
forall a. Show a => a -> String
show CID
remoteCID String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
                           String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Local SockAddr: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SockAddr -> String
forall a. Show a => a -> String
show SockAddr
localSockAddr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
                           String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Remote SockAddr: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SockAddr -> String
forall a. Show a => a -> String
show SockAddr
remoteSockAddr String -> ShowS
forall a. [a] -> [a] -> [a]
++
                           if Bool
retry then String
"\nQUIC retry" else String
""

----------------------------------------------------------------

-- | Statistics of a connection.
data ConnectionStats = ConnectionStats {
    ConnectionStats -> Int
txBytes :: Int
  , ConnectionStats -> Int
rxBytes :: Int
  } deriving (ConnectionStats -> ConnectionStats -> Bool
(ConnectionStats -> ConnectionStats -> Bool)
-> (ConnectionStats -> ConnectionStats -> Bool)
-> Eq ConnectionStats
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConnectionStats -> ConnectionStats -> Bool
$c/= :: ConnectionStats -> ConnectionStats -> Bool
== :: ConnectionStats -> ConnectionStats -> Bool
$c== :: ConnectionStats -> ConnectionStats -> Bool
Eq, Int -> ConnectionStats -> ShowS
[ConnectionStats] -> ShowS
ConnectionStats -> String
(Int -> ConnectionStats -> ShowS)
-> (ConnectionStats -> String)
-> ([ConnectionStats] -> ShowS)
-> Show ConnectionStats
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConnectionStats] -> ShowS
$cshowList :: [ConnectionStats] -> ShowS
show :: ConnectionStats -> String
$cshow :: ConnectionStats -> String
showsPrec :: Int -> ConnectionStats -> ShowS
$cshowsPrec :: Int -> ConnectionStats -> ShowS
Show)

-- | Getting statistics of a connection.
getConnectionStats :: Connection -> IO ConnectionStats
getConnectionStats :: Connection -> IO ConnectionStats
getConnectionStats Connection
conn = do
    Int
tx <- Connection -> IO Int
getTxBytes Connection
conn
    Int
rx <- Connection -> IO Int
getRxBytes Connection
conn
    ConnectionStats -> IO ConnectionStats
forall (m :: * -> *) a. Monad m => a -> m a
return (ConnectionStats -> IO ConnectionStats)
-> ConnectionStats -> IO ConnectionStats
forall a b. (a -> b) -> a -> b
$ ConnectionStats :: Int -> Int -> ConnectionStats
ConnectionStats {
        txBytes :: Int
txBytes = Int
tx
      , rxBytes :: Int
rxBytes = Int
rx
      }