Make Config from TLS context

[epoberezkin]

I am going to just make Config from TLS Context in our app, but it feels like it should be provided as part of this library – similarly to creating config from Socket?

@kazu-yamamoto what do you think?

[kazu-yamamoto]

http2 is designed to not depend on tls intentionally. Other packages which depends on both http2 and tls should provide such functionality.

[edsko]

For what it's worth, I ended up defining the below. Might be useful for some others, too. (And if something is incorrect, I'd love to hear it :slightly_smiling_face:).

module Network.GRPC.Util.HTTP2.TLS (
    -- * HTTP2 over TLS
    allocTlsConfig
  , freeTlsConfig
  ) where

import Data.ByteString qualified as BS.Strict
import Data.ByteString qualified as Strict (ByteString)
import Data.ByteString.Lazy qualified as BS.Lazy
import Data.IORef
import Foreign (mallocBytes)
import Network.HPACK qualified as HPACK
import Network.TLS qualified as TLS
import System.TimeManager qualified as TimeManager

-- Despite the import of @.Server@, this config works for clients also
import Network.HTTP2.Server qualified as HTTP2

{-------------------------------------------------------------------------------
  HTTP2 over TLS
-------------------------------------------------------------------------------}

-- | Make configuration for TLS (server or client)
--
-- Adapted from 'HTTP2.allocSimpleConfig'.
allocTlsConfig :: TLS.Context -> HPACK.BufferSize -> IO HTTP2.Config
allocTlsConfig tlsContext bufSize = do
    writeBuffer <- mallocBytes bufSize
    leftoverRef <- newIORef Nothing
    timeManager <- TimeManager.initialize 30_000_000
    return HTTP2.Config {
        confWriteBuffer       = writeBuffer
      , confBufferSize        = bufSize
      , confSendAll           = TLS.sendData tlsContext . BS.Lazy.fromStrict
      , confReadN             = tlsReadN tlsContext leftoverRef . fromIntegral
      , confPositionReadMaker = HTTP2.defaultPositionReadMaker
      , confTimeoutManager    = timeManager
      }

freeTlsConfig :: TLS.Context -> HTTP2.Config -> IO ()
freeTlsConfig tlsContext cfg = do
    TLS.bye tlsContext
    HTTP2.freeSimpleConfig cfg

-- | Read @N@ bytes
tlsReadN ::
     TLS.Context
  -> IORef (Maybe Strict.ByteString)  -- ^ Leftover data
  -> Word                             -- ^ Number of bytes to read
  -> IO Strict.ByteString
tlsReadN tlsContext leftoverRef n =
    go . initAccBS =<< readIORef leftoverRef
  where
    -- Precondition: precondition (2) of 'splitAccBS'
    go :: AccByteString -> IO Strict.ByteString
    go !acc
      | accLength acc < n = go =<< appendAccBS acc <$> TLS.recvData tlsContext
      | otherwise         = do
          let (bs, acc') = splitAccBS n acc
          writeIORef leftoverRef acc'
          return bs

{-------------------------------------------------------------------------------
  Auxiliary: accumulate strict bytestrings
-------------------------------------------------------------------------------}

-- | Accumulate strict bytestrings until we have enough bytes
data AccByteString = AccBS {
       -- | Total accumulated length
       accLength  :: !Word

       -- | Accumulated bytestrings, in reverse order
     , accStrings :: [Strict.ByteString]
     }

initAccBS :: Maybe Strict.ByteString -> AccByteString
initAccBS Nothing   = AccBS 0 []
initAccBS (Just bs) = AccBS (fromIntegral $ BS.Strict.length bs) [bs]

appendAccBS :: AccByteString -> Strict.ByteString -> AccByteString
appendAccBS AccBS{accLength, accStrings} bs = AccBS{
      accLength  = accLength + fromIntegral (BS.Strict.length bs)
    , accStrings = bs : accStrings
    }

-- | Split the accumulated bytestrings after @n@ bytes
--
-- Preconditions:
--
-- 1. The accumulated length must be @>= n@
-- 2. The accumulated length without the most recently added bytestring
--    must be @<= n@
--
-- These two preconditions together imply that all accumulated bytestrings
-- except the most recent will be required.
splitAccBS :: Word -> AccByteString -> (Strict.ByteString, Maybe Strict.ByteString)
splitAccBS n AccBS{accLength, accStrings} =
    if leftoverLen == 0 then
      (BS.Strict.concat $ reverse accStrings, Nothing)
    else
      -- If @leftoverLen > 0@ then @accLength > 0@: we must have some strings
      case accStrings of
        []              -> error "splitAccBS: invalid AccByteString"
        mostRecent:rest ->
          let neededLen = fromIntegral $
                -- cannot underflow due to precondition (2)
                BS.Strict.length mostRecent - fromIntegral leftoverLen
              (needed, leftover) =
                BS.Strict.splitAt neededLen mostRecent
          in ( BS.Strict.concat $ reverse (needed : rest)
             , if BS.Strict.null leftover
                 then Nothing
                 else Just leftover
             )
  where
    -- cannot underflow due to precondition (1)
    leftoverLen :: Word
    leftoverLen = accLength - n

[kazu-yamamoto]

I'm working on this now. https://github.com/kazu-yamamoto/http2-tls

[kazu-yamamoto]

http2-tls has been released.