Use new File type to track content and direction

bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs

@@ -1,5 +1,7 @@
 {- HLINT ignore "Reduce duplication" -}
 {- HLINT ignore "Use uncurry" -}
+
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
@@ -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 ()
 readSigningKey name filePath =
   liftIO (readSigningKeyFile filePath) >>= \case
     Left err -> liftTxGenError err

bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -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

bench/tx-generator/src/Cardano/TxGenerator/Internal/Orphans.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
+
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module  Cardano.TxGenerator.Internal.Orphans
@@ -10,15 +11,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
   toJSON Mainnet = "Mainnet"

bench/tx-generator/src/Cardano/TxGenerator/Setup/NixService.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE StandaloneDeriving #-}
@@ -19,11 +20,11 @@ import           Data.List.NonEmpty (NonEmpty)
 import           Data.Maybe (fromMaybe)
 import           GHC.Generics (Generic)
 
-import           Cardano.CLI.Types (SigningKeyFile (..))
+import           Cardano.CLI.Types (FileDirection (..), SigningKeyFile)
 import           Cardano.Node.Configuration.NodeAddress (NodeIPv4Address)
 import           Cardano.Node.Types (AdjustFilePaths (..))
 
-import           Cardano.Api (AnyCardanoEra, Lovelace)
+import           Cardano.Api (AnyCardanoEra, Lovelace, mapFile)
 import           Cardano.TxGenerator.Internal.Orphans ()
 import           Cardano.TxGenerator.Types
 
@@ -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)
@@ -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
     }
 
 

bench/tx-generator/src/Cardano/TxGenerator/Setup/SigningKey.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 -- | This module provides convenience functions when dealing with signing keys.
@@ -15,7 +16,7 @@ import qualified Data.ByteString as BS (ByteString)
 import           Data.ByteString.Base16 as Base16 (decode)
 
 import           Cardano.Api
-import           Cardano.CLI.Types (SigningKeyFile (..))
+import           Cardano.CLI.Types (SigningKeyFile)
 
 import           Cardano.TxGenerator.Types (TxGenError (..))
 
@@ -37,9 +38,8 @@ parseSigningKeyBase16 k
         , teRawCBOR = addr
         }
 
-readSigningKeyFile :: SigningKeyFile -> IO (Either TxGenError (SigningKey PaymentKey))
-readSigningKeyFile (SigningKeyFile f)
-  = first ApiError <$> readFileTextEnvelopeAnyOf acceptedTypes f
+readSigningKeyFile :: SigningKeyFile In -> IO (Either TxGenError (SigningKey PaymentKey))
+readSigningKeyFile f = first ApiError <$> readFileTextEnvelopeAnyOf acceptedTypes f
 
 acceptedTypes :: [FromSomeType HasTextEnvelope (SigningKey PaymentKey)]
 acceptedTypes =

cardano-api/cardano-api.cabal

@@ -24,6 +24,7 @@ common project-config
                         -Wcompat
                         -Wincomplete-record-updates
                         -Wincomplete-uni-patterns
+                        -Wno-unticked-promoted-constructors
                         -Wpartial-fields
                         -Wredundant-constraints
                         -Wunused-packages

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

@@ -1,15 +1,12 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Cardano.Api.IO
-  ( OutputFile(..)
-
-  , writeByteStringFileWithOwnerPermissions
+  ( writeByteStringFileWithOwnerPermissions
   , writeByteStringFile
   , writeByteStringOutput
 
@@ -57,7 +54,6 @@ import qualified Data.ByteString.Lazy as LBSC
 import           Data.String (IsString)
 import           Data.Text (Text)
 import qualified Data.Text.IO as Text
-import           GHC.Generics (Generic)
 import qualified System.IO as IO
 import           System.IO (Handle)
 
@@ -77,12 +73,6 @@ newtype File content (direction :: FileDirection) = File
   { unFile :: FilePath
   } deriving newtype (Eq, Ord, Read, Show, IsString, FromJSON, ToJSON)
 
-newtype OutputFile = OutputFile
-  { unOutputFile :: FilePath
-  }
-  deriving Generic
-  deriving newtype (Eq, Ord, Show, IsString, ToJSON, FromJSON)
-
 handleFileForWritingWithOwnerPermission
   :: FilePath
   -> (Handle -> IO ())
@@ -127,7 +117,11 @@ handleFileForWritingWithOwnerPermission path f = do
     (targetDir, targetFile) = splitFileName path
 #endif
 
-writeByteStringFile :: MonadIO m => File content 'Out -> ByteString -> m (Either (FileError ()) ())
+writeByteStringFile :: ()
+  => MonadIO m
+  => File content Out
+  -> ByteString
+  -> m (Either (FileError ()) ())
 writeByteStringFile fp bs = runExceptT $
   handleIOExceptT (FileIOError (unFile fp)) $ BS.writeFile (unFile fp) bs
 
@@ -139,46 +133,66 @@ writeByteStringFileWithOwnerPermissions fp bs =
   handleFileForWritingWithOwnerPermission fp $ \h ->
     BS.hPut h bs
 
-writeByteStringOutput :: MonadIO m => Maybe FilePath -> ByteString -> m (Either (FileError ()) ())
+writeByteStringOutput :: ()
+  => MonadIO m
+  => Maybe (File content Out)
+  -> ByteString
+  -> m (Either (FileError ()) ())
 writeByteStringOutput mOutput bs = runExceptT $
   case mOutput of
-    Just fp -> handleIOExceptT (FileIOError fp) $ BS.writeFile fp bs
+    Just fp -> handleIOExceptT (FileIOError (unFile fp)) $ BS.writeFile (unFile fp) bs
     Nothing -> liftIO $ BSC.putStr bs
 
-writeLazyByteStringFile :: MonadIO m => FilePath -> LBS.ByteString -> m (Either (FileError ()) ())
+writeLazyByteStringFile :: ()
+  => MonadIO m
+  => File content Out
+  -> LBS.ByteString
+  -> m (Either (FileError ()) ())
 writeLazyByteStringFile fp bs = runExceptT $
-  handleIOExceptT (FileIOError fp) $ LBS.writeFile fp bs
+  handleIOExceptT (FileIOError (unFile fp)) $ LBS.writeFile (unFile fp) bs
 
 writeLazyByteStringFileWithOwnerPermissions
-  :: FilePath
+  :: File content Out
   -> LBS.ByteString
   -> IO (Either (FileError ()) ())
 writeLazyByteStringFileWithOwnerPermissions fp lbs =
-  handleFileForWritingWithOwnerPermission fp $ \h ->
+  handleFileForWritingWithOwnerPermission (unFile fp) $ \h ->
     LBS.hPut h lbs
 
-writeLazyByteStringOutput :: MonadIO m => Maybe FilePath -> LBS.ByteString -> m (Either (FileError ()) ())
+writeLazyByteStringOutput :: ()
+  => MonadIO m
+  => Maybe (File content Out)
+  -> LBS.ByteString
+  -> m (Either (FileError ()) ())
 writeLazyByteStringOutput mOutput bs = runExceptT $
   case mOutput of
-    Just fp -> handleIOExceptT (FileIOError fp) $ LBS.writeFile fp bs
+    Just fp -> handleIOExceptT (FileIOError (unFile fp)) $ LBS.writeFile (unFile fp) bs
     Nothing -> liftIO $ LBSC.putStr bs
 
-writeTextFile :: MonadIO m => FilePath -> Text -> m (Either (FileError ()) ())
+writeTextFile :: ()
+  => MonadIO m
+  => File content Out
+  -> Text
+  -> m (Either (FileError ()) ())
 writeTextFile fp t = runExceptT $
-  handleIOExceptT (FileIOError fp) $ Text.writeFile fp t
+  handleIOExceptT (FileIOError (unFile fp)) $ Text.writeFile (unFile fp) t
 
 writeTextFileWithOwnerPermissions
-  :: FilePath
+  :: File content Out
   -> Text
   -> IO (Either (FileError ()) ())
 writeTextFileWithOwnerPermissions fp t =
-  handleFileForWritingWithOwnerPermission fp $ \h ->
+  handleFileForWritingWithOwnerPermission (unFile fp) $ \h ->
     Text.hPutStr h t
 
-writeTextOutput :: MonadIO m => Maybe FilePath -> Text -> m (Either (FileError ()) ())
+writeTextOutput :: ()
+  => MonadIO m
+  => Maybe (File content Out)
+  -> Text
+  -> m (Either (FileError ()) ())
 writeTextOutput mOutput t = runExceptT $
   case mOutput of
-    Just fp -> handleIOExceptT (FileIOError fp) $ Text.writeFile fp t
+    Just fp -> handleIOExceptT (FileIOError (unFile fp)) $ Text.writeFile (unFile fp) t
     Nothing -> liftIO $ Text.putStr t
 
 mapFile :: (FilePath -> FilePath) -> File content direction -> File content direction

cardano-api/src/Cardano/Api/IPC.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -9,7 +10,6 @@
 
 -- The Shelley ledger uses promoted data kinds which we have to use, but we do
 -- not export any from this API. We also use them unticked as nature intended.
-{-# LANGUAGE DataKinds #-}
 {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
 
 -- | Node IPC protocols

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

@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE RankNTypes #-}
@@ -17,6 +18,7 @@ import           Data.List.NonEmpty (NonEmpty)
 import           Cardano.Api.DeserialiseAnyOf
 import           Cardano.Api.Error
 import           Cardano.Api.HasTypeProxy
+import           Cardano.Api.IO
 import           Cardano.Api.SerialiseBech32
 import           Cardano.Api.SerialiseTextEnvelope
 import           Cardano.Api.Utils
@@ -46,7 +48,7 @@ readKeyFile asType acceptedFormats path = do
 readKeyFileTextEnvelope
   :: HasTextEnvelope a
   => AsType a
-  -> FilePath
+  -> File content In
   -> IO (Either (FileError InputDecodeError) a)
 readKeyFileTextEnvelope asType fp =
     first (fmap InputTextEnvelopeError) <$> readFileTextEnvelope asType fp
@@ -57,18 +59,18 @@ readKeyFileTextEnvelope asType fp =
 -- The contents of the file can either be Bech32-encoded or in the text
 -- envelope format.
 readKeyFileAnyOf
-  :: forall b.
+  :: forall content b.
      [FromSomeType SerialiseAsBech32 b]
   -> [FromSomeType HasTextEnvelope b]
-  -> FilePath
+  -> File content In
   -> IO (Either (FileError InputDecodeError) b)
 readKeyFileAnyOf bech32Types textEnvTypes path = do
-  eContent <- fmap Right (readFileBlocking path) `catches` [Handler handler]
+  eContent <- fmap Right (readFileBlocking (unFile path)) `catches` [Handler handler]
   case eContent of
     Left e -> return $ Left e
     Right content ->
-      return . first (FileError path) $ deserialiseInputAnyOf bech32Types textEnvTypes content
+      return . first (FileError (unFile path)) $ deserialiseInputAnyOf bech32Types textEnvTypes content
  where
   handler :: IOException -> IO (Either (FileError InputDecodeError) BS.ByteString)
-  handler e = return . Left $ FileIOError path e
+  handler e = return . Left $ FileIOError (unFile path) e
 

cardano-api/src/Cardano/Api/Keys/Shelley.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -9,7 +10,6 @@
 
 -- The Shelley ledger uses promoted data kinds which we have to use, but we do
 -- not export any from this API. We also use them unticked as nature intended.
-{-# LANGUAGE DataKinds #-}
 {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
 
 -- | Shelley key types and their 'Key' class instances

cardano-api/src/Cardano/Api/Query.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE EmptyCase #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -13,7 +14,6 @@
 
 -- The Shelley ledger uses promoted data kinds which we have to use, but we do
 -- not export any from this API. We also use them unticked as nature intended.
-{-# LANGUAGE DataKinds #-}
 {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
 
 

cardano-api/src/Cardano/Api/SerialiseLedgerCddl.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE EmptyCase #-}
 {-# LANGUAGE GADTs #-}
@@ -48,6 +49,7 @@ import qualified Cardano.Ledger.Binary as CBOR
 import           Cardano.Api.Eras
 import           Cardano.Api.Error
 import           Cardano.Api.HasTypeProxy
+import           Cardano.Api.IO
 import           Cardano.Api.SerialiseCBOR
 import           Cardano.Api.Tx
 import           Cardano.Api.Utils
@@ -213,23 +215,23 @@ deserialiseWitnessLedgerCddl era TextEnvelopeCddl{teCddlRawCBOR,teCddlDescriptio
 
 writeTxFileTextEnvelopeCddl
   :: IsCardanoEra era
-  => FilePath
+  => File content Out
   -> Tx era
   -> IO (Either (FileError ()) ())
 writeTxFileTextEnvelopeCddl path tx =
   runExceptT $ do
-    handleIOExceptT (FileIOError path) $ LBS.writeFile path txJson
+    handleIOExceptT (FileIOError (unFile path)) $ LBS.writeFile (unFile path) txJson
  where
   txJson = encodePretty' textEnvelopeCddlJSONConfig (serialiseTxLedgerCddl tx) <> "\n"
 
 writeTxWitnessFileTextEnvelopeCddl
   :: ShelleyBasedEra era
-  -> FilePath
+  -> File () Out
   -> KeyWitness era
   -> IO (Either (FileError ()) ())
 writeTxWitnessFileTextEnvelopeCddl sbe path w =
   runExceptT $ do
-    handleIOExceptT (FileIOError path) $ LBS.writeFile path txJson
+    handleIOExceptT (FileIOError (unFile path)) $ LBS.writeFile (unFile path) txJson
  where
   txJson = encodePretty' textEnvelopeCddlJSONConfig (serialiseWitnessLedgerCddl sbe w) <> "\n"