-- | Part of the gRPC spec that maps to HTTP2 pseudo-headers
--
-- Intended for unqualified import.
module Network.GRPC.Spec.Headers.PseudoHeaders (
    -- * Definition
    ServerHeaders(..)
  , ResourceHeaders(..)
  , PseudoHeaders(..)
    -- ** Individual headers
  , Method(..)
  , Scheme(..)
  , Address(..)
  , Path(..)
  , rpcPath
  ) where

import Data.ByteString qualified as Strict (ByteString)
import Data.Hashable
import Data.Proxy
import Network.Socket (HostName, PortNumber)

import Network.GRPC.Spec.RPC

{-------------------------------------------------------------------------------
  Definition

  This is not intended to be a general definition of pseudo-headers in HTTP2,
  but rather a reflection of how these pseudo-headers are used in gRPC.
-------------------------------------------------------------------------------}

-- | Partial pseudo headers: identify the server, but not a specific resource
data ServerHeaders = ServerHeaders {
      ServerHeaders -> Scheme
serverScheme  :: Scheme
    , ServerHeaders -> Address
serverAddress :: Address
    }
  deriving stock (Int -> ServerHeaders -> ShowS
[ServerHeaders] -> ShowS
ServerHeaders -> String
(Int -> ServerHeaders -> ShowS)
-> (ServerHeaders -> String)
-> ([ServerHeaders] -> ShowS)
-> Show ServerHeaders
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServerHeaders -> ShowS
showsPrec :: Int -> ServerHeaders -> ShowS
$cshow :: ServerHeaders -> String
show :: ServerHeaders -> String
$cshowList :: [ServerHeaders] -> ShowS
showList :: [ServerHeaders] -> ShowS
Show)

-- | Request pseudo-methods
--
-- <https://datatracker.ietf.org/doc/html/rfc7540#section-8.1.2.3>
data ResourceHeaders = ResourceHeaders {
      ResourceHeaders -> Method
resourceMethod :: Method
    , ResourceHeaders -> Path
resourcePath   :: Path
    }
  deriving stock (Int -> ResourceHeaders -> ShowS
[ResourceHeaders] -> ShowS
ResourceHeaders -> String
(Int -> ResourceHeaders -> ShowS)
-> (ResourceHeaders -> String)
-> ([ResourceHeaders] -> ShowS)
-> Show ResourceHeaders
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResourceHeaders -> ShowS
showsPrec :: Int -> ResourceHeaders -> ShowS
$cshow :: ResourceHeaders -> String
show :: ResourceHeaders -> String
$cshowList :: [ResourceHeaders] -> ShowS
showList :: [ResourceHeaders] -> ShowS
Show)

-- | All pseudo-headers
data PseudoHeaders = PseudoHeaders {
      PseudoHeaders -> ServerHeaders
serverHeaders   :: ServerHeaders
    , PseudoHeaders -> ResourceHeaders
resourceHeaders :: ResourceHeaders
    }
  deriving stock (Int -> PseudoHeaders -> ShowS
[PseudoHeaders] -> ShowS
PseudoHeaders -> String
(Int -> PseudoHeaders -> ShowS)
-> (PseudoHeaders -> String)
-> ([PseudoHeaders] -> ShowS)
-> Show PseudoHeaders
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PseudoHeaders -> ShowS
showsPrec :: Int -> PseudoHeaders -> ShowS
$cshow :: PseudoHeaders -> String
show :: PseudoHeaders -> String
$cshowList :: [PseudoHeaders] -> ShowS
showList :: [PseudoHeaders] -> ShowS
Show)

-- | Method
--
-- The only method supported by gRPC is @POST@.
--
-- See also <https://datatracker.ietf.org/doc/html/rfc7231#section-4>.
data Method = Post
  deriving stock (Int -> Method -> ShowS
[Method] -> ShowS
Method -> String
(Int -> Method -> ShowS)
-> (Method -> String) -> ([Method] -> ShowS) -> Show Method
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Method -> ShowS
showsPrec :: Int -> Method -> ShowS
$cshow :: Method -> String
show :: Method -> String
$cshowList :: [Method] -> ShowS
showList :: [Method] -> ShowS
Show)

-- | Scheme
--
-- See <https://datatracker.ietf.org/doc/html/rfc3986#section-3.1>.
data Scheme = Http | Https
  deriving stock (Int -> Scheme -> ShowS
[Scheme] -> ShowS
Scheme -> String
(Int -> Scheme -> ShowS)
-> (Scheme -> String) -> ([Scheme] -> ShowS) -> Show Scheme
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Scheme -> ShowS
showsPrec :: Int -> Scheme -> ShowS
$cshow :: Scheme -> String
show :: Scheme -> String
$cshowList :: [Scheme] -> ShowS
showList :: [Scheme] -> ShowS
Show)

-- | Address
--
-- The address of a server to connect to. This is not standard gRPC
-- nomenclature, but follows convention such as adopted by
-- [grpcurl](https://github.com/fullstorydev/grpcurl) and
-- [grpc-client-cli](https://github.com/vadimi/grpc-client-cli), which
-- distinguish between the /address/ of a server to connect to (hostname and
-- port), and the (optional) HTTP /authority/, which is an (optional) string to
-- be included as the HTTP2
-- [:authority](https://datatracker.ietf.org/doc/html/rfc3986#section-3.2)
-- [pseudo-header](https://datatracker.ietf.org/doc/html/rfc7540#section-8.1.2.3).
data Address = Address {
      -- | Hostname
      Address -> String
addressHost :: HostName

      -- | TCP port
    , Address -> PortNumber
addressPort :: PortNumber

      -- | Authority
      --
      -- When the authority is not specified, it defaults to @addressHost@.
      --
      -- This is used both for the HTTP2 @:authority@ pseudo-header as well
      -- as for TLS SNI (if using a secure connection).
      --
      -- Although the HTTP(2) specification allows the authority to include a
      -- port number, and many servers can accept this, this will /not/ work
      -- with TLS, and it is therefore recommended not to include a port number.
      -- Note that the HTTP2 spec explicitly /disallows/ the authority to
      -- include @userinfo@@.
    , Address -> Maybe String
addressAuthority :: Maybe String
    }
  deriving stock (Int -> Address -> ShowS
[Address] -> ShowS
Address -> String
(Int -> Address -> ShowS)
-> (Address -> String) -> ([Address] -> ShowS) -> Show Address
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Address -> ShowS
showsPrec :: Int -> Address -> ShowS
$cshow :: Address -> String
show :: Address -> String
$cshowList :: [Address] -> ShowS
showList :: [Address] -> ShowS
Show)

-- | Path
--
-- The gRPC spec specifies:
--
-- > Path → ":path" "/" Service-Name "/" {method name} # But see note below.
--
-- Moreover, it says:
--
-- > Path is case-sensitive. Some gRPC implementations may allow the Path format
-- > shown above to be overridden, but this functionality is strongly
-- > discouraged. gRPC does not go out of its way to break users that are using
-- > this kind of override, but we do not actively support it, and some
-- > functionality (e.g., service config support) will not work when the path is
-- > not of the form shown above.
--
-- We don't support these non-standard paths at all.
data Path = Path {
      Path -> ByteString
pathService :: Strict.ByteString
    , Path -> ByteString
pathMethod  :: Strict.ByteString
    }
  deriving stock (Int -> Path -> ShowS
[Path] -> ShowS
Path -> String
(Int -> Path -> ShowS)
-> (Path -> String) -> ([Path] -> ShowS) -> Show Path
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Path -> ShowS
showsPrec :: Int -> Path -> ShowS
$cshow :: Path -> String
show :: Path -> String
$cshowList :: [Path] -> ShowS
showList :: [Path] -> ShowS
Show, Path -> Path -> Bool
(Path -> Path -> Bool) -> (Path -> Path -> Bool) -> Eq Path
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Path -> Path -> Bool
== :: Path -> Path -> Bool
$c/= :: Path -> Path -> Bool
/= :: Path -> Path -> Bool
Eq)

instance Hashable Path where
  hashWithSalt :: Int -> Path -> Int
hashWithSalt Int
salt Path{ByteString
pathService :: Path -> ByteString
pathService :: ByteString
pathService, ByteString
pathMethod :: Path -> ByteString
pathMethod :: ByteString
pathMethod} =
      Int -> (ByteString, ByteString) -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (ByteString
pathService, ByteString
pathMethod)

-- | Construct path
rpcPath :: IsRPC rpc => Proxy rpc -> Path
rpcPath :: forall {k} (rpc :: k). IsRPC rpc => Proxy rpc -> Path
rpcPath Proxy rpc
proxy = ByteString -> ByteString -> Path
Path (Proxy rpc -> ByteString
forall k (rpc :: k).
(IsRPC rpc, HasCallStack) =>
Proxy rpc -> ByteString
rpcServiceName Proxy rpc
proxy) (Proxy rpc -> ByteString
forall k (rpc :: k).
(IsRPC rpc, HasCallStack) =>
Proxy rpc -> ByteString
rpcMethodName Proxy rpc
proxy)