Merge pull request #3263 from input-output-hk/jordan/CDEC-403

[CDEC-403] Remove partial field accessors from `HandlerSpec`, `InductiveValidationError`, `InvariantViolation` and `ValidationResult` data types.
input-output-hk · Jul 19, 2018 · de0b762 · de0b762
2 parents efb498f + 0d5b014
commit de0b762
Show file tree

Hide file tree

Showing 4 changed files with 108 additions and 116 deletions.
diff --git a/infra/src/Pos/Infra/Communication/Types/Protocol.hs b/infra/src/Pos/Infra/Communication/Types/Protocol.hs
@@ -186,8 +186,9 @@ buildBS :: ByteString -> B.Builder
 buildBS = bprint base16F
 
 data HandlerSpec
-    = ConvHandler { hsReplyType :: MessageCode }
-    | UnknownHandler Word8 ByteString
+    -- | ConvHandler hsReplyType
+    = ConvHandler !MessageCode
+    | UnknownHandler !Word8 !ByteString
     deriving (Show, Generic, Eq)
 
 instance Bi HandlerSpec where

diff --git a/wallet-new/test/unit/Test/Spec/Translation.hs b/wallet-new/test/unit/Test/Spec/Translation.hs
@@ -292,17 +292,17 @@ data ValidationResult h a =
     ExpectedValid
 
     -- | We expected the chain to be invalid; DSL and Cardano both agree
-  | ExpectedInvalid {
-        validationErrorDsl     :: Text
-      , validationErrorCardano :: Cardano.VerifyBlocksException
-      }
+    -- ExpectedInvalid
+    --     validationErrorDsl
+    --     validationErrorCardano
+  | ExpectedInvalid !Text !Cardano.VerifyBlocksException
 
     -- | Variation on 'ExpectedInvalid', where we cannot even /construct/
     -- the Cardano chain, much less validate it.
-  | ExpectedInvalid' {
-        validationErrorDsl :: Text
-      , validationErrorInt :: IntException
-      }
+    -- ExpectedInvalid
+    --     validationErrorDsl
+    --     validationErrorInt
+  | ExpectedInvalid'  !Text !IntException
 
     -- | Disagreement between the DSL and Cardano
     --
@@ -315,10 +315,10 @@ data ValidationResult h a =
     --
     -- We record the error message from Cardano, if Cardano thought the chain
     -- was invalid, as well as the ledger that causes the problem.
-  | Disagreement {
-        validationLedger       :: Ledger h a
-      , validationDisagreement :: Disagreement h a
-      }
+    -- Disagreement
+    --     validationLedger
+    --     validationDisagreement
+  | Disagreement !(Ledger h a) !(Disagreement h a)
 
 -- | Disagreement between Cardano and the DSL
 --
@@ -357,23 +357,29 @@ expectInvalid _otherwise            = False
 
 instance (Hash h a, Buildable a) => Buildable (ValidationResult h a) where
   build ExpectedValid = "ExpectedValid"
-  build ExpectedInvalid{..} = bprint
+  build (ExpectedInvalid
+             validationErrorDsl
+             validationErrorCardano) = bprint
       ( "ExpectedInvalid"
       % ", errorDsl:     " % build
       % ", errorCardano: " % build
       % "}"
       )
       validationErrorDsl
       validationErrorCardano
-  build ExpectedInvalid'{..} = bprint
+  build (ExpectedInvalid'
+             validationErrorDsl
+             validationErrorInt) = bprint
       ( "ExpectedInvalid'"
       % ", errorDsl: " % build
       % ", errorInt: " % build
       % "}"
       )
       validationErrorDsl
       validationErrorInt
-  build Disagreement{..} = bprint
+  build (Disagreement
+             validationLedger
+             validationDisagreement) = bprint
       ( "Disagreement "
       % "{ ledger: "       % build
       % ", disagreement: " % build

diff --git a/wallet-new/test/unit/Wallet/Inductive/Invariants.hs b/wallet-new/test/unit/Wallet/Inductive/Invariants.hs
@@ -56,20 +56,12 @@ invariant name e p = void . interpret notChecked ((:[]) . e) p'
     notChecked :: History h a
                -> InvalidInput h a
                -> InvariantViolation h a
-    notChecked history reason = InvariantNotChecked {
-          invariantNotCheckedName   = name
-        , invariantNotCheckedReason = reason
-        , invariantNotCheckedEvents = history
-        }
+    notChecked history reason = InvariantNotChecked name reason history
 
     violation :: History h a
               -> InvariantViolationEvidence
               -> InvariantViolation h a
-    violation history ev = InvariantViolation {
-          invariantViolationName     = name
-        , invariantViolationEvidence = ev
-        , invariantViolationEvents   = history
-        }
+    violation history ev = InvariantViolation name ev history
 
     p' :: History h a
        -> [Wallet h a]
@@ -82,28 +74,18 @@ invariant name e p = void . interpret notChecked ((:[]) . e) p'
 -- | Invariant violation
 data InvariantViolation h a =
     -- | Invariance violation
-    InvariantViolation {
-        -- | Name of the invariant
-        invariantViolationName     :: Text
-
-        -- | Evidence that the invariant was violated
-      , invariantViolationEvidence :: InvariantViolationEvidence
-
-        -- | The evens that led to the error
-      , invariantViolationEvents   :: History h a
-      }
+    --       invariantViolationName     =  Name of the invariant
+    --       invariantViolationEvidence = Evidence that the invariant
+    --                                    was violated
+    --       invariantViolationEvents   = The evennts that led to the error
+    InvariantViolation !Text !InvariantViolationEvidence !(History h a)
 
     -- | The invariant was not checked because the input was invalid
-  | InvariantNotChecked {
-        -- | Name of the invariant
-        invariantNotCheckedName   :: Text
-
-        -- | Why did we not check the invariant
-      , invariantNotCheckedReason :: InvalidInput h a
-
-        -- | The events that led to the error
-      , invariantNotCheckedEvents :: History h a
-      }
+    --   InvariantNotChecked
+    --       invariantNotCheckedName   = Name of the invariant
+    --       invariantNotCheckedReason = Why did we not check the invariant
+    --       invariantNotCheckedEvents = The events that led to the error
+  | InvariantNotChecked !Text !(InvalidInput h a) !(History h a)
 
 {-------------------------------------------------------------------------------
   Evidence that an invariant was violated
@@ -288,20 +270,12 @@ walletEquivalent lbl e e' = void .
     notChecked :: History h a
                -> InvalidInput h a
                -> InvariantViolation h a
-    notChecked history reason = InvariantNotChecked {
-          invariantNotCheckedName   = lbl
-        , invariantNotCheckedReason = reason
-        , invariantNotCheckedEvents = history
-        }
+    notChecked history reason = InvariantNotChecked lbl reason history
 
     violation :: History h a
               -> InvariantViolationEvidence
               -> InvariantViolation h a
-    violation history ev = InvariantViolation {
-          invariantViolationName     = lbl
-        , invariantViolationEvidence = ev
-        , invariantViolationEvents   = history
-        }
+    violation history ev = InvariantViolation lbl ev history
 
     p :: History h a
       -> [Wallet h a]
@@ -332,7 +306,10 @@ walletEquivalent lbl e e' = void .
 -------------------------------------------------------------------------------}
 
 instance (Hash h a, Buildable a) => Buildable (InvariantViolation h a) where
-  build InvariantViolation{..} = bprint
+  build (InvariantViolation
+             invariantViolationName
+             invariantViolationEvidence
+             invariantViolationEvents) = bprint
     ( "InvariantViolation "
     % "{ name:     " % build
     % ", evidence: " % build
@@ -342,7 +319,10 @@ instance (Hash h a, Buildable a) => Buildable (InvariantViolation h a) where
     invariantViolationName
     invariantViolationEvidence
     invariantViolationEvents
-  build (InvariantNotChecked{..}) = bprint
+  build (InvariantNotChecked
+             invariantNotCheckedName
+             invariantNotCheckedReason
+             invariantNotCheckedEvents) = bprint
     ( "InvariantNotChecked "
     % "{ name:   " % build
     % ", reason: " % build

diff --git a/wallet-new/test/unit/Wallet/Inductive/Validation.hs b/wallet-new/test/unit/Wallet/Inductive/Validation.hs
@@ -45,55 +45,46 @@ data ValidatedInductive h a = ValidatedInductive {
 
 data InductiveValidationError h a =
     -- | Bootstrap transaction is invalid
-    InductiveInvalidBoot {
-        -- | The bootstrap transaction
-        inductiveInvalidBoot  :: Transaction h a
-
-        -- | The error message
-      , inductiveInvalidError :: Text
-      }
+    -- InductiveInvalidBoot
+    --     inductiveInvalidBoot  = The bootstrap transaction
+    --     inductiveInvalidError = The error message
+    InductiveInvalidBoot !(Transaction h a) !Text
 
     -- | Invalid transaction in the given block
-  | InductiveInvalidApplyBlock {
-        -- | The events leading up to the error
-        inductiveInvalidEvents      :: OldestFirst [] (WalletEvent h a)
-
-        -- | The transactions in the block we successfully validated
-      , inductiveInvalidBlockPrefix :: OldestFirst [] (Transaction h a)
-
-        -- | The transaction that was invalid
-      , inductiveInvalidTransaction :: Transaction h a
-
-        -- | The error message
-      , inductiveInvalidError       :: Text
-      }
+    -- InductiveInvalidApplyBlock
+    --     inductiveInvalidEvents      = The events leading up to the error
+    --     inductiveInvalidBlockPrefix = The transactions in the block we
+    --                                   successfully validated
+    --     inductiveInvalidTransaction = The transaction that was invalid
+    --     inductiveInvalidError       = The error message
+  | InductiveInvalidApplyBlock
+        !(OldestFirst [] (WalletEvent h a))
+        !(OldestFirst [] (Transaction h a))
+        !(Transaction h a)
+        !Text
 
     -- | A 'NewPending' call was invalid because the input was already spent
-  | InductiveInvalidNewPendingAlreadySpent {
-        -- | The events leading up to the error
-        inductiveInvalidEvents      :: OldestFirst [] (WalletEvent h a)
-
-        -- | The transaction that was invalid
-      , inductiveInvalidTransaction :: Transaction h a
-
-        -- | The specific input that was not valid
-      , inductiveInvalidInput       :: Input h a
-      }
+    -- InductiveInvalidNewPendingAlreadySpent
+    --     inductiveInvalidEvents      = The events leading up to the error
+    --     inductiveInvalidTransaction = The transaction that was invalid
+    --     inductiveInvalidInput       = The specific input that was not valid
+  | InductiveInvalidNewPendingAlreadySpent
+        !(OldestFirst [] (WalletEvent h a))
+        !(Transaction h a)
+        !(Input h a)
 
     -- | A 'NewPending' call was invalid because the input was not @ours@
-  | InductiveInvalidNewPendingNotOurs {
-        -- | The events leading up to the error
-        inductiveInvalidEvents      :: OldestFirst [] (WalletEvent h a)
-
-        -- | The transaction that was invalid
-      , inductiveInvalidTransaction :: Transaction h a
+    -- InductiveInvalidNewPendingNotOurs
+    --     inductiveInvalidEvents      = The events leading up to the error
+    --     inductiveInvalidTransaction = The transaction that was invalid
+    --     inductiveInvalidInput       = The specific input that was not valid
+    --     inductiveInvalidAddress     = The address this input belonged to
+  | InductiveInvalidNewPendingNotOurs
+        !(OldestFirst [] (WalletEvent h a))
+        !(Transaction h a)
+        !(Input h a)
+        !a
 
-        -- | The specific input that was not valid
-      , inductiveInvalidInput       :: Input h a
-
-        -- | The address this input belonged to
-      , inductiveInvalidAddress     :: a
-      }
 
 {-------------------------------------------------------------------------------
   Validation proper
@@ -150,19 +141,20 @@ inductiveIsValid Inductive{..} = do
         forM_ (zip inputs resolved) $ \(input, mAddr) ->
           case mAddr of
             Nothing ->
-              throwError InductiveInvalidNewPendingAlreadySpent {
-                  inductiveInvalidEvents      = toOldestFirst viEvents
-                , inductiveInvalidTransaction = t
-                , inductiveInvalidInput       = input
-                }
+              throwError
+                  $ InductiveInvalidNewPendingAlreadySpent
+                        (toOldestFirst viEvents)
+                        t
+                        input
             Just addr ->
               unless (addr `Set.member` inductiveOurs) $
-                throwError InductiveInvalidNewPendingNotOurs {
-                    inductiveInvalidEvents      = toOldestFirst viEvents
-                  , inductiveInvalidTransaction = t
-                  , inductiveInvalidInput       = input
-                  , inductiveInvalidAddress     = addr
-                  }
+                throwError
+                    $ InductiveInvalidNewPendingNotOurs
+                          (toOldestFirst viEvents)
+                          t
+                          input
+                          addr
+
         goEvents es vi
 
     goBlock :: OldestFirst [] (WalletEvent h a) -- Events leading to this point (for err msgs)
@@ -201,15 +193,21 @@ inductiveIsValid Inductive{..} = do
 -------------------------------------------------------------------------------}
 
 instance (Hash h a, Buildable a) => Buildable (InductiveValidationError h a) where
-  build InductiveInvalidBoot{..} = bprint
+  build (InductiveInvalidBoot
+             inductiveInvalidBoot
+             inductiveInvalidError) = bprint
     ( "InductiveInvalidBoot"
     % "{ boot:  " % build
     % ", error: " % build
     % "}"
     )
     inductiveInvalidBoot
     inductiveInvalidError
-  build InductiveInvalidApplyBlock{..} = bprint
+  build (InductiveInvalidApplyBlock
+             inductiveInvalidEvents
+             inductiveInvalidBlockPrefix
+             inductiveInvalidTransaction
+             inductiveInvalidError) = bprint
     ( "InductiveInvalidApplyBlock"
     % "{ events:      " % build
     % ", blockPrefix: " % build
@@ -220,7 +218,10 @@ instance (Hash h a, Buildable a) => Buildable (InductiveValidationError h a) whe
     inductiveInvalidBlockPrefix
     inductiveInvalidTransaction
     inductiveInvalidError
-  build InductiveInvalidNewPendingAlreadySpent{..} = bprint
+  build (InductiveInvalidNewPendingAlreadySpent
+             inductiveInvalidEvents
+             inductiveInvalidTransaction
+             inductiveInvalidInput) = bprint
     ( "InductiveInvalidNewPendingAlreadySpent"
     % "{ events:      " % build
     % ", transaction: " % build
@@ -230,7 +231,11 @@ instance (Hash h a, Buildable a) => Buildable (InductiveValidationError h a) whe
     inductiveInvalidEvents
     inductiveInvalidTransaction
     inductiveInvalidInput
-  build InductiveInvalidNewPendingNotOurs{..} = bprint
+  build (InductiveInvalidNewPendingNotOurs
+             inductiveInvalidEvents
+             inductiveInvalidTransaction
+             inductiveInvalidInput
+             inductiveInvalidAddress) = bprint
     ( "InductiveInvalidNewPendingNotOurs"
     % "{ events:      " % build
     % ", transaction: " % build