{-# LANGUAGE UndecidableInstances #-}

module Tendermint.SDK.BaseApp.Query.Store
  ( StoreLeaf
  , storeQueryHandler
  --, StoreQueryHandlers(..)
  ) where

--import           Control.Lens                        (to, (^.))
import           Data.ByteArray.Base64String         (fromBytes)
import           Data.Proxy
--import           Data.String.Conversions             (cs)
import           Data.Word                           (Word64)
--import           GHC.TypeLits                        (KnownSymbol, symbolVal)
import           Polysemy                            (Member, Members, Sem)
import           Polysemy.Error                      (throw)
import           Polysemy.Tagged                     (Tagged)
import           Servant.API                         ((:>))
import           Tendermint.SDK.BaseApp.Errors       (makeAppError)
import           Tendermint.SDK.BaseApp.Query.Effect (QueryEffs)
import           Tendermint.SDK.BaseApp.Query.Router (HasQueryRouter (..))
import           Tendermint.SDK.BaseApp.Query.Types  (Leaf, QA, QueryArgs (..),
                                                      QueryData,
                                                      QueryResult (..))
import           Tendermint.SDK.BaseApp.Router       (RouterError (..))
import           Tendermint.SDK.BaseApp.Store        (RawKey (..), ReadStore,
                                                      Scope (..), makeKeyBytes)
import qualified Tendermint.SDK.BaseApp.Store.Array  as A
import qualified Tendermint.SDK.BaseApp.Store.List   as L
import qualified Tendermint.SDK.BaseApp.Store.Map    as M
import qualified Tendermint.SDK.BaseApp.Store.Var    as V
import           Tendermint.SDK.Codec                (HasCodec)

{-

"account" :> StoreLeaf (Map Address Account) :<|>

  "count" :> StoreLeaf (Var Count) :<|>

  "counts" :> StoreLeaf (Array Count)

-}


data StoreLeaf a

instance (QueryData k, HasCodec v, Member (Tagged 'QueryAndMempool ReadStore) r) => HasQueryRouter (StoreLeaf (M.Map k v)) r where

   type RouteQ (StoreLeaf (M.Map k v)) r = RouteQ (QA k :> Leaf v) r
   routeQ :: Proxy (StoreLeaf (Map k v))
-> Proxy r
-> Delayed
     (Sem r)
     env
     QueryRequest
     (RouteQ (StoreLeaf (Map k v)) (QueryEffs :& r))
-> Router env r QueryRequest Query
routeQ _ = Proxy (QA k :> Leaf v)
-> Proxy r
-> Delayed
     (Sem r) env QueryRequest (RouteQ (QA k :> Leaf v) (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 (QA k :> Leaf v)
forall k (t :: k). Proxy t
Proxy @(QA k :> Leaf v))
   hoistQueryRouter :: Proxy (StoreLeaf (Map k v))
-> Proxy r
-> (forall a. Sem s a -> Sem s' a)
-> RouteQ (StoreLeaf (Map k v)) s
-> RouteQ (StoreLeaf (Map k v)) s'
hoistQueryRouter _ pr :: Proxy r
pr nat :: forall a. Sem s a -> Sem s' a
nat f :: RouteQ (StoreLeaf (Map k v)) s
f = Proxy (QA k :> Leaf v)
-> Proxy r
-> (forall a. Sem s a -> Sem s' a)
-> RouteQ (QA k :> Leaf v) s
-> RouteQ (QA k :> Leaf v) 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 (QA k :> Leaf v)
forall k (t :: k). Proxy t
Proxy @(QA k :> Leaf v)) Proxy r
pr forall a. Sem s a -> Sem s' a
nat RouteQ (QA k :> Leaf v) s
RouteQ (StoreLeaf (Map k v)) s
f

instance (HasCodec a, Member (Tagged 'QueryAndMempool ReadStore) r) => HasQueryRouter (StoreLeaf (V.Var a)) r where

   type RouteQ (StoreLeaf (V.Var a)) r = RouteQ (QA () :> Leaf a) r
   routeQ :: Proxy (StoreLeaf (Var a))
-> Proxy r
-> Delayed
     (Sem r)
     env
     QueryRequest
     (RouteQ (StoreLeaf (Var a)) (QueryEffs :& r))
-> Router env r QueryRequest Query
routeQ _ = Proxy (QA () :> Leaf a)
-> Proxy r
-> Delayed
     (Sem r)
     env
     QueryRequest
     (RouteQ (QA () :> Leaf 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 (QA () :> Leaf a)
forall k (t :: k). Proxy t
Proxy @(QA () :> Leaf a))
   hoistQueryRouter :: Proxy (StoreLeaf (Var a))
-> Proxy r
-> (forall a. Sem s a -> Sem s' a)
-> RouteQ (StoreLeaf (Var a)) s
-> RouteQ (StoreLeaf (Var a)) s'
hoistQueryRouter _ pr :: Proxy r
pr nat :: forall a. Sem s a -> Sem s' a
nat f :: RouteQ (StoreLeaf (Var a)) s
f = Proxy (QA () :> Leaf a)
-> Proxy r
-> (forall a. Sem s a -> Sem s' a)
-> RouteQ (QA () :> Leaf a) s
-> RouteQ (QA () :> Leaf 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 (QA () :> Leaf a)
forall k (t :: k). Proxy t
Proxy @(QA () :> Leaf a)) Proxy r
pr forall a. Sem s a -> Sem s' a
nat RouteQ (QA () :> Leaf a) s
RouteQ (StoreLeaf (Var a)) s
f

instance (HasCodec a, Member (Tagged 'QueryAndMempool ReadStore) r) => HasQueryRouter (StoreLeaf (A.Array a)) r where

   type RouteQ (StoreLeaf (A.Array a)) r = RouteQ (QA Word64 :> Leaf a) r
   routeQ :: Proxy (StoreLeaf (Array a))
-> Proxy r
-> Delayed
     (Sem r)
     env
     QueryRequest
     (RouteQ (StoreLeaf (Array a)) (QueryEffs :& r))
-> Router env r QueryRequest Query
routeQ _ = Proxy (QA Word64 :> Leaf a)
-> Proxy r
-> Delayed
     (Sem r)
     env
     QueryRequest
     (RouteQ (QA Word64 :> Leaf 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 (QA Word64 :> Leaf a)
forall k (t :: k). Proxy t
Proxy @(QA Word64 :> Leaf a))
   hoistQueryRouter :: Proxy (StoreLeaf (Array a))
-> Proxy r
-> (forall a. Sem s a -> Sem s' a)
-> RouteQ (StoreLeaf (Array a)) s
-> RouteQ (StoreLeaf (Array a)) s'
hoistQueryRouter _ pr :: Proxy r
pr nat :: forall a. Sem s a -> Sem s' a
nat f :: RouteQ (StoreLeaf (Array a)) s
f = Proxy (QA Word64 :> Leaf a)
-> Proxy r
-> (forall a. Sem s a -> Sem s' a)
-> RouteQ (QA Word64 :> Leaf a) s
-> RouteQ (QA Word64 :> Leaf 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 (QA Word64 :> Leaf a)
forall k (t :: k). Proxy t
Proxy @(QA Word64 :> Leaf a)) Proxy r
pr forall a. Sem s a -> Sem s' a
nat RouteQ (QA Word64 :> Leaf a) s
RouteQ (StoreLeaf (Array a)) s
f

class StoreQueryHandler ns h where
    storeQueryHandler :: ns -> h

instance
  ( RawKey k
  , HasCodec v
  , Members QueryEffs r
  )
   => StoreQueryHandler (M.Map k v) (QueryArgs k -> Sem r (QueryResult v)) where
  storeQueryHandler :: Map k v -> QueryArgs k -> Sem r (QueryResult v)
storeQueryHandler m :: Map k v
m QueryArgs{..} = do
    let key :: k
key = k
queryArgsData
    Maybe v
mRes <- k -> Map k v -> Sem r (Maybe v)
forall (r :: EffectRow) k v.
(Members '[Error AppError, ReadStore] r, RawKey k, HasCodec v) =>
k -> Map k v -> Sem r (Maybe v)
M.lookup k
key Map k v
m
    case Maybe v
mRes of
      Nothing -> AppError -> Sem r (QueryResult v)
forall e (r :: EffectRow) a.
MemberWithError (Error e) r =>
e -> Sem r a
throw (AppError -> Sem r (QueryResult v))
-> (RouterError -> AppError)
-> RouterError
-> Sem r (QueryResult v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RouterError -> AppError
forall e. IsAppError e => e -> AppError
makeAppError (RouterError -> Sem r (QueryResult v))
-> RouterError -> Sem r (QueryResult v)
forall a b. (a -> b) -> a -> b
$ RouterError
ResourceNotFound
      Just (v
res :: v) -> QueryResult v -> Sem r (QueryResult v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (QueryResult v -> Sem r (QueryResult v))
-> QueryResult v -> Sem r (QueryResult v)
forall a b. (a -> b) -> a -> b
$ QueryResult :: forall a.
a -> Int64 -> Base64String -> Maybe Proof -> Int64 -> QueryResult a
QueryResult
        -- TODO: actually handle proofs
        { queryResultData :: v
queryResultData = v
res
        , queryResultIndex :: Int64
queryResultIndex = 0
        , queryResultKey :: Base64String
queryResultKey = ByteString -> Base64String
forall ba. ByteArrayAccess ba => ba -> Base64String
fromBytes (ByteString -> Base64String)
-> (k -> ByteString) -> k -> Base64String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreKey -> ByteString
makeKeyBytes (StoreKey -> ByteString) -> (k -> StoreKey) -> k -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k v -> k -> StoreKey
forall k v. RawKey k => Map k v -> k -> StoreKey
M.makeFullStoreKey Map k v
m (k -> Base64String) -> k -> Base64String
forall a b. (a -> b) -> a -> b
$ k
key
        , queryResultProof :: Maybe Proof
queryResultProof = Maybe Proof
forall a. Maybe a
Nothing
        , queryResultHeight :: Int64
queryResultHeight = 0
        }

instance
  ( HasCodec a
  , Members QueryEffs r
  )
   => StoreQueryHandler (A.Array a) (QueryArgs Word64 -> Sem r (QueryResult a)) where
  storeQueryHandler :: Array a -> QueryArgs Word64 -> Sem r (QueryResult a)
storeQueryHandler as :: Array a
as QueryArgs{..} = do
    let i :: Word64
i = Word64
queryArgsData
    Maybe a
mRes <- Array a
as Array a -> Word64 -> Sem r (Maybe a)
forall (r :: EffectRow) a.
(Members '[Error AppError, ReadStore] r, HasCodec a) =>
Array a -> Word64 -> Sem r (Maybe a)
A.!! Word64
i
    case Maybe a
mRes of
      Nothing -> AppError -> Sem r (QueryResult a)
forall e (r :: EffectRow) a.
MemberWithError (Error e) r =>
e -> Sem r a
throw (AppError -> Sem r (QueryResult a))
-> (RouterError -> AppError)
-> RouterError
-> Sem r (QueryResult a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RouterError -> AppError
forall e. IsAppError e => e -> AppError
makeAppError (RouterError -> Sem r (QueryResult a))
-> RouterError -> Sem r (QueryResult a)
forall a b. (a -> b) -> a -> b
$ RouterError
ResourceNotFound
      Just (a
res :: a) -> QueryResult a -> Sem r (QueryResult a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (QueryResult a -> Sem r (QueryResult a))
-> QueryResult a -> Sem r (QueryResult a)
forall a b. (a -> b) -> a -> b
$ QueryResult :: forall a.
a -> Int64 -> Base64String -> Maybe Proof -> Int64 -> QueryResult a
QueryResult
        -- TODO: actually handle proofs
        { queryResultData :: a
queryResultData = a
res
        , queryResultIndex :: Int64
queryResultIndex = 0
        , queryResultKey :: Base64String
queryResultKey = ByteString -> Base64String
forall ba. ByteArrayAccess ba => ba -> Base64String
fromBytes (ByteString -> Base64String)
-> (Word64 -> ByteString) -> Word64 -> Base64String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreKey -> ByteString
makeKeyBytes (StoreKey -> ByteString)
-> (Word64 -> StoreKey) -> Word64 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array a -> Word64 -> StoreKey
forall a. Array a -> Word64 -> StoreKey
A.makeFullStoreKey Array a
as (Word64 -> Base64String) -> Word64 -> Base64String
forall a b. (a -> b) -> a -> b
$ Word64
i
        , queryResultProof :: Maybe Proof
queryResultProof = Maybe Proof
forall a. Maybe a
Nothing
        , queryResultHeight :: Int64
queryResultHeight = 0
        }

instance
  ( HasCodec a
  , Members QueryEffs r
  )
   => StoreQueryHandler (L.List a) (QueryArgs Word64 -> Sem r (QueryResult a)) where
  storeQueryHandler :: List a -> QueryArgs Word64 -> Sem r (QueryResult a)
storeQueryHandler as :: List a
as QueryArgs{..} = do
    let i :: Word64
i = Word64
queryArgsData
    Maybe a
mRes <- List a
as List a -> Word64 -> Sem r (Maybe a)
forall (r :: EffectRow) a.
(Members '[Error AppError, ReadStore] r, HasCodec a) =>
List a -> Word64 -> Sem r (Maybe a)
L.!! Word64
i
    case Maybe a
mRes of
      Nothing -> AppError -> Sem r (QueryResult a)
forall e (r :: EffectRow) a.
MemberWithError (Error e) r =>
e -> Sem r a
throw (AppError -> Sem r (QueryResult a))
-> (RouterError -> AppError)
-> RouterError
-> Sem r (QueryResult a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RouterError -> AppError
forall e. IsAppError e => e -> AppError
makeAppError (RouterError -> Sem r (QueryResult a))
-> RouterError -> Sem r (QueryResult a)
forall a b. (a -> b) -> a -> b
$ RouterError
ResourceNotFound
      Just (a
res :: a) -> QueryResult a -> Sem r (QueryResult a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (QueryResult a -> Sem r (QueryResult a))
-> QueryResult a -> Sem r (QueryResult a)
forall a b. (a -> b) -> a -> b
$ QueryResult :: forall a.
a -> Int64 -> Base64String -> Maybe Proof -> Int64 -> QueryResult a
QueryResult
        -- TODO: actually handle proofs
        { queryResultData :: a
queryResultData = a
res
        , queryResultIndex :: Int64
queryResultIndex = 0
        , queryResultKey :: Base64String
queryResultKey = ByteString -> Base64String
forall ba. ByteArrayAccess ba => ba -> Base64String
fromBytes (ByteString -> Base64String)
-> (Word64 -> ByteString) -> Word64 -> Base64String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreKey -> ByteString
makeKeyBytes (StoreKey -> ByteString)
-> (Word64 -> StoreKey) -> Word64 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List a -> Word64 -> StoreKey
forall a. List a -> Word64 -> StoreKey
L.makeFullStoreKey List a
as (Word64 -> Base64String) -> Word64 -> Base64String
forall a b. (a -> b) -> a -> b
$ Word64
i
        , queryResultProof :: Maybe Proof
queryResultProof = Maybe Proof
forall a. Maybe a
Nothing
        , queryResultHeight :: Int64
queryResultHeight = 0
        }

instance
  ( HasCodec a
  , Members QueryEffs r
  )
   => StoreQueryHandler (V.Var a) (QueryArgs () -> Sem r (QueryResult a)) where
  storeQueryHandler :: Var a -> QueryArgs () -> Sem r (QueryResult a)
storeQueryHandler var :: Var a
var QueryArgs{..} = do
    Maybe a
mRes <- Var a -> Sem r (Maybe a)
forall (r :: EffectRow) a.
(Members QueryEffs r, HasCodec a) =>
Var a -> Sem r (Maybe a)
V.takeVar Var a
var
    case Maybe a
mRes of
      Nothing -> AppError -> Sem r (QueryResult a)
forall e (r :: EffectRow) a.
MemberWithError (Error e) r =>
e -> Sem r a
throw (AppError -> Sem r (QueryResult a))
-> (RouterError -> AppError)
-> RouterError
-> Sem r (QueryResult a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RouterError -> AppError
forall e. IsAppError e => e -> AppError
makeAppError (RouterError -> Sem r (QueryResult a))
-> RouterError -> Sem r (QueryResult a)
forall a b. (a -> b) -> a -> b
$ RouterError
ResourceNotFound
      Just (a
res :: a) -> QueryResult a -> Sem r (QueryResult a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (QueryResult a -> Sem r (QueryResult a))
-> QueryResult a -> Sem r (QueryResult a)
forall a b. (a -> b) -> a -> b
$ QueryResult :: forall a.
a -> Int64 -> Base64String -> Maybe Proof -> Int64 -> QueryResult a
QueryResult
        -- TODO: actually handle proofs
        { queryResultData :: a
queryResultData = a
res
        , queryResultIndex :: Int64
queryResultIndex = 0
        , queryResultKey :: Base64String
queryResultKey = ByteString -> Base64String
forall ba. ByteArrayAccess ba => ba -> Base64String
fromBytes (ByteString -> Base64String)
-> (Var a -> ByteString) -> Var a -> Base64String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreKey -> ByteString
makeKeyBytes (StoreKey -> ByteString)
-> (Var a -> StoreKey) -> Var a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var a -> StoreKey
forall a. Var a -> StoreKey
V.makeFullStoreKey (Var a -> Base64String) -> Var a -> Base64String
forall a b. (a -> b) -> a -> b
$ Var a
var
        , queryResultProof :: Maybe Proof
queryResultProof = Maybe Proof
forall a. Maybe a
Nothing
        , queryResultHeight :: Int64
queryResultHeight = 0
        }

--class StoreQueryHandlers ns r where
--    type QueryApi kvs :: *
--    storeQueryHandlers :: Proxy kvs -> Store ns -> Proxy r -> RouteQ (QueryApi kvs) r
--
--instance
--    ( IsKey k ns
--    , a ~ Value k ns
--    , HasCodec a
--    , Members QueryEffs r
--    )  => StoreQueryHandlers ns r where
--      type QueryApi (s :> StoreLeaf (M.Map k v)) =  s :> QA k :> StoreLeaf a
--      storeQueryHandlers _ store _ = storeQueryHandler (Proxy :: Proxy a) store

--instance
--    ( IsKey k ns
--    , a ~ Value k ns
--    , HasCodec a
--    , StoreQueryHandlers ((k', a') ': as) ns r
--    , Members QueryEffs r
--    ) => StoreQueryHandlers ((k,a) ': (k', a') : as) ns r where
--        type (QueryApi ((k, a) ': (k', a') : as)) = (QA k :> StoreLeaf a) :<|> QueryApi ((k', a') ': as)
--        storeQueryHandlers _ store pr =
--          storeQueryHandler  (Proxy :: Proxy a) store :<|>
--          storeQueryHandlers (Proxy :: Proxy ((k', a') ': as)) store pr
--