-- | Meta-information we maintain about an open connection
--
-- Intended for qualified import.
--
-- > import Network.GRPC.Client.Meta (Meta)
-- > import Network.GRPC.Client.Meta qualified as Meta
module Network.GRPC.Client.Meta (
    -- * Definition
    Meta(..)
  , init
  , update
  ) where

import Prelude hiding (init)

import Control.Monad.Catch
import Data.List.NonEmpty (NonEmpty)

import Network.GRPC.Common.Compression qualified as Compr
import Network.GRPC.Spec

{-------------------------------------------------------------------------------
  Definition
-------------------------------------------------------------------------------}

-- | Information about on open connection
data Meta = Meta {
      -- | Compression algorithm used for sending messages to the server
      --
      -- Nothing if the compression negotation has not yet happened.
      Meta -> Maybe Compression
outboundCompression :: Maybe Compression
    }
  deriving stock (Int -> Meta -> ShowS
[Meta] -> ShowS
Meta -> String
(Int -> Meta -> ShowS)
-> (Meta -> String) -> ([Meta] -> ShowS) -> Show Meta
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Meta -> ShowS
showsPrec :: Int -> Meta -> ShowS
$cshow :: Meta -> String
show :: Meta -> String
$cshowList :: [Meta] -> ShowS
showList :: [Meta] -> ShowS
Show)

-- | Initial connection state
init :: Maybe Compression -> Meta
init :: Maybe Compression -> Meta
init Maybe Compression
initCompr = Meta {
      outboundCompression :: Maybe Compression
outboundCompression = Maybe Compression
initCompr
    }

{-------------------------------------------------------------------------------
  Update
-------------------------------------------------------------------------------}

-- | Update 'Meta' given response headers
--
-- Returns the updated 'Meta'.
update ::
     MonadThrow m
  => Compr.Negotation -> ResponseHeaders' HandledSynthesized -> Meta -> m Meta
update :: forall (m :: * -> *).
MonadThrow m =>
Negotation -> ResponseHeaders' HandledSynthesized -> Meta -> m Meta
update Negotation
compr ResponseHeaders' HandledSynthesized
hdrs Meta
meta =
    Maybe Compression -> Meta
Meta
      (Maybe Compression -> Meta) -> m (Maybe Compression) -> m Meta
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Negotation
-> Either
     (InvalidHeaders HandledSynthesized)
     (Maybe (NonEmpty CompressionId))
-> Maybe Compression
-> m (Maybe Compression)
forall (m :: * -> *).
MonadThrow m =>
Negotation
-> Either
     (InvalidHeaders HandledSynthesized)
     (Maybe (NonEmpty CompressionId))
-> Maybe Compression
-> m (Maybe Compression)
updateCompression
            Negotation
compr
            (ResponseHeaders' HandledSynthesized
-> HKD
     (Checked (InvalidHeaders HandledSynthesized))
     (Maybe (NonEmpty CompressionId))
forall (f :: * -> *).
ResponseHeaders_ f -> HKD f (Maybe (NonEmpty CompressionId))
responseAcceptCompression ResponseHeaders' HandledSynthesized
hdrs)
            (Meta -> Maybe Compression
outboundCompression Meta
meta)

-- Update choice of compression, if necessary
--
-- We have four possibilities:
--
-- a. We chose from the list of server reported supported algorithms
-- b. The server didn't report which algorithms are supported
-- c. Compression algorithms have already been set
-- d. We could not parse the list of compression algorithms sent by the server
updateCompression :: forall m.
     MonadThrow m
  => Compr.Negotation
  -> Either (InvalidHeaders HandledSynthesized) (Maybe (NonEmpty CompressionId))
  -> Maybe Compression -> m (Maybe Compression)
updateCompression :: forall (m :: * -> *).
MonadThrow m =>
Negotation
-> Either
     (InvalidHeaders HandledSynthesized)
     (Maybe (NonEmpty CompressionId))
-> Maybe Compression
-> m (Maybe Compression)
updateCompression Negotation
negotation (Right Maybe (NonEmpty CompressionId)
accepted) = Maybe Compression -> m (Maybe Compression)
go
  where
    go :: Maybe Compression -> m (Maybe Compression)
    go :: Maybe Compression -> m (Maybe Compression)
go Maybe Compression
Nothing      = case Negotation -> NonEmpty CompressionId -> Compression
Compr.choose Negotation
negotation (NonEmpty CompressionId -> Compression)
-> Maybe (NonEmpty CompressionId) -> Maybe Compression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (NonEmpty CompressionId)
accepted of
                        Just Compression
compr -> Maybe Compression -> m (Maybe Compression)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Compression -> m (Maybe Compression))
-> Maybe Compression -> m (Maybe Compression)
forall a b. (a -> b) -> a -> b
$ Compression -> Maybe Compression
forall a. a -> Maybe a
Just Compression
compr  -- (a)
                        Maybe Compression
Nothing    -> Maybe Compression -> m (Maybe Compression)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Compression
forall a. Maybe a
Nothing       -- (b)
    go (Just Compression
compr) = Maybe Compression -> m (Maybe Compression)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Compression -> m (Maybe Compression))
-> Maybe Compression -> m (Maybe Compression)
forall a b. (a -> b) -> a -> b
$ Compression -> Maybe Compression
forall a. a -> Maybe a
Just Compression
compr                  -- (c)
updateCompression Negotation
_ (Left InvalidHeaders HandledSynthesized
_invalid) = Maybe Compression -> m (Maybe Compression)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return               -- (d)