LocalStateQuery: cddl codec specification

ouroboros-network/protocol-tests/Ouroboros/Network/Protocol/LocalStateQuery/Test.hs

@@ -7,7 +7,11 @@
 {-# LANGUAGE StandaloneDeriving  #-}
 
 {-# OPTIONS_GHC -Wno-orphans #-}
-module Ouroboros.Network.Protocol.LocalStateQuery.Test (tests) where
+module Ouroboros.Network.Protocol.LocalStateQuery.Test
+  ( tests
+  , codec
+  , Query (..)
+  ) where
 
 import qualified Codec.CBOR.Decoding as CBOR
 import qualified Codec.CBOR.Encoding as CBOR

ouroboros-network/test-cddl/Main.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE DataKinds #-}
@@ -50,6 +51,9 @@ import Ouroboros.Network.Protocol.TxSubmission.Type as TxSubmission
 import Ouroboros.Network.Protocol.TxSubmission.Test (TxId, Tx)
 import Ouroboros.Network.Protocol.LocalTxSubmission.Codec (codecLocalTxSubmission)
 import Ouroboros.Network.Protocol.LocalTxSubmission.Type as LocalTxSubmission
+import Ouroboros.Network.Protocol.LocalStateQuery.Type as LocalStateQuery
+import Ouroboros.Network.Protocol.LocalStateQuery.Test (Query (..))
+import qualified Ouroboros.Network.Protocol.LocalStateQuery.Test as LocalStateQuery
 import qualified Ouroboros.Network.Protocol.LocalTxSubmission.Test as LocalTxSubmission (Tx, Reject)
 
 
@@ -78,17 +82,19 @@ tests specPath =
   , testProperty "encode TxSubmission"          (prop_specTxSubmission specPath)
   , testProperty "encode Handshake"             (prop_specHandshake specPath)
   , testProperty "encode local Tx submission"   (prop_specLocalTxSubmission specPath)
+  , testProperty "encode LocalStateQuery"       (prop_specLocalStateQuery specPath)
   -- Test the parsers with CDDL-generated messages.
   , testProperty "generate and decode" $ ioProperty $ generateAndDecode 100 specPath
   ]
 
 -- The concrete/monomorphic types used for the test.
 type MonoCodec x = Codec x DeserialiseFailure IO ByteString
-type CS = ChainSync BlockHeader (Point BlockHeader) (Tip BlockHeader)
-type BF = BlockFetch Block (Point Block)
-type HS = Handshake VersionNumber CBOR.Term
-type TS = TxSubmission TxId Tx
-type LT = LocalTxSubmission LocalTxSubmission.Tx LocalTxSubmission.Reject
+type CS  = ChainSync BlockHeader (Point BlockHeader) (Tip BlockHeader)
+type BF  = BlockFetch Block (Point Block)
+type HS  = Handshake VersionNumber CBOR.Term
+type TS  = TxSubmission TxId Tx
+type LT  = LocalTxSubmission LocalTxSubmission.Tx LocalTxSubmission.Reject
+type LSQ = LocalStateQuery Block (Point Block) Query
 
 codecCS :: MonoCodec CS
 codecCS = codecChainSync
@@ -107,6 +113,9 @@ codecTS = codecTxSubmission Serialise.encode Serialise.decode Serialise.encode S
 codecLT :: MonoCodec LT
 codecLT = codecLocalTxSubmission Serialise.encode Serialise.decode Serialise.encode Serialise.decode
 
+codecLSQ :: MonoCodec LSQ
+codecLSQ = LocalStateQuery.codec True
+
 prop_specCS :: FilePath -> AnyMessageAndAgency CS -> Property
 prop_specCS specPath = prop_CDDLSpec specPath (0, codecCS)
 
@@ -124,6 +133,9 @@ prop_specLocalTxSubmission specPath = prop_CDDLSpec specPath (6, codecLT)
 prop_specHandshake :: FilePath -> AnyMessageAndAgency HS -> Property
 prop_specHandshake specPath = prop_CDDLSpec specPath (5, versionNumberHandshakeCodec)
 
+prop_specLocalStateQuery :: FilePath -> AnyMessageAndAgency LSQ -> Property
+prop_specLocalStateQuery specPath = prop_CDDLSpec specPath (7, codecLSQ)
+
 prop_CDDLSpec :: FilePath -- ^ "messages.cddl" spec file path
               -> (Word, MonoCodec ps)
               -> AnyMessageAndAgency ps -> Property
@@ -214,6 +226,7 @@ decodeMsg (tag, input) = case tag of
     4 -> tryParsers ["txSubmission"]          txSubmissionParsers
     5 -> tryParsers ["handshake"]             handshakeParsers
     6 -> tryParsers ["localTxSubmission"]     localTxSubmissionParsers
+    7 -> tryParsers ["localStateQuery"]       localStateQueryParsers
     _ -> error "unkown tag"
     where
         -- typed-protocols codecs are parameterized on the tokens which
@@ -286,3 +299,10 @@ decodeMsg (tag, input) = case tag of
             , runLT (ServerAgency LocalTxSubmission.TokBusy)
             ]
 
+        runLSQ = run codecLSQ
+        localStateQueryParsers = [
+              runLSQ (ClientAgency LocalStateQuery.TokIdle)
+            , runLSQ (ClientAgency LocalStateQuery.TokAcquired)
+            , runLSQ (ServerAgency LocalStateQuery.TokAcquiring)
+            , runLSQ (ServerAgency (LocalStateQuery.TokQuerying QueryPoint))
+            ]

ouroboros-network/test/messages.cddl

@@ -8,8 +8,14 @@ allMessages
     / [4, txSubmissionMessage]
     / [5, handshakeMessage]
     / [6, localTxSubmissionMessage]
+    / [7, localStateQueryMessage]
+
+
+;
+; ChainSync mini-protocol
+;
+
 
-; ChainSync Protocol
 ; reference implementation of the codec in :
 ; ouroboros-network/src/Ouroboros/Network/Protocol/ChainSync/Codec.hs
 chainSyncMessage
@@ -36,7 +42,10 @@ tip = [point, uint]
 
 points = [ *point ]
 
-; BlockFetch Protocol
+;
+; BlockFetch mini-protocol
+;
+
 ; reference implementation of the codec in :
 ; ouroboros-network/src/Ouroboros/Network/Protocol/BlockFetch/Codec.hs
 
@@ -55,7 +64,12 @@ msgNoBlocks     = [3]
 msgBlock        = [4, #6.24(bytes .cbor block)]
 msgBatchDone    = [5]
 
-; Transaction Submission Protocol
+
+;
+; TxSubmission mini-protocol
+;
+
+
 ; reference implementation of the codec in :
 ; ouroboros-network/src/Ouroboros/Network/Protocol/TxSubmission/Codec.hs
 
@@ -81,7 +95,12 @@ txIdAndSize     = [txId, txSizeInBytes]
 txId            = int
 txSizeInBytes   = word32
 
-; The handshake Protocol
+
+;
+; Handshake mini-protocol
+;
+
+
 ; reference implementation of the codec in:
 ; ouroboros-network/src/Ouroboros/Network/Protocol/Handshake/Codec.hs
 
@@ -119,7 +138,12 @@ refuseReasonVersionMismatch      = [0, [ *versionNumber ] ]
 refuseReasonHandshakeDecodeError = [1, versionNumber, tstr]
 refuseReasonRefused              = [2, versionNumber, tstr]
 
-; The local transaction submission protocol.
+
+;
+; LocalTxSubmission mini-protocol
+;
+
+
 ; Reference implementation of the codec in:
 ; ouroboros-network/src/Ouroboros/Network/Protocol/LocalTxSubmission/Codec.hs
 
@@ -160,3 +184,41 @@ rejectReason = int
 word16 = uint
 word32 = uint
 word64 = uint
+
+;
+; LocalStateQuery mini-protocol.
+;
+
+localStateQueryMessage
+  = msgAcquire
+  / msgAcquired
+  / msgFailure
+  / msgQuery
+  / msgResult
+  / msgRelease
+  / msgReAcquire
+  / lsqMsgDone
+
+acquireFailurePointTooOld     = 0
+acquireFailurePointNotOnChain = 1
+
+failure      = acquireFailurePointTooOld
+             / acquireFailurePointNotOnChain
+
+; 'query' and 'result' encodings are not specified; The values are only used
+; for compatibility with
+; 'Ouroboros.Network.Protocol.LocalStateQuery.Test.codec'
+query        = null
+result       = []
+             / [point]
+
+msgAcquire   = [0, point]
+             / [8] 
+msgAcquired  = [1]
+msgFailure   = [2, failure]
+msgQuery     = [3, query]
+msgResult    = [4, result]
+msgRelease   = [5]
+msgReAcquire = [6, point]
+             / [9]
+lsqMsgDone   = [7]