-- | Utilities for working with headers
module Network.GRPC.Common.Headers (
    HasRequiredHeaders(..)
  , RequiredHeaders(..)
  , verifyRequired
  , verifyAll
  , verifyAllIf
  ) where

import Data.Functor.Identity
import Data.Kind
import Data.Void

import Network.GRPC.Spec
import Network.GRPC.Spec.Util.HKD (Undecorated, Checked)
import Network.GRPC.Spec.Util.HKD qualified as HKD

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

-- | Required headers
--
-- Required headers are headers that @grapesy@ needs to know in order to
-- function. For example, we /need/ to know which compression algorithm the peer
-- is using for their messages to us.
class HKD.Traversable h => HasRequiredHeaders h where
  data RequiredHeaders h :: Type
  requiredHeaders :: h (Checked e) -> Either e (RequiredHeaders h)

-- | Like 'requiredHeaders', but for already verified headers
requiredHeadersVerified ::
     HasRequiredHeaders h
  => h Undecorated -> RequiredHeaders h
requiredHeadersVerified :: forall (h :: (* -> *) -> *).
HasRequiredHeaders h =>
h Undecorated -> RequiredHeaders h
requiredHeadersVerified =
    (Void -> RequiredHeaders h)
-> (RequiredHeaders h -> RequiredHeaders h)
-> Either Void (RequiredHeaders h)
-> RequiredHeaders h
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Void -> RequiredHeaders h
forall a. Void -> a
absurd RequiredHeaders h -> RequiredHeaders h
forall a. a -> a
id (Either Void (RequiredHeaders h) -> RequiredHeaders h)
-> (h Undecorated -> Either Void (RequiredHeaders h))
-> h Undecorated
-> RequiredHeaders h
forall b c a. (b -> c) -> (a -> b) -> a -> c
. h (Checked Void) -> Either Void (RequiredHeaders h)
forall e. h (Checked e) -> Either e (RequiredHeaders h)
forall (h :: (* -> *) -> *) e.
HasRequiredHeaders h =>
h (Checked e) -> Either e (RequiredHeaders h)
requiredHeaders (h (Checked Void) -> Either Void (RequiredHeaders h))
-> (h Undecorated -> h (Checked Void))
-> h Undecorated
-> Either Void (RequiredHeaders h)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Identity a -> Either Void a)
-> h (DecoratedWith Identity) -> h (Checked Void)
forall (t :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Traversable t =>
(forall a. f a -> g a)
-> t (DecoratedWith f) -> t (DecoratedWith g)
HKD.map Identity a -> Either Void a
forall a. Identity a -> Either Void a
noError (h (DecoratedWith Identity) -> h (Checked Void))
-> (h Undecorated -> h (DecoratedWith Identity))
-> h Undecorated
-> h (Checked Void)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. h Undecorated -> h (DecoratedWith Identity)
forall (t :: (* -> *) -> *).
Coerce t =>
t Undecorated -> t (DecoratedWith Identity)
HKD.decorate
  where
    noError :: Identity a -> Either Void a
    noError :: forall a. Identity a -> Either Void a
noError = a -> Either Void a
forall a b. b -> Either a b
Right (a -> Either Void a)
-> (Identity a -> a) -> Identity a -> Either Void a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity a -> a
forall a. Identity a -> a
runIdentity

-- | Validate only the required headers
--
-- By default, we only check those headers @grapesy@ needs to function.
verifyRequired ::
     HasRequiredHeaders h
  => h (Checked (InvalidHeaders HandledSynthesized))
  -> Either (InvalidHeaders HandledSynthesized) (RequiredHeaders h)
verifyRequired :: forall (h :: (* -> *) -> *).
HasRequiredHeaders h =>
h (Checked (InvalidHeaders HandledSynthesized))
-> Either (InvalidHeaders HandledSynthesized) (RequiredHeaders h)
verifyRequired = h (Checked (InvalidHeaders HandledSynthesized))
-> Either (InvalidHeaders HandledSynthesized) (RequiredHeaders h)
forall e. h (Checked e) -> Either e (RequiredHeaders h)
forall (h :: (* -> *) -> *) e.
HasRequiredHeaders h =>
h (Checked e) -> Either e (RequiredHeaders h)
requiredHeaders

-- | Validate /all/ headers
--
-- Validate all headers; we do this only if
-- 'Network.GRPC.Client.connVerifyHeaders' (on the client) or
-- 'Network.GRPC.Server.serverVerifyHeaders' (on the server) is enabled.
verifyAll :: forall h.
     HasRequiredHeaders h
  => h (Checked (InvalidHeaders HandledSynthesized))
  -> Either (InvalidHeaders HandledSynthesized) (h Undecorated, RequiredHeaders h)
verifyAll :: forall (h :: (* -> *) -> *).
HasRequiredHeaders h =>
h (Checked (InvalidHeaders HandledSynthesized))
-> Either
     (InvalidHeaders HandledSynthesized)
     (h Undecorated, RequiredHeaders h)
verifyAll = (h Undecorated -> (h Undecorated, RequiredHeaders h))
-> Either (InvalidHeaders HandledSynthesized) (h Undecorated)
-> Either
     (InvalidHeaders HandledSynthesized)
     (h Undecorated, RequiredHeaders h)
forall a b.
(a -> b)
-> Either (InvalidHeaders HandledSynthesized) a
-> Either (InvalidHeaders HandledSynthesized) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap h Undecorated -> (h Undecorated, RequiredHeaders h)
aux (Either (InvalidHeaders HandledSynthesized) (h Undecorated)
 -> Either
      (InvalidHeaders HandledSynthesized)
      (h Undecorated, RequiredHeaders h))
-> (h (Checked (InvalidHeaders HandledSynthesized))
    -> Either (InvalidHeaders HandledSynthesized) (h Undecorated))
-> h (Checked (InvalidHeaders HandledSynthesized))
-> Either
     (InvalidHeaders HandledSynthesized)
     (h Undecorated, RequiredHeaders h)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. h (Checked (InvalidHeaders HandledSynthesized))
-> Either (InvalidHeaders HandledSynthesized) (h Undecorated)
forall (t :: (* -> *) -> *) (m :: * -> *).
(Traversable t, Applicative m) =>
t (DecoratedWith m) -> m (t Undecorated)
HKD.sequence
  where
    aux :: h Undecorated -> (h Undecorated, RequiredHeaders h)
    aux :: h Undecorated -> (h Undecorated, RequiredHeaders h)
aux h Undecorated
verifyd = (h Undecorated
verifyd, h Undecorated -> RequiredHeaders h
forall (h :: (* -> *) -> *).
HasRequiredHeaders h =>
h Undecorated -> RequiredHeaders h
requiredHeadersVerified h Undecorated
verifyd)

-- | Convenience wrapper, conditionally verifying all headers
verifyAllIf ::
     HasRequiredHeaders h
  => Bool
  -> h (Checked (InvalidHeaders HandledSynthesized))
  -> Either (InvalidHeaders HandledSynthesized) (RequiredHeaders h)
verifyAllIf :: forall (h :: (* -> *) -> *).
HasRequiredHeaders h =>
Bool
-> h (Checked (InvalidHeaders HandledSynthesized))
-> Either (InvalidHeaders HandledSynthesized) (RequiredHeaders h)
verifyAllIf Bool
False = h (Checked (InvalidHeaders HandledSynthesized))
-> Either (InvalidHeaders HandledSynthesized) (RequiredHeaders h)
forall (h :: (* -> *) -> *).
HasRequiredHeaders h =>
h (Checked (InvalidHeaders HandledSynthesized))
-> Either (InvalidHeaders HandledSynthesized) (RequiredHeaders h)
verifyRequired
verifyAllIf Bool
True  = ((h Undecorated, RequiredHeaders h) -> RequiredHeaders h)
-> Either
     (InvalidHeaders HandledSynthesized)
     (h Undecorated, RequiredHeaders h)
-> Either (InvalidHeaders HandledSynthesized) (RequiredHeaders h)
forall a b.
(a -> b)
-> Either (InvalidHeaders HandledSynthesized) a
-> Either (InvalidHeaders HandledSynthesized) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (h Undecorated, RequiredHeaders h) -> RequiredHeaders h
forall a b. (a, b) -> b
snd (Either
   (InvalidHeaders HandledSynthesized)
   (h Undecorated, RequiredHeaders h)
 -> Either (InvalidHeaders HandledSynthesized) (RequiredHeaders h))
-> (h (Checked (InvalidHeaders HandledSynthesized))
    -> Either
         (InvalidHeaders HandledSynthesized)
         (h Undecorated, RequiredHeaders h))
-> h (Checked (InvalidHeaders HandledSynthesized))
-> Either (InvalidHeaders HandledSynthesized) (RequiredHeaders h)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. h (Checked (InvalidHeaders HandledSynthesized))
-> Either
     (InvalidHeaders HandledSynthesized)
     (h Undecorated, RequiredHeaders h)
forall (h :: (* -> *) -> *).
HasRequiredHeaders h =>
h (Checked (InvalidHeaders HandledSynthesized))
-> Either
     (InvalidHeaders HandledSynthesized)
     (h Undecorated, RequiredHeaders h)
verifyAll

{-------------------------------------------------------------------------------
  Request
-------------------------------------------------------------------------------}

instance HasRequiredHeaders RequestHeaders_ where
  data RequiredHeaders RequestHeaders_ = RequiredRequestHeaders {
        RequiredHeaders RequestHeaders_ -> Maybe CompressionId
requiredRequestCompression :: Maybe CompressionId
      , RequiredHeaders RequestHeaders_ -> Maybe Timeout
requiredRequestTimeout     :: Maybe Timeout
      }

  requiredHeaders :: forall e.
RequestHeaders_ (Checked e)
-> Either e (RequiredHeaders RequestHeaders_)
requiredHeaders RequestHeaders_ (Checked e)
requestHeaders =
      Maybe CompressionId
-> Maybe Timeout -> RequiredHeaders RequestHeaders_
RequiredRequestHeaders
        (Maybe CompressionId
 -> Maybe Timeout -> RequiredHeaders RequestHeaders_)
-> Either e (Maybe CompressionId)
-> Either e (Maybe Timeout -> RequiredHeaders RequestHeaders_)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RequestHeaders_ (Checked e)
-> HKD (Checked e) (Maybe CompressionId)
forall (f :: * -> *).
RequestHeaders_ f -> HKD f (Maybe CompressionId)
requestCompression RequestHeaders_ (Checked e)
requestHeaders
        Either e (Maybe Timeout -> RequiredHeaders RequestHeaders_)
-> Either e (Maybe Timeout)
-> Either e (RequiredHeaders RequestHeaders_)
forall a b. Either e (a -> b) -> Either e a -> Either e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RequestHeaders_ (Checked e) -> HKD (Checked e) (Maybe Timeout)
forall (f :: * -> *). RequestHeaders_ f -> HKD f (Maybe Timeout)
requestTimeout     RequestHeaders_ (Checked e)
requestHeaders

{-------------------------------------------------------------------------------
  Response
-------------------------------------------------------------------------------}

instance HasRequiredHeaders ResponseHeaders_ where
  data RequiredHeaders ResponseHeaders_ = RequiredResponseHeaders {
      RequiredHeaders ResponseHeaders_ -> Maybe CompressionId
requiredResponseCompression :: Maybe CompressionId
    }

  requiredHeaders :: forall e.
ResponseHeaders_ (Checked e)
-> Either e (RequiredHeaders ResponseHeaders_)
requiredHeaders ResponseHeaders_ (Checked e)
responseHeaders =
      Maybe CompressionId -> RequiredHeaders ResponseHeaders_
RequiredResponseHeaders
        (Maybe CompressionId -> RequiredHeaders ResponseHeaders_)
-> Either e (Maybe CompressionId)
-> Either e (RequiredHeaders ResponseHeaders_)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResponseHeaders_ (Checked e)
-> HKD (Checked e) (Maybe CompressionId)
forall (f :: * -> *).
ResponseHeaders_ f -> HKD f (Maybe CompressionId)
responseCompression ResponseHeaders_ (Checked e)
responseHeaders

{-------------------------------------------------------------------------------
  Trailers-Only
-------------------------------------------------------------------------------}

instance HasRequiredHeaders TrailersOnly_ where
  data RequiredHeaders TrailersOnly_ = NoRequiredTrailers
  requiredHeaders :: forall e.
TrailersOnly_ (Checked e)
-> Either e (RequiredHeaders TrailersOnly_)
requiredHeaders TrailersOnly_ (Checked e)
_ = RequiredHeaders TrailersOnly_
-> Either e (RequiredHeaders TrailersOnly_)
forall a. a -> Either e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RequiredHeaders TrailersOnly_
NoRequiredTrailers