Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

New File type that tracks whether the file is an input or output file or both #5017

Closed
wants to merge 8 commits into from
Closed

New File type that tracks whether the file is an input or output file or both #5017

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
8 commits
Select commit Hold shift + click to select a range
9be44ba
Rename FileDirection to ParserFileDirection
newhoggy Apr 13, 2023
970406d
New File type that tracks direction
newhoggy Apr 13, 2023
26abc42
New Cardano.Api.IO module
newhoggy Mar 26, 2023
cb18ddc
Use new File type for tracking read/write
newhoggy Mar 27, 2023
1aea008
Aeson instances for all the file types
newhoggy Apr 13, 2023
e8e32fb
Delete obsolete OutputFile type
newhoggy Apr 13, 2023
5bcf42b
Annotate uses of HasFileMode
newhoggy Apr 13, 2023
8846dbc
Replace HasFileMode typeclass with plain functions
newhoggy Mar 28, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 2 additions & 1 deletion bench/tx-generator/src/Cardano/Benchmarking/OuroborosImports.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -41,6 +41,7 @@ import Cardano.Api (BlockType (..), ConsensusModeParams (..), EpochSlo
LocalNodeConnectInfo (..), NetworkId (..), PaymentKey, SigningKey, TxInMode,
TxValidationErrorInMode, protocolInfo, submitTxToNodeLocal)
import Cardano.Ledger.Shelley.Genesis (ShelleyGenesis)
import Cardano.Node.Types (File (..))

type CardanoBlock = Consensus.CardanoBlock StandardCrypto

Expand All @@ -65,6 +66,6 @@ makeLocalConnectInfo networkId sock
= LocalNodeConnectInfo
(CardanoModeParams (EpochSlots 21600))
networkId
sock
(File sock)

type LocalSubmitTx = (TxInMode CardanoMode -> IO (SubmitResult (TxValidationErrorInMode CardanoMode)))
8 changes: 5 additions & 3 deletions bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,5 +1,4 @@
{- HLINT ignore "Reduce duplication" -}
{- HLINT ignore "Use uncurry" -}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
Expand All @@ -13,6 +12,9 @@
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

{- HLINT ignore "Reduce duplication" -}
{- HLINT ignore "Use uncurry" -}

module Cardano.Benchmarking.Script.Core
where

Expand Down Expand Up @@ -88,7 +90,7 @@ setProtocolParameters s = case s of
protocolParameters <- liftIO $ readProtocolParametersFile file
setProtoParamMode $ ProtocolParameterLocal protocolParameters

readSigningKey :: String -> SigningKeyFile -> ActionM ()
readSigningKey :: String -> SigningKeyFile 'In -> ActionM ()
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

We usually make use of the pragma {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} but it's not the end of the world if we don't.

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

When we bump to 9.6.1 we can replace DataKinds with TypeData: https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/type_data.html

readSigningKey name filePath =
liftIO (readSigningKeyFile filePath) >>= \case
Left err -> liftTxGenError err
Expand Down
3 changes: 2 additions & 1 deletion bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
Expand Down Expand Up @@ -50,7 +51,7 @@ data Action where
InitWallet :: !String -> Action
StartProtocol :: !FilePath -> !(Maybe FilePath) -> Action
Delay :: !Double -> Action
ReadSigningKey :: !String -> !SigningKeyFile -> Action
ReadSigningKey :: !String -> !(SigningKeyFile 'In) -> Action
DefineSigningKey :: !String -> !(SigningKey PaymentKey) -> Action
AddFund :: !AnyCardanoEra -> !String -> !TxIn -> !Lovelace -> !String -> Action
WaitBenchmark :: !String -> Action
Expand Down
8 changes: 0 additions & 8 deletions bench/tx-generator/src/Cardano/TxGenerator/Internal/Orphans.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -10,14 +10,6 @@ import Data.Aeson
import qualified Ouroboros.Network.Magic as Ouroboros (NetworkMagic (..))

import Cardano.Api (NetworkId (..))
import Cardano.CLI.Types (SigningKeyFile (..))


instance ToJSON SigningKeyFile where
toJSON (SigningKeyFile a) = toJSON a

instance FromJSON SigningKeyFile where
parseJSON a = SigningKeyFile <$> parseJSON a


instance ToJSON NetworkId where
Expand Down
7 changes: 4 additions & 3 deletions bench/tx-generator/src/Cardano/TxGenerator/Setup/NixService.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
Expand All @@ -23,7 +24,7 @@ import Cardano.CLI.Types (SigningKeyFile (..))
import Cardano.Node.Configuration.NodeAddress (NodeIPv4Address)
import Cardano.Node.Types (AdjustFilePaths (..))

import Cardano.Api (AnyCardanoEra, Lovelace)
import Cardano.Api (AnyCardanoEra, FileDirection (..), Lovelace, MapFile (..))
import Cardano.TxGenerator.Internal.Orphans ()
import Cardano.TxGenerator.Types

Expand All @@ -42,7 +43,7 @@ data NixServiceOptions = NixServiceOptions {
, _nix_plutus :: Maybe TxGenPlutusParams
, _nix_nodeConfigFile :: Maybe FilePath
, _nix_cardanoTracerSocket :: Maybe FilePath
, _nix_sigKey :: SigningKeyFile
, _nix_sigKey :: SigningKeyFile 'In
, _nix_localNodeSocketPath :: String
, _nix_targetNodes :: NonEmpty NodeIPv4Address
} deriving (Show, Eq)
Expand Down Expand Up @@ -70,7 +71,7 @@ instance AdjustFilePaths NixServiceOptions where
adjustFilePaths f opts
= opts {
_nix_nodeConfigFile = f <$> _nix_nodeConfigFile opts
, _nix_sigKey = SigningKeyFile . f . unSigningKeyFile $ _nix_sigKey opts
, _nix_sigKey = mapFile f $ _nix_sigKey opts
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

An example of how mapFile is used.

Without the MapFile type class, this expression becomes:

SigningKeyFile . File . f . unFile . unSigningKeyFile $ _nix_sigKey opts

}


Expand Down
4 changes: 2 additions & 2 deletions bench/tx-generator/src/Cardano/TxGenerator/Setup/NodeConfig.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -19,7 +19,7 @@ import Cardano.Node.Configuration.POM
import Cardano.Node.Handlers.Shutdown (ShutdownConfig (..))
import Cardano.Node.Protocol.Cardano
import Cardano.Node.Protocol.Types (SomeConsensusProtocol (..))
import Cardano.Node.Types (ConfigYamlFilePath (..), GenesisFile,
import Cardano.Node.Types (ConfigYamlFilePath (..), File (..), GenesisFile,
NodeProtocolConfiguration (..), NodeShelleyProtocolConfiguration (..),
ProtocolFilepaths (..))
import Cardano.TxGenerator.Types
Expand Down Expand Up @@ -63,7 +63,7 @@ mkNodeConfig configFp_
$ first (TxGenError . ("mkNodeConfig: " ++))
$! makeNodeConfiguration (configYamlPc <> filesPc)
where
configFp = ConfigYamlFilePath configFp_
configFp = ConfigYamlFilePath $ File configFp_

filesPc :: PartialNodeConfiguration
filesPc = defaultPartialNodeConfiguration
Expand Down
3 changes: 2 additions & 1 deletion bench/tx-generator/src/Cardano/TxGenerator/Setup/SigningKey.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}

-- | This module provides convenience functions when dealing with signing keys.
Expand Down Expand Up @@ -37,7 +38,7 @@ parseSigningKeyBase16 k
, teRawCBOR = addr
}

readSigningKeyFile :: SigningKeyFile -> IO (Either TxGenError (SigningKey PaymentKey))
readSigningKeyFile :: SigningKeyFile 'In -> IO (Either TxGenError (SigningKey PaymentKey))
readSigningKeyFile (SigningKeyFile f)
= first ApiError <$> readFileTextEnvelopeAnyOf acceptedTypes f

Expand Down
2 changes: 2 additions & 0 deletions cardano-api/cardano-api.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -66,6 +66,7 @@ library
Cardano.Api.Error
Cardano.Api.Fees
Cardano.Api.Genesis
Cardano.Api.IO
Cardano.Api.GenesisParameters
Cardano.Api.Hash
Cardano.Api.HasTypeProxy
Expand All @@ -84,6 +85,7 @@ library
Cardano.Api.LedgerState
Cardano.Api.Modes
Cardano.Api.NetworkId
Cardano.Api.Options
Cardano.Api.OperationalCertificate
Cardano.Api.Protocol
Cardano.Api.ProtocolParameters
Expand Down
26 changes: 24 additions & 2 deletions cardano-api/src/Cardano/Api.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -35,7 +35,13 @@ module Cardano.Api (
shelleyBasedToCardanoEra,

-- ** IO
OutputFile(..),
File(..),
MapFile(..),
Directory(..),
FileDirection(..),

toFileIn,
toFileOut,

writeByteStringFileWithOwnerPermissions,
writeByteStringFile,
Expand Down Expand Up @@ -765,7 +771,6 @@ module Cardano.Api (
chainPointToSlotNo,
chainPointToHeaderHash,
makeChainTip,
parseFilePath,
writeSecrets,

-- ** Cast functions
Expand Down Expand Up @@ -797,6 +802,21 @@ module Cardano.Api (

-- ** CLI option parsing
bounded,
fileOption,
inFileOption,
outFileOption,
parseFile,
parseFileIn,
parseFilePath,
parseFileOut,
parseDirectory,

toGenesisFileIn,
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

These functions aren't used anywhere. Why implement them?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

For completeness so that if someone wanted to use them, they'd be available.

toGenesisFileOut,
toNetworkConfigFileIn,
toNetworkConfigFileOut,
toNodeConfigIn,
toNodeConfigOut,
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

These are the functions that have been added in order to delete HasFileMode.

) where

import Cardano.Api.Address
Expand Down Expand Up @@ -827,6 +847,7 @@ import Cardano.Api.LedgerState
import Cardano.Api.Modes
import Cardano.Api.NetworkId
import Cardano.Api.OperationalCertificate
import Cardano.Api.Options
import Cardano.Api.Protocol
import Cardano.Api.ProtocolParameters
import Cardano.Api.Query hiding (LedgerState (..))
Expand All @@ -845,3 +866,4 @@ import Cardano.Api.TxMetadata
import Cardano.Api.Utils
import Cardano.Api.Value
import Cardano.Api.ValueParser

14 changes: 9 additions & 5 deletions cardano-api/src/Cardano/Api/Environment.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,3 +1,5 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}

Expand All @@ -8,16 +10,18 @@ module Cardano.Api.Environment
, renderEnvSocketError
) where

import Data.Aeson
import Data.Aeson (FromJSON, ToJSON)
import Data.String (IsString)
import Data.Text (Text)
import qualified Data.Text as Text
import System.Environment (lookupEnv)

import Cardano.Api.IO (File (..), FileDirection (..), MapFile)
import Cardano.Api.Utils (textShow)

newtype SocketPath
= SocketPath { unSocketPath :: FilePath }
deriving (FromJSON, Show, Eq, Ord)
newtype SocketPath = SocketPath
{ unSocketPath :: File 'InOut
} deriving newtype (Eq, Ord, Show, IsString, MapFile, FromJSON, ToJSON)

newtype EnvSocketError = CliEnvVarLookup Text deriving Show

Expand All @@ -34,7 +38,7 @@ readEnvSocketPath = do
mEnvName <- lookupEnv envName
case mEnvName of
Just sPath ->
return . Right $ SocketPath sPath
return . Right $ SocketPath $ File sPath
Nothing ->
return . Left $ CliEnvVarLookup (Text.pack envName)
where
Expand Down
Loading