Fix all GHC warnings

cem-script.cabal

@@ -21,7 +21,7 @@ common common-lang
   ghc-options:
     -Wall -Wcompat -Wincomplete-record-updates
     -Wincomplete-uni-patterns -Wredundant-constraints
-    -Wmissing-export-lists -Wmissing-deriving-strategies
+    -Wmissing-deriving-strategies
     -Wno-redundant-constraints
 
   if !flag(dev)
@@ -187,6 +187,9 @@ test-suite cem-sdk-test
     common-offchain,
 
   type:           exitcode-stdio-1.0
+  ghc-options:
+    -Wno-missing-signatures
+    -Wno-incomplete-uni-patterns
   build-depends:
     , cem-script
     , cem-script:cardano-extras

src-lib/cardano-extras/Cardano/Extras.hs

@@ -1,3 +1,5 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+
 {- | Various utils to cope with `cardano-api` types
 Mainly stolen from `hydra-cardano-api` and some from `atlas`
 -}
@@ -23,7 +25,7 @@ import Cardano.Api (
   AssetId (..),
   AssetName (..),
   BabbageEra,
-  BabbageEraOnwards (BabbageEraOnwardsBabbage, BabbageEraOnwardsConway),
+  BabbageEraOnwards (BabbageEraOnwardsBabbage),
   BuildTx,
   BuildTxWith (..),
   ConsensusModeParams (..),

src-lib/cardano-extras/Plutus/Extras.hs

@@ -3,7 +3,6 @@ module Plutus.Extras where
 import PlutusTx.Prelude
 
 import Cardano.Api (
-  PlutusScriptVersion (..),
   Script (..),
   SerialiseAsRawBytes (serialiseToRawBytes),
   hashScript,

src-lib/data-spine/Data/Spine.hs

@@ -3,18 +3,13 @@
 {-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE PolyKinds #-}
 
-module Data.Spine where
+module Data.Spine (HasSpine (..), deriveSpine, OfSpine (..)) where
 
 import Prelude
 
-import Control.Monad
-import Control.Monad.Reader (MonadReader (..))
-import GHC.Records
 import Language.Haskell.TH
 import Language.Haskell.TH.Syntax
 
-import Data.Singletons
-
 -- | Definitions
 
 {- | Spine is datatype, which tags constructors of ADT.
@@ -41,23 +36,6 @@ instance (HasSpine sop1, HasSpine sop2) => HasSpine (sop1, sop2) where
 -- | Newtype encoding sop value of fixed known spine
 newtype OfSpine (x :: Spine datatype) = UnsafeMkOfSpine {getValue :: datatype}
 
--- matchOfSpine :: sop -> ...
--- matchOfSpineDMap :: sop -> DMap Spine (OfSpine -> a)
--- mkOfSpine :: sop -> Some .. OfSpine
-
--- TODO: move to module
-
-{- | This class has same behaviour as `MonadReader` storing some record.
-| The difference is that you may not have real record stored.
--}
-class (Monad m) => MonadRecord record m where
-  askField :: forall label a. (HasField label record a) => m a
-  default askField ::
-    forall label a.
-    (MonadReader record m, HasField label record a) =>
-    m a
-  askField = getField @label <$> ask @record
-
 -- | Deriving utils
 addSuffix :: Name -> String -> Name
 addSuffix (Name (OccName name) flavour) suffix =
@@ -92,7 +70,7 @@ deriveTags ty suff classes = do
 
 deriveMapping :: Name -> String -> Q Exp
 deriveMapping ty suff = do
-  (tyName, csNames) <- reifyDatatype ty
+  (_, csNames) <- reifyDatatype ty
   -- XXX: Quasi-quote splice does not work for case matches list
   let
     matches =
@@ -106,11 +84,9 @@ deriveMapping ty suff = do
 -}
 deriveSpine :: Name -> Q [Dec]
 deriveSpine name = do
-  info <- reify name
   let
     suffix = "Spine"
     spineName = addSuffix name suffix
-    spineTypeQ = reifyType spineName
   spineDec <- deriveTags name suffix [''Eq, ''Ord, ''Enum, ''Show]
   -- TODO: derive Sing
   -- TODO: derive HasField (OfSpine ...)

src/Cardano/CEM.hs

@@ -16,7 +16,6 @@ import PlutusLedgerApi.V1.Crypto (PubKeyHash)
 import PlutusLedgerApi.V2 (
   ToData (..),
   Value,
-  fromData,
  )
 import PlutusTx.Show.TH (deriveShow)
 
@@ -28,7 +27,6 @@ import Data.Spine
 data AddressSpec
   = ByAddress Address
   | ByPubKey PubKeyHash
-  | ByScript -- TODO
   | BySameScript
   deriving stock (Show, Prelude.Eq)
 
@@ -73,7 +71,7 @@ data TxFanConstraint script = MkTxFanC
   , txFanCFilter :: TxFanFilter script
   , txFanCQuantor :: Quantor
   }
-  deriving (Show)
+  deriving stock (Show)
 
 -- Main API
 
@@ -124,7 +122,7 @@ data TransitionSpec script = MkTransitionSpec
   { constraints :: [TxFanConstraint script]
   , signers :: [PubKeyHash]
   }
-  deriving (Show)
+  deriving stock (Show)
 
 {- | Static part of CEMScript datum.
 Datatype is actually used only by off-chain code due to Plutus limitations.

src/Cardano/CEM/Examples/Auction.hs

@@ -12,7 +12,7 @@ import PlutusLedgerApi.V1.Crypto (PubKeyHash)
 import PlutusLedgerApi.V1.Interval qualified as Interval
 import PlutusLedgerApi.V1.Time (POSIXTime)
 import PlutusLedgerApi.V1.Value (CurrencySymbol (..), TokenName (..), singleton)
-import PlutusLedgerApi.V2 (Address, ToData, Value)
+import PlutusLedgerApi.V2 (Value)
 import PlutusTx qualified
 import PlutusTx.Show.TH (deriveShow)
 
@@ -152,10 +152,10 @@ instance CEMScript SimpleAuction where
     _ -> Left "Incorrect state for transition"
     where
       initialBid = MkBet (seller params) 0
-      nextState state =
+      nextState state' =
         MkTxFanC
           Out
-          (MkTxFanFilter BySameScript (bySameCEM state))
+          (MkTxFanFilter BySameScript (bySameCEM state'))
           (SumValueEq $ lot params)
       betAdaValue = adaValue . betAmount
       adaValue =

src/Cardano/CEM/Examples/Compilation.hs

@@ -1,5 +1,8 @@
 {-# LANGUAGE NoPolyKinds #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
+-- This warnings work incorrectly in presence of our Plutus code
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+{-# OPTIONS_GHC -Wno-unused-local-binds #-}
 
 module Cardano.CEM.Examples.Compilation where
 
@@ -14,16 +17,14 @@ import Cardano.CEM.Examples.Voting
 import Cardano.CEM.OnChain (CEMScriptCompiled (..), genericCEMScript)
 import Cardano.CEM.Stages (SingleStage)
 
-compiledAuction = $(PlutusTx.compileUntyped (genericCEMScript ''SimpleAuction ''SimpleAuctionStage))
-
 instance CEMScriptCompiled SimpleAuction where
   {-# INLINEABLE cemScriptCompiled #-}
   cemScriptCompiled Proxy =
-    serialiseCompiledCode compiledAuction
-
-compiledVoting = $(PlutusTx.compileUntyped (genericCEMScript ''SimpleVoting ''SingleStage))
+    serialiseCompiledCode
+      $(PlutusTx.compileUntyped (genericCEMScript ''SimpleAuction ''SimpleAuctionStage))
 
 instance CEMScriptCompiled SimpleVoting where
   {-# INLINEABLE cemScriptCompiled #-}
   cemScriptCompiled Proxy =
-    serialiseCompiledCode compiledVoting
+    serialiseCompiledCode
+      $(PlutusTx.compileUntyped (genericCEMScript ''SimpleVoting ''SingleStage))

src/Cardano/CEM/Examples/Voting.hs

@@ -15,8 +15,6 @@ import PlutusTx qualified
 import PlutusTx.AssocMap qualified as PMap
 import PlutusTx.Show.TH (deriveShow)
 
-import Cardano.Api.Ledger (Vote)
-
 import Cardano.CEM
 import Cardano.CEM.Stages
 import Data.Spine (deriveSpine)
@@ -26,7 +24,7 @@ import Data.Spine (deriveSpine)
 data SimpleVoting
 
 data VoteValue = Yes | No | Abstain
-  deriving (Prelude.Show, Prelude.Eq)
+  deriving stock (Prelude.Show, Prelude.Eq)
 
 instance Eq VoteValue where
   Yes == Yes = True
@@ -36,7 +34,7 @@ instance Eq VoteValue where
 
 -- | Policy determinig who can vote
 data JuryPolicy = Anyone | FixedJuryList [PubKeyHash] | WithToken Value
-  deriving (Prelude.Show, Prelude.Eq)
+  deriving stock (Prelude.Show, Prelude.Eq)
 
 -- Votes storage
 
@@ -73,20 +71,20 @@ data SimpleVotingParams = MkVotingParams
   , abstainAllowed :: Bool
   , drawDecision :: VoteValue
   }
-  deriving (Prelude.Show, Prelude.Eq)
+  deriving stock (Prelude.Show, Prelude.Eq)
 
 data SimpleVotingState
   = NotStarted
   | InProgress VoteStorage
   | Finalized VoteValue
-  deriving (Prelude.Show, Prelude.Eq)
+  deriving stock (Prelude.Show, Prelude.Eq)
 
 data SimpleVotingTransition
   = Create
   | Start
   | Vote PubKeyHash VoteValue
   | Finalize
-  deriving (Prelude.Show, Prelude.Eq)
+  deriving stock (Prelude.Show, Prelude.Eq)
 
 PlutusTx.unstableMakeIsData ''VoteValue
 PlutusTx.unstableMakeIsData ''JuryPolicy
@@ -168,5 +166,5 @@ instance CEMScript SimpleVoting where
             }
       _ -> Left "Wrong state transition" where
     where
-      nextScriptState state =
-        MkTxFanC Out (MkTxFanFilter BySameScript (bySameCEM state)) (Exist 1)
+      nextScriptState state' =
+        MkTxFanC Out (MkTxFanFilter BySameScript (bySameCEM state')) (Exist 1)

src/Cardano/CEM/Monads.hs

@@ -2,36 +2,20 @@ module Cardano.CEM.Monads where
 
 import Prelude
 
-import Control.Monad.IO.Class (MonadIO (..))
-import Data.Bifunctor (Bifunctor (..))
-import Data.Data (Proxy (..))
-import Data.Map qualified as Map
 import Data.Set (Set)
 
 import PlutusLedgerApi.V1.Address (Address)
 import PlutusLedgerApi.V2 (
   Interval (..),
   POSIXTime (..),
-  UnsafeFromData (..),
-  always,
-  fromData,
  )
 
 import Cardano.Api hiding (Address, In, Out, queryUtxo, txIns)
-import Cardano.Api.Shelley (PlutusScript (..), PoolId, ReferenceScript (..), fromPlutusData, toMaryValue, toPlutusData)
+import Cardano.Api.IPC (TxValidationError)
+import Cardano.Api.Shelley (PoolId)
 import Cardano.Ledger.Core (PParams)
 
-import Cardano.Api.IPC (TxValidationError)
-import Cardano.CEM
-import Cardano.CEM.OnChain
 import Cardano.Extras
-import Cardano.Ledger.Shelley.API (ApplyTxError)
-import Control.Monad.Except (ExceptT (..), MonadError (..), runExceptT)
-import Control.Monad.Trans (MonadTrans (..))
-import Data.List (find)
-import Data.Maybe (listToMaybe)
-import Data.Spine (HasSpine (..))
-import Text.Show.Pretty (ppShow)
 
 -- MonadBlockchainParams
 

src/Cardano/CEM/Monads/CLB.hs

@@ -1,17 +1,16 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+
 module Cardano.CEM.Monads.CLB where
 
 import Prelude
 
-import Control.Monad.Reader (MonadReader (..), ReaderT (..), asks)
 import Control.Monad.State (StateT (..), gets)
-import Control.Monad.Trans (MonadIO (..))
 import Data.Map qualified as Map
 import Data.Set qualified as Set
 
 -- Cardano imports
 import Cardano.Api hiding (queryUtxo)
 import Cardano.Api.Query (fromLedgerUTxO)
-import Cardano.Api.Shelley (LedgerProtocolParameters (..))
 
 -- Lib imports
 import Clb (
@@ -35,7 +34,6 @@ import Clb.TimeSlot (posixTimeToUTCTime)
 import Cardano.CEM.Monads
 import Cardano.CEM.Monads.L1Commons
 import Cardano.CEM.OffChain (fromPlutusAddressInMonad)
-import Cardano.Extras
 
 instance (MonadFail m) => MonadBlockchainParams (ClbT m) where
   askNetworkId :: ClbT m NetworkId
@@ -80,6 +78,7 @@ instance (MonadFail m) => MonadSubmitTx (ClbT m) where
         case result of
           Success _ _ -> return $ Right $ getTxId body
           _ -> fail "TODO"
+      Right (_, _) -> fail "Unsupported tx format"
       Left e -> return $ Left $ UnhandledAutobalanceError e
 
 instance (MonadFail m) => MonadTest (ClbT m) where

src/Cardano/CEM/Monads/L1.hs

@@ -12,7 +12,6 @@ import Unsafe.Coerce (unsafeCoerce)
 
 -- Cardano imports
 import Cardano.Api hiding (queryUtxo)
-import Cardano.Api.IPC (TxValidationError)
 import Ouroboros.Network.Protocol.LocalStateQuery.Type (Target (..))
 
 -- Project imports
@@ -67,11 +66,11 @@ instance MonadBlockchainParams L1Runner where
 
 queryCardanoNodeWrapping :: QueryInShelleyBasedEra Era b -> L1Runner b
 queryCardanoNodeWrapping query =
-  handleEitherEra =<< queryCardanoNode (wrapQuery query)
+  handleEitherEra =<< queryCardanoNode wrapped
   where
     handleEitherEra (Right x) = return x
     handleEitherEra (Left _) = fail "Unexpected era mismatch"
-    wrapQuery query = QueryInEra (QueryInShelleyBasedEra shelleyBasedEra query)
+    wrapped = QueryInEra (QueryInShelleyBasedEra shelleyBasedEra query)
 
 -- Design inspired by `Hydra.Chain.CardanoClient` helpers
 queryCardanoNode ::
@@ -108,17 +107,20 @@ instance MonadSubmitTx L1Runner where
               return $ Right $ getTxId body
             SubmitFail (TxValidationErrorInCardanoMode e) ->
               return $ Left $ UnhandledNodeSubmissionError $ unsafeCoerce e
+            SubmitFail (TxValidationEraMismatch _) ->
+              error "Era mismatch error"
       Left e -> return $ Left $ UnhandledAutobalanceError e
 
 instance MonadTest L1Runner where
   -- FIXME: cache keys and better error handling
   getTestWalletSks = do
-    mapM key [0 .. 2]
+    mapM keyN [0 .. 2]
     where
-      key n = do
+      keyN n = do
         keyBytes <- liftIO $ BS.readFile $ keysPaths !! fromInteger n
-        let Just key = parseSigningKeyTE keyBytes
-        return key
+        case parseSigningKeyTE keyBytes of
+          Just key -> return key
+          Nothing -> fail "Could not read key"
       keysPaths =
         [ "./devnet/credentials/faucet.sk"
         , "./devnet/credentials/bob.sk"

src/Cardano/CEM/Monads/L1Commons.hs

@@ -8,9 +8,6 @@ import Prelude
 import Control.Monad.Except (ExceptT (..), runExceptT)
 import Data.Map qualified as Map
 
--- Lib imports
-import Text.Show.Pretty (ppShow)
-
 -- Cardano imports
 import Cardano.Api hiding (queryUtxo)
 import Cardano.Api.Shelley (LedgerProtocolParameters (..))