From 37398541fb1dcf7db678a9eaa0284a53f391755d Mon Sep 17 00:00:00 2001
From: Thomas Winant <thomas@well-typed.com>
Date: Tue, 28 Jan 2020 18:43:22 +0100
Subject: [PATCH] Turn Query into a GADT

---
 .../Ouroboros/Consensus/Ledger/Abstract.hs    |  22 +--
 .../Consensus/Ledger/Byron/Ledger.hs          |  43 +++---
 .../src/Ouroboros/Consensus/Ledger/Dual.hs    |  10 +-
 .../Ouroboros/Consensus/Ledger/Mock/Block.hs  |  18 +--
 .../Consensus/LocalStateQueryServer.hs        |  12 +-
 .../Ouroboros/Consensus/Node/Run/Abstract.hs  |   9 +-
 .../Ouroboros/Consensus/Node/Run/DualByron.hs |   2 +-
 .../src/Ouroboros/Consensus/Node/Run/Mock.hs  |  10 +-
 .../src/Ouroboros/Consensus/NodeNetwork.hs    |  16 +--
 .../Test/Consensus/Ledger/Byron.hs            |  58 +++++---
 .../Test/Consensus/LocalStateQueryServer.hs   |  15 +-
 .../test-consensus/Test/ThreadNet/Network.hs  |   5 +-
 .../test-util/Test/Util/TestBlock.hs          |  19 ++-
 .../Protocol/LocalStateQuery/Client.hs        |  69 ++++-----
 .../Network/Protocol/LocalStateQuery/Codec.hs |  83 ++++++-----
 .../Protocol/LocalStateQuery/Direct.hs        |  22 +--
 .../Protocol/LocalStateQuery/Examples.hs      |  69 +++++----
 .../Protocol/LocalStateQuery/Server.hs        |  75 +++++-----
 .../Network/Protocol/LocalStateQuery/Test.hs  | 136 +++++++++---------
 .../Network/Protocol/LocalStateQuery/Type.hs  | 117 ++++++++++-----
 20 files changed, 454 insertions(+), 356 deletions(-)

diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Abstract.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Abstract.hs
index aeaa389527e..414639077eb 100644
--- a/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Abstract.hs
+++ b/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Abstract.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds               #-}
 {-# LANGUAGE FlexibleContexts        #-}
 {-# LANGUAGE TypeFamilies            #-}
+{-# LANGUAGE TypeOperators           #-}
 {-# LANGUAGE UndecidableSuperClasses #-}
 
 -- | Interface to the ledger layer
@@ -14,9 +15,11 @@ module Ouroboros.Consensus.Ledger.Abstract (
   , ProtocolLedgerView(..)
   , AnachronyFailure(..)
   , QueryLedger(..)
+  , ShowQuery(..)
   ) where
 
 import           Control.Monad.Except
+import           Data.Type.Equality ((:~:))
 import           GHC.Stack (HasCallStack)
 
 import           Cardano.Prelude (NoUnexpectedThunks)
@@ -24,6 +27,8 @@ import           Cardano.Prelude (NoUnexpectedThunks)
 import           Ouroboros.Network.Block (ChainHash, HasHeader, Point, SlotNo,
                      pointHash, pointSlot)
 import           Ouroboros.Network.Point (WithOrigin)
+import           Ouroboros.Network.Protocol.LocalStateQuery.Type
+                     (ShowQuery (..))
 
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.Protocol.Abstract
@@ -174,15 +179,14 @@ data AnachronyFailure
 --
 -- Used by the LocalStateQuery protocol to allow clients to query the ledger
 -- state.
-class UpdateLedger blk => QueryLedger blk where
+class (UpdateLedger blk, ShowQuery (Query blk)) => QueryLedger blk where
 
-  -- | Different queries supported by the ledger
-  data family Query  blk :: *
-
-  -- | The result types for the queries
-  data family Result blk :: *
-  -- TODO index Result by Query so that we always get the expected result
-  -- type?
+  -- | Different queries supported by the ledger, indexed by the result type.
+  data family Query  blk :: * -> *
 
   -- | Answer the given query about the ledger state.
-  answerQuery :: Query blk -> LedgerState blk -> Result blk
+  answerQuery :: Query blk result -> LedgerState blk -> result
+
+  -- | Generalisation of value-level equality of two queries.
+  eqQuery :: Query blk result1 -> Query blk result2
+          -> Maybe (result1 :~: result2)
diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Byron/Ledger.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Byron/Ledger.hs
index 93c9df88524..bd2be1d9a23 100644
--- a/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Byron/Ledger.hs
+++ b/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Byron/Ledger.hs
@@ -1,9 +1,11 @@
 {-# LANGUAGE DeriveAnyClass      #-}
 {-# LANGUAGE DeriveGeneric       #-}
 {-# LANGUAGE FlexibleInstances   #-}
-{-# LANGUAGE NamedFieldPuns      #-}
+{-# LANGUAGE GADTs               #-}
+{-# LANGUAGE RankNTypes          #-}
 {-# LANGUAGE RecordWildCards     #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving  #-}
 {-# LANGUAGE TypeFamilies        #-}
 
 {-# OPTIONS_GHC -Wno-orphans #-}
@@ -14,7 +16,6 @@ module Ouroboros.Consensus.Ledger.Byron.Ledger (
     LedgerConfig(..)
   , LedgerState(..)
   , Query(..)
-  , Result(..)
   , initByronLedgerState
     -- * Serialisation
   , encodeByronLedgerState
@@ -36,6 +37,7 @@ import           Control.Monad.Except
 import           Data.ByteString (ByteString)
 import           Data.Sequence (Seq)
 import qualified Data.Sequence as Seq.Lazy
+import           Data.Type.Equality ((:~:) (Refl))
 import           GHC.Generics (Generic)
 
 import           Cardano.Prelude (NoUnexpectedThunks)
@@ -52,6 +54,7 @@ import qualified Cardano.Chain.ValidationMode as CC
 import           Ouroboros.Network.Block (Point (..), SlotNo (..), blockSlot)
 import           Ouroboros.Network.Point (WithOrigin (..))
 import qualified Ouroboros.Network.Point as Point
+import           Ouroboros.Network.Protocol.LocalStateQuery.Codec (Some (..))
 
 import           Ouroboros.Consensus.Ledger.Abstract
 import qualified Ouroboros.Consensus.Ledger.Byron.Auxiliary as Aux
@@ -125,16 +128,19 @@ initByronLedgerState genesis mUtxo = ByronLedgerState {
     override (Just utxo) st = st { CC.cvsUtxo = utxo }
 
 instance QueryLedger ByronBlock where
-  data Query ByronBlock
-    = GetUpdateInterfaceState
-    deriving (Eq, Show)
-
-  data Result ByronBlock
-    = UpdateInterfaceState UPI.State
-    deriving (Eq, Show)
+  data Query ByronBlock :: * -> * where
+    GetUpdateInterfaceState :: Query ByronBlock UPI.State
 
   answerQuery GetUpdateInterfaceState ledgerState =
-    UpdateInterfaceState (CC.cvsUpdateState (byronLedgerState ledgerState))
+    CC.cvsUpdateState (byronLedgerState ledgerState)
+
+  eqQuery GetUpdateInterfaceState GetUpdateInterfaceState = Just Refl
+
+deriving instance Eq (Query ByronBlock result)
+deriving instance Show (Query ByronBlock result)
+
+instance ShowQuery (Query ByronBlock) where
+  showResult GetUpdateInterfaceState = show
 
 instance ConfigContainsGenesis (LedgerConfig ByronBlock) where
   getGenesisConfig = unByronLedgerConfig
@@ -331,19 +337,22 @@ decodeByronLedgerState = do
       <$> decode
       <*> History.decodeDelegationHistory
 
-encodeByronQuery :: Query ByronBlock -> Encoding
+encodeByronQuery :: Query ByronBlock result -> Encoding
 encodeByronQuery query = case query of
     GetUpdateInterfaceState -> CBOR.encodeWord8 0
 
-decodeByronQuery :: Decoder s (Query ByronBlock)
+decodeByronQuery :: Decoder s (Some (Query ByronBlock))
 decodeByronQuery = do
     tag <- CBOR.decodeWord8
     case tag of
-      0 -> return GetUpdateInterfaceState
+      0 -> return $ Some GetUpdateInterfaceState
       _ -> fail $ "decodeByronQuery: invalid tag " <> show tag
 
-encodeByronResult :: Result ByronBlock -> Encoding
-encodeByronResult (UpdateInterfaceState state) = toCBOR state
+encodeByronResult :: Query ByronBlock result -> result -> Encoding
+encodeByronResult query = case query of
+    GetUpdateInterfaceState -> toCBOR
 
-decodeByronResult :: Decoder s (Result ByronBlock)
-decodeByronResult = UpdateInterfaceState <$> fromCBOR
+decodeByronResult :: Query ByronBlock result
+                  -> forall s. Decoder s result
+decodeByronResult query = case query of
+    GetUpdateInterfaceState -> fromCBOR
diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Dual.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Dual.hs
index 6d59b0caab7..376899f367d 100644
--- a/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Dual.hs
+++ b/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Dual.hs
@@ -434,12 +434,14 @@ instance Bridge m a => ProtocolLedgerView (DualBlock m a) where
 
 -- | Not used in the tests: no constructors
 instance Bridge m a => QueryLedger (DualBlock m a) where
-  data Query (DualBlock m a)
-    deriving (Show)
-  data Result (DualBlock m a)
+  data Query (DualBlock m a) result
     deriving (Show)
 
-  answerQuery q _ledgerState = case q of {}
+  answerQuery = \case {}
+  eqQuery     = \case {}
+
+instance ShowQuery (Query (DualBlock m a)) where
+  showResult = \case {}
 
 {-------------------------------------------------------------------------------
   Mempool support
diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Mock/Block.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Mock/Block.hs
index 603930b5098..5df9e9a9537 100644
--- a/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Mock/Block.hs
+++ b/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Mock/Block.hs
@@ -2,9 +2,11 @@
 {-# LANGUAGE DeriveGeneric              #-}
 {-# LANGUAGE DerivingStrategies         #-}
 {-# LANGUAGE EmptyCase                  #-}
+{-# LANGUAGE EmptyDataDeriving          #-}
 {-# LANGUAGE FlexibleContexts           #-}
 {-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase                 #-}
 {-# LANGUAGE MultiParamTypeClasses      #-}
 {-# LANGUAGE NamedFieldPuns             #-}
 {-# LANGUAGE RankNTypes                 #-}
@@ -38,9 +40,6 @@ module Ouroboros.Consensus.Ledger.Mock.Block (
     -- * 'ApplyTx' (mempool support)
   , GenTx(..)
   , mkSimpleGenTx
-    -- * 'QueryLedger'
-  , Query(..)
-  , Result(..)
     -- * Crypto
   , SimpleCrypto
   , SimpleStandardCrypto
@@ -334,13 +333,14 @@ mkSimpleGenTx tx = SimpleGenTx
 
 instance (SimpleCrypto c, Typeable ext, SupportedBlock (SimpleBlock c ext))
       => QueryLedger (SimpleBlock c ext) where
-  data Query  (SimpleBlock c ext) = QueryLedgerTip
-    deriving (Show, Generic, Serialise)
-  data Result (SimpleBlock c ext) = ResultLedgerTip (Point (SimpleBlock c ext))
-    deriving (Show, Generic, Serialise)
+  data Query (SimpleBlock c ext) result
+    deriving (Show)
+
+  answerQuery = \case {}
+  eqQuery     = \case {}
 
-  answerQuery QueryLedgerTip (SimpleLedgerState MockState { mockTip }) =
-    ResultLedgerTip mockTip
+instance ShowQuery (Query (SimpleBlock c ext)) where
+  showResult = \case {}
 
 {-------------------------------------------------------------------------------
   Crypto needed for simple blocks
diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/LocalStateQueryServer.hs b/ouroboros-consensus/src/Ouroboros/Consensus/LocalStateQueryServer.hs
index f4cc085d78f..706a28e96f6 100644
--- a/ouroboros-consensus/src/Ouroboros/Consensus/LocalStateQueryServer.hs
+++ b/ouroboros-consensus/src/Ouroboros/Consensus/LocalStateQueryServer.hs
@@ -24,13 +24,13 @@ import           Ouroboros.Storage.ChainDB (LedgerCursor (..),
 localStateQueryServer
   :: forall m blk. (IOLike m, QueryLedger blk)
   => m (LedgerCursor m blk)
-  -> LocalStateQueryServer blk (Query blk) (Result blk) m ()
+  -> LocalStateQueryServer blk (Query blk) m ()
 localStateQueryServer newLedgerCursor =
     LocalStateQueryServer $ idle <$> newLedgerCursor
   where
     idle
       :: LedgerCursor m blk
-      -> ServerStIdle blk (Query blk) (Result blk) m ()
+      -> ServerStIdle blk (Query blk) m ()
     idle ledgerCursor = ServerStIdle
       { recvMsgAcquire = handleAcquire ledgerCursor
       , recvMsgDone    = return ()
@@ -39,7 +39,7 @@ localStateQueryServer newLedgerCursor =
     handleAcquire
       :: LedgerCursor m blk
       -> Point blk
-      -> m (ServerStAcquiring blk (Query blk) (Result blk) m ())
+      -> m (ServerStAcquiring blk (Query blk) m ())
     handleAcquire ledgerCursor pt =
       ledgerCursorMove ledgerCursor pt <&> \case
         Left failure ->
@@ -50,7 +50,7 @@ localStateQueryServer newLedgerCursor =
     acquired
       :: LedgerState blk
       -> LedgerCursor m blk
-      -> ServerStAcquired blk (Query blk) (Result blk) m ()
+      -> ServerStAcquired blk (Query blk) m ()
     acquired ledgerState ledgerCursor = ServerStAcquired
       { recvMsgQuery     = handleQuery ledgerState ledgerCursor
       , recvMsgReAcquire = handleAcquire ledgerCursor
@@ -60,8 +60,8 @@ localStateQueryServer newLedgerCursor =
     handleQuery
       :: LedgerState blk
       -> LedgerCursor m blk
-      -> Query blk
-      -> m (ServerStQuerying blk (Query blk) (Result blk) m ())
+      -> Query blk result
+      -> m (ServerStQuerying blk (Query blk) m () result)
     handleQuery ledgerState ledgerCursor query = return $
       SendMsgResult
         (answerQuery query ledgerState)
diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Node/Run/Abstract.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Node/Run/Abstract.hs
index 1e4fb5d2fd7..dbce47a9d23 100644
--- a/ouroboros-consensus/src/Ouroboros/Consensus/Node/Run/Abstract.hs
+++ b/ouroboros-consensus/src/Ouroboros/Consensus/Node/Run/Abstract.hs
@@ -21,6 +21,7 @@ import           Cardano.Crypto (ProtocolMagicId)
 import           Ouroboros.Network.Block (BlockNo, HeaderHash, SlotNo)
 import           Ouroboros.Network.BlockFetch (SizeInBytes)
 import           Ouroboros.Network.Magic (NetworkMagic)
+import           Ouroboros.Network.Protocol.LocalStateQuery.Codec (Some (..))
 
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.BlockchainTime (SystemStart)
@@ -128,8 +129,8 @@ class ( ProtocolLedgerView blk
   nodeEncodeLedgerState   :: NodeConfig (BlockProtocol blk) -> LedgerState blk -> Encoding
   nodeEncodeChainState    :: Proxy blk -> NodeConfig (BlockProtocol blk) -> ChainState (BlockProtocol blk) -> Encoding
   nodeEncodeApplyTxError  :: Proxy blk -> ApplyTxErr blk -> Encoding
-  nodeEncodeQuery         :: Query blk -> Encoding
-  nodeEncodeResult        :: Result blk -> Encoding
+  nodeEncodeQuery         :: Query blk result -> Encoding
+  nodeEncodeResult        :: Query blk result -> result -> Encoding
 
   -- Decoders
   nodeDecodeHeader        :: forall s. NodeConfig (BlockProtocol blk) -> Decoder s (Lazy.ByteString -> Header blk)
@@ -140,5 +141,5 @@ class ( ProtocolLedgerView blk
   nodeDecodeLedgerState   :: forall s. NodeConfig (BlockProtocol blk) -> Decoder s (LedgerState blk)
   nodeDecodeChainState    :: forall s. Proxy blk -> NodeConfig (BlockProtocol blk) -> Decoder s (ChainState (BlockProtocol blk))
   nodeDecodeApplyTxError  :: forall s. Proxy blk -> Decoder s (ApplyTxErr blk)
-  nodeDecodeQuery         :: forall s. Decoder s (Query blk)
-  nodeDecodeResult        :: forall s. Decoder s (Result blk)
+  nodeDecodeQuery         :: forall s. Decoder s (Some (Query blk))
+  nodeDecodeResult        :: Query blk result -> forall s. Decoder s result
diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Node/Run/DualByron.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Node/Run/DualByron.hs
index 8f2bef83007..198c59ad477 100644
--- a/ouroboros-consensus/src/Ouroboros/Consensus/Node/Run/DualByron.hs
+++ b/ouroboros-consensus/src/Ouroboros/Consensus/Node/Run/DualByron.hs
@@ -105,7 +105,7 @@ instance RunNode DualByronBlock where
                                let k = pbftSecurityParam $ pbftParams cfg
                                in decodeByronChainState k
   nodeDecodeQuery         = error "DualByron.nodeDecodeQuery"
-  nodeDecodeResult        = error "DualByron.nodeDecodeResult"
+  nodeDecodeResult        = \case {}
 
 extractEpochSlots :: NodeConfig DualByronProtocol -> EpochSlots
 extractEpochSlots = Byron.extractEpochSlots . dualNodeConfigMain
diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Node/Run/Mock.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Node/Run/Mock.hs
index e65e6cd2f69..3b334e5f2ab 100644
--- a/ouroboros-consensus/src/Ouroboros/Consensus/Node/Run/Mock.hs
+++ b/ouroboros-consensus/src/Ouroboros/Consensus/Node/Run/Mock.hs
@@ -1,5 +1,7 @@
+{-# LANGUAGE EmptyCase            #-}
 {-# LANGUAGE FlexibleContexts     #-}
 {-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE LambdaCase           #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
@@ -64,8 +66,8 @@ instance ( ProtocolLedgerView (SimpleBlock SimpleMockCrypto ext)
   nodeEncodeLedgerState     = const encode
   nodeEncodeChainState      = const mockEncodeChainState
   nodeEncodeApplyTxError    = const encode
-  nodeEncodeQuery           = encode
-  nodeEncodeResult          = encode
+  nodeEncodeQuery           = \case {}
+  nodeEncodeResult          = \case {}
 
   nodeDecodeBlock           = const (const <$> decode)
   nodeDecodeHeader          = const (const <$> decode)
@@ -75,5 +77,5 @@ instance ( ProtocolLedgerView (SimpleBlock SimpleMockCrypto ext)
   nodeDecodeLedgerState     = const decode
   nodeDecodeChainState      = const mockDecodeChainState
   nodeDecodeApplyTxError    = const decode
-  nodeDecodeQuery           = decode
-  nodeDecodeResult          = decode
+  nodeDecodeQuery           = error "Mock.nodeDecodeQuery"
+  nodeDecodeResult          = \case {}
diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/NodeNetwork.hs b/ouroboros-consensus/src/Ouroboros/Consensus/NodeNetwork.hs
index 5ff7994ab7b..b2e75e11d66 100644
--- a/ouroboros-consensus/src/Ouroboros/Consensus/NodeNetwork.hs
+++ b/ouroboros-consensus/src/Ouroboros/Consensus/NodeNetwork.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE NamedFieldPuns        #-}
+{-# LANGUAGE QuantifiedConstraints #-}
 {-# LANGUAGE RankNTypes            #-}
 {-# LANGUAGE RecordWildCards       #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
@@ -133,7 +134,7 @@ data ProtocolHandlers m peer blk = ProtocolHandlers {
         :: LocalTxSubmissionServer (GenTx blk) (ApplyTxErr blk) m ()
 
     , phLocalStateQueryServer
-        :: LocalStateQueryServer blk (Query blk) (Result blk) m ()
+        :: LocalStateQueryServer blk (Query blk) m ()
     }
 
 protocolHandlers
@@ -215,7 +216,7 @@ data ProtocolCodecs blk failure m
                                          failure m bytesLCS
   , pcLocalTxSubmissionCodec    :: Codec (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))
                                          failure m bytesLTX
-  , pcLocalStateQueryCodec      :: Codec (LocalStateQuery blk (Query blk) (Result blk))
+  , pcLocalStateQueryCodec      :: Codec (LocalStateQuery blk (Query blk))
                                          failure m bytesLSQ
   }
 
@@ -288,7 +289,7 @@ protocolCodecs cfg = ProtocolCodecs {
 
 -- | Id codecs used in tests.
 --
-protocolCodecsId :: Monad m
+protocolCodecsId :: (Monad m, QueryLedger blk)
                  => ProtocolCodecs blk CodecFailure m
                       (AnyMessage (ChainSync (Header blk) (Tip blk)))
                       (AnyMessage (ChainSync (Serialised (Header blk)) (Tip blk)))
@@ -297,7 +298,7 @@ protocolCodecsId :: Monad m
                       (AnyMessage (TxSubmission (GenTxId blk) (GenTx blk)))
                       (AnyMessage (ChainSync (Serialised blk) (Tip blk)))
                       (AnyMessage (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)))
-                      (AnyMessage (LocalStateQuery blk (Query blk) (Result blk)))
+                      (AnyMessage (LocalStateQuery blk (Query blk)))
 protocolCodecsId = ProtocolCodecs {
       pcChainSyncCodec            = codecChainSyncId
     , pcChainSyncCodecSerialised  = codecChainSyncId
@@ -306,7 +307,7 @@ protocolCodecsId = ProtocolCodecs {
     , pcTxSubmissionCodec         = codecTxSubmissionId
     , pcLocalChainSyncCodec       = codecChainSyncId
     , pcLocalTxSubmissionCodec    = codecLocalTxSubmissionId
-    , pcLocalStateQueryCodec      = codecLocalStateQueryId
+    , pcLocalStateQueryCodec      = codecLocalStateQueryId eqQuery
     }
 
 -- | A record of 'Tracer's for the different protocols.
@@ -320,7 +321,7 @@ data ProtocolTracers' peer blk failure f = ProtocolTracers {
   , ptTxSubmissionTracer         :: f (TraceLabelPeer peer (TraceSendRecv (TxSubmission (GenTxId blk) (GenTx blk))))
   , ptLocalChainSyncTracer       :: f (TraceLabelPeer peer (TraceSendRecv (ChainSync (Serialised blk) (Tip blk))))
   , ptLocalTxSubmissionTracer    :: f (TraceLabelPeer peer (TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
-  , ptLocalStateQueryTracer      :: f (TraceLabelPeer peer (TraceSendRecv (LocalStateQuery blk (Query blk) (Result blk))))
+  , ptLocalStateQueryTracer      :: f (TraceLabelPeer peer (TraceSendRecv (LocalStateQuery blk (Query blk))))
   }
 
 -- | Use a 'nullTracer' for each protocol.
@@ -342,8 +343,7 @@ showProtocolTracers :: ( Show blk
                        , Show (GenTx blk)
                        , Show (GenTxId blk)
                        , Show (ApplyTxErr blk)
-                       , Show (Query blk)
-                       , Show (Result blk)
+                       , ShowQuery (Query blk)
                        , HasHeader blk
                        )
                     => Tracer m String -> ProtocolTracers m peer blk failure
diff --git a/ouroboros-consensus/test-consensus/Test/Consensus/Ledger/Byron.hs b/ouroboros-consensus/test-consensus/Test/Consensus/Ledger/Byron.hs
index 79c4f7277dc..5614a118daf 100644
--- a/ouroboros-consensus/test-consensus/Test/Consensus/Ledger/Byron.hs
+++ b/ouroboros-consensus/test-consensus/Test/Consensus/Ledger/Byron.hs
@@ -1,11 +1,14 @@
 {-# LANGUAGE DerivingStrategies         #-}
 {-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE GADTs                      #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase                 #-}
 {-# LANGUAGE NamedFieldPuns             #-}
 {-# LANGUAGE OverloadedStrings          #-}
 {-# LANGUAGE RankNTypes                 #-}
 {-# LANGUAGE RecordWildCards            #-}
 {-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE StandaloneDeriving         #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 module Test.Consensus.Ledger.Byron (tests) where
 
@@ -32,6 +35,7 @@ import           Cardano.Crypto (ProtocolMagicId (..))
 
 import           Ouroboros.Network.Block (HeaderHash, SlotNo)
 import           Ouroboros.Network.Point (WithOrigin (At))
+import           Ouroboros.Network.Protocol.LocalStateQuery.Codec (Some (..))
 
 import           Ouroboros.Consensus.Block (BlockProtocol, Header)
 import           Ouroboros.Consensus.Ledger.Byron
@@ -178,13 +182,17 @@ prop_roundtrip_ApplyTxErr :: ApplyTxErr ByronBlock -> Property
 prop_roundtrip_ApplyTxErr =
     roundtrip encodeByronApplyTxError decodeByronApplyTxError
 
-prop_roundtrip_Query :: Query ByronBlock -> Property
+prop_roundtrip_Query :: Some (Query ByronBlock) -> Property
 prop_roundtrip_Query =
-    roundtrip encodeByronQuery decodeByronQuery
+    roundtrip
+      (\case { Some query -> encodeByronQuery query })
+      decodeByronQuery
 
-prop_roundtrip_Result :: Result ByronBlock -> Property
+prop_roundtrip_Result :: CC.UPI.State -> Property
 prop_roundtrip_Result =
-    roundtrip encodeByronResult decodeByronResult
+    roundtrip
+      (encodeByronResult GetUpdateInterfaceState)
+      (decodeByronResult GetUpdateInterfaceState)
 
 {-------------------------------------------------------------------------------
   BinaryInfo
@@ -518,8 +526,8 @@ instance Arbitrary ApplyMempoolPayloadErr where
     -- , MempoolUpdateVoteErr     <$> arbitrary
     ]
 
-instance Arbitrary (Query ByronBlock) where
-  arbitrary = return GetUpdateInterfaceState
+instance Arbitrary (Some (Query ByronBlock)) where
+  arbitrary = pure $ Some GetUpdateInterfaceState
 
 instance Arbitrary EpochNumber where
   arbitrary = hedgehog CC.genEpochNumber
@@ -548,19 +556,25 @@ instance Arbitrary CC.Update.ProtocolParameters where
 instance Arbitrary CC.Update.SoftwareVersion where
   arbitrary = hedgehog CC.genSoftwareVersion
 
-instance Arbitrary (Result ByronBlock) where
-  arbitrary = UpdateInterfaceState <$> genUPIState
-    where
-      genUPIState :: Gen CC.UPI.State
-      genUPIState = CC.UPI.State
-        <$> arbitrary
-        <*> arbitrary
-        <*> arbitrary
-        <*> pure mempty -- TODO CandidateProtocolUpdate's constructor is not exported
-        <*> arbitrary
-        <*> arbitrary
-        <*> arbitrary
-        <*> arbitrary
-        <*> arbitrary
-        <*> pure mempty -- TODO Endorsement is not exported
-        <*> arbitrary
+instance Arbitrary CC.UPI.State where
+  arbitrary = CC.UPI.State
+    <$> arbitrary
+    <*> arbitrary
+    <*> arbitrary
+    <*> pure mempty -- TODO CandidateProtocolUpdate's constructor is not exported
+    <*> arbitrary
+    <*> arbitrary
+    <*> arbitrary
+    <*> arbitrary
+    <*> arbitrary
+    <*> pure mempty -- TODO Endorsement is not exported
+    <*> arbitrary
+
+{-------------------------------------------------------------------------------
+  Orphans
+-------------------------------------------------------------------------------}
+
+instance Eq (Some (Query ByronBlock)) where
+  Some GetUpdateInterfaceState == Some GetUpdateInterfaceState = True
+
+deriving instance Show (Some (Query ByronBlock))
diff --git a/ouroboros-consensus/test-consensus/Test/Consensus/LocalStateQueryServer.hs b/ouroboros-consensus/test-consensus/Test/Consensus/LocalStateQueryServer.hs
index df70a1b272c..7c338647fde 100644
--- a/ouroboros-consensus/test-consensus/Test/Consensus/LocalStateQueryServer.hs
+++ b/ouroboros-consensus/test-consensus/Test/Consensus/LocalStateQueryServer.hs
@@ -117,7 +117,7 @@ prop_localStateQueryServer k bt p = checkOutcome k chain actualOutcome
 checkOutcome
   :: SecurityParam
   -> Chain TestBlock
-  -> [(Point TestBlock, Either AcquireFailure [Result TestBlock])]
+  -> [(Point TestBlock, Either AcquireFailure (Point TestBlock))]
   -> Property
 checkOutcome k chain = conjoin . map (uncurry checkResult)
   where
@@ -127,11 +127,11 @@ checkOutcome k chain = conjoin . map (uncurry checkResult)
 
     checkResult
       :: Point TestBlock
-      -> Either AcquireFailure [Result TestBlock]
+      -> Either AcquireFailure (Point TestBlock)
       -> Property
     checkResult pt = \case
-      Right results
-        -> tabulate "Acquired" ["Success"] $ results === [ResultLedgerTip pt]
+      Right result
+        -> tabulate "Acquired" ["Success"] $ result === pt
       Left AcquireFailurePointNotOnChain
         | Chain.pointOnChain pt chain
         -> counterexample
@@ -155,16 +155,15 @@ mkClient
   -> LocalStateQueryClient
        TestBlock
        (Query TestBlock)
-       (Result TestBlock)
        m
-       [(Point TestBlock, Either AcquireFailure [Result TestBlock])]
-mkClient points = localStateQueryClient [(pt, [QueryLedgerTip]) | pt <- points]
+       [(Point TestBlock, Either AcquireFailure (Point TestBlock))]
+mkClient points = localStateQueryClient [(pt, QueryLedgerTip) | pt <- points]
 
 mkServer
   :: IOLike m
   => SecurityParam
   -> Chain TestBlock
-  -> m (LocalStateQueryServer TestBlock (Query TestBlock) (Result TestBlock) m ())
+  -> m (LocalStateQueryServer TestBlock (Query TestBlock) m ())
 mkServer k chain = do
     lgrDB <- initLgrDB k chain
     return $ localStateQueryServer $ LedgerCursor.newLedgerCursor lgrDB getImmutablePoint
diff --git a/ouroboros-consensus/test-consensus/Test/ThreadNet/Network.hs b/ouroboros-consensus/test-consensus/Test/ThreadNet/Network.hs
index 42f88f05240..99074a69e96 100644
--- a/ouroboros-consensus/test-consensus/Test/ThreadNet/Network.hs
+++ b/ouroboros-consensus/test-consensus/Test/ThreadNet/Network.hs
@@ -668,7 +668,7 @@ runThreadNetwork ThreadNetworkArgs
            (AnyMessage (TxSubmission (GenTxId blk) (GenTx blk)))
            (AnyMessage (ChainSync (Serialised blk) (Tip blk)))
            (AnyMessage (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)))
-           (AnyMessage (LocalStateQuery blk (Query blk) (Result blk)))
+           (AnyMessage (LocalStateQuery blk (Query blk)))
     customProtocolCodecs cfg = ProtocolCodecs
         { pcChainSyncCodec =
             mapFailureCodec CodecBytesFailure $
@@ -1061,8 +1061,7 @@ type TracingConstraints blk =
   , Show (Header blk)
   , Show (GenTx blk)
   , Show (GenTxId blk)
-  , Show (Query blk)
-  , Show (Result blk)
+  , ShowQuery (Query blk)
   )
 
 {-------------------------------------------------------------------------------
diff --git a/ouroboros-consensus/test-util/Test/Util/TestBlock.hs b/ouroboros-consensus/test-util/Test/Util/TestBlock.hs
index fd2507305a9..9e6659d735c 100644
--- a/ouroboros-consensus/test-util/Test/Util/TestBlock.hs
+++ b/ouroboros-consensus/test-util/Test/Util/TestBlock.hs
@@ -4,12 +4,14 @@
 {-# LANGUAGE DerivingStrategies         #-}
 {-# LANGUAGE DerivingVia                #-}
 {-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE GADTs                      #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MultiParamTypeClasses      #-}
 {-# LANGUAGE NamedFieldPuns             #-}
 {-# LANGUAGE PatternSynonyms            #-}
 {-# LANGUAGE RecordWildCards            #-}
 {-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE StandaloneDeriving         #-}
 {-# LANGUAGE TypeFamilies               #-}
 
 -- | Minimal instantiation of the consensus layer to be able to run the ChainDB
@@ -23,7 +25,6 @@ module Test.Util.TestBlock (
   , TestBlockError(..)
   , Header(..)
   , Query(..)
-  , Result(..)
   , firstBlock
   , successorBlock
   , modifyFork
@@ -62,6 +63,7 @@ import qualified Data.Map.Strict as Map
 import           Data.Maybe (fromMaybe)
 import           Data.Tree (Tree (..))
 import qualified Data.Tree as Tree
+import           Data.Type.Equality ((:~:) (Refl))
 import           Data.Word
 import           GHC.Generics (Generic)
 import qualified System.Random as R
@@ -305,13 +307,18 @@ instance ProtocolLedgerView TestBlock where
   anachronisticProtocolLedgerView _ _ _ = Right ()
 
 instance QueryLedger TestBlock where
-  data Query  TestBlock = QueryLedgerTip
-    deriving (Eq, Show, Generic, Serialise)
-  data Result TestBlock = ResultLedgerTip (Point TestBlock)
-    deriving (Eq, Show, Generic, Serialise)
+  data Query TestBlock result where
+    QueryLedgerTip :: Query TestBlock (Point TestBlock)
 
   answerQuery QueryLedgerTip (TestLedger { lastAppliedPoint }) =
-    ResultLedgerTip lastAppliedPoint
+    lastAppliedPoint
+  eqQuery QueryLedgerTip QueryLedgerTip = Just Refl
+
+deriving instance Eq (Query TestBlock result)
+deriving instance Show (Query TestBlock result)
+
+instance ShowQuery (Query TestBlock) where
+  showResult QueryLedgerTip = show
 
 testInitLedger :: LedgerState TestBlock
 testInitLedger = TestLedger Block.genesisPoint
diff --git a/ouroboros-network/src/Ouroboros/Network/Protocol/LocalStateQuery/Client.hs b/ouroboros-network/src/Ouroboros/Network/Protocol/LocalStateQuery/Client.hs
index 04bf56d8b29..a834e371406 100644
--- a/ouroboros-network/src/Ouroboros/Network/Protocol/LocalStateQuery/Client.hs
+++ b/ouroboros-network/src/Ouroboros/Network/Protocol/LocalStateQuery/Client.hs
@@ -22,8 +22,8 @@ import           Ouroboros.Network.Block (Point)
 import           Ouroboros.Network.Protocol.LocalStateQuery.Type
 
 
-newtype LocalStateQueryClient block query result m a = LocalStateQueryClient {
-      runLocalStateQueryClient :: ClientStIdle block query result m a
+newtype LocalStateQueryClient block query m a = LocalStateQueryClient {
+      runLocalStateQueryClient :: ClientStIdle block query m a
     }
 
 -- | In the 'StIdle' protocol state, the client has agency and must send:
@@ -31,13 +31,13 @@ newtype LocalStateQueryClient block query result m a = LocalStateQueryClient {
 --  * a request to acquire a state
 --  * a termination messge
 --
-data ClientStIdle block query result (m :: * -> *) a where
+data ClientStIdle block query (m :: * -> *) a where
   SendMsgAcquire :: Point block
-                 -> ClientStAcquiring block query result m a
-                 -> ClientStIdle      block query result m a
+                 -> ClientStAcquiring block query m a
+                 -> ClientStIdle      block query m a
 
   SendMsgDone    :: a
-                 -> ClientStIdle      block query result m a
+                 -> ClientStIdle      block query m a
 
 -- | In the 'StAcquiring' protocol state, the client does not have agency.
 -- Instead it is waiting for:
@@ -47,11 +47,11 @@ data ClientStIdle block query result (m :: * -> *) a where
 --
 -- It must be prepared to handle either.
 --
-data ClientStAcquiring block query result m a = ClientStAcquiring {
-      recvMsgAcquired ::    ClientStAcquired block query result m a,
+data ClientStAcquiring block query m a = ClientStAcquiring {
+      recvMsgAcquired ::    ClientStAcquired block query m a,
 
       recvMsgFailure  :: AcquireFailure
-                      -> m (ClientStIdle     block query result m a)
+                      -> m (ClientStIdle     block query m a)
     }
 
 -- | In the 'StAcquired' protocol state, the client has agency and must send:
@@ -60,41 +60,41 @@ data ClientStAcquiring block query result m a = ClientStAcquiring {
 --  * a request to (re)acquire another state
 --  * a release of the current state
 --
-data ClientStAcquired block query result m a where
-  SendMsgQuery     :: query
-                   -> ClientStQuerying block query result m a
-                   -> ClientStAcquired block query result m a
+data ClientStAcquired block query m a where
+  SendMsgQuery     :: query result
+                   -> ClientStQuerying block query m a result
+                   -> ClientStAcquired block query m a
 
   SendMsgReAcquire :: Point block
-                   -> ClientStAcquiring block query result m a
-                   -> ClientStAcquired  block query result m a
+                   -> ClientStAcquiring block query m a
+                   -> ClientStAcquired  block query m a
 
-  SendMsgRelease   :: ClientStIdle      block query result m a
-                   -> ClientStAcquired  block query result m a
+  SendMsgRelease   :: ClientStIdle      block query m a
+                   -> ClientStAcquired  block query m a
 
 -- | In the 'StQuerying' protocol state, the client does not have agency.
 -- Instead it is waiting for:
 --
 --  * a result
 --
-data ClientStQuerying block query result m a = ClientStQuerying {
-      recvMsgResult :: result -> m (ClientStAcquired block query result m a)
+data ClientStQuerying block query m a result = ClientStQuerying {
+      recvMsgResult :: result -> m (ClientStAcquired block query m a)
     }
 
 -- | Interpret a 'LocalStateQueryClient' action sequence as a 'Peer' on the
 -- client side of the 'LocalStateQuery' protocol.
 --
 localStateQueryClientPeer
-  :: forall block query result m a.
+  :: forall block query m a.
      Monad m
-  => LocalStateQueryClient block query result m a
-  -> Peer (LocalStateQuery block query result) AsClient StIdle m a
+  => LocalStateQueryClient block query m a
+  -> Peer (LocalStateQuery block query) AsClient StIdle m a
 localStateQueryClientPeer (LocalStateQueryClient handler) =
     handleStIdle handler
   where
     handleStIdle
-      :: ClientStIdle block query result m a
-      -> Peer (LocalStateQuery block query result) AsClient StIdle m a
+      :: ClientStIdle block query m a
+      -> Peer (LocalStateQuery block query) AsClient StIdle m a
     handleStIdle req = case req of
       SendMsgAcquire pt stAcquiring ->
         Yield (ClientAgency TokIdle)
@@ -106,21 +106,21 @@ localStateQueryClientPeer (LocalStateQueryClient handler) =
               (Done TokDone a)
 
     handleStAcquiring
-      :: ClientStAcquiring block query result m a
-      -> Peer (LocalStateQuery block query result) AsClient StAcquiring m a
+      :: ClientStAcquiring block query m a
+      -> Peer (LocalStateQuery block query) AsClient StAcquiring m a
     handleStAcquiring ClientStAcquiring{recvMsgAcquired, recvMsgFailure} =
       Await (ServerAgency TokAcquiring) $ \req -> case req of
         MsgAcquired        -> handleStAcquired recvMsgAcquired
         MsgFailure failure -> Effect $ handleStIdle <$> recvMsgFailure failure
 
     handleStAcquired
-      :: ClientStAcquired block query result m a
-      -> Peer (LocalStateQuery block query result) AsClient StAcquired m a
+      :: ClientStAcquired block query m a
+      -> Peer (LocalStateQuery block query) AsClient StAcquired m a
     handleStAcquired req = case req of
       SendMsgQuery query stQuerying ->
         Yield (ClientAgency TokAcquired)
               (MsgQuery query)
-              (handleStQuerying stQuerying)
+              (handleStQuerying query stQuerying)
       SendMsgReAcquire pt stAcquiring ->
         Yield (ClientAgency TokAcquired)
               (MsgReAcquire pt)
@@ -131,8 +131,9 @@ localStateQueryClientPeer (LocalStateQueryClient handler) =
               (handleStIdle stIdle)
 
     handleStQuerying
-      :: ClientStQuerying block query result m a
-      -> Peer (LocalStateQuery block query result) AsClient StQuerying m a
-    handleStQuerying ClientStQuerying{recvMsgResult} =
-      Await (ServerAgency TokQuerying) $ \req -> case req of
-        MsgResult result -> Effect (handleStAcquired <$> recvMsgResult result)
+      :: query result
+      -> ClientStQuerying block query m a result
+      -> Peer (LocalStateQuery block query) AsClient (StQuerying result) m a
+    handleStQuerying query ClientStQuerying{recvMsgResult} =
+      Await (ServerAgency (TokQuerying query)) $ \req -> case req of
+        MsgResult _ result -> Effect (handleStAcquired <$> recvMsgResult result)
diff --git a/ouroboros-network/src/Ouroboros/Network/Protocol/LocalStateQuery/Codec.hs b/ouroboros-network/src/Ouroboros/Network/Protocol/LocalStateQuery/Codec.hs
index 9f6104040b8..2687ea22072 100644
--- a/ouroboros-network/src/Ouroboros/Network/Protocol/LocalStateQuery/Codec.hs
+++ b/ouroboros-network/src/Ouroboros/Network/Protocol/LocalStateQuery/Codec.hs
@@ -4,9 +4,12 @@
 {-# LANGUAGE PolyKinds           #-}
 {-# LANGUAGE RankNTypes          #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeOperators       #-}
+
 module Ouroboros.Network.Protocol.LocalStateQuery.Codec (
     codecLocalStateQuery
   , codecLocalStateQueryId
+  , Some (..)
   ) where
 
 import           Control.Monad.Class.MonadST
@@ -15,6 +18,7 @@ import qualified Codec.CBOR.Decoding as CBOR
 import qualified Codec.CBOR.Encoding as CBOR
 import qualified Codec.CBOR.Read as CBOR
 import           Data.ByteString.Lazy (ByteString)
+import           Data.Type.Equality ((:~:) (..))
 
 import           Network.TypedProtocol.Codec.Cbor
 
@@ -22,16 +26,19 @@ import           Ouroboros.Network.Protocol.LocalStateQuery.Type
 
 import           Ouroboros.Network.Block (Point)
 
+data Some (f :: k -> *) where
+    Some :: f a -> Some f
+
 codecLocalStateQuery
-  :: forall block query result m.
+  :: forall block query m.
      MonadST m
   => (Point block -> CBOR.Encoding)
   -> (forall s . CBOR.Decoder s (Point block))
-  -> (query -> CBOR.Encoding)
-  -> (forall s . CBOR.Decoder s query)
-  -> (result -> CBOR.Encoding)
-  -> (forall s . CBOR.Decoder s result)
-  -> Codec (LocalStateQuery block query result) CBOR.DeserialiseFailure m ByteString
+  -> (forall result . query result -> CBOR.Encoding)
+  -> (forall s . CBOR.Decoder s (Some query))
+  -> (forall result . query result -> result -> CBOR.Encoding)
+  -> (forall result . query result -> forall s . CBOR.Decoder s result)
+  -> Codec (LocalStateQuery block query) CBOR.DeserialiseFailure m ByteString
 codecLocalStateQuery encodePoint  decodePoint
                      encodeQuery  decodeQuery
                      encodeResult decodeResult =
@@ -49,9 +56,11 @@ codecLocalStateQuery encodePoint  decodePoint
         1 -> return AcquireFailurePointNotOnChain
         _ -> fail $ "decodeFailure: invalid tag " <> show tag
 
-    encode :: forall (pr :: PeerRole) st st'.
+    encode :: forall (pr  :: PeerRole)
+                     (st  :: LocalStateQuery block query)
+                     (st' :: LocalStateQuery block query).
               PeerHasAgency pr st
-           -> Message (LocalStateQuery block query result) st st'
+           -> Message (LocalStateQuery block query) st st'
            -> CBOR.Encoding
     encode (ClientAgency TokIdle) (MsgAcquire pt) =
         CBOR.encodeListLen 2
@@ -72,10 +81,10 @@ codecLocalStateQuery encodePoint  decodePoint
      <> CBOR.encodeWord 3
      <> encodeQuery query
 
-    encode (ServerAgency TokQuerying) (MsgResult result) =
+    encode (ServerAgency (TokQuerying _query)) (MsgResult query result) =
         CBOR.encodeListLen 2
      <> CBOR.encodeWord 4
-     <> encodeResult result
+     <> encodeResult query result
 
     encode (ClientAgency TokAcquired) MsgRelease =
         CBOR.encodeListLen 1
@@ -90,7 +99,7 @@ codecLocalStateQuery encodePoint  decodePoint
         CBOR.encodeListLen 1
      <> CBOR.encodeWord 7
 
-    decode :: forall (pr :: PeerRole) s (st :: LocalStateQuery block query result).
+    decode :: forall (pr :: PeerRole) s (st :: LocalStateQuery block query).
               PeerHasAgency pr st
            -> CBOR.Decoder s (SomeMessage st)
     decode stok = do
@@ -109,12 +118,12 @@ codecLocalStateQuery encodePoint  decodePoint
           return (SomeMessage (MsgFailure failure))
 
         (ClientAgency TokAcquired, 2, 3) -> do
-          query <- decodeQuery
+          Some query <- decodeQuery
           return (SomeMessage (MsgQuery query))
 
-        (ServerAgency TokQuerying, 2, 4) -> do
-          result <- decodeResult
-          return (SomeMessage (MsgResult result))
+        (ServerAgency (TokQuerying query), 2, 4) -> do
+          result <- decodeResult query
+          return (SomeMessage (MsgResult query result))
 
         (ClientAgency TokAcquired, 1, 5) ->
           return (SomeMessage MsgRelease)
@@ -132,7 +141,7 @@ codecLocalStateQuery encodePoint  decodePoint
           fail "codecLocalStateQuery.Acquired: unexpected key"
         (ServerAgency TokAcquiring, _, _) ->
           fail "codecLocalStateQuery.Acquiring: unexpected key"
-        (ServerAgency TokQuerying, _, _) ->
+        (ServerAgency (TokQuerying _), _, _) ->
           fail "codecLocalStateQuery.Querying: unexpected key"
 
 
@@ -140,36 +149,44 @@ codecLocalStateQuery encodePoint  decodePoint
 -- any serialisation. It keeps the typed messages, wrapped in 'AnyMessage'.
 --
 codecLocalStateQueryId
-  :: forall block query result m.
+  :: forall block (query :: * -> *) m.
      Monad m
-  => Codec (LocalStateQuery block query result)
+  => (forall result1 result2.
+          query result1
+       -> query result2
+       -> Maybe (result1 :~: result2)
+     )
+  -> Codec (LocalStateQuery block query)
            CodecFailure m
-           (AnyMessage (LocalStateQuery block query result))
-codecLocalStateQueryId =
+           (AnyMessage (LocalStateQuery block query))
+codecLocalStateQueryId eqQuery =
   Codec encode decode
  where
   encode :: forall (pr :: PeerRole) st st'.
             PeerHasAgency pr st
-         -> Message (LocalStateQuery block query result) st st'
-         -> AnyMessage (LocalStateQuery block query result)
+         -> Message (LocalStateQuery block query) st st'
+         -> AnyMessage (LocalStateQuery block query)
   encode _ = AnyMessage
 
-  decode :: forall (pr :: PeerRole) st.
+  decode :: forall (pr :: PeerRole) (st :: LocalStateQuery block query).
             PeerHasAgency pr st
-         -> m (DecodeStep (AnyMessage (LocalStateQuery block query result))
+         -> m (DecodeStep (AnyMessage (LocalStateQuery block query))
                           CodecFailure m (SomeMessage st))
   decode stok = return $ DecodePartial $ \bytes -> case (stok, bytes) of
-    (ClientAgency TokIdle,      Just (AnyMessage msg@(MsgAcquire{})))   -> res msg
-    (ClientAgency TokIdle,      Just (AnyMessage msg@(MsgDone{})))      -> res msg
-    (ClientAgency TokAcquired,  Just (AnyMessage msg@(MsgQuery{})))     -> res msg
-    (ClientAgency TokAcquired,  Just (AnyMessage msg@(MsgReAcquire{}))) -> res msg
-    (ClientAgency TokAcquired,  Just (AnyMessage msg@(MsgRelease{})))   -> res msg
-    (ServerAgency TokAcquiring, Just (AnyMessage msg@(MsgAcquired{})))  -> res msg
-    (ServerAgency TokAcquiring, Just (AnyMessage msg@(MsgFailure{})))   -> res msg
-    (ServerAgency TokQuerying,  Just (AnyMessage msg@(MsgResult{})))    -> res msg
+    (ClientAgency TokIdle,         Just (AnyMessage msg@(MsgAcquire{})))   -> res msg
+    (ClientAgency TokIdle,         Just (AnyMessage msg@(MsgDone{})))      -> res msg
+    (ClientAgency TokAcquired,     Just (AnyMessage msg@(MsgQuery{})))     -> res msg
+    (ClientAgency TokAcquired,     Just (AnyMessage msg@(MsgReAcquire{}))) -> res msg
+    (ClientAgency TokAcquired,     Just (AnyMessage msg@(MsgRelease{})))   -> res msg
+    (ServerAgency TokAcquiring,    Just (AnyMessage msg@(MsgAcquired{})))  -> res msg
+    (ServerAgency TokAcquiring,    Just (AnyMessage msg@(MsgFailure{})))   -> res msg
+    (ServerAgency (TokQuerying q), Just (AnyMessage msg@(MsgResult query _)))
+       | Just Refl <- eqQuery q query
+       -> res msg
     (_, Nothing) -> return (DecodeFail CodecFailureOutOfInput)
     (_, _)       -> return (DecodeFail (CodecFailure failmsg))
 
-  res :: Message (LocalStateQuery block query result) st st' -> m (DecodeStep bytes failure m (SomeMessage st))
+  res :: Message (LocalStateQuery block query) st st'
+      -> m (DecodeStep bytes failure m (SomeMessage st))
   res msg = return (DecodeDone (SomeMessage msg) Nothing)
   failmsg = "codecLocalStateQueryId: no matching message"
diff --git a/ouroboros-network/src/Ouroboros/Network/Protocol/LocalStateQuery/Direct.hs b/ouroboros-network/src/Ouroboros/Network/Protocol/LocalStateQuery/Direct.hs
index 0f582ce03b2..45bce77d076 100644
--- a/ouroboros-network/src/Ouroboros/Network/Protocol/LocalStateQuery/Direct.hs
+++ b/ouroboros-network/src/Ouroboros/Network/Protocol/LocalStateQuery/Direct.hs
@@ -8,17 +8,17 @@ import           Ouroboros.Network.Protocol.LocalStateQuery.Client
 import           Ouroboros.Network.Protocol.LocalStateQuery.Server
 
 direct
-  :: forall block query result m a b.
+  :: forall block query m a b.
      Monad m
-  => LocalStateQueryClient block query result m a
-  -> LocalStateQueryServer block query result m b
+  => LocalStateQueryClient block query m a
+  -> LocalStateQueryServer block query m b
   -> m (a, b)
 direct (LocalStateQueryClient client) (LocalStateQueryServer mserver) =
     mserver >>= directIdle client
   where
     directIdle
-      :: ClientStIdle block query result m a
-      -> ServerStIdle block query result m b
+      :: ClientStIdle block query m a
+      -> ServerStIdle block query m b
       -> m (a, b)
     directIdle (SendMsgAcquire pt client') ServerStIdle{recvMsgAcquire} = do
       server' <- recvMsgAcquire pt
@@ -28,8 +28,8 @@ direct (LocalStateQueryClient client) (LocalStateQueryServer mserver) =
       return (a, b)
 
     directAcquiring
-      :: ClientStAcquiring block query result m a
-      -> ServerStAcquiring block query result m b
+      :: ClientStAcquiring block query m a
+      -> ServerStAcquiring block query m b
       -> m (a, b)
     directAcquiring ClientStAcquiring{recvMsgAcquired} (SendMsgAcquired server') =
       let client' = recvMsgAcquired
@@ -39,8 +39,8 @@ direct (LocalStateQueryClient client) (LocalStateQueryServer mserver) =
       directIdle client' server'
 
     directAcquired
-      :: ClientStAcquired block query result m a
-      -> ServerStAcquired block query result m b
+      :: ClientStAcquired block query m a
+      -> ServerStAcquired block query m b
       -> m (a, b)
     directAcquired (SendMsgQuery query client') ServerStAcquired{recvMsgQuery} = do
       server' <- recvMsgQuery query
@@ -53,8 +53,8 @@ direct (LocalStateQueryClient client) (LocalStateQueryServer mserver) =
       directIdle client' server'
 
     directQuerying
-      :: ClientStQuerying block query result m a
-      -> ServerStQuerying block query result m b
+      :: ClientStQuerying block query m a result
+      -> ServerStQuerying block query m b result
       -> m (a, b)
     directQuerying ClientStQuerying{recvMsgResult} (SendMsgResult result server') = do
       client' <- recvMsgResult result
diff --git a/ouroboros-network/src/Ouroboros/Network/Protocol/LocalStateQuery/Examples.hs b/ouroboros-network/src/Ouroboros/Network/Protocol/LocalStateQuery/Examples.hs
index 0db20696eda..88042771ea7 100644
--- a/ouroboros-network/src/Ouroboros/Network/Protocol/LocalStateQuery/Examples.hs
+++ b/ouroboros-network/src/Ouroboros/Network/Protocol/LocalStateQuery/Examples.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE RankNTypes          #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 module Ouroboros.Network.Protocol.LocalStateQuery.Examples where
 
@@ -15,56 +16,52 @@ import           Ouroboros.Network.Protocol.LocalStateQuery.Type
 
 -- | An example 'LocalStateQueryClient', which, for each point in the given
 -- list, acquires the state for that point, and if that succeeds, returns the
--- results for all the corresponding queries. When the state could not be
--- acquired, the 'AcquireFailure' is returned instead of the query results.
+-- result for the corresponding query. When the state could not be acquired,
+-- the 'AcquireFailure' is returned instead of the query results.
 --
 localStateQueryClient
   :: forall block query result m. Applicative m
-  => [(Point block, [query])]
-  -> LocalStateQueryClient block query result m
-                           [(Point block, Either AcquireFailure [result])]
+  => [(Point block, query result)]
+  -> LocalStateQueryClient block query m
+                           [(Point block, Either AcquireFailure result)]
 localStateQueryClient = LocalStateQueryClient . goIdle []
   where
     goIdle
-      :: [(Point block, Either AcquireFailure [result])]  -- ^ Accumulator
-      -> [(Point block, [query])]  -- ^ Remainder
-      -> ClientStIdle block query result m
-                      [(Point block, Either AcquireFailure [result])]
-    goIdle acc []                = SendMsgDone $ reverse acc
-    goIdle acc ((pt, qs):ptqss') = SendMsgAcquire pt $
-      goAcquiring acc pt qs ptqss'
+      :: [(Point block, Either AcquireFailure result)]  -- ^ Accumulator
+      -> [(Point block, query result)]  -- ^ Remainder
+      -> ClientStIdle block query m
+                      [(Point block, Either AcquireFailure result)]
+    goIdle acc []              = SendMsgDone $ reverse acc
+    goIdle acc ((pt, q):ptqs') = SendMsgAcquire pt $ goAcquiring acc pt q ptqs'
 
     goAcquiring
-      :: [(Point block, Either AcquireFailure [result])]  -- ^ Accumulator
+      :: [(Point block, Either AcquireFailure result)]  -- ^ Accumulator
       -> Point block
-      -> [query]
-      -> [(Point block, [query])]  -- ^ Remainder
-      -> ClientStAcquiring block query result m
-                           [(Point block, Either AcquireFailure [result])]
-    goAcquiring acc pt qs ptqss' = ClientStAcquiring {
-        recvMsgAcquired = goQuery [] qs $ \rs -> goAcquired ((pt, Right rs):acc) ptqss'
+      -> query result
+      -> [(Point block, query result)]  -- ^ Remainder
+      -> ClientStAcquiring block query m
+                           [(Point block, Either AcquireFailure result)]
+    goAcquiring acc pt q ptqss' = ClientStAcquiring {
+        recvMsgAcquired = goQuery q $ \r -> goAcquired ((pt, Right r):acc) ptqss'
       , recvMsgFailure  = \failure -> pure $ goIdle ((pt, Left failure):acc) ptqss'
       }
 
     goAcquired
-      :: [(Point block, Either AcquireFailure [result])]
-      -> [(Point block, [query])]   -- ^ Remainder
-      -> ClientStAcquired block query result m
-                          [(Point block, Either AcquireFailure [result])]
+      :: [(Point block, Either AcquireFailure result)]
+      -> [(Point block, query result)]   -- ^ Remainder
+      -> ClientStAcquired block query m
+                          [(Point block, Either AcquireFailure result)]
     goAcquired acc [] = SendMsgRelease $ SendMsgDone $ reverse acc
     goAcquired acc ((pt, qs):ptqss') = SendMsgReAcquire pt $
       goAcquiring acc pt qs ptqss'
 
     goQuery
       :: forall a.
-        [result]  -- ^ Result accumulator
-      -> [query]
-      -> ([result] -> ClientStAcquired block query result m a)
+         query result
+      -> (result -> ClientStAcquired block query m a)
          -- ^ Continuation
-      -> ClientStAcquired block query result m a
-    goQuery acc []      k = k (reverse acc)
-    goQuery acc (q:qs') k = SendMsgQuery q $ ClientStQuerying $ \r ->
-      pure $ goQuery (r:acc) qs' k
+      -> ClientStAcquired block query m a
+    goQuery q k = SendMsgQuery q $ ClientStQuerying $ \r -> pure $ k r
 
 --
 -- Example server
@@ -74,25 +71,25 @@ localStateQueryClient = LocalStateQueryClient . goIdle []
 -- acquire a @state@, after which the second will be used to query the state.
 --
 localStateQueryServer
-  :: forall block query result m state. Applicative m
+  :: forall block query m state. Applicative m
   => (Point block -> Either AcquireFailure state)
-  -> (state -> query -> result)
-  -> LocalStateQueryServer block query result m ()
+  -> (forall result. state -> query result -> result)
+  -> LocalStateQueryServer block query m ()
 localStateQueryServer acquire answer =
     LocalStateQueryServer $ pure goIdle
   where
-    goIdle :: ServerStIdle block query result m ()
+    goIdle :: ServerStIdle block query m ()
     goIdle = ServerStIdle {
         recvMsgAcquire = goAcquiring
       , recvMsgDone    = pure ()
       }
 
-    goAcquiring :: Point block -> m (ServerStAcquiring block query result m ())
+    goAcquiring :: Point block -> m (ServerStAcquiring block query m ())
     goAcquiring pt = pure $ case acquire pt of
       Left failure -> SendMsgFailure failure goIdle
       Right state  -> SendMsgAcquired $ goAcquired state
 
-    goAcquired :: state -> ServerStAcquired block query result m ()
+    goAcquired :: state -> ServerStAcquired block query m ()
     goAcquired state = ServerStAcquired {
         recvMsgQuery     = \query ->
           pure $ SendMsgResult (answer state query) $ goAcquired state
diff --git a/ouroboros-network/src/Ouroboros/Network/Protocol/LocalStateQuery/Server.hs b/ouroboros-network/src/Ouroboros/Network/Protocol/LocalStateQuery/Server.hs
index 71118579f7f..4ad3a89d5c2 100644
--- a/ouroboros-network/src/Ouroboros/Network/Protocol/LocalStateQuery/Server.hs
+++ b/ouroboros-network/src/Ouroboros/Network/Protocol/LocalStateQuery/Server.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds           #-}
 {-# LANGUAGE GADTs               #-}
 {-# LANGUAGE NamedFieldPuns      #-}
+{-# LANGUAGE RankNTypes          #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 module Ouroboros.Network.Protocol.LocalStateQuery.Server (
       -- * Protocol type for the server
@@ -21,8 +22,8 @@ import           Ouroboros.Network.Block (Point)
 import           Ouroboros.Network.Protocol.LocalStateQuery.Type
 
 
-newtype LocalStateQueryServer block query result m a = LocalStateQueryServer {
-      runLocalStateQueryServer :: m (ServerStIdle block query result m a)
+newtype LocalStateQueryServer block query m a = LocalStateQueryServer {
+      runLocalStateQueryServer :: m (ServerStIdle block query m a)
     }
 
 -- | In the 'StIdle' protocol state, the server does not have agency. Instead
@@ -33,9 +34,9 @@ newtype LocalStateQueryServer block query result m a = LocalStateQueryServer {
 --
 -- It must be prepared to handle either.
 --
-data ServerStIdle block query result m a = ServerStIdle {
+data ServerStIdle block query m a = ServerStIdle {
        recvMsgAcquire :: Point block
-                      -> m (ServerStAcquiring block query result m a),
+                      -> m (ServerStAcquiring block query m a),
 
        recvMsgDone    :: m a
      }
@@ -46,16 +47,16 @@ data ServerStIdle block query result m a = ServerStIdle {
 --  * acquired
 --  * failure to acquire
 --
-data ServerStAcquiring block query result m a where
-  SendMsgAcquired :: ServerStAcquired  block query result m a
-                  -> ServerStAcquiring block query result m a
+data ServerStAcquiring block query m a where
+  SendMsgAcquired :: ServerStAcquired  block query m a
+                  -> ServerStAcquiring block query m a
 
   SendMsgFailure  :: AcquireFailure
-                  -> ServerStIdle      block query result m a
-                  -> ServerStAcquiring block query result m a
+                  -> ServerStIdle      block query m a
+                  -> ServerStAcquiring block query m a
 
--- | In the 'StAcquired' protocol state, the server does not have agency. Instead
--- it is waiting for:
+-- | In the 'StAcquired' protocol state, the server does not have agency.
+-- Instead it is waiting for:
 --
 --  * a query
 --  * a request to (re)acquire another state
@@ -63,39 +64,40 @@ data ServerStAcquiring block query result m a where
 --
 -- It must be prepared to handle either.
 --
-data ServerStAcquired block query result m a = ServerStAcquired {
-      recvMsgQuery     :: query
-                       -> m (ServerStQuerying  block query result m a),
+data ServerStAcquired block query m a = ServerStAcquired {
+      recvMsgQuery     :: forall result.
+                          query result
+                       -> m (ServerStQuerying  block query m a result),
 
       recvMsgReAcquire :: Point block
-                       -> m (ServerStAcquiring block query result m a),
+                       -> m (ServerStAcquiring block query m a),
 
-      recvMsgRelease   :: m (ServerStIdle      block query result m a)
+      recvMsgRelease   :: m (ServerStIdle      block query m a)
     }
 
 -- | In the 'StQuerying' protocol state, the server has agency and must send:
 --
 --  * a result
 --
-data ServerStQuerying block query result m a where
+data ServerStQuerying block query m a result where
   SendMsgResult :: result
-                -> ServerStAcquired block query result m a
-                -> ServerStQuerying block query result m a
+                -> ServerStAcquired block query m a
+                -> ServerStQuerying block query m a result
 
 -- | Interpret a 'LocalStateQueryServer' action sequence as a 'Peer' on the server
 -- side of the 'LocalStateQuery' protocol.
 --
 localStateQueryServerPeer
-  :: forall block query result m a.
+  :: forall block query m a.
      Monad m
-  => LocalStateQueryServer block query result m a
-  -> Peer (LocalStateQuery block query result) AsServer StIdle m a
+  => LocalStateQueryServer block query m a
+  -> Peer (LocalStateQuery block query) AsServer StIdle m a
 localStateQueryServerPeer (LocalStateQueryServer handler) =
     Effect $ handleStIdle <$> handler
   where
     handleStIdle
-      :: ServerStIdle block query result m a
-      -> Peer (LocalStateQuery block query result) AsServer StIdle m a
+      :: ServerStIdle block query m a
+      -> Peer (LocalStateQuery block query) AsServer StIdle m a
     handleStIdle ServerStIdle{recvMsgAcquire, recvMsgDone} =
       Await (ClientAgency TokIdle) $ \req -> case req of
         MsgAcquire pt -> Effect $
@@ -104,8 +106,8 @@ localStateQueryServerPeer (LocalStateQueryServer handler) =
           Done TokDone <$> recvMsgDone
 
     handleStAcquiring
-      :: ServerStAcquiring block query result m a
-      -> Peer (LocalStateQuery block query result) AsServer StAcquiring m a
+      :: ServerStAcquiring block query m a
+      -> Peer (LocalStateQuery block query) AsServer StAcquiring m a
     handleStAcquiring req = case req of
       SendMsgAcquired stAcquired    ->
         Yield (ServerAgency TokAcquiring)
@@ -117,18 +119,19 @@ localStateQueryServerPeer (LocalStateQueryServer handler) =
               (handleStIdle stIdle)
 
     handleStAcquired
-      :: ServerStAcquired block query result m a
-      -> Peer (LocalStateQuery block query result) AsServer StAcquired m a
+      :: ServerStAcquired block query m a
+      -> Peer (LocalStateQuery block query) AsServer StAcquired m a
     handleStAcquired ServerStAcquired{recvMsgQuery, recvMsgReAcquire, recvMsgRelease} =
       Await (ClientAgency TokAcquired) $ \req -> case req of
-        MsgQuery query  -> Effect $ handleStQuerying  <$> recvMsgQuery query
-        MsgReAcquire pt -> Effect $ handleStAcquiring <$> recvMsgReAcquire pt
-        MsgRelease      -> Effect $ handleStIdle      <$> recvMsgRelease
+        MsgQuery query  -> Effect $ handleStQuerying query <$> recvMsgQuery query
+        MsgReAcquire pt -> Effect $ handleStAcquiring      <$> recvMsgReAcquire pt
+        MsgRelease      -> Effect $ handleStIdle           <$> recvMsgRelease
 
     handleStQuerying
-      :: ServerStQuerying block query result m a
-      -> Peer (LocalStateQuery block query result) AsServer StQuerying m a
-    handleStQuerying (SendMsgResult result stAcquired) =
-      Yield (ServerAgency TokQuerying)
-            (MsgResult result)
+      :: query result
+      -> ServerStQuerying block query m a result
+      -> Peer (LocalStateQuery block query) AsServer (StQuerying result) m a
+    handleStQuerying query (SendMsgResult result stAcquired) =
+      Yield (ServerAgency (TokQuerying query))
+            (MsgResult query result)
             (handleStAcquired stAcquired)
diff --git a/ouroboros-network/src/Ouroboros/Network/Protocol/LocalStateQuery/Test.hs b/ouroboros-network/src/Ouroboros/Network/Protocol/LocalStateQuery/Test.hs
index e38911f2794..339527731d3 100644
--- a/ouroboros-network/src/Ouroboros/Network/Protocol/LocalStateQuery/Test.hs
+++ b/ouroboros-network/src/Ouroboros/Network/Protocol/LocalStateQuery/Test.hs
@@ -1,18 +1,19 @@
-{-# LANGUAGE DeriveAnyClass    #-}
-{-# LANGUAGE DeriveGeneric     #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs             #-}
-{-# LANGUAGE NamedFieldPuns    #-}
+{-# LANGUAGE FlexibleInstances   #-}
+{-# LANGUAGE GADTs               #-}
+{-# LANGUAGE NamedFieldPuns      #-}
+{-# LANGUAGE RankNTypes          #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving  #-}
 
 {-# OPTIONS_GHC -Wno-orphans #-}
 module Ouroboros.Network.Protocol.LocalStateQuery.Test (tests) where
 
+import qualified Codec.CBOR.Decoding as CBOR
+import qualified Codec.CBOR.Encoding as CBOR
 import           Data.ByteString.Lazy (ByteString)
 import           Data.Map (Map)
 import qualified Data.Map as Map
 
-import           GHC.Generics (Generic)
-
 import           Control.Monad.Class.MonadAsync (MonadAsync)
 import           Control.Monad.Class.MonadST (MonadST)
 import           Control.Monad.Class.MonadThrow (MonadCatch)
@@ -20,7 +21,6 @@ import           Control.Monad.IOSim
 import           Control.Monad.ST (runST)
 import           Control.Tracer (nullTracer)
 
-import           Codec.Serialise (Serialise)
 import qualified Codec.Serialise as Serialise (decode, encode)
 
 import           Network.TypedProtocol.Channel
@@ -30,10 +30,7 @@ import           Network.TypedProtocol.Proofs
 
 import           Ouroboros.Network.Channel
 
-import           Ouroboros.Network.Block (ChainHash (..), SlotNo, StandardHash,
-                     pointHash, pointSlot)
 import           Ouroboros.Network.MockChain.Chain (Point)
-import           Ouroboros.Network.Point (WithOrigin (..))
 import           Ouroboros.Network.Testing.ConcreteBlock (Block)
 
 import           Ouroboros.Network.Protocol.LocalStateQuery.Client
@@ -77,30 +74,25 @@ tests =
 -- Common types & clients and servers used in the tests in this module.
 --
 
-data Query
-  = QuerySlot
-  | QueryHash
-  deriving (Eq, Show, Generic, Serialise)
+data Query result where
+  QueryPoint :: Query (Point Block)
 
-data Result
-  = ResultSlot (WithOrigin SlotNo)
-  | ResultHash (ChainHash Block)
-  deriving (Eq, Show, Generic, Serialise)
+deriving instance Show (Query result)
 
 -- | Information to test an example server and client.
 data Setup = Setup
-  { clientInput   :: [(Point Block, [Query])]
+  { clientInput   :: [(Point Block, Query (Point Block))]
     -- ^ Input for 'localStateQueryClient'
   , serverAcquire :: Point Block -> Either AcquireFailure (Point Block)
     -- ^ First input parameter for 'localStateQueryServer'
-  , serverAnswer  :: Point Block -> Query -> Result
+  , serverAnswer  :: forall result. Point Block -> Query result -> result
     -- ^ Second input parameter for 'localStateQueryServer'
-  , expected      :: [(Point Block, Either AcquireFailure [Result])]
+  , expected      :: [(Point Block, Either AcquireFailure (Point Block))]
     -- ^ Expected result for the 'localStateQueryClient'.
   }
 
 mkSetup
-  :: Map (Point Block) (Maybe AcquireFailure, [Query])
+  :: Map (Point Block) (Maybe AcquireFailure, Query (Point Block))
      -- ^ For each point, the given state queries will be executed. In case of
      -- the second field is an 'AcquireFailure', the server will fail with
      -- that failure.
@@ -108,7 +100,7 @@ mkSetup
      -- This is the randomly generated input for the 'Setup'.
   -> Setup
 mkSetup input = Setup {
-      clientInput   = [(pt, qs) | (pt, (_, qs)) <- Map.toList input]
+      clientInput   = [(pt, q) | (pt, (_, q)) <- Map.toList input]
     , serverAcquire = \pt -> case Map.lookup pt input of
         Just (Just failure, _qs) -> Left failure
         Just (Nothing,      _qs) -> Right pt
@@ -117,16 +109,16 @@ mkSetup input = Setup {
     , serverAnswer  = answer
     , expected      =
         [ (pt, res)
-        | (pt, (mbFailure, qs)) <- Map.toList input
+        | (pt, (mbFailure, q)) <- Map.toList input
         , let res = case mbFailure of
-                Nothing      -> Right $ map (answer pt) qs
+                Nothing      -> Right $ answer pt q
                 Just failure -> Left failure
         ]
     }
   where
+    answer :: Point Block -> Query result -> result
     answer pt q = case q of
-      QuerySlot -> ResultSlot $ pointSlot pt
-      QueryHash -> ResultHash $ pointHash pt
+      QueryPoint -> pt
 
 
 --
@@ -136,7 +128,8 @@ mkSetup input = Setup {
 -- | Run a simple local state query client and server, directly on the wrappers,
 -- without going via the 'Peer'.
 --
-prop_direct :: Map (Point Block) (Maybe AcquireFailure, [Query]) -> Property
+prop_direct :: Map (Point Block) (Maybe AcquireFailure, Query (Point Block))
+            -> Property
 prop_direct input =
     runSimOrThrow
       (direct
@@ -155,7 +148,8 @@ prop_direct input =
 -- | Run a simple local state query client and server, going via the 'Peer'
 -- representation, but without going via a channel.
 --
-prop_connect :: Map (Point Block) (Maybe AcquireFailure, [Query]) -> Property
+prop_connect :: Map (Point Block) (Maybe AcquireFailure, Query (Point Block))
+             -> Property
 prop_connect input =
     case runSimOrThrow
            (connect
@@ -177,7 +171,7 @@ prop_connect input =
 --
 prop_channel :: (MonadAsync m, MonadCatch m, MonadST m)
              => m (Channel m ByteString, Channel m ByteString)
-             -> Map (Point Block) (Maybe AcquireFailure, [Query])
+             -> Map (Point Block) (Maybe AcquireFailure, Query (Point Block))
              -> m Property
 prop_channel createChannels input =
 
@@ -196,20 +190,23 @@ prop_channel createChannels input =
 
 -- | Run 'prop_channel' in the simulation monad.
 --
-prop_channel_ST :: Map (Point Block) (Maybe AcquireFailure, [Query]) -> Property
+prop_channel_ST :: Map (Point Block) (Maybe AcquireFailure, Query (Point Block))
+                -> Property
 prop_channel_ST input =
     runSimOrThrow
       (prop_channel createConnectedChannels input)
 
 -- | Run 'prop_channel' in the IO monad.
 --
-prop_channel_IO :: Map (Point Block) (Maybe AcquireFailure, [Query]) -> Property
+prop_channel_IO :: Map (Point Block) (Maybe AcquireFailure, Query (Point Block))
+                -> Property
 prop_channel_IO input =
     ioProperty (prop_channel createConnectedChannels input)
 
 -- | Run 'prop_channel' in the IO monad using local pipes.
 --
-prop_pipe_IO :: Map (Point Block) (Maybe AcquireFailure, [Query]) -> Property
+prop_pipe_IO :: Map (Point Block) (Maybe AcquireFailure, Query (Point Block))
+             -> Property
 prop_pipe_IO input =
     ioProperty (prop_channel createPipeConnectedChannels input)
 
@@ -224,22 +221,10 @@ instance Arbitrary AcquireFailure where
     , AcquireFailurePointNotOnChain
     ]
 
-instance Arbitrary Query where
-  arbitrary = elements [QuerySlot, QueryHash]
+instance Arbitrary (Query (Point Block)) where
+  arbitrary = pure QueryPoint
 
-instance Arbitrary Result where
-  arbitrary = oneof
-    [ ResultSlot <$> frequency
-        [ (1, pure Origin)
-        , (9, At <$> arbitrary)
-        ]
-    , ResultHash <$> frequency
-        [ (1, pure GenesisHash)
-        , (9, BlockHash <$> arbitrary)
-        ]
-    ]
-
-instance Arbitrary (AnyMessageAndAgency (LocalStateQuery Block Query Result)) where
+instance Arbitrary (AnyMessageAndAgency (LocalStateQuery Block Query)) where
   arbitrary = oneof
     [ AnyMessageAndAgency (ClientAgency TokIdle) <$>
         (MsgAcquire <$> arbitrary)
@@ -251,10 +236,10 @@ instance Arbitrary (AnyMessageAndAgency (LocalStateQuery Block Query Result)) wh
         (MsgFailure <$> arbitrary)
 
     , AnyMessageAndAgency (ClientAgency TokAcquired) <$>
-        (MsgQuery <$> arbitrary)
+        (MsgQuery <$> (arbitrary :: Gen (Query (Point Block))))
 
-    , AnyMessageAndAgency (ServerAgency TokQuerying) <$>
-        (MsgResult <$> arbitrary)
+    , AnyMessageAndAgency (ServerAgency (TokQuerying QueryPoint)) <$>
+        (MsgResult QueryPoint <$> arbitrary)
 
     , AnyMessageAndAgency (ClientAgency TokAcquired) <$>
         pure MsgRelease
@@ -266,12 +251,13 @@ instance Arbitrary (AnyMessageAndAgency (LocalStateQuery Block Query Result)) wh
         pure MsgDone
     ]
 
-instance (StandardHash block, Show query, Show result) =>
-          Show (AnyMessageAndAgency (LocalStateQuery block query result)) where
+instance ShowQuery Query where
+  showResult QueryPoint = show
+
+instance Show (AnyMessageAndAgency (LocalStateQuery Block Query)) where
   show (AnyMessageAndAgency _ msg) = show msg
 
-instance (StandardHash block, Eq query, Eq result) =>
-          Eq (AnyMessage (LocalStateQuery block query result)) where
+instance  Eq (AnyMessage (LocalStateQuery Block Query)) where
 
   (==) (AnyMessage (MsgAcquire pt))
        (AnyMessage (MsgAcquire pt')) = pt == pt'
@@ -283,10 +269,14 @@ instance (StandardHash block, Eq query, Eq result) =>
        (AnyMessage (MsgFailure failure')) = failure == failure'
 
   (==) (AnyMessage (MsgQuery query))
-       (AnyMessage (MsgQuery query')) = query == query'
+       (AnyMessage (MsgQuery query')) =
+         case (query, query') of
+           (QueryPoint, QueryPoint) -> True
 
-  (==) (AnyMessage (MsgResult result))
-       (AnyMessage (MsgResult result')) = result == result'
+  (==) (AnyMessage (MsgResult query  result))
+       (AnyMessage (MsgResult query' result')) =
+         case (query, query') of
+           (QueryPoint, QueryPoint) -> result == result'
 
   (==) (AnyMessage MsgRelease)
        (AnyMessage MsgRelease) = True
@@ -301,34 +291,48 @@ instance (StandardHash block, Eq query, Eq result) =>
 
 
 codec :: MonadST m
-      => Codec (LocalStateQuery Block Query Result)
+      => Codec (LocalStateQuery Block Query)
                 DeserialiseFailure
                 m ByteString
 codec = codecLocalStateQuery
           Serialise.encode Serialise.decode
-          Serialise.encode Serialise.decode
-          Serialise.encode Serialise.decode
+          encodeQuery      decodeQuery
+          encodeResult     decodeResult
+  where
+    encodeQuery :: Query result -> CBOR.Encoding
+    encodeQuery QueryPoint = Serialise.encode ()
+
+    decodeQuery :: forall s . CBOR.Decoder s (Some Query)
+    decodeQuery = do
+      () <- Serialise.decode
+      return $ Some QueryPoint
+
+    encodeResult :: Query result -> result -> CBOR.Encoding
+    encodeResult QueryPoint = Serialise.encode
+
+    decodeResult :: Query result -> forall s. CBOR.Decoder s result
+    decodeResult QueryPoint = Serialise.decode
 
 -- | Check the codec round trip property.
 --
-prop_codec :: AnyMessageAndAgency (LocalStateQuery Block Query Result) -> Bool
+prop_codec :: AnyMessageAndAgency (LocalStateQuery Block Query) -> Bool
 prop_codec msg =
   runST (prop_codecM codec msg)
 
 -- | Check for data chunk boundary problems in the codec using 2 chunks.
 --
-prop_codec_splits2 :: AnyMessageAndAgency (LocalStateQuery Block Query Result) -> Bool
+prop_codec_splits2 :: AnyMessageAndAgency (LocalStateQuery Block Query) -> Bool
 prop_codec_splits2 msg =
   runST (prop_codec_splitsM splits2 codec msg)
 
 -- | Check for data chunk boundary problems in the codec using 3 chunks.
 --
-prop_codec_splits3 :: AnyMessageAndAgency (LocalStateQuery Block Query Result) -> Bool
+prop_codec_splits3 :: AnyMessageAndAgency (LocalStateQuery Block Query) -> Bool
 prop_codec_splits3 msg =
   runST (prop_codec_splitsM splits3 codec msg)
 
 prop_codec_cbor
-  :: AnyMessageAndAgency (LocalStateQuery Block Query Result)
+  :: AnyMessageAndAgency (LocalStateQuery Block Query)
   -> Bool
 prop_codec_cbor msg =
   runST (prop_codec_cborM codec msg)
diff --git a/ouroboros-network/src/Ouroboros/Network/Protocol/LocalStateQuery/Type.hs b/ouroboros-network/src/Ouroboros/Network/Protocol/LocalStateQuery/Type.hs
index 6c84e420782..a5613978e5c 100644
--- a/ouroboros-network/src/Ouroboros/Network/Protocol/LocalStateQuery/Type.hs
+++ b/ouroboros-network/src/Ouroboros/Network/Protocol/LocalStateQuery/Type.hs
@@ -1,10 +1,13 @@
-{-# LANGUAGE DataKinds          #-}
-{-# LANGUAGE EmptyCase          #-}
-{-# LANGUAGE FlexibleInstances  #-}
-{-# LANGUAGE GADTs              #-}
-{-# LANGUAGE PolyKinds          #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TypeFamilies       #-}
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE EmptyCase             #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE GADTs                 #-}
+{-# LANGUAGE PolyKinds             #-}
+{-# LANGUAGE QuantifiedConstraints #-}
+{-# LANGUAGE RankNTypes            #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE UndecidableInstances  #-}
 
 -- | The type of the local ledger state query protocol.
 --
@@ -13,9 +16,8 @@
 --
 module Ouroboros.Network.Protocol.LocalStateQuery.Type where
 
-
-import Network.TypedProtocol.Core
-import Ouroboros.Network.Block (Point, StandardHash)
+import           Network.TypedProtocol.Core
+import           Ouroboros.Network.Block (Point, StandardHash)
 
 
 -- | The kind of the local state query protocol, and the types of
@@ -24,42 +26,41 @@ import Ouroboros.Network.Block (Point, StandardHash)
 -- It is parametrised over the type of block (for points), the type of queries
 -- and query results.
 --
-data LocalStateQuery block query result where
+data LocalStateQuery block query where
 
   -- | The client has agency. It can ask to acquire a state or terminate.
   --
   -- There is no timeout in this state.
   --
-  StIdle :: LocalStateQuery block query result
+  StIdle :: LocalStateQuery block query
 
   -- | The server has agency. it must acquire the state at the requested point
   -- or report a failure.
   --
   -- There is a timeout in this state.
   --
-  StAcquiring :: LocalStateQuery block query result
+  StAcquiring :: LocalStateQuery block query
 
   -- | The client has agency. It can request queries against the current state,
   -- or it can release the state.
   --
-  StAcquired :: LocalStateQuery block query result
+  StAcquired :: LocalStateQuery block query
 
   -- | The server has agency. It must respond with the query result.
   --
-  StQuerying :: LocalStateQuery block query result
+  StQuerying :: result -> LocalStateQuery block query
 
   -- | Nobody has agency. The terminal state.
   --
-  StDone   :: LocalStateQuery block query result
-
+  StDone :: LocalStateQuery block query
 
-instance Protocol (LocalStateQuery block query result) where
+instance Protocol (LocalStateQuery block query) where
 
   -- | The messages in the state query protocol.
   --
-  -- The pattern of use is to 
+  -- The pattern of use is to
   --
-  data Message (LocalStateQuery block query result) from to where
+  data Message (LocalStateQuery block query) from to where
 
     -- | The client requests that the state as of a particular recent point on
     -- the server's chain (within K of the tip) be made available to query,
@@ -67,37 +68,40 @@ instance Protocol (LocalStateQuery block query result) where
     --
     MsgAcquire
       :: Point block
-      -> Message (LocalStateQuery block query result) StIdle StAcquiring
+      -> Message (LocalStateQuery block query) StIdle StAcquiring
 
     -- | The server can confirm that it has the state at the requested point.
     --
     MsgAcquired
-      :: Message (LocalStateQuery block query result) StAcquiring StAcquired
+      :: Message (LocalStateQuery block query) StAcquiring StAcquired
 
     -- | The server can report that it cannot obtain the state for the
     -- requested point.
     --
     MsgFailure
       :: AcquireFailure
-      -> Message (LocalStateQuery block query result) StAcquiring StIdle
+      -> Message (LocalStateQuery block query) StAcquiring StIdle
 
     -- | The client can perform queries on the current acquired state.
     --
     MsgQuery
-      :: query
-      -> Message (LocalStateQuery block query result) StAcquired StQuerying
+      :: query result
+      -> Message (LocalStateQuery block query) StAcquired (StQuerying result)
 
-    -- | The server must reply with the query results.
+    -- | The server must reply with the queries.
     --
     MsgResult
-      :: result
-      -> Message (LocalStateQuery block query result) StQuerying StAcquired
+      :: query result
+         -- ^ The query will not be sent across the network, it is solely used
+         -- as evidence that @result@ is a valid type index of @query@.
+      -> result
+      -> Message (LocalStateQuery block query) (StQuerying result) StAcquired
 
     -- | The client can instruct the server to release the state. This lets
     -- the server free resources.
     --
     MsgRelease
-      :: Message (LocalStateQuery block query result) StAcquired StIdle
+      :: Message (LocalStateQuery block query) StAcquired StIdle
 
     -- | This is like 'MsgAcquire' but for when the client already has a
     -- state. By moveing to another state directly without a 'MsgRelease' it
@@ -109,12 +113,12 @@ instance Protocol (LocalStateQuery block query result) where
     --
     MsgReAcquire
       :: Point block
-      -> Message (LocalStateQuery block query result) StAcquired StAcquiring
+      -> Message (LocalStateQuery block query) StAcquired StAcquiring
 
     -- | The client can terminate the protocol.
     --
     MsgDone
-      :: Message (LocalStateQuery block query result) StIdle StDone
+      :: Message (LocalStateQuery block query) StIdle StDone
 
 
   data ClientHasAgency st where
@@ -123,7 +127,8 @@ instance Protocol (LocalStateQuery block query result) where
 
   data ServerHasAgency st where
     TokAcquiring  :: ServerHasAgency StAcquiring
-    TokQuerying   :: ServerHasAgency StQuerying
+    TokQuerying   :: query result
+                  -> ServerHasAgency (StQuerying result :: LocalStateQuery block query)
 
   data NobodyHasAgency st where
     TokDone  :: NobodyHasAgency StDone
@@ -140,13 +145,47 @@ data AcquireFailure = AcquireFailurePointTooOld
                     | AcquireFailurePointNotOnChain
   deriving (Eq, Enum, Show)
 
-deriving instance (StandardHash block, Show query, Show result) =>
-                   Show (Message (LocalStateQuery block query result) from to)
-
-instance Show (ClientHasAgency (st :: LocalStateQuery block query result)) where
+instance Show (ClientHasAgency (st :: LocalStateQuery block query)) where
   show TokIdle     = "TokIdle"
   show TokAcquired = "TokAcquired"
 
-instance Show (ServerHasAgency (st :: LocalStateQuery block query result)) where
-  show TokAcquiring = "TokAcquiring"
-  show TokQuerying  = "TokQuerying"
+instance Show (ServerHasAgency (st :: LocalStateQuery block query)) where
+  show TokAcquiring    = "TokAcquiring"
+  show (TokQuerying _) = "TokQuerying"
+
+-- | To implement 'Show' for:
+--
+-- > ('Message' ('LocalStateQuery' block query) st st')
+--
+-- we need a way to print the @query@ GADT and its type index, @result@. This
+-- class contain the method we need to provide this 'Show' instance.
+--
+-- We use a type class for this, as this 'Show' constraint propagates to a lot
+-- of places.
+class (forall result. Show (query result)) => ShowQuery query where
+    showResult :: forall result. query result -> result -> String
+
+instance (ShowQuery query, StandardHash block)
+      => Show (Message (LocalStateQuery block query) st st') where
+  showsPrec p msg = case msg of
+      MsgAcquire pt -> showParen (p >= 11) $
+        showString "MsgAcquire " .
+        showsPrec 11 pt
+      MsgAcquired ->
+        showString "MsgAcquired"
+      MsgFailure failure -> showParen (p >= 11) $
+        showString "MsgFailure " .
+        showsPrec 11 failure
+      MsgQuery query -> showParen (p >= 11) $
+        showString "MsgQuery " .
+        showsPrec 11 query
+      MsgResult query result -> showParen (p >= 11) $
+        showString "MsgResult " .
+        showParen True (showString (showResult query result))
+      MsgRelease ->
+        showString "MsgRelease"
+      MsgReAcquire pt -> showParen (p >= 11) $
+        showString "MsgReAcquire " .
+        showsPrec 11 pt
+      MsgDone ->
+        showString "MsgDone"