Skip to content

Commit

Permalink
wip
Browse files Browse the repository at this point in the history
  • Loading branch information
erikd committed Jun 2, 2023
1 parent 8d8329e commit 5bd7370
Show file tree
Hide file tree
Showing 24 changed files with 87 additions and 42 deletions.
33 changes: 31 additions & 2 deletions cabal.project
Expand Up @@ -14,9 +14,9 @@ repository cardano-haskell-packages
-- update either of these.
index-state:
-- Bump this if you need newer packages from Hackage
, hackage.haskell.org 2023-04-26T22:25:13Z
, hackage.haskell.org 2023-06-01T19:11:19Z
-- Bump this if you need newer packages from CHaP
, cardano-haskell-packages 2023-05-23T16:25:08Z
, cardano-haskell-packages 2023-06-01T04:18:39Z

packages:
./ouroboros-consensus
Expand Down Expand Up @@ -77,3 +77,32 @@ package strict-stm

package text-short
flags: +asserts

if impl(ghc >= 9.6)
allow-newer:
, *:base
, *:ghc-prim
, *:template-haskell

source-repository-package
type: git
location: https://github.com/input-output-hk/cardano-ledger
tag: 65982615f1520b75ad3a2b80cdd714aaa28f31f0
subdir:
eras/allegra/impl
eras/alonzo/impl
eras/alonzo/test-suite
eras/babbage/impl
eras/babbage/test-suite
eras/byron/ledger/executable-spec
eras/byron/ledger/impl
eras/byron/ledger/impl/test
eras/conway/impl
eras/conway/test-suite
eras/mary/impl
eras/shelley/impl
eras/shelley/test-suite
eras/shelley-ma/test-suite
libs/cardano-ledger-api
libs/cardano-ledger-binary
libs/cardano-ledger-core
22 changes: 11 additions & 11 deletions ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal
Expand Up @@ -114,7 +114,7 @@ library
Ouroboros.Consensus.Shelley.Ledger.Query.PParamsLegacyEncoder

build-depends:
, base >=4.14 && <4.17
, base >=4.14 && <4.19
, base-deriving-via
, bytestring >=0.10 && <0.12
, cardano-binary
Expand All @@ -123,8 +123,8 @@ library
, cardano-crypto-wrapper
, cardano-data
, cardano-ledger-allegra
, cardano-ledger-alonzo ^>=1.2.1
, cardano-ledger-babbage ^>=1.2.1
, cardano-ledger-alonzo ^>=1.3
, cardano-ledger-babbage ^>=1.3
, cardano-ledger-binary
, cardano-ledger-byron
, cardano-ledger-conway
Expand All @@ -142,15 +142,15 @@ library
, formatting >=6.3 && <7.2
, measures
, microlens
, mtl >=2.2 && <2.3
, mtl
, nothunks
, ouroboros-consensus ^>=0.7
, ouroboros-consensus-protocol ^>=0.5.0.1
, ouroboros-network-api ^>=0.5
, serialise >=0.2 && <0.3
, small-steps
, text >=1.2 && <1.3
, these >=1.1 && <1.2
, text ^>=2.0
, these ^>=1.2
, vector-map

library byronspec
Expand All @@ -177,15 +177,15 @@ library byronspec
Ouroboros.Consensus.ByronSpec.Ledger.Rules

build-depends:
, base >=4.14 && <4.17
, base >=4.14 && <4.19
, bimap >=0.4 && <0.5
, byron-spec-chain
, byron-spec-ledger
, cardano-ledger-binary
, cardano-ledger-byron-test
, cborg >=0.2.2 && <0.3
, containers >=0.5 && <0.7
, mtl >=2.2 && <2.3
, mtl ^>=2.3
, nothunks
, ouroboros-consensus ^>=0.7
, serialise >=0.2 && <0.3
Expand Down Expand Up @@ -488,7 +488,7 @@ library cardano-tools

build-depends:
, aeson
, base >=4.14 && <4.17
, base >=4.14 && <4.19
, base16-bytestring >=1.0
, bytestring >=0.10 && <0.12
, cardano-crypto
Expand All @@ -514,7 +514,7 @@ library cardano-tools
, filepath
, fs-api
, microlens
, mtl >=2.2 && <2.3
, mtl ^>=2.3
, network
, nothunks
, ouroboros-consensus ^>=0.7
Expand All @@ -526,7 +526,7 @@ library cardano-tools
, ouroboros-network-framework
, ouroboros-network-protocols
, serialise >=0.2 && <0.3
, text >=1.2 && <1.3
, text
, text-builder
, transformers
, transformers-except
Expand Down
Expand Up @@ -100,7 +100,7 @@ library
ViewPatterns

build-depends:
, base >=4.14 && <4.17
, base >=4.14 && <4.19
, bytestring >=0.10 && <0.12
, cborg ^>=0.2.2
, containers >=0.5 && <0.7
Expand All @@ -110,7 +110,7 @@ library
, fs-api
, hashable
, io-classes ^>=1.1
, mtl ^>=2.2
, mtl ^>=2.3
, ouroboros-consensus ^>=0.7
, ouroboros-network >=0.7 && <0.8 || ^>=0.8
, ouroboros-network-api ^>=0.5
Expand All @@ -119,7 +119,7 @@ library
, random
, serialise ^>=0.2
, si-timers ^>=1.1
, text >=1.2 && <1.3
, text ^>=2.0
, time
, typed-protocols

Expand Down Expand Up @@ -149,7 +149,7 @@ library diffusion-testlib
, containers
, contra-tracer
, fgl
, fs-sim
, fs-sim >=0.1.0.2
, graphviz >=2999.20.1.0
, io-classes
, io-sim
Expand Down Expand Up @@ -246,7 +246,7 @@ test-suite consensus-test
, containers
, diffusion-testlib
, directory
, fs-api
, fs-api >=0.1.0.2
, fs-sim
, io-sim
, mtl
Expand Down
Expand Up @@ -40,7 +40,7 @@ library
Ouroboros.Consensus.Protocol.Translate

build-depends:
, base >=4.14 && <4.17
, base >=4.14 && <4.19
, bytestring
, cardano-binary
, cardano-crypto-class
Expand Down
10 changes: 5 additions & 5 deletions ouroboros-consensus/ouroboros-consensus.cabal
Expand Up @@ -290,7 +290,7 @@ library
ViewPatterns

build-depends:
, base >=4.14 && <4.17
, base >=4.14 && <4.19
, base16-bytestring
, bimap >=0.4 && <0.5
, binary >=0.8 && <0.11
Expand All @@ -309,7 +309,7 @@ library
, hashable
, io-classes ^>=1.1
, measures
, mtl >=2.2 && <2.3
, mtl ^>=2.3
, nothunks >=0.1.2 && <0.2
, ouroboros-network-api ^>=0.5
, ouroboros-network-mock ^>=0.1.0.1
Expand All @@ -322,8 +322,8 @@ library
, sop-core >=0.5 && <0.6
, streaming
, strict-stm ^>=1.1
, text >=1.2 && <1.3
, these >=1.1 && <1.2
, text ^>=2.0
, these ^>=1.2
, time
, transformers
, typed-protocols
Expand Down Expand Up @@ -613,7 +613,7 @@ test-suite storage-test
, ouroboros-network-mock
, pretty-show
, QuickCheck
, quickcheck-state-machine >=0.7.0 && <0.7.1
, quickcheck-state-machine ^>=0.7
, random
, serialise
, tasty
Expand Down
Expand Up @@ -6,6 +6,7 @@
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Ouroboros.Consensus.Block.Forging (
Expand Down
@@ -1,11 +1,11 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}

module Ouroboros.Consensus.Block.RealPoint (
-- * Non-genesis points
Expand Down Expand Up @@ -83,7 +83,7 @@ blockRealPoint blk = RealPoint s h
where
HeaderFields { headerFieldSlot = s, headerFieldHash = h } = getHeaderFields blk

headerRealPoint :: HasHeader (Header blk) => Header blk -> RealPoint blk
headerRealPoint :: (HasHeader blk, HasHeader (Header blk)) => Header blk -> RealPoint blk
headerRealPoint hdr = RealPoint s h
where
HeaderFields { headerFieldSlot = s, headerFieldHash = h } = getHeaderFields hdr
Expand Down
@@ -1,6 +1,7 @@
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

module Ouroboros.Consensus.Block.SupportsProtocol (BlockSupportsProtocol (..)) where

Expand Down
Expand Up @@ -11,7 +11,8 @@ module Ouroboros.Consensus.Forecast (
) where

import Control.Exception (Exception)
import Control.Monad.Except
import Control.Monad (guard)
import Control.Monad.Except (Except)
import Data.Word (Word64)
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.HardFork.History.Util (addSlots)
Expand Down
Expand Up @@ -2,6 +2,7 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
-- | Intended for qualified import
--
Expand Down
Expand Up @@ -5,6 +5,7 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

-- | Intended for qualified import
--
Expand Down
@@ -1,6 +1,7 @@
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
-- | Intended for qualified import
--
-- > import Ouroboros.Consensus.Fragment.ValidatedDiff (ValidatedChainDiff (..))
Expand Down
Expand Up @@ -3,6 +3,7 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Ouroboros.Consensus.HardFork.Combinator.PartialConfig (
Expand Down
Expand Up @@ -41,7 +41,8 @@ module Ouroboros.Consensus.HardFork.History.Qry (

import Codec.Serialise (Serialise (..))
import Control.Exception (throw)
import Control.Monad.Except
import Control.Monad (ap, liftM, guard, (>=>))
import Control.Monad.Except ()
import Data.Bifunctor
import Data.Fixed (divMod')
import Data.Foldable (toList)
Expand Down
Expand Up @@ -49,7 +49,8 @@ import Codec.CBOR.Decoding (TokenType (TypeNull), decodeNull,
peekTokenType)
import Codec.CBOR.Encoding (encodeListLen, encodeNull)
import Codec.Serialise
import Control.Monad.Except
import Control.Monad (unless)
import Control.Monad.Except (Except, throwError)
import Data.Bifunctor
import Data.Foldable (toList)
import Data.Kind (Type)
Expand Down
Expand Up @@ -3,6 +3,7 @@
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

-- | Definition is 'IsLedger'
--
Expand Down
Expand Up @@ -4,6 +4,7 @@
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

module Ouroboros.Consensus.Ledger.Inspect (
InspectLedger (..)
Expand Down
Expand Up @@ -39,7 +39,8 @@ module Ouroboros.Consensus.Protocol.PBFT.State (
import Codec.Serialise (Serialise (..))
import Codec.Serialise.Decoding (Decoder)
import Codec.Serialise.Encoding (Encoding)
import Control.Monad.Except
import Control.Monad (unless)
import Control.Monad.Except (Except, runExcept, throwError)
import qualified Data.Foldable as Foldable
import Data.List (sortOn)
import Data.Map.Strict (Map)
Expand Down
Expand Up @@ -52,8 +52,9 @@ module Ouroboros.Consensus.Storage.ImmutableDB.API (
) where

import qualified Codec.CBOR.Read as CBOR
import Control.Monad.Except (ExceptT (..), lift, runExceptT,
import Control.Monad.Except (ExceptT (..), runExceptT,
throwError)
import Control.Monad.Trans.Class (lift)
import qualified Data.ByteString.Lazy as Lazy
import Data.Either (isRight)
import Data.Function (on)
Expand Down
Expand Up @@ -133,7 +133,7 @@ decodeAsFlatTerm bs0 =
provideInput bs
| BS.null bs = return []
| otherwise = do
next <- lift $ ST.Lazy.strictToLazyST $ do
next <- S.lift $ ST.Lazy.strictToLazyST $ do
-- This will always be a 'Partial' here because decodeTermToken
-- always starts by requesting initial input. Only decoders that
-- fail or return a value without looking at their input can give
Expand All @@ -146,7 +146,7 @@ decodeAsFlatTerm bs0 =
CBOR.R.IDecode s CBOR.F.TermToken
-> ExceptT CBOR.R.DeserialiseFailure (ST.Lazy.ST s) CBOR.F.FlatTerm
collectOutput (CBOR.R.Fail _ _ err) = throwError err
collectOutput (CBOR.R.Partial k) = lift (ST.Lazy.strictToLazyST (k Nothing)) >>=
collectOutput (CBOR.R.Partial k) = S.lift (ST.Lazy.strictToLazyST (k Nothing)) >>=
collectOutput
collectOutput (CBOR.R.Done bs' _ x) = do xs <- provideInput bs'
return (x : xs)
Expand Down
Expand Up @@ -25,6 +25,7 @@ module Ouroboros.Consensus.Util.MonadSTM.RAWLock (
, unsafeReleaseWriteAccess
) where

import Control.Monad (join)
import Control.Monad.Except
import Data.Functor (($>))
import GHC.Generics (Generic)
Expand Down
Expand Up @@ -4,6 +4,7 @@
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

-- TODO: this module ought to use 'MonadMVar'
-- See https://github.com/input-output-hk/io-sim/issues/34
Expand Down

0 comments on commit 5bd7370

Please sign in to comment.