Merge pull request #99 from input-output-hk/mgalazyn/chore/update-ledger

Update ledger and consensus

cabal.project

@@ -13,8 +13,8 @@ repository cardano-haskell-packages
 -- See CONTRIBUTING for information about these, including some Nix commands
 -- you need to run if you change them
 index-state:
-  , hackage.haskell.org 2023-07-02T00:00:00Z
-  , cardano-haskell-packages 2023-07-02T00:00:00Z
+  , hackage.haskell.org 2023-07-03T00:00:00Z
+  , cardano-haskell-packages 2023-07-07T22:30:00Z
 
 packages:
     cardano-api

cardano-api/cardano-api.cabal

@@ -126,17 +126,17 @@ library internal
                       , cardano-crypto-class >= 2.1.1
                       , cardano-crypto-wrapper ^>= 1.5
                       , cardano-data >= 1.0
-                      , cardano-ledger-alonzo >= 1.3
-                      , cardano-ledger-allegra >= 1.2
-                      , cardano-ledger-api >= 1.2.0.1
-                      , cardano-ledger-babbage >= 1.3
+                      , cardano-ledger-alonzo >= 1.3.1.1
+                      , cardano-ledger-allegra >= 1.2.0.2
+                      , cardano-ledger-api >= 1.3
+                      , cardano-ledger-babbage >= 1.4.0.1
                       , cardano-ledger-binary
-                      , cardano-ledger-byron >= 1.0.0.1
-                      , cardano-ledger-conway >= 1.3
-                      , cardano-ledger-core >= 1.3
-                      , cardano-ledger-mary >= 1.1
-                      , cardano-ledger-shelley >= 1.3
-                      , cardano-protocol-tpraos >= 1.0.3.1
+                      , cardano-ledger-byron >= 1.0.0.2
+                      , cardano-ledger-conway >= 1.5
+                      , cardano-ledger-core >= 1.4
+                      , cardano-ledger-mary >= 1.3.0.2
+                      , cardano-ledger-shelley >= 1.4.1.0
+                      , cardano-protocol-tpraos >= 1.0.3.3
                       , cardano-slotting >= 0.1
                       , cardano-strict-containers >= 0.1
                       , cborg
@@ -153,9 +153,9 @@ library internal
                       , mtl
                       , network
                       , optparse-applicative-fork
-                      , ouroboros-consensus >= 0.7
-                      , ouroboros-consensus-cardano >= 0.6
-                      , ouroboros-consensus-diffusion >= 0.6
+                      , ouroboros-consensus >= 0.9
+                      , ouroboros-consensus-cardano >= 0.7
+                      , ouroboros-consensus-diffusion >= 0.7
                       , ouroboros-consensus-protocol >= 0.5
                       , ouroboros-network
                       , ouroboros-network-api
@@ -170,7 +170,7 @@ library internal
                       , serialise
                       , small-steps ^>= 1.0
                       , stm
-                      , text
+                      , text >= 2.0
                       , time
                       , transformers
                       , transformers-except ^>= 0.1.3
@@ -228,11 +228,11 @@ library gen
                       , cardano-binary >= 1.6 && < 1.8
                       , cardano-crypto-class ^>= 2.1
                       , cardano-crypto-test ^>= 1.5
-                      , cardano-ledger-alonzo >= 1.3
+                      , cardano-ledger-alonzo >= 1.3.1.1
                       , cardano-ledger-alonzo-test
                       , cardano-ledger-byron-test >= 1.5
-                      , cardano-ledger-core >= 1.3
-                      , cardano-ledger-shelley >= 1.3
+                      , cardano-ledger-core >= 1.4
+                      , cardano-ledger-shelley >= 1.4.1.0
                       , containers
                       , hedgehog >= 1.1
                       , text
@@ -252,8 +252,8 @@ test-suite cardano-api-test
                       , cardano-crypto-class ^>= 2.1
                       , cardano-crypto-test ^>= 1.5
                       , cardano-crypto-tests ^>= 2.1
-                      , cardano-ledger-api >= 1.2.0.1
-                      , cardano-ledger-core:{cardano-ledger-core, testlib} >= 1.2
+                      , cardano-ledger-api >= 1.3
+                      , cardano-ledger-core:{cardano-ledger-core, testlib} >= 1.4
                       , containers
                       , hedgehog >= 1.1
                       , hedgehog-quickcheck
@@ -298,10 +298,10 @@ test-suite cardano-api-golden
                       , cardano-crypto-class
                       , cardano-data >= 1.0
                       , cardano-ledger-alonzo
-                      , cardano-ledger-api >= 1.2.0.1
-                      , cardano-ledger-core:{cardano-ledger-core, testlib} >= 1.2
+                      , cardano-ledger-api >= 1.3
+                      , cardano-ledger-core:{cardano-ledger-core, testlib} >= 1.4
                       , cardano-ledger-shelley
-                      , cardano-ledger-shelley-test >= 1.2
+                      , cardano-ledger-shelley-test >= 1.2.0.1
                       , cardano-slotting ^>= 0.1
                       , containers
                       , errors

cardano-api/internal/Cardano/Api/Error.hs

@@ -9,12 +9,17 @@ module Cardano.Api.Error
   , throwErrorAsException
   , ErrorAsException(..)
   , FileError(..)
+  , fileIOExceptT
   ) where
 
 import           Control.Exception (Exception (..), IOException, throwIO)
+import           Control.Monad.Except (throwError)
+import           Control.Monad.IO.Class (MonadIO)
+import           Control.Monad.Trans.Except (ExceptT)
+import           Control.Monad.Trans.Except.Extra (handleIOExceptT)
+import           System.Directory (doesFileExist)
 import           System.IO (Handle)
 
-
 class Show e => Error e where
 
     displayError :: e -> String
@@ -46,6 +51,7 @@ data FileError e = FileError FilePath e
                      FilePath
                      -- ^ Temporary path
                      Handle
+                 | FileDoesNotExistError FilePath
                  | FileIOError FilePath IOException
   deriving (Show, Eq, Functor)
 
@@ -54,6 +60,8 @@ instance Error e => Error (FileError e) where
     "Error creating temporary file at: " ++ tempPath ++
     "/n" ++ "Target path: " ++ targetPath ++
     "/n" ++ "Handle: " ++ show h
+  displayError (FileDoesNotExistError path) =
+    "Error file not found at: " ++ path
   displayError (FileIOError path ioe) =
     path ++ ": " ++ displayException ioe
   displayError (FileError path e) =
@@ -62,3 +70,12 @@ instance Error e => Error (FileError e) where
 instance Error IOException where
   displayError = show
 
+fileIOExceptT :: MonadIO m
+              => FilePath
+              -> (FilePath -> IO s)
+              -> ExceptT (FileError e) m s
+fileIOExceptT fp readFile' = do
+  fileExists <- handleIOExceptT (FileIOError fp) $ doesFileExist fp
+  if fileExists then handleIOExceptT (FileIOError fp) $ readFile' fp
+                else throwError (FileDoesNotExistError fp)
+

cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs

@@ -15,6 +15,7 @@ module Cardano.Api.Governance.Actions.VotingProcedure where
 import           Cardano.Api.Address
 import           Cardano.Api.Eras
 import           Cardano.Api.HasTypeProxy
+import           Cardano.Api.Keys.Shelley
 import           Cardano.Api.Script
 import           Cardano.Api.SerialiseCBOR (FromCBOR (fromCBOR), SerialiseAsCBOR (..),
                    ToCBOR (toCBOR))
@@ -30,7 +31,8 @@ import qualified Cardano.Ledger.Conway.Governance as Gov
 import           Cardano.Ledger.Core (EraCrypto)
 import qualified Cardano.Ledger.Core as Shelley
 import qualified Cardano.Ledger.Credential as Ledger
-import           Cardano.Ledger.Keys
+import           Cardano.Ledger.Crypto (StandardCrypto)
+import           Cardano.Ledger.Keys (HasKeyRole (..), KeyRole (Voting))
 import qualified Cardano.Ledger.TxIn as Ledger
 
 import           Data.ByteString.Lazy (ByteString)
@@ -88,13 +90,13 @@ makeGoveranceActionIdentifier sbe txin =
              , Gov.gaidGovActionIx = Gov.GovernanceActionIx txix
              }
 
--- toVotingCredential :: _ -> Ledger.Credential 'Voting (EraCrypto ledgerera)
--- toVotingCredential = undefined
 
-data VoterType
-  = CC -- ^ Constitutional committee
-  | DR -- ^ Delegated representative
-  | SP -- ^ Stake pool operator
+-- TODO: Conway era - These should be the different keys corresponding to the CC and DRs.
+-- We can then derive the StakeCredentials from them.
+data VoterType era
+  = CC (VotingCredential era) -- ^ Constitutional committee
+  | DR (VotingCredential era)-- ^ Delegated representative
+  | SP (Hash StakePoolKey) -- ^ Stake pool operator
   deriving (Show, Eq)
 
 data VoteChoice
@@ -103,10 +105,14 @@ data VoteChoice
   | Abst -- ^ Abstain
   deriving (Show, Eq)
 
-toVoterRole :: VoterType -> Gov.VoterRole
-toVoterRole CC = Gov.ConstitutionalCommittee
-toVoterRole DR = Gov.DRep
-toVoterRole SP = Gov.SPO
+toVoterRole
+  :: EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto
+  => ShelleyBasedEra era
+  -> VoterType era
+  -> Gov.Voter (Shelley.EraCrypto (ShelleyLedgerEra era))
+toVoterRole _ (CC (VotingCredential cred)) = Gov.CommitteeVoter $ coerceKeyRole cred -- TODO: Conway era - Alexey realllllyyy doesn't like this. We need to fix it.
+toVoterRole _ (DR (VotingCredential cred)) = Gov.DRepVoter cred
+toVoterRole _ (SP (StakePoolKeyHash kh)) = Gov.StakePoolVoter kh
 
 toVote :: VoteChoice -> Gov.Vote
 toVote No = Gov.VoteNo
@@ -149,16 +155,14 @@ deriving instance Eq (VotingCredential crypto)
 createVotingProcedure
   :: ShelleyBasedEra era
   -> VoteChoice
-  -> VoterType
+  -> VoterType era
   -> GovernanceActionIdentifier (ShelleyLedgerEra era)
-  -> VotingCredential era -- ^ Governance witness credential (ledger checks that you are allowed to vote)
   -> Vote era
-createVotingProcedure sbe vChoice vt (GovernanceActionIdentifier govActId) (VotingCredential govWitnessCredential) =
+createVotingProcedure sbe vChoice vt (GovernanceActionIdentifier govActId) =
   obtainEraCryptoConstraints sbe
     $ Vote $ Gov.VotingProcedure
       { Gov.vProcGovActionId = govActId
-      , Gov.vProcRole = toVoterRole vt
-      , Gov.vProcRoleKeyHash = govWitnessCredential
+      , Gov.vProcVoter = toVoterRole sbe vt
       , Gov.vProcVote = toVote vChoice
       , Gov.vProcAnchor = SNothing -- TODO: Conway
       }

cardano-api/internal/Cardano/Api/IO.hs

@@ -34,7 +34,7 @@ module Cardano.Api.IO
   , writeSecrets
   ) where
 
-import           Cardano.Api.Error (FileError (..))
+import           Cardano.Api.Error (FileError (..), fileIOExceptT)
 import           Cardano.Api.IO.Base
 import           Cardano.Api.IO.Compat
 
@@ -54,21 +54,21 @@ readByteStringFile :: ()
   => File content In
   -> m (Either (FileError e) ByteString)
 readByteStringFile fp = runExceptT $
-  handleIOExceptT (FileIOError (unFile fp)) $ BS.readFile (unFile fp)
+  fileIOExceptT (unFile fp) BS.readFile
 
 readLazyByteStringFile :: ()
   => MonadIO m
   => File content In
   -> m (Either (FileError e) LBS.ByteString)
 readLazyByteStringFile fp = runExceptT $
-  handleIOExceptT (FileIOError (unFile fp)) $ LBS.readFile (unFile fp)
+  fileIOExceptT (unFile fp) LBS.readFile
 
 readTextFile :: ()
   => MonadIO m
   => File content In
   -> m (Either (FileError e) Text)
 readTextFile fp = runExceptT $
-  handleIOExceptT (FileIOError (unFile fp)) $ Text.readFile (unFile fp)
+  fileIOExceptT (unFile fp) Text.readFile
 
 writeByteStringFile :: ()
   => MonadIO m

cardano-api/internal/Cardano/Api/IO/Compat/Posix.hs

@@ -17,14 +17,14 @@ module Cardano.Api.IO.Compat.Posix
 
 #ifdef UNIX
 
-import           Cardano.Api.Error (FileError (..))
+import           Cardano.Api.Error (FileError (..), fileIOExceptT)
 import           Cardano.Api.IO.Base
 
 import           Control.Exception (IOException, bracket, bracketOnError, try)
 import           Control.Monad (forM_, when)
 import           Control.Monad.Except (ExceptT, runExceptT)
 import           Control.Monad.IO.Class
-import           Control.Monad.Trans.Except.Extra (handleIOExceptT, left)
+import           Control.Monad.Trans.Except.Extra (left)
 import qualified Data.ByteString as BS
 import           System.Directory ()
 import           System.FilePath ((</>))
@@ -62,7 +62,7 @@ handleFileForWritingWithOwnerPermissionImpl path f = do
       bracket
         (fdToHandle fd)
         IO.hClose
-        (runExceptT . handleIOExceptT (FileIOError path) . f)
+        (runExceptT . fileIOExceptT path . const . f)
 
 writeSecretsImpl :: FilePath -> [Char] -> [Char] -> (a -> BS.ByteString) -> [a] -> IO ()
 writeSecretsImpl outDir prefix suffix secretOp xs =

cardano-api/internal/Cardano/Api/Keys/Read.hs

@@ -18,9 +18,8 @@ import           Cardano.Api.SerialiseBech32
 import           Cardano.Api.SerialiseTextEnvelope
 import           Cardano.Api.Utils
 
-import           Control.Exception
+import           Control.Monad.Except (runExceptT)
 import           Data.Bifunctor
-import           Data.ByteString as BS
 import           Data.List.NonEmpty (NonEmpty)
 
 -- | Read a cryptographic key from a file.
@@ -33,14 +32,11 @@ readKeyFile
   -> FilePath
   -> IO (Either (FileError InputDecodeError) a)
 readKeyFile asType acceptedFormats path = do
-  eContent <- fmap Right (readFileBlocking path) `catches` [Handler handler]
+  eContent <- runExceptT $ fileIOExceptT path readFileBlocking
   case eContent of
     Left e -> return $ Left e
     Right content ->
       return . first (FileError path) $ deserialiseInput asType acceptedFormats content
- where
-  handler :: IOException -> IO (Either (FileError InputDecodeError) BS.ByteString)
-  handler e = return . Left $ FileIOError path e
 
 -- | Read a cryptographic key from a file.
 --
@@ -65,12 +61,8 @@ readKeyFileAnyOf
   -> File content In
   -> IO (Either (FileError InputDecodeError) b)
 readKeyFileAnyOf bech32Types textEnvTypes path = do
-  eContent <- fmap Right (readFileBlocking (unFile path)) `catches` [Handler handler]
+  eContent <- runExceptT $ fileIOExceptT (unFile path) readFileBlocking
   case eContent of
     Left e -> return $ Left e
     Right content ->
       return . first (FileError (unFile path)) $ deserialiseInputAnyOf bech32Types textEnvTypes content
- where
-  handler :: IOException -> IO (Either (FileError InputDecodeError) BS.ByteString)
-  handler e = return . Left $ FileIOError (unFile path) e
-