{-# LANGUAGE UndecidableInstances #-}
module Tendermint.SDK.BaseApp.Query.Router
  ( HasQueryRouter(..)
  , methodRouter
  ) where

import           Control.Monad                        (join)
import           Data.Kind                            (Type)
import           Data.Proxy
import           Data.String.Conversions              (cs)
import           Data.Text                            (Text)
import           GHC.TypeLits                         (KnownSymbol, symbolVal)
import           Network.ABCI.Types.Messages.Response as Response
import           Network.HTTP.Types.URI               (QueryText,
                                                       parseQueryText)
import           Polysemy                             (Member, Sem)
import           Polysemy.Tagged                      (Tagged)
import           Servant.API
import           Servant.API.Modifiers                (FoldLenient,
                                                       FoldRequired,
                                                       RequestArgument,
                                                       unfoldRequestArgument)
import           Tendermint.SDK.BaseApp.Query.Effect  (QueryEffs, runQuery)
import           Tendermint.SDK.BaseApp.Query.Types   (EmptyQueryServer (..),
                                                       Leaf, QA, QueryArgs (..),
                                                       QueryData (..),
                                                       QueryRequest (..),
                                                       QueryResult (..))
import qualified Tendermint.SDK.BaseApp.Router        as R
import           Tendermint.SDK.BaseApp.Store         (ReadStore, Scope (..))
import           Tendermint.SDK.Codec                 (HasCodec (..))
import           Tendermint.SDK.Types.Effects         ((:&))
import           Web.HttpApiData                      (parseUrlPieceMaybe)

--------------------------------------------------------------------------------

-- | This class is used to construct a router given a 'layout' type. The layout
-- | is constructed using the combinators that appear in the instances here, no other
-- | Servant combinators are recognized.
class HasQueryRouter layout r where
  -- | A routeQ handler.
  type RouteQ layout r :: Type
  -- | Transform a routeQ handler into a 'Router'.
  routeQ
    :: Proxy layout
    -> Proxy r
    -> R.Delayed (Sem r) env QueryRequest (RouteQ layout (QueryEffs :& r))
    -> R.Router env r QueryRequest Response.Query

  hoistQueryRouter :: Proxy layout -> Proxy r -> (forall a. Sem s a -> Sem s' a) -> RouteQ layout s -> RouteQ layout s'

instance (HasQueryRouter a r, HasQueryRouter b r) => HasQueryRouter (a :<|> b) r where
  type RouteQ (a :<|> b) r = RouteQ a r :<|> RouteQ b r

  routeQ :: Proxy (a :<|> b)
-> Proxy r
-> Delayed
     (Sem r) env QueryRequest (RouteQ (a :<|> b) (QueryEffs :& r))
-> Router env r QueryRequest Query
routeQ _ pr :: Proxy r
pr server :: Delayed
  (Sem r) env QueryRequest (RouteQ (a :<|> b) (QueryEffs :& r))
server =
     Router env r QueryRequest Query
-> Router env r QueryRequest Query
-> Router env r QueryRequest Query
forall env a. Router' env a -> Router' env a -> Router' env a
R.choice (Proxy a
-> Proxy r
-> Delayed (Sem r) env QueryRequest (RouteQ a (QueryEffs :& r))
-> Router env r QueryRequest Query
forall k (layout :: k) (r :: EffectRow) env.
HasQueryRouter layout r =>
Proxy layout
-> Proxy r
-> Delayed
     (Sem r) env QueryRequest (RouteQ layout (QueryEffs :& r))
-> Router env r QueryRequest Query
routeQ (Proxy a
forall k (t :: k). Proxy t
Proxy @a) Proxy r
pr ((\ (a :: RouteQ a (ReadStore : Error AppError : r)
a :<|> _) -> RouteQ a (ReadStore : Error AppError : r)
a) ((RouteQ a (ReadStore : Error AppError : r)
  :<|> RouteQ b (ReadStore : Error AppError : r))
 -> RouteQ a (ReadStore : Error AppError : r))
-> Delayed
     (Sem r)
     env
     QueryRequest
     (RouteQ a (ReadStore : Error AppError : r)
      :<|> RouteQ b (ReadStore : Error AppError : r))
-> Delayed
     (Sem r)
     env
     QueryRequest
     (RouteQ a (ReadStore : Error AppError : r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Delayed
  (Sem r)
  env
  QueryRequest
  (RouteQ a (ReadStore : Error AppError : r)
   :<|> RouteQ b (ReadStore : Error AppError : r))
Delayed
  (Sem r) env QueryRequest (RouteQ (a :<|> b) (QueryEffs :& r))
server))
              (Proxy b
-> Proxy r
-> Delayed (Sem r) env QueryRequest (RouteQ b (QueryEffs :& r))
-> Router env r QueryRequest Query
forall k (layout :: k) (r :: EffectRow) env.
HasQueryRouter layout r =>
Proxy layout
-> Proxy r
-> Delayed
     (Sem r) env QueryRequest (RouteQ layout (QueryEffs :& r))
-> Router env r QueryRequest Query
routeQ (Proxy b
forall k (t :: k). Proxy t
Proxy @b) Proxy r
pr ((\ (_ :<|> b :: RouteQ b (ReadStore : Error AppError : r)
b) -> RouteQ b (ReadStore : Error AppError : r)
b) ((RouteQ a (ReadStore : Error AppError : r)
  :<|> RouteQ b (ReadStore : Error AppError : r))
 -> RouteQ b (ReadStore : Error AppError : r))
-> Delayed
     (Sem r)
     env
     QueryRequest
     (RouteQ a (ReadStore : Error AppError : r)
      :<|> RouteQ b (ReadStore : Error AppError : r))
-> Delayed
     (Sem r)
     env
     QueryRequest
     (RouteQ b (ReadStore : Error AppError : r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Delayed
  (Sem r)
  env
  QueryRequest
  (RouteQ a (ReadStore : Error AppError : r)
   :<|> RouteQ b (ReadStore : Error AppError : r))
Delayed
  (Sem r) env QueryRequest (RouteQ (a :<|> b) (QueryEffs :& r))
server))
  hoistQueryRouter :: Proxy (a :<|> b)
-> Proxy r
-> (forall a. Sem s a -> Sem s' a)
-> RouteQ (a :<|> b) s
-> RouteQ (a :<|> b) s'
hoistQueryRouter _ pr :: Proxy r
pr nat :: forall a. Sem s a -> Sem s' a
nat (a :<|> b) =
    Proxy a
-> Proxy r
-> (forall a. Sem s a -> Sem s' a)
-> RouteQ a s
-> RouteQ a s'
forall k (layout :: k) (r :: EffectRow) (s :: EffectRow)
       (s' :: EffectRow).
HasQueryRouter layout r =>
Proxy layout
-> Proxy r
-> (forall a. Sem s a -> Sem s' a)
-> RouteQ layout s
-> RouteQ layout s'
hoistQueryRouter (Proxy a
forall k (t :: k). Proxy t
Proxy @a) Proxy r
pr forall a. Sem s a -> Sem s' a
nat RouteQ a s
a RouteQ a s' -> RouteQ b s' -> RouteQ a s' :<|> RouteQ b s'
forall a b. a -> b -> a :<|> b
:<|> Proxy b
-> Proxy r
-> (forall a. Sem s a -> Sem s' a)
-> RouteQ b s
-> RouteQ b s'
forall k (layout :: k) (r :: EffectRow) (s :: EffectRow)
       (s' :: EffectRow).
HasQueryRouter layout r =>
Proxy layout
-> Proxy r
-> (forall a. Sem s a -> Sem s' a)
-> RouteQ layout s
-> RouteQ layout s'
hoistQueryRouter (Proxy b
forall k (t :: k). Proxy t
Proxy @b) Proxy r
pr forall a. Sem s a -> Sem s' a
nat RouteQ b s
b

instance (HasQueryRouter sublayout r, KnownSymbol path) => HasQueryRouter (path :> sublayout) r where

  type RouteQ (path :> sublayout) r = RouteQ sublayout r

  routeQ :: Proxy (path :> sublayout)
-> Proxy r
-> Delayed
     (Sem r)
     env
     QueryRequest
     (RouteQ (path :> sublayout) (QueryEffs :& r))
-> Router env r QueryRequest Query
routeQ _ pr :: Proxy r
pr subserver :: Delayed
  (Sem r)
  env
  QueryRequest
  (RouteQ (path :> sublayout) (QueryEffs :& r))
subserver =
    Text
-> Router env r QueryRequest Query
-> Router env r QueryRequest Query
forall env a. Text -> Router' env a -> Router' env a
R.pathRouter (String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Proxy path -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal Proxy path
proxyPath)) (Proxy sublayout
-> Proxy r
-> Delayed
     (Sem r) env QueryRequest (RouteQ sublayout (QueryEffs :& r))
-> Router env r QueryRequest Query
forall k (layout :: k) (r :: EffectRow) env.
HasQueryRouter layout r =>
Proxy layout
-> Proxy r
-> Delayed
     (Sem r) env QueryRequest (RouteQ layout (QueryEffs :& r))
-> Router env r QueryRequest Query
routeQ (Proxy sublayout
forall k (t :: k). Proxy t
Proxy :: Proxy sublayout) Proxy r
pr Delayed
  (Sem r) env QueryRequest (RouteQ sublayout (QueryEffs :& r))
Delayed
  (Sem r)
  env
  QueryRequest
  (RouteQ (path :> sublayout) (QueryEffs :& r))
subserver)
    where proxyPath :: Proxy path
proxyPath = Proxy path
forall k (t :: k). Proxy t
Proxy :: Proxy path

  hoistQueryRouter :: Proxy (path :> sublayout)
-> Proxy r
-> (forall a. Sem s a -> Sem s' a)
-> RouteQ (path :> sublayout) s
-> RouteQ (path :> sublayout) s'
hoistQueryRouter _ pr :: Proxy r
pr nat :: forall a. Sem s a -> Sem s' a
nat = Proxy sublayout
-> Proxy r
-> (forall a. Sem s a -> Sem s' a)
-> RouteQ sublayout s
-> RouteQ sublayout s'
forall k (layout :: k) (r :: EffectRow) (s :: EffectRow)
       (s' :: EffectRow).
HasQueryRouter layout r =>
Proxy layout
-> Proxy r
-> (forall a. Sem s a -> Sem s' a)
-> RouteQ layout s
-> RouteQ layout s'
hoistQueryRouter (Proxy sublayout
forall k (t :: k). Proxy t
Proxy @sublayout) Proxy r
pr forall a. Sem s a -> Sem s' a
nat

instance ( HasQueryRouter sublayout r, KnownSymbol sym, FromHttpApiData a
         , SBoolI (FoldRequired mods), SBoolI (FoldLenient mods)
         ) => HasQueryRouter (QueryParam' mods sym a :> sublayout) r where

  type RouteQ (QueryParam' mods sym a :> sublayout) r = RequestArgument mods a -> RouteQ sublayout r

  routeQ :: Proxy (QueryParam' mods sym a :> sublayout)
-> Proxy r
-> Delayed
     (Sem r)
     env
     QueryRequest
     (RouteQ (QueryParam' mods sym a :> sublayout) (QueryEffs :& r))
-> Router env r QueryRequest Query
routeQ _ pr :: Proxy r
pr subserver :: Delayed
  (Sem r)
  env
  QueryRequest
  (RouteQ (QueryParam' mods sym a :> sublayout) (QueryEffs :& r))
subserver =
    let querytext :: QueryRequest -> Network.HTTP.Types.URI.QueryText
        querytext :: QueryRequest -> QueryText
querytext q :: QueryRequest
q = ByteString -> QueryText
parseQueryText (ByteString -> QueryText)
-> (Text -> ByteString) -> Text -> QueryText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> QueryText) -> Text -> QueryText
forall a b. (a -> b) -> a -> b
$ QueryRequest -> Text
queryRequestParamString QueryRequest
q
        paramname :: Text
paramname = String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy sym -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy sym
forall k (t :: k). Proxy t
Proxy :: Proxy sym)
        parseParam :: QueryRequest
-> DelayedM (Sem r) QueryRequest (RequestArgument mods a)
parseParam q :: QueryRequest
q = Proxy mods
-> DelayedM (Sem r) QueryRequest (RequestArgument mods a)
-> (Text -> DelayedM (Sem r) QueryRequest (RequestArgument mods a))
-> Maybe (Either Text a)
-> DelayedM (Sem r) QueryRequest (RequestArgument mods a)
forall (mods :: [*]) (m :: * -> *) a.
(Monad m, SBoolI (FoldRequired mods), SBoolI (FoldLenient mods)) =>
Proxy mods
-> m (RequestArgument mods a)
-> (Text -> m (RequestArgument mods a))
-> Maybe (Either Text a)
-> m (RequestArgument mods a)
unfoldRequestArgument (Proxy mods
forall k (t :: k). Proxy t
Proxy :: Proxy mods) DelayedM (Sem r) QueryRequest (RequestArgument mods a)
errReq Text -> DelayedM (Sem r) QueryRequest (RequestArgument mods a)
errSt Maybe (Either Text a)
mev
          where
            mev :: Maybe (Either Text a)
            mev :: Maybe (Either Text a)
mev = (Text -> Either Text a) -> Maybe Text -> Maybe (Either Text a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Either Text a
forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam (Maybe Text -> Maybe (Either Text a))
-> Maybe Text -> Maybe (Either Text a)
forall a b. (a -> b) -> a -> b
$ Maybe (Maybe Text) -> Maybe Text
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe Text) -> Maybe Text)
-> Maybe (Maybe Text) -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> QueryText -> Maybe (Maybe Text)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
paramname (QueryText -> Maybe (Maybe Text))
-> QueryText -> Maybe (Maybe Text)
forall a b. (a -> b) -> a -> b
$ QueryRequest -> QueryText
querytext QueryRequest
q
            errReq :: DelayedM (Sem r) QueryRequest (RequestArgument mods a)
errReq = RouterError
-> DelayedM (Sem r) QueryRequest (RequestArgument mods a)
forall (m :: * -> *) req a.
Monad m =>
RouterError -> DelayedM m req a
R.delayedFail (RouterError
 -> DelayedM (Sem r) QueryRequest (RequestArgument mods a))
-> RouterError
-> DelayedM (Sem r) QueryRequest (RequestArgument mods a)
forall a b. (a -> b) -> a -> b
$ Text -> RouterError
R.InvalidRequest ("Query parameter " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs Text
paramname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " is required.")
            errSt :: Text -> DelayedM (Sem r) QueryRequest (RequestArgument mods a)
errSt e :: Text
e = RouterError
-> DelayedM (Sem r) QueryRequest (RequestArgument mods a)
forall (m :: * -> *) req a.
Monad m =>
RouterError -> DelayedM m req a
R.delayedFail (RouterError
 -> DelayedM (Sem r) QueryRequest (RequestArgument mods a))
-> RouterError
-> DelayedM (Sem r) QueryRequest (RequestArgument mods a)
forall a b. (a -> b) -> a -> b
$ Text -> RouterError
R.InvalidRequest ("Error parsing query param " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs Text
paramname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs Text
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ".")
        delayed :: Delayed
  (Sem r)
  env
  QueryRequest
  (RouteQ sublayout (ReadStore : Error AppError : r))
delayed = Delayed
  (Sem r)
  env
  QueryRequest
  (RequestArgument mods a
   -> RouteQ sublayout (ReadStore : Error AppError : r))
-> DelayedM (Sem r) QueryRequest (RequestArgument mods a)
-> Delayed
     (Sem r)
     env
     QueryRequest
     (RouteQ sublayout (ReadStore : Error AppError : r))
forall (m :: * -> *) env req a b.
Monad m =>
Delayed m env req (a -> b)
-> DelayedM m req a -> Delayed m env req b
R.addParameter Delayed
  (Sem r)
  env
  QueryRequest
  (RouteQ (QueryParam' mods sym a :> sublayout) (QueryEffs :& r))
Delayed
  (Sem r)
  env
  QueryRequest
  (RequestArgument mods a
   -> RouteQ sublayout (ReadStore : Error AppError : r))
subserver (DelayedM (Sem r) QueryRequest (RequestArgument mods a)
 -> Delayed
      (Sem r)
      env
      QueryRequest
      (RouteQ sublayout (ReadStore : Error AppError : r)))
-> DelayedM (Sem r) QueryRequest (RequestArgument mods a)
-> Delayed
     (Sem r)
     env
     QueryRequest
     (RouteQ sublayout (ReadStore : Error AppError : r))
forall a b. (a -> b) -> a -> b
$ (QueryRequest
 -> DelayedM (Sem r) QueryRequest (RequestArgument mods a))
-> DelayedM (Sem r) QueryRequest (RequestArgument mods a)
forall (m :: * -> *) req a.
Monad m =>
(req -> DelayedM m req a) -> DelayedM m req a
R.withRequest QueryRequest
-> DelayedM (Sem r) QueryRequest (RequestArgument mods a)
parseParam
    in Proxy sublayout
-> Proxy r
-> Delayed
     (Sem r) env QueryRequest (RouteQ sublayout (QueryEffs :& r))
-> Router env r QueryRequest Query
forall k (layout :: k) (r :: EffectRow) env.
HasQueryRouter layout r =>
Proxy layout
-> Proxy r
-> Delayed
     (Sem r) env QueryRequest (RouteQ layout (QueryEffs :& r))
-> Router env r QueryRequest Query
routeQ (Proxy sublayout
forall k (t :: k). Proxy t
Proxy :: Proxy sublayout) Proxy r
pr Delayed
  (Sem r)
  env
  QueryRequest
  (RouteQ sublayout (ReadStore : Error AppError : r))
Delayed
  (Sem r) env QueryRequest (RouteQ sublayout (QueryEffs :& r))
delayed

  hoistQueryRouter :: Proxy (QueryParam' mods sym a :> sublayout)
-> Proxy r
-> (forall a. Sem s a -> Sem s' a)
-> RouteQ (QueryParam' mods sym a :> sublayout) s
-> RouteQ (QueryParam' mods sym a :> sublayout) s'
hoistQueryRouter _ pr :: Proxy r
pr nat :: forall a. Sem s a -> Sem s' a
nat f :: RouteQ (QueryParam' mods sym a :> sublayout) s
f = Proxy sublayout
-> Proxy r
-> (forall a. Sem s a -> Sem s' a)
-> RouteQ sublayout s
-> RouteQ sublayout s'
forall k (layout :: k) (r :: EffectRow) (s :: EffectRow)
       (s' :: EffectRow).
HasQueryRouter layout r =>
Proxy layout
-> Proxy r
-> (forall a. Sem s a -> Sem s' a)
-> RouteQ layout s
-> RouteQ layout s'
hoistQueryRouter (Proxy sublayout
forall k (t :: k). Proxy t
Proxy @sublayout) Proxy r
pr forall a. Sem s a -> Sem s' a
nat (RouteQ sublayout s -> RouteQ sublayout s')
-> (RequestArgument mods a -> RouteQ sublayout s)
-> RequestArgument mods a
-> RouteQ sublayout s'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RouteQ (QueryParam' mods sym a :> sublayout) s
RequestArgument mods a -> RouteQ sublayout s
f

instance (FromHttpApiData a, HasQueryRouter sublayout r) => HasQueryRouter (Capture' mods capture a :> sublayout) r where

  type RouteQ (Capture' mods capture a :> sublayout) r = a -> RouteQ sublayout r

  routeQ :: Proxy (Capture' mods capture a :> sublayout)
-> Proxy r
-> Delayed
     (Sem r)
     env
     QueryRequest
     (RouteQ (Capture' mods capture a :> sublayout) (QueryEffs :& r))
-> Router env r QueryRequest Query
routeQ _ pr :: Proxy r
pr subserver :: Delayed
  (Sem r)
  env
  QueryRequest
  (RouteQ (Capture' mods capture a :> sublayout) (QueryEffs :& r))
subserver =
    Router' (Text, env) (Application (Sem r) QueryRequest Query)
-> Router env r QueryRequest Query
forall env a. Router' (Text, env) a -> Router' env a
R.CaptureRouter (Router' (Text, env) (Application (Sem r) QueryRequest Query)
 -> Router env r QueryRequest Query)
-> Router' (Text, env) (Application (Sem r) QueryRequest Query)
-> Router env r QueryRequest Query
forall a b. (a -> b) -> a -> b
$
        Proxy sublayout
-> Proxy r
-> Delayed
     (Sem r)
     (Text, env)
     QueryRequest
     (RouteQ sublayout (QueryEffs :& r))
-> Router' (Text, env) (Application (Sem r) QueryRequest Query)
forall k (layout :: k) (r :: EffectRow) env.
HasQueryRouter layout r =>
Proxy layout
-> Proxy r
-> Delayed
     (Sem r) env QueryRequest (RouteQ layout (QueryEffs :& r))
-> Router env r QueryRequest Query
routeQ (Proxy sublayout
forall k (t :: k). Proxy t
Proxy :: Proxy sublayout)
              Proxy r
pr
              (Delayed
  (Sem r)
  env
  QueryRequest
  (a -> RouteQ sublayout (ReadStore : Error AppError : r))
-> (Text -> DelayedM (Sem r) QueryRequest a)
-> Delayed
     (Sem r)
     (Text, env)
     QueryRequest
     (RouteQ sublayout (ReadStore : Error AppError : r))
forall (m :: * -> *) env req a b captured.
Monad m =>
Delayed m env req (a -> b)
-> (captured -> DelayedM m req a)
-> Delayed m (captured, env) req b
R.addCapture Delayed
  (Sem r)
  env
  QueryRequest
  (RouteQ (Capture' mods capture a :> sublayout) (QueryEffs :& r))
Delayed
  (Sem r)
  env
  QueryRequest
  (a -> RouteQ sublayout (ReadStore : Error AppError : r))
subserver ((Text -> DelayedM (Sem r) QueryRequest a)
 -> Delayed
      (Sem r)
      (Text, env)
      QueryRequest
      (RouteQ sublayout (QueryEffs :& r)))
-> (Text -> DelayedM (Sem r) QueryRequest a)
-> Delayed
     (Sem r)
     (Text, env)
     QueryRequest
     (RouteQ sublayout (QueryEffs :& r))
forall a b. (a -> b) -> a -> b
$ \ txt :: Text
txt -> case Text -> Maybe a
forall a. FromHttpApiData a => Text -> Maybe a
parseUrlPieceMaybe Text
txt of
                 Nothing -> RouterError -> DelayedM (Sem r) QueryRequest a
forall (m :: * -> *) req a.
Monad m =>
RouterError -> DelayedM m req a
R.delayedFail RouterError
R.PathNotFound
                 Just v :: a
v  -> a -> DelayedM (Sem r) QueryRequest a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v
              )
  hoistQueryRouter :: Proxy (Capture' mods capture a :> sublayout)
-> Proxy r
-> (forall a. Sem s a -> Sem s' a)
-> RouteQ (Capture' mods capture a :> sublayout) s
-> RouteQ (Capture' mods capture a :> sublayout) s'
hoistQueryRouter _ pr :: Proxy r
pr nat :: forall a. Sem s a -> Sem s' a
nat f :: RouteQ (Capture' mods capture a :> sublayout) s
f = Proxy sublayout
-> Proxy r
-> (forall a. Sem s a -> Sem s' a)
-> RouteQ sublayout s
-> RouteQ sublayout s'
forall k (layout :: k) (r :: EffectRow) (s :: EffectRow)
       (s' :: EffectRow).
HasQueryRouter layout r =>
Proxy layout
-> Proxy r
-> (forall a. Sem s a -> Sem s' a)
-> RouteQ layout s
-> RouteQ layout s'
hoistQueryRouter (Proxy sublayout
forall k (t :: k). Proxy t
Proxy @sublayout) Proxy r
pr forall a. Sem s a -> Sem s' a
nat (RouteQ sublayout s -> RouteQ sublayout s')
-> (a -> RouteQ sublayout s) -> a -> RouteQ sublayout s'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RouteQ (Capture' mods capture a :> sublayout) s
a -> RouteQ sublayout s
f

instance (QueryData a, HasQueryRouter sublayout r) => HasQueryRouter (QA a :> sublayout) r where

  type RouteQ (QA a :> sublayout) r = QueryArgs a -> RouteQ sublayout r

  routeQ :: Proxy (QA a :> sublayout)
-> Proxy r
-> Delayed
     (Sem r)
     env
     QueryRequest
     (RouteQ (QA a :> sublayout) (QueryEffs :& r))
-> Router env r QueryRequest Query
routeQ _ pr :: Proxy r
pr subserver :: Delayed
  (Sem r)
  env
  QueryRequest
  (RouteQ (QA a :> sublayout) (QueryEffs :& r))
subserver =
    let parseQueryArgs :: QueryRequest -> DelayedM m req (QueryArgs a)
parseQueryArgs QueryRequest{..} = case Base64String -> Either String a
forall a. QueryData a => Base64String -> Either String a
fromQueryData Base64String
queryRequestData of
          Left e :: String
e -> RouterError -> DelayedM m req (QueryArgs a)
forall (m :: * -> *) req a.
Monad m =>
RouterError -> DelayedM m req a
R.delayedFail (RouterError -> DelayedM m req (QueryArgs a))
-> RouterError -> DelayedM m req (QueryArgs a)
forall a b. (a -> b) -> a -> b
$ Text -> RouterError
R.InvalidRequest ("Error parsing query data, " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ".")
          Right a :: a
a -> QueryArgs a -> DelayedM m req (QueryArgs a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure QueryArgs :: forall a. Bool -> a -> Int64 -> QueryArgs a
QueryArgs
            { queryArgsData :: a
queryArgsData = a
a
            , queryArgsHeight :: Int64
queryArgsHeight = Int64
queryRequestHeight
            , queryArgsProve :: Bool
queryArgsProve = Bool
queryRequestProve
            }
        delayed :: Delayed
  (Sem r)
  env
  QueryRequest
  (RouteQ sublayout (ReadStore : Error AppError : r))
delayed = Delayed
  (Sem r)
  env
  QueryRequest
  (QueryArgs a -> RouteQ sublayout (ReadStore : Error AppError : r))
-> DelayedM (Sem r) QueryRequest (QueryArgs a)
-> Delayed
     (Sem r)
     env
     QueryRequest
     (RouteQ sublayout (ReadStore : Error AppError : r))
forall (m :: * -> *) env req a b.
Monad m =>
Delayed m env req (a -> b)
-> DelayedM m req a -> Delayed m env req b
R.addBody Delayed
  (Sem r)
  env
  QueryRequest
  (RouteQ (QA a :> sublayout) (QueryEffs :& r))
Delayed
  (Sem r)
  env
  QueryRequest
  (QueryArgs a -> RouteQ sublayout (ReadStore : Error AppError : r))
subserver (DelayedM (Sem r) QueryRequest (QueryArgs a)
 -> Delayed
      (Sem r)
      env
      QueryRequest
      (RouteQ sublayout (ReadStore : Error AppError : r)))
-> DelayedM (Sem r) QueryRequest (QueryArgs a)
-> Delayed
     (Sem r)
     env
     QueryRequest
     (RouteQ sublayout (ReadStore : Error AppError : r))
forall a b. (a -> b) -> a -> b
$ (QueryRequest -> DelayedM (Sem r) QueryRequest (QueryArgs a))
-> DelayedM (Sem r) QueryRequest (QueryArgs a)
forall (m :: * -> *) req a.
Monad m =>
(req -> DelayedM m req a) -> DelayedM m req a
R.withRequest QueryRequest -> DelayedM (Sem r) QueryRequest (QueryArgs a)
forall a (m :: * -> *) req.
(QueryData a, Monad m) =>
QueryRequest -> DelayedM m req (QueryArgs a)
parseQueryArgs
    in Proxy sublayout
-> Proxy r
-> Delayed
     (Sem r) env QueryRequest (RouteQ sublayout (QueryEffs :& r))
-> Router env r QueryRequest Query
forall k (layout :: k) (r :: EffectRow) env.
HasQueryRouter layout r =>
Proxy layout
-> Proxy r
-> Delayed
     (Sem r) env QueryRequest (RouteQ layout (QueryEffs :& r))
-> Router env r QueryRequest Query
routeQ (Proxy sublayout
forall k (t :: k). Proxy t
Proxy :: Proxy sublayout) Proxy r
pr Delayed
  (Sem r)
  env
  QueryRequest
  (RouteQ sublayout (ReadStore : Error AppError : r))
Delayed
  (Sem r) env QueryRequest (RouteQ sublayout (QueryEffs :& r))
delayed

  hoistQueryRouter :: Proxy (QA a :> sublayout)
-> Proxy r
-> (forall a. Sem s a -> Sem s' a)
-> RouteQ (QA a :> sublayout) s
-> RouteQ (QA a :> sublayout) s'
hoistQueryRouter _ pr :: Proxy r
pr nat :: forall a. Sem s a -> Sem s' a
nat f :: RouteQ (QA a :> sublayout) s
f = Proxy sublayout
-> Proxy r
-> (forall a. Sem s a -> Sem s' a)
-> RouteQ sublayout s
-> RouteQ sublayout s'
forall k (layout :: k) (r :: EffectRow) (s :: EffectRow)
       (s' :: EffectRow).
HasQueryRouter layout r =>
Proxy layout
-> Proxy r
-> (forall a. Sem s a -> Sem s' a)
-> RouteQ layout s
-> RouteQ layout s'
hoistQueryRouter (Proxy sublayout
forall k (t :: k). Proxy t
Proxy @sublayout) Proxy r
pr forall a. Sem s a -> Sem s' a
nat (RouteQ sublayout s -> RouteQ sublayout s')
-> (QueryArgs a -> RouteQ sublayout s)
-> QueryArgs a
-> RouteQ sublayout s'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RouteQ (QA a :> sublayout) s
QueryArgs a -> RouteQ sublayout s
f

instance (Member (Tagged 'QueryAndMempool ReadStore) r, HasCodec a) => HasQueryRouter (Leaf a) r where

   type RouteQ (Leaf a) r = Sem r (QueryResult a)
   routeQ :: Proxy (Leaf a)
-> Proxy r
-> Delayed
     (Sem r) env QueryRequest (RouteQ (Leaf a) (QueryEffs :& r))
-> Router env r QueryRequest Query
routeQ _ _ = Delayed (Sem r) env QueryRequest (RouteQ (Leaf a) (QueryEffs :& r))
-> Router env r QueryRequest Query
forall a (r :: EffectRow) env req.
(HasCodec a, Member (Tagged 'QueryAndMempool ReadStore) r) =>
Delayed (Sem r) env req (Sem (QueryEffs :& r) (QueryResult a))
-> Router env r req Query
methodRouter
   hoistQueryRouter :: Proxy (Leaf a)
-> Proxy r
-> (forall a. Sem s a -> Sem s' a)
-> RouteQ (Leaf a) s
-> RouteQ (Leaf a) s'
hoistQueryRouter _ _ = (forall a. Sem s a -> Sem s' a)
-> RouteQ (Leaf a) s -> RouteQ (Leaf a) s'
forall a b. (a -> b) -> a -> b
($)

instance HasQueryRouter EmptyQueryServer r where
  type RouteQ EmptyQueryServer r = EmptyQueryServer
  routeQ :: Proxy EmptyQueryServer
-> Proxy r
-> Delayed
     (Sem r) env QueryRequest (RouteQ EmptyQueryServer (QueryEffs :& r))
-> Router env r QueryRequest Query
routeQ _ _ _ = Map Text (Router env r QueryRequest Query)
-> [env -> Application (Sem r) QueryRequest Query]
-> Router env r QueryRequest Query
forall env a.
Map Text (Router' env a) -> [env -> a] -> Router' env a
R.StaticRouter Map Text (Router env r QueryRequest Query)
forall a. Monoid a => a
mempty [env -> Application (Sem r) QueryRequest Query]
forall a. Monoid a => a
mempty
  hoistQueryRouter :: Proxy EmptyQueryServer
-> Proxy r
-> (forall a. Sem s a -> Sem s' a)
-> RouteQ EmptyQueryServer s
-> RouteQ EmptyQueryServer s'
hoistQueryRouter _ _ _ = RouteQ EmptyQueryServer s -> RouteQ EmptyQueryServer s'
forall a. a -> a
id

--------------------------------------------------------------------------------

methodRouter
  :: HasCodec a
  => Member (Tagged 'QueryAndMempool ReadStore) r
  => R.Delayed (Sem r) env req (Sem (QueryEffs :& r) (QueryResult a))
  -> R.Router env r req Response.Query
methodRouter :: Delayed (Sem r) env req (Sem (QueryEffs :& r) (QueryResult a))
-> Router env r req Query
methodRouter action :: Delayed (Sem r) env req (Sem (QueryEffs :& r) (QueryResult a))
action =
  let route' :: env -> req -> Sem r (RouteResult Query)
route' env :: env
env q :: req
q = Delayed (Sem r) env req (Sem r Query)
-> env
-> req
-> (Query -> Sem r (RouteResult Query))
-> Sem r (RouteResult Query)
forall (r :: EffectRow) env req a b.
Delayed (Sem r) env req (Sem r a)
-> env
-> req
-> (a -> Sem r (RouteResult b))
-> Sem r (RouteResult b)
R.runAction (Sem (ReadStore : Error AppError : r) (QueryResult a) -> Sem r Query
forall a (r :: EffectRow).
(HasCodec a, Member (Tagged 'QueryAndMempool ReadStore) r) =>
Sem (QueryEffs :& r) (QueryResult a) -> Sem r Query
runQuery (Sem (ReadStore : Error AppError : r) (QueryResult a)
 -> Sem r Query)
-> Delayed
     (Sem r)
     env
     req
     (Sem (ReadStore : Error AppError : r) (QueryResult a))
-> Delayed (Sem r) env req (Sem r Query)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Delayed
  (Sem r)
  env
  req
  (Sem (ReadStore : Error AppError : r) (QueryResult a))
Delayed (Sem r) env req (Sem (QueryEffs :& r) (QueryResult a))
action) env
env req
q (RouteResult Query -> Sem r (RouteResult Query)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RouteResult Query -> Sem r (RouteResult Query))
-> (Query -> RouteResult Query)
-> Query
-> Sem r (RouteResult Query)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> RouteResult Query
forall a. a -> RouteResult a
R.Route)
  in (env -> req -> Sem r (RouteResult Query)) -> Router env r req Query
forall env a. (env -> a) -> Router' env a
R.leafRouter env -> req -> Sem r (RouteResult Query)
route'