-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

module Morley.Client.RPC.QueryFixedParam
  ( QueryFixedParam
  ) where

import Data.ByteString.Builder qualified as Builder
import Data.ByteString.Lazy qualified as LBS
import Servant.API (ToHttpApiData(..), type (:>))
import Servant.Client.Core (HasClient(..), appendToQueryString)

import Morley.Util.TypeLits (KnownSymbol, Symbol, symbolValT')

-- | Like servant's @QueryParam@, but the value is fixed as a
-- type-level string.
data QueryFixedParam (name :: Symbol) (value :: Symbol)

instance (KnownSymbol sym, KnownSymbol val, HasClient m api)
      => HasClient m (QueryFixedParam sym val :> api) where

  type Client m (QueryFixedParam sym val :> api) = Client m api

  clientWithRoute :: Proxy m
-> Proxy (QueryFixedParam sym val :> api)
-> Request
-> Client m (QueryFixedParam sym val :> api)
clientWithRoute Proxy m
pm Proxy (QueryFixedParam sym val :> api)
Proxy Request
req =
    Proxy m -> Proxy api -> Request -> Client m api
forall (m :: * -> *) api.
HasClient m api =>
Proxy m -> Proxy api -> Request -> Client m api
clientWithRoute Proxy m
pm (Proxy api
forall {k} (t :: k). Proxy t
Proxy :: Proxy api)
      (Request -> Client m api) -> Request -> Client m api
forall a b. (a -> b) -> a -> b
$ Text -> Maybe ByteString -> Request -> Request
appendToQueryString Text
pname (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeQueryParamValue Text
pval) Request
req
    where
      pname :: Text
pname = forall (s :: Symbol). KnownSymbol s => Text
symbolValT' @sym
      pval :: Text
pval  = forall (s :: Symbol). KnownSymbol s => Text
symbolValT' @val
      -- Lifted from the unreleased https://github.com/haskell-servant/servant/pull/1549
      encodeQueryParamValue :: Text -> ByteString
encodeQueryParamValue = ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Builder.toLazyByteString (Builder -> ByteString) -> (Text -> Builder) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
forall a. ToHttpApiData a => a -> Builder
toEncodedUrlPiece

  hoistClientMonad :: forall (mon :: * -> *) (mon' :: * -> *).
Proxy m
-> Proxy (QueryFixedParam sym val :> api)
-> (forall x. mon x -> mon' x)
-> Client mon (QueryFixedParam sym val :> api)
-> Client mon' (QueryFixedParam sym val :> api)
hoistClientMonad Proxy m
pm Proxy (QueryFixedParam sym val :> api)
_ forall x. mon x -> mon' x
f Client mon (QueryFixedParam sym val :> api)
cl = Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
forall (m :: * -> *) api (mon :: * -> *) (mon' :: * -> *).
HasClient m api =>
Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
hoistClientMonad Proxy m
pm (Proxy api
forall {k} (t :: k). Proxy t
Proxy :: Proxy api) forall x. mon x -> mon' x
f Client mon api
Client mon (QueryFixedParam sym val :> api)
cl