Fix compilation of several Hydra modules

Some instances are incomplete as it is missing the
SerialiseAsRawBytesError from cardano-api to produce the proper Left
values. See IntersectMBO/cardano-node#5085

Author: ch1bo

hydra-node/src/Hydra/Chain.hs

@@ -80,7 +80,7 @@ newtype HeadId = HeadId ByteString
 
 instance SerialiseAsRawBytes HeadId where
   serialiseToRawBytes (HeadId bytes) = bytes
-  deserialiseFromRawBytes _ = Just . HeadId
+  deserialiseFromRawBytes _ = Right . HeadId
 
 instance HasTypeProxy HeadId where
   data AsType HeadId = AsHeadId
@@ -189,14 +189,14 @@ instance Arbitrary ChainSlot where
 
 -- | Handle to interface with the main chain network
 newtype Chain tx m = Chain
-  { -- | Construct and send a transaction to the main chain corresponding to the
-    -- given 'PostChainTx' description and the current 'ChainState'. This
-    -- function is not expected to block, so it is only responsible for
-    -- submitting, but it should validate the created transaction against a
-    -- reasonable local view of the chain and throw an exception when invalid.
-    --
-    -- Does at least throw 'PostTxError'.
-    postTx :: (IsChainState tx, MonadThrow m) => ChainStateType tx -> PostChainTx tx -> m ()
+  { postTx :: (IsChainState tx, MonadThrow m) => ChainStateType tx -> PostChainTx tx -> m ()
+  -- ^ Construct and send a transaction to the main chain corresponding to the
+  -- given 'PostChainTx' description and the current 'ChainState'. This
+  -- function is not expected to block, so it is only responsible for
+  -- submitting, but it should validate the created transaction against a
+  -- reasonable local view of the chain and throw an exception when invalid.
+  --
+  -- Does at least throw 'PostTxError'.
   }
 
 data ChainEvent tx

hydra-node/src/Hydra/Crypto.hs

@@ -61,7 +61,7 @@ import Hydra.Cardano.Api (
   serialiseToRawBytesHexText,
  )
 import qualified Hydra.Contract.HeadState as OnChain
-import qualified Plutus.V2.Ledger.Api as Plutus
+import qualified PlutusLedgerApi.V2 as Plutus
 import Test.QuickCheck (vectorOf)
 import Test.QuickCheck.Instances.ByteString ()
 import Text.Show (Show (..))
@@ -85,7 +85,8 @@ instance SerialiseAsRawBytes (Hash HydraKey) where
   serialiseToRawBytes (HydraKeyHash vkh) = hashToBytes vkh
 
   deserialiseFromRawBytes (AsHash AsHydraKey) bs =
-    HydraKeyHash <$> hashFromBytes bs
+    maybe (error "TODO: SerialiseAsRawBytesError, but constructor not exported") Right $
+      HydraKeyHash <$> hashFromBytes bs
 
 instance Key HydraKey where
   -- Hydra verification key, which can be used to 'verify' signed messages.
@@ -134,7 +135,8 @@ instance SerialiseAsRawBytes (SigningKey HydraKey) where
     rawSerialiseSignKeyDSIGN sk
 
   deserialiseFromRawBytes (AsSigningKey AsHydraKey) bs =
-    HydraSigningKey <$> rawDeserialiseSignKeyDSIGN bs
+    maybe (error "TODO: SerialiseAsRawBytesError, but constructor not exported") Right $
+      HydraSigningKey <$> rawDeserialiseSignKeyDSIGN bs
 
 instance HasTextEnvelope (SigningKey HydraKey) where
   textEnvelopeType _ =
@@ -149,7 +151,8 @@ instance SerialiseAsRawBytes (VerificationKey HydraKey) where
     rawSerialiseVerKeyDSIGN vk
 
   deserialiseFromRawBytes (AsVerificationKey AsHydraKey) bs =
-    HydraVerificationKey <$> rawDeserialiseVerKeyDSIGN bs
+    maybe (error "TODO: SerialiseAsRawBytesError, but constructor not exported") Right $
+      HydraVerificationKey <$> rawDeserialiseVerKeyDSIGN bs
 
 instance ToJSON (VerificationKey HydraKey) where
   toJSON = toJSON . serialiseToRawBytesHexText

hydra-node/src/Hydra/Options.hs

@@ -22,9 +22,7 @@ import Hydra.Cardano.Api (
   NetworkMagic (..),
   SlotNo (..),
   TxId (..),
-  UsingRawBytesHex (..),
   deserialiseFromRawBytes,
-  deserialiseFromRawBytesBase16,
   deserialiseFromRawBytesHex,
   proxyToAsType,
   serialiseToRawBytesHexText,
@@ -266,16 +264,16 @@ cardanoLedgerProtocolParametersParser =
     )
 
 data ChainConfig = DirectChainConfig
-  { -- | Network identifer to which we expect to connect.
-    networkId :: NetworkId
-  , -- | Path to a domain socket used to connect to the server.
-    nodeSocket :: FilePath
-  , -- | Path to the cardano signing key of the internal wallet.
-    cardanoSigningKey :: FilePath
-  , -- | Paths to other node's verification keys.
-    cardanoVerificationKeys :: [FilePath]
-  , -- | Point at which to start following the chain.
-    startChainFrom :: Maybe ChainPoint
+  { networkId :: NetworkId
+  -- ^ Network identifer to which we expect to connect.
+  , nodeSocket :: FilePath
+  -- ^ Path to a domain socket used to connect to the server.
+  , cardanoSigningKey :: FilePath
+  -- ^ Path to the cardano signing key of the internal wallet.
+  , cardanoVerificationKeys :: [FilePath]
+  -- ^ Paths to other node's verification keys.
+  , startChainFrom :: Maybe ChainPoint
+  -- ^ Point at which to start following the chain.
   , contestationPeriod :: ContestationPeriod
   }
   deriving (Eq, Show, Generic, ToJSON, FromJSON)
@@ -525,11 +523,9 @@ startChainFromParser =
       case T.splitOn "." (toText chainPointStr) of
         [slotNoTxt, headerHashTxt] -> do
           slotNo <- SlotNo <$> readMaybe (toString slotNoTxt)
-          UsingRawBytesHex headerHash <-
-            either
-              (const Nothing)
-              Just
-              (deserialiseFromRawBytesBase16 (encodeUtf8 headerHashTxt))
+          headerHash <-
+            either (const Nothing) Just $
+              deserialiseFromRawBytesHex (proxyToAsType Proxy) (encodeUtf8 headerHashTxt)
           pure $ ChainPoint slotNo headerHash
         _emptyOrSingularList ->
           Nothing
@@ -630,7 +626,7 @@ validateRunOptions :: RunOptions -> Either InvalidOptions ()
 validateRunOptions RunOptions{hydraVerificationKeys, chainConfig}
   | numberOfOtherParties + 1 > maximumNumberOfParties = Left MaximumNumberOfPartiesExceeded
   | length (cardanoVerificationKeys chainConfig) /= length hydraVerificationKeys =
-    Left CardanoAndHydraKeysMissmatch
+      Left CardanoAndHydraKeysMissmatch
   | otherwise = Right ()
  where
   -- let's take the higher number of loaded cardano/hydra keys
@@ -766,5 +762,5 @@ genChainPoint = ChainPoint <$> (SlotNo <$> arbitrary) <*> someHeaderHash
  where
   someHeaderHash = do
     bytes <- vectorOf 32 arbitrary
-    let hash = fromMaybe (error "invalid bytes") $ deserialiseFromRawBytes (proxyToAsType Proxy) . BS.pack $ bytes
+    let hash = either (error "invalid bytes") id $ deserialiseFromRawBytes (proxyToAsType Proxy) . BS.pack $ bytes
     pure hash

hydra-node/src/Hydra/Party.hs

@@ -3,7 +3,7 @@
 -- Hydra protocol.
 module Hydra.Party where
 
-import Hydra.Prelude hiding (show)
+import Hydra.Prelude
 
 import Data.Aeson (ToJSONKey)
 import Data.Aeson.Types (FromJSONKey)
@@ -48,6 +48,6 @@ partyToChain Party{vkey} =
 -- for an explanation why this is a distinct type.
 partyFromChain :: MonadFail m => OnChain.Party -> m Party
 partyFromChain =
-  maybe (fail "partyFromChain got Nothing") (pure . Party)
+  either (\e -> fail $ "partyFromChain failed: " <> show e) (pure . Party)
     . deserialiseFromRawBytes (AsVerificationKey AsHydraKey)
     . OnChain.partyToVerficationKeyBytes

hydra-node/src/Hydra/Snapshot.hs

@@ -12,7 +12,7 @@ import Hydra.Cardano.Api (SigningKey)
 import qualified Hydra.Contract.HeadState as Onchain
 import Hydra.Crypto (HydraKey, MultiSignature, aggregate, sign)
 import Hydra.Ledger (IsTx (..))
-import Plutus.V2.Ledger.Api (toBuiltin, toData)
+import PlutusLedgerApi.V2 (toBuiltin, toData)
 import Test.QuickCheck (frequency, suchThat)
 import Test.QuickCheck.Instances.Natural ()
 
@@ -24,8 +24,8 @@ newtype SnapshotNumber
 data Snapshot tx = Snapshot
   { number :: SnapshotNumber
   , utxo :: UTxOType tx
-  , -- | The set of transactions that lead to 'utxo'
-    confirmed :: [tx]
+  , confirmed :: [tx]
+  -- ^ The set of transactions that lead to 'utxo'
   }
   deriving (Generic)
 
@@ -127,10 +127,10 @@ genConfirmedSnapshot ::
 genConfirmedSnapshot minSn utxo sks
   | minSn > 0 = confirmedSnapshot
   | otherwise =
-    frequency
-      [ (1, initialSnapshot)
-      , (9, confirmedSnapshot)
-      ]
+      frequency
+        [ (1, initialSnapshot)
+        , (9, confirmedSnapshot)
+        ]
  where
   initialSnapshot =
     pure $ InitialSnapshot utxo