Skip to content

Commit

Permalink
Fix compilation of several Hydra modules
Browse files Browse the repository at this point in the history
Some instances are incomplete as it is missing the
SerialiseAsRawBytesError from cardano-api to produce the proper Left
values. See IntersectMBO/cardano-node#5085
  • Loading branch information
ch1bo committed Apr 18, 2023
1 parent 3af32a1 commit 1bbc315
Show file tree
Hide file tree
Showing 5 changed files with 40 additions and 41 deletions.
18 changes: 9 additions & 9 deletions hydra-node/src/Hydra/Chain.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
11 changes: 7 additions & 4 deletions hydra-node/src/Hydra/Crypto.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 (..))
Expand All @@ -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.
Expand Down Expand Up @@ -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 _ =
Expand All @@ -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
Expand Down
34 changes: 15 additions & 19 deletions hydra-node/src/Hydra/Options.hs
Original file line number Diff line number Diff line change
Expand Up @@ -22,9 +22,7 @@ import Hydra.Cardano.Api (
NetworkMagic (..),
SlotNo (..),
TxId (..),
UsingRawBytesHex (..),
deserialiseFromRawBytes,
deserialiseFromRawBytesBase16,
deserialiseFromRawBytesHex,
proxyToAsType,
serialiseToRawBytesHexText,
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
4 changes: 2 additions & 2 deletions hydra-node/src/Hydra/Party.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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
14 changes: 7 additions & 7 deletions hydra-node/src/Hydra/Snapshot.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 ()

Expand All @@ -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)

Expand Down Expand Up @@ -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
Expand Down

0 comments on commit 1bbc315

Please sign in to comment.