diff --git a/.github/workflows/formatting.yaml b/.github/workflows/formatting.yaml index 8e206879ba8..2af62a4951d 100644 --- a/.github/workflows/formatting.yaml +++ b/.github/workflows/formatting.yaml @@ -27,3 +27,7 @@ jobs: - name: 📐 Check code formatting run: | nix develop .#fmt --command treefmt --fail-on-change + + - name: 📐 Check hlint + run: | + nix develop .#fmt --command hlint . diff --git a/.hlint.yaml b/.hlint.yaml new file mode 100644 index 00000000000..6c7a77fac7a --- /dev/null +++ b/.hlint.yaml @@ -0,0 +1,2 @@ +- ignore: {name: Redundant <$>, within: [Hydra.Contract.HeadTokens]} +- ignore: {name: Redundant compare, within: [Hydra.PartySpec]} diff --git a/hydra-cardano-api/src/Hydra/Cardano/Api/ScriptHash.hs b/hydra-cardano-api/src/Hydra/Cardano/Api/ScriptHash.hs index a1d962f102b..fb13a6ba8e9 100644 --- a/hydra-cardano-api/src/Hydra/Cardano/Api/ScriptHash.hs +++ b/hydra-cardano-api/src/Hydra/Cardano/Api/ScriptHash.hs @@ -26,5 +26,4 @@ hashScriptInAnyLang (ScriptInAnyLang _ script) = instance Arbitrary ScriptHash where arbitrary = do - plutusScript <- arbitrary - pure $ hashScript (PlutusScript PlutusScriptV2 plutusScript) + hashScript . PlutusScript PlutusScriptV2 <$> arbitrary diff --git a/hydra-cardano-api/src/Hydra/Cardano/Api/TxOut.hs b/hydra-cardano-api/src/Hydra/Cardano/Api/TxOut.hs index e8be53d7340..2b43f3c0d15 100644 --- a/hydra-cardano-api/src/Hydra/Cardano/Api/TxOut.hs +++ b/hydra-cardano-api/src/Hydra/Cardano/Api/TxOut.hs @@ -167,7 +167,7 @@ fromPlutusTxOut :: Plutus.TxOut -> Maybe (TxOut CtxUTxO era) fromPlutusTxOut network out = do - value <- shelleyBasedEraConstraints (shelleyBasedEra @era) $ TxOutValueShelleyBased (shelleyBasedEra @era) <$> (toLedgerValue (maryEraOnwards @era) <$> fromPlutusValue plutusValue) + value <- shelleyBasedEraConstraints (shelleyBasedEra @era) (TxOutValueShelleyBased (shelleyBasedEra @era) . toLedgerValue (maryEraOnwards @era) <$> fromPlutusValue plutusValue) pure $ TxOut addressInEra value datum ReferenceScriptNone where addressInEra = fromPlutusAddress network plutusAddress diff --git a/hydra-cluster/bench/Main.hs b/hydra-cluster/bench/Main.hs index f64d658c999..6cd84708577 100644 --- a/hydra-cluster/bench/Main.hs +++ b/hydra-cluster/bench/Main.hs @@ -1,5 +1,4 @@ {-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE OverloadedRecordDot #-} module Main where diff --git a/hydra-cluster/src/Hydra/Cluster/Mithril.hs b/hydra-cluster/src/Hydra/Cluster/Mithril.hs index 021a7128f23..95141f47d88 100644 --- a/hydra-cluster/src/Hydra/Cluster/Mithril.hs +++ b/hydra-cluster/src/Hydra/Cluster/Mithril.hs @@ -52,14 +52,14 @@ downloadLatestSnapshotTo tracer network directory = do genesisKeyURLForNetwork :: KnownNetwork -> Maybe String genesisKeyURLForNetwork = \case - Mainnet -> Just $ "https://raw.githubusercontent.com/input-output-hk/mithril/main/mithril-infra/configuration/release-mainnet/genesis.vkey" - Preproduction -> Just $ "https://raw.githubusercontent.com/input-output-hk/mithril/main/mithril-infra/configuration/release-preprod/genesis.vkey" - Preview -> Just $ "https://raw.githubusercontent.com/input-output-hk/mithril/main/mithril-infra/configuration/pre-release-preview/genesis.vkey" - Sanchonet -> Just $ "https://raw.githubusercontent.com/input-output-hk/mithril/main/mithril-infra/configuration/testing-sanchonet/genesis.vkey" + Mainnet -> Just "https://raw.githubusercontent.com/input-output-hk/mithril/main/mithril-infra/configuration/release-mainnet/genesis.vkey" + Preproduction -> Just "https://raw.githubusercontent.com/input-output-hk/mithril/main/mithril-infra/configuration/release-preprod/genesis.vkey" + Preview -> Just "https://raw.githubusercontent.com/input-output-hk/mithril/main/mithril-infra/configuration/pre-release-preview/genesis.vkey" + Sanchonet -> Just "https://raw.githubusercontent.com/input-output-hk/mithril/main/mithril-infra/configuration/testing-sanchonet/genesis.vkey" aggregatorEndpointForNetwork :: KnownNetwork -> Maybe String aggregatorEndpointForNetwork = \case - Mainnet -> Just $ "https://aggregator.release-mainnet.api.mithril.network/aggregator" - Preproduction -> Just $ "https://aggregator.release-preprod.api.mithril.network/aggregator" - Preview -> Just $ "https://aggregator.pre-release-preview.api.mithril.network/aggregator" - Sanchonet -> Just $ "https://aggregator.testing-sanchonet.api.mithril.network/aggregator" + Mainnet -> Just "https://aggregator.release-mainnet.api.mithril.network/aggregator" + Preproduction -> Just "https://aggregator.release-preprod.api.mithril.network/aggregator" + Preview -> Just "https://aggregator.pre-release-preview.api.mithril.network/aggregator" + Sanchonet -> Just "https://aggregator.testing-sanchonet.api.mithril.network/aggregator" diff --git a/hydra-cluster/test/Test/Hydra/Cluster/CardanoCliSpec.hs b/hydra-cluster/test/Test/Hydra/Cluster/CardanoCliSpec.hs index 07aa12d1307..ae6385ec1d1 100644 --- a/hydra-cluster/test/Test/Hydra/Cluster/CardanoCliSpec.hs +++ b/hydra-cluster/test/Test/Hydra/Cluster/CardanoCliSpec.hs @@ -42,15 +42,15 @@ spec = it "query protocol-parameters is compatible with our FromJSON instance" $ \tracer -> withTempDir "hydra-cluster" $ \tmpDir -> do withCardanoNodeDevnet tracer tmpDir $ \RunningNode{nodeSocket, networkId} -> do - protocolParameters <- cliQueryProtocolParameters nodeSocket (networkId) - case (parseEither pparamsFromJson protocolParameters) of + protocolParameters <- cliQueryProtocolParameters nodeSocket networkId + case parseEither pparamsFromJson protocolParameters of Left e -> failure $ "Failed to decode JSON: " <> e <> "\n" <> show protocolParameters Right _ -> pure () it "query protocol-parameters matches our schema" $ \tracer -> withJsonSpecifications $ \tmpDir -> withCardanoNodeDevnet tracer tmpDir $ \RunningNode{nodeSocket, networkId} -> do - pparamsValue <- cliQueryProtocolParameters nodeSocket (networkId) + pparamsValue <- cliQueryProtocolParameters nodeSocket networkId validateJSON (tmpDir "api.json") (key "components" . key "schemas" . key "ProtocolParameters") diff --git a/hydra-node/exe/hydra-net/Main.hs b/hydra-node/exe/hydra-net/Main.hs index 64f2b6ec75b..22ff7f765cd 100644 --- a/hydra-node/exe/hydra-net/Main.hs +++ b/hydra-node/exe/hydra-net/Main.hs @@ -183,7 +183,7 @@ injectReqSn peer snapshotNumber hydraKeyFile fakeHydraKeyFile = do traceWith tracer $ ConnectedTo sockAddr runClient iomgr (mkApplication sk party tracer) sock where - runClient iomgr app sock = + runClient iomgr app = connectToNodeSocket iomgr unversionedHandshakeCodec @@ -192,7 +192,6 @@ injectReqSn peer snapshotNumber hydraKeyFile fakeHydraKeyFile = do networkConnectTracers (HandshakeCallbacks acceptableVersion queryVersion) (unversionedProtocol app) - sock networkConnectTracers = NetworkConnectTracers @@ -207,17 +206,17 @@ injectReqSn peer snapshotNumber hydraKeyFile fakeHydraKeyFile = do _ -> die "getAdrrInfo failed" mkApplication sk party tracer = - OuroborosApplication $ + OuroborosApplication [ MiniProtocol { miniProtocolNum = MiniProtocolNum 42 , miniProtocolLimits = MiniProtocolLimits{maximumIngressQueue = maxBound} , miniProtocolRun = InitiatorProtocolOnly ( mkMiniProtocolCbFromPeer - ( \_ -> - ( (contramap TraceSendRecv tracer) + ( const + ( contramap TraceSendRecv tracer , codecFireForget - , (fireForgetClientPeer $ client tracer sk party) + , fireForgetClientPeer $ client tracer sk party ) ) ) diff --git a/hydra-node/src/Hydra/API/ServerOutput.hs b/hydra-node/src/Hydra/API/ServerOutput.hs index c2543a3b407..46b4eab5f8e 100644 --- a/hydra-node/src/Hydra/API/ServerOutput.hs +++ b/hydra-node/src/Hydra/API/ServerOutput.hs @@ -156,7 +156,7 @@ instance data WithUTxO = WithUTxO | WithoutUTxO deriving stock (Eq, Show) -data ServerOutputConfig = ServerOutputConfig +newtype ServerOutputConfig = ServerOutputConfig { utxoInSnapshot :: WithUTxO } deriving stock (Eq, Show) diff --git a/hydra-node/src/Hydra/Chain/CardanoClient.hs b/hydra-node/src/Hydra/Chain/CardanoClient.hs index bd855fdfc58..d76d75a2402 100644 --- a/hydra-node/src/Hydra/Chain/CardanoClient.hs +++ b/hydra-node/src/Hydra/Chain/CardanoClient.hs @@ -171,7 +171,7 @@ submitTransaction networkId socket tx = -- safely constructed through 'buildTransaction'. data SubmitTransactionException = SubmitEraMismatch EraMismatch - | SubmitTxValidationError (TxValidationErrorInCardanoMode) + | SubmitTxValidationError TxValidationErrorInCardanoMode deriving stock (Show) instance Exception SubmitTransactionException @@ -240,7 +240,7 @@ querySystemStart networkId socket queryPoint = -- Throws at least 'QueryException' if query fails. queryEraHistory :: NetworkId -> SocketPath -> QueryPoint -> IO EraHistory queryEraHistory networkId socket queryPoint = - runQuery networkId socket queryPoint $ QueryEraHistory + runQuery networkId socket queryPoint QueryEraHistory -- | Query the current epoch number. -- diff --git a/hydra-node/src/Hydra/Crypto.hs b/hydra-node/src/Hydra/Crypto.hs index f0b5f60e2d7..568a58c8192 100644 --- a/hydra-node/src/Hydra/Crypto.hs +++ b/hydra-node/src/Hydra/Crypto.hs @@ -85,8 +85,7 @@ instance SerialiseAsRawBytes (Hash HydraKey) where serialiseToRawBytes (HydraKeyHash vkh) = hashToBytes vkh deserialiseFromRawBytes (AsHash AsHydraKey) bs = - maybe (error "TODO: SerialiseAsRawBytesError, but constructor not exported") Right $ - 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. @@ -135,8 +134,7 @@ instance SerialiseAsRawBytes (SigningKey HydraKey) where rawSerialiseSignKeyDSIGN sk deserialiseFromRawBytes (AsSigningKey AsHydraKey) bs = - maybe (error "TODO: SerialiseAsRawBytesError, but constructor not exported") Right $ - HydraSigningKey <$> rawDeserialiseSignKeyDSIGN bs + maybe (error "TODO: SerialiseAsRawBytesError, but constructor not exported") (Right . HydraSigningKey) (rawDeserialiseSignKeyDSIGN bs) instance HasTextEnvelope (SigningKey HydraKey) where textEnvelopeType _ = @@ -151,8 +149,7 @@ instance SerialiseAsRawBytes (VerificationKey HydraKey) where rawSerialiseVerKeyDSIGN vk deserialiseFromRawBytes (AsVerificationKey AsHydraKey) bs = - maybe (error "TODO: SerialiseAsRawBytesError, but constructor not exported") Right $ - HydraVerificationKey <$> rawDeserialiseVerKeyDSIGN bs + maybe (error "TODO: SerialiseAsRawBytesError, but constructor not exported") (Right . HydraVerificationKey) (rawDeserialiseVerKeyDSIGN bs) instance ToJSON (VerificationKey HydraKey) where toJSON = toJSON . serialiseToRawBytesHexText diff --git a/hydra-node/src/Hydra/HeadLogic/Error.hs b/hydra-node/src/Hydra/HeadLogic/Error.hs index a4b37b5e569..2a46f302698 100644 --- a/hydra-node/src/Hydra/HeadLogic/Error.hs +++ b/hydra-node/src/Hydra/HeadLogic/Error.hs @@ -15,8 +15,8 @@ import Hydra.Snapshot (SnapshotNumber) -- | Preliminary type for collecting errors occurring during 'update'. -- TODO: Try to merge this (back) into 'Outcome'. data LogicError tx - = InvalidEvent {invalidEvent :: (Event tx), currentHeadState :: (HeadState tx)} - | RequireFailed {requirementFailure :: (RequirementFailure tx)} + = InvalidEvent {invalidEvent :: Event tx, currentHeadState :: HeadState tx} + | RequireFailed {requirementFailure :: RequirementFailure tx} | NotOurHead {ourHeadId :: HeadId, otherHeadId :: HeadId} deriving stock (Generic) diff --git a/hydra-node/src/Hydra/Ledger/Cardano.hs b/hydra-node/src/Hydra/Ledger/Cardano.hs index 59d0cc530bf..d266c0ec50d 100644 --- a/hydra-node/src/Hydra/Ledger/Cardano.hs +++ b/hydra-node/src/Hydra/Ledger/Cardano.hs @@ -132,8 +132,8 @@ instance ToJSON Tx where toJSON tx = let TextEnvelopeType envelopeType = textEnvelopeType (proxyToAsType (Proxy @Tx)) in object - [ "cborHex" .= (Aeson.String $ decodeUtf8 $ Base16.encode $ serialiseToCBOR tx) - , "txId" .= (txId tx) + [ "cborHex" .= Aeson.String (decodeUtf8 $ Base16.encode $ serialiseToCBOR tx) + , "txId" .= txId tx , "type" .= envelopeType , "description" .= Aeson.String mempty ] @@ -153,7 +153,7 @@ instance FromJSON Tx where (o .:? "txId") >>= \case Nothing -> pure tx Just txid' -> do - guard (txid' == (txId tx)) + guard (txid' == txId tx) pure tx instance Arbitrary Tx where @@ -362,8 +362,8 @@ genTxOut = `suchThat` notByronAddress where gen = - fmap (modifyTxOutValue (<> (lovelaceToValue $ Lovelace 10_000_000))) $ - oneof + modifyTxOutValue (<> (lovelaceToValue $ Lovelace 10_000_000)) + <$> oneof [ fromLedgerTxOut <$> arbitrary , notMultiAsset . fromLedgerTxOut <$> arbitrary ] @@ -429,7 +429,7 @@ genAddressInEra networkId = mkVkAddress networkId <$> genVerificationKey genValue :: Gen Value -genValue = liftA2 (<>) (pure $ lovelaceToValue $ Lovelace 10_000_000) (scale (`div` 10) $ fromLedgerValue <$> arbitrary) +genValue = fmap ((lovelaceToValue $ Lovelace 10_000_000) <>) (scale (`div` 10) $ fromLedgerValue <$> arbitrary) -- | Generate UTXO entries that do not contain any assets. Useful to test / -- measure cases where diff --git a/hydra-node/src/Hydra/Network/Ouroboros/Server.hs b/hydra-node/src/Hydra/Network/Ouroboros/Server.hs index f7adf23f3d2..b3899bbe062 100644 --- a/hydra-node/src/Hydra/Network/Ouroboros/Server.hs +++ b/hydra-node/src/Hydra/Network/Ouroboros/Server.hs @@ -29,9 +29,8 @@ fireForgetServerPeer :: Peer (FireForget msg) 'AsServer 'StIdle m a fireForgetServerPeer FireForgetServer{recvMsg, recvMsgDone} = -- In the 'StIdle' the server is awaiting a request message - Await (ClientAgency TokIdle) $ \msg -> + Await (ClientAgency TokIdle) $ \case -- The client got to choose between two messages and we have to handle -- either of them - case msg of - MsgSend payload -> Effect $ fireForgetServerPeer <$> recvMsg payload - MsgDone -> Effect $ Done TokDone <$> recvMsgDone + MsgSend payload -> Effect $ fireForgetServerPeer <$> recvMsg payload + MsgDone -> Effect $ Done TokDone <$> recvMsgDone diff --git a/hydra-node/src/Hydra/Options.hs b/hydra-node/src/Hydra/Options.hs index 97c620a5948..8386fbb7239 100644 --- a/hydra-node/src/Hydra/Options.hs +++ b/hydra-node/src/Hydra/Options.hs @@ -886,7 +886,7 @@ genDirPath = do pure $ intercalate "/" path genChainPoint :: Gen ChainPoint -genChainPoint = ChainPoint <$> (SlotNo <$> arbitrary) <*> someHeaderHash +genChainPoint = (ChainPoint . SlotNo <$> arbitrary) <*> someHeaderHash where someHeaderHash = do bytes <- vectorOf 32 arbitrary diff --git a/hydra-node/src/Hydra/Party.hs b/hydra-node/src/Hydra/Party.hs index 1f7c1bf7459..f4924e292e2 100644 --- a/hydra-node/src/Hydra/Party.hs +++ b/hydra-node/src/Hydra/Party.hs @@ -29,7 +29,7 @@ instance ToJSONKey Party where toJSONKey = toJSONKeyText (serialiseToRawBytesHexText . vkey) instance FromJSONKey Party where - fromJSONKey = FromJSONKeyTextParser $ partyFromHexText + fromJSONKey = FromJSONKeyTextParser partyFromHexText where partyFromHexText :: MonadFail m => Text -> m Party partyFromHexText t = diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Close.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Close.hs index 25fa8e3f563..f274dd609b9 100644 --- a/hydra-node/test/Hydra/Chain/Direct/Contract/Close.hs +++ b/hydra-node/test/Hydra/Chain/Direct/Contract/Close.hs @@ -399,11 +399,9 @@ data CloseInitialMutation -- right away. genCloseInitialMutation :: (Tx, UTxO) -> Gen SomeMutation genCloseInitialMutation (tx, _utxo) = - oneof - [ SomeMutation (Just $ toErrorCode IncorrectClosedContestationDeadline) MutateCloseContestationDeadline' <$> do - mutatedDeadline <- genMutatedDeadline - pure $ ChangeOutput 0 $ modifyInlineDatum (replaceContestationDeadline mutatedDeadline) headTxOut - ] + SomeMutation (Just $ toErrorCode IncorrectClosedContestationDeadline) MutateCloseContestationDeadline' <$> do + mutatedDeadline <- genMutatedDeadline + pure $ ChangeOutput 0 $ modifyInlineDatum (replaceContestationDeadline mutatedDeadline) headTxOut where headTxOut = fromJust $ txOuts' tx !!? 0 diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Init.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Init.hs index 0f36f51c4a2..a5993d5b5f6 100644 --- a/hydra-node/test/Hydra/Chain/Direct/Contract/Init.hs +++ b/hydra-node/test/Hydra/Chain/Direct/Contract/Init.hs @@ -137,7 +137,7 @@ genInitMutation (tx, _utxo) = out removeInitialOutputDatum ix out = - ChangeOutput ix $ modifyTxOutDatum (const $ TxOutDatumNone) out + ChangeOutput ix $ modifyTxOutDatum (const TxOutDatumNone) out changeInitialOutputToNotAHeadId ix out = ChangeOutput ix $ modifyTxOutDatum (const $ TxOutDatumInline $ toScriptData (42 :: Integer)) out diff --git a/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs b/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs index e547e5542bb..aa301fd0d1b 100644 --- a/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs +++ b/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs @@ -81,7 +81,7 @@ spec = genericCoverTable [transition] $ counterexample (show transition) $ let utxo = getKnownUTxO st - in case (observeHeadTx testNetworkId utxo tx) of + in case observeHeadTx testNetworkId utxo tx of NoHeadTx -> property False Init{} -> transition === Transition.Init Abort{} -> transition === Transition.Abort diff --git a/hydra-node/test/Hydra/Chain/Direct/WalletSpec.hs b/hydra-node/test/Hydra/Chain/Direct/WalletSpec.hs index 4c3efe3fbe5..76af8487350 100644 --- a/hydra-node/test/Hydra/Chain/Direct/WalletSpec.hs +++ b/hydra-node/test/Hydra/Chain/Direct/WalletSpec.hs @@ -275,7 +275,7 @@ genChainPoint = -- | Generate a chain point at given slot with a likely invalid block header hash. genChainPointAt :: SlotNo -> Gen ChainPoint genChainPointAt s = - ChainPoint s <$> (HeaderHash <$> arbitrary) + ChainPoint s . HeaderHash <$> arbitrary -- | Generate an arbitrary list of transactions from a UTXO set such that, -- transactions may *sometimes* consume given UTXO and produce new ones. The diff --git a/hydra-node/test/Hydra/JSONSchemaSpec.hs b/hydra-node/test/Hydra/JSONSchemaSpec.hs index 48456e9a409..330ab92c461 100644 --- a/hydra-node/test/Hydra/JSONSchemaSpec.hs +++ b/hydra-node/test/Hydra/JSONSchemaSpec.hs @@ -19,12 +19,12 @@ spec = do validateJSON (dir "api.json") id Null it "fails on non-existing schema file" $ - validateJSON ("does-not-exist.json") id Null + validateJSON "does-not-exist.json" id Null `shouldThrow` exceptionContaining @IOException "does-not-exist.json" it "fails with missing tool" $ do withClearedPATH $ - validateJSON ("does-not-matter.json") id Null + validateJSON "does-not-matter.json" id Null `shouldThrow` exceptionContaining @IOException "installed" it "selects a sub-schema correctly" $ diff --git a/hydra-node/test/Hydra/Network/ReliabilitySpec.hs b/hydra-node/test/Hydra/Network/ReliabilitySpec.hs index a4439172c42..74149f788e5 100644 --- a/hydra-node/test/Hydra/Network/ReliabilitySpec.hs +++ b/hydra-node/test/Hydra/Network/ReliabilitySpec.hs @@ -173,7 +173,7 @@ spec = parallel $ do let networkMessagesFile = tmpDir <> "/network-messages" Persistence{load, save} <- createPersistence $ tmpDir <> "/acks" - PersistenceIncremental{loadAll, append} <- createPersistenceIncremental $ networkMessagesFile + PersistenceIncremental{loadAll, append} <- createPersistenceIncremental networkMessagesFile let messagePersistence = MessagePersistence diff --git a/hydra-plutus-extras/src/Hydra/Plutus/Orphans.hs b/hydra-plutus-extras/src/Hydra/Plutus/Orphans.hs index aede2f67b58..e6476a718b1 100644 --- a/hydra-plutus-extras/src/Hydra/Plutus/Orphans.hs +++ b/hydra-plutus-extras/src/Hydra/Plutus/Orphans.hs @@ -47,7 +47,7 @@ instance Arbitrary a => Arbitrary (UpperBound a) where arbitrary = upperBound <$> arbitrary instance ToJSON PubKeyHash where - toJSON = \kh -> + toJSON kh = object [ "tag" .= Aeson.String "PubKeyHash" , "keyHash" .= Aeson.String (decodeUtf8 $ Base16.encode $ fromBuiltin $ getPubKeyHash kh) diff --git a/hydra-plutus/exe/inspect-script/Main.hs b/hydra-plutus/exe/inspect-script/Main.hs index cc339e51eb6..22e224dae28 100644 --- a/hydra-plutus/exe/inspect-script/Main.hs +++ b/hydra-plutus/exe/inspect-script/Main.hs @@ -108,7 +108,7 @@ main = do , (abortDatum, "abortDatum") ] - headDatum = toData $ Head.Initial 1_000_000_000_000 [] (toPlutusCurrencySymbol $ HeadTokens.headPolicyId $ someTxIn) (toPlutusTxOutRef someTxIn) + headDatum = toData $ Head.Initial 1_000_000_000_000 [] (toPlutusCurrencySymbol $ HeadTokens.headPolicyId someTxIn) (toPlutusTxOutRef someTxIn) someTxIn = TxIn (TxId $ unsafeHashFromBytes "01234567890123456789012345678901") (TxIx 1) diff --git a/hydra-plutus/src/Hydra/Contract/Error.hs b/hydra-plutus/src/Hydra/Contract/Error.hs index b8c1adc13a4..d77af3577cf 100644 --- a/hydra-plutus/src/Hydra/Contract/Error.hs +++ b/hydra-plutus/src/Hydra/Contract/Error.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE TemplateHaskell #-} - -- | Error codes to be used in plutus scripts. -- -- Define a new type and instantiate 'ToErrorCode' for error cases you want to diff --git a/hydra-plutus/src/Hydra/Contract/Initial.hs b/hydra-plutus/src/Hydra/Contract/Initial.hs index 92fbb4d698f..c83bf27b2b0 100644 --- a/hydra-plutus/src/Hydra/Contract/Initial.hs +++ b/hydra-plutus/src/Hydra/Contract/Initial.hs @@ -117,9 +117,9 @@ checkCommit commitValidator headId committedRefs context = go = \case ([], []) -> True - ([], (_ : _)) -> + ([], _ : _) -> traceError $(errorCode MissingCommittedTxOutInOutputDatum) - ((_ : _), []) -> + (_ : _, []) -> traceError $(errorCode CommittedTxOutMissingInOutputDatum) (TxInInfo{txInInfoOutRef, txInInfoResolved} : restCommitted, Commit{input, preSerializedOutput} : restCommits) -> Builtins.serialiseData (toBuiltinData txInInfoResolved) == preSerializedOutput diff --git a/hydra-test-utils/src/Test/Network/Ports.hs b/hydra-test-utils/src/Test/Network/Ports.hs index 219072bde12..574348b2409 100644 --- a/hydra-test-utils/src/Test/Network/Ports.hs +++ b/hydra-test-utils/src/Test/Network/Ports.hs @@ -35,4 +35,4 @@ withFreePort action = getRandomPort >>= action randomUnusedTCPPorts :: Int -> IO [Int] randomUnusedTCPPorts count = fmap fromIntegral - <$> replicateM count (withFreePort (\port -> return port)) + <$> replicateM count (withFreePort return) diff --git a/nix/hydra/shell.nix b/nix/hydra/shell.nix index 57aa818ff52..ffa692fc252 100644 --- a/nix/hydra/shell.nix +++ b/nix/hydra/shell.nix @@ -16,6 +16,8 @@ let fourmolu = pkgs.haskell-nix.tool compiler "fourmolu" "0.14.0.0"; cabal-fmt = pkgs.haskell-nix.tool compiler "cabal-fmt" "0.1.9"; + hlint = pkgs.haskell-nix.tool compiler "hlint" "3.8"; + apply-refact = pkgs.haskell-nix.tool compiler "apply-refact" "0.14.0.0"; # Build HLS form our fork (see flake.nix) haskell-language-server = pkgs.haskell-nix.tool compiler "haskell-language-server" rec { @@ -45,6 +47,8 @@ let fourmolu cabal-fmt pkgs.nixpkgs-fmt + hlint + apply-refact # For validating JSON instances against a pre-defined schema pkgs.check-jsonschema # For generating plantuml drawings @@ -155,6 +159,8 @@ let fourmolu cabal-fmt pkgs.nixpkgs-fmt + hlint + apply-refact ]; }; diff --git a/plutus-cbor/test/Plutus/Codec/CBOR/EncodingSpec.hs b/plutus-cbor/test/Plutus/Codec/CBOR/EncodingSpec.hs index c574d7fc3d8..386f4794187 100644 --- a/plutus-cbor/test/Plutus/Codec/CBOR/EncodingSpec.hs +++ b/plutus-cbor/test/Plutus/Codec/CBOR/EncodingSpec.hs @@ -236,7 +236,7 @@ genInteger = genByteString :: Gen ByteString genByteString = do - (\n -> BS.pack <$> vector n) =<< elements [0, 8, 16, 28, 32] + fmap BS.pack . vector =<< elements [0, 8, 16, 28, 32] shrinkByteString :: ByteString -> [ByteString] shrinkByteString =