-- |
-- Module      : Network.TLS.Context
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
--
module Network.TLS.Hooks
    ( Logging(..)
    , Hooks(..)
    , defaultHooks
    ) where

import qualified Data.ByteString as B
import Network.TLS.Struct (Header, Handshake)
import Network.TLS.Struct13 (Handshake13)
import Network.TLS.X509 (CertificateChain)
import Data.Default.Class

-- | Hooks for logging
--
-- This is called when sending and receiving packets and IO
data Logging = Logging
    { Logging -> String -> IO ()
loggingPacketSent :: String -> IO ()
    , Logging -> String -> IO ()
loggingPacketRecv :: String -> IO ()
    , Logging -> ByteString -> IO ()
loggingIOSent     :: B.ByteString -> IO ()
    , Logging -> Header -> ByteString -> IO ()
loggingIORecv     :: Header -> B.ByteString -> IO ()
    }

defaultLogging :: Logging
defaultLogging :: Logging
defaultLogging = Logging :: (String -> IO ())
-> (String -> IO ())
-> (ByteString -> IO ())
-> (Header -> ByteString -> IO ())
-> Logging
Logging
    { loggingPacketSent :: String -> IO ()
loggingPacketSent = \String
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    , loggingPacketRecv :: String -> IO ()
loggingPacketRecv = \String
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    , loggingIOSent :: ByteString -> IO ()
loggingIOSent     = \ByteString
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    , loggingIORecv :: Header -> ByteString -> IO ()
loggingIORecv     = \Header
_ ByteString
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    }

instance Default Logging where
    def :: Logging
def = Logging
defaultLogging

-- | A collection of hooks actions.
data Hooks = Hooks
    { -- | called at each handshake message received
      Hooks -> Handshake -> IO Handshake
hookRecvHandshake    :: Handshake -> IO Handshake
      -- | called at each handshake message received for TLS 1.3
    , Hooks -> Handshake13 -> IO Handshake13
hookRecvHandshake13  :: Handshake13 -> IO Handshake13
      -- | called at each certificate chain message received
    , Hooks -> CertificateChain -> IO ()
hookRecvCertificates :: CertificateChain -> IO ()
      -- | hooks on IO and packets, receiving and sending.
    , Hooks -> Logging
hookLogging          :: Logging
    }

defaultHooks :: Hooks
defaultHooks :: Hooks
defaultHooks = Hooks :: (Handshake -> IO Handshake)
-> (Handshake13 -> IO Handshake13)
-> (CertificateChain -> IO ())
-> Logging
-> Hooks
Hooks
    { hookRecvHandshake :: Handshake -> IO Handshake
hookRecvHandshake    = Handshake -> IO Handshake
forall (m :: * -> *) a. Monad m => a -> m a
return
    , hookRecvHandshake13 :: Handshake13 -> IO Handshake13
hookRecvHandshake13  = Handshake13 -> IO Handshake13
forall (m :: * -> *) a. Monad m => a -> m a
return
    , hookRecvCertificates :: CertificateChain -> IO ()
hookRecvCertificates = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> IO ())
-> (CertificateChain -> ()) -> CertificateChain -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> CertificateChain -> ()
forall a b. a -> b -> a
const ()
    , hookLogging :: Logging
hookLogging          = Logging
forall a. Default a => a
def
    }

instance Default Hooks where
    def :: Hooks
def = Hooks
defaultHooks