Review fixes

cardano-api/src/Cardano/API.hs

@@ -191,7 +191,7 @@ module Cardano.API (
     deserialiseFromTextEnvelope,
     readFileTextEnvelope,
     writeFileTextEnvelope,
-    writeTextEnvelopeFileWithOwnerPermissions,
+    writeFileTextEnvelopeWithOwnerPermissions,
     readTextEnvelopeFromFile,
     readTextEnvelopeOfTypeFromFile,
     -- *** Reading one of several key types
@@ -200,8 +200,7 @@ module Cardano.API (
     readFileTextEnvelopeAnyOf,
 
     -- * Errors
-    Error,
-    displayError,
+    Error(..),
     throwErrorAsException,
     FileError,
 

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

@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE DeriveAnyClass #-}
@@ -17,10 +16,6 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE ViewPatterns #-}
 
-#if !defined(mingw32_HOST_OS)
-#define UNIX
-#endif
-
 -- 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 #-}
@@ -231,10 +226,9 @@ module Cardano.Api.Typed (
     deserialiseFromTextEnvelope,
     readFileTextEnvelope,
     writeFileTextEnvelope,
-    writeTextEnvelopeFileWithOwnerPermissions,
+    writeFileTextEnvelopeWithOwnerPermissions,
     readTextEnvelopeFromFile,
     readTextEnvelopeOfTypeFromFile,
-    textEnvelopeToJSON,
 
     -- *** Reading one of several key types
     FromSomeType(..),
@@ -402,12 +396,9 @@ import           Control.Monad.Trans.Except (ExceptT (..))
 import           Control.Monad.Trans.Except.Extra
 import           Control.Tracer (nullTracer)
 import           System.Directory (removeFile, renameFile)
+import           System.FilePath (splitFileName, (<.>))
 import           System.IO (Handle, hClose, openTempFile)
-#ifdef UNIX
-import           System.FilePath.Posix (splitFileName, (<.>))
-#else
-import           System.FilePath.Windows (splitFileName, (<.>))
-#endif
+
 
 import           Data.Aeson (FromJSON (..), ToJSON (..), Value (..), object, (.:), (.=))
 import qualified Data.Aeson as Aeson
@@ -3128,6 +3119,22 @@ deserialiseFromTextEnvelopeAnyOf types te =
 
     matching (FromSomeType ttoken _f) = actualType == textEnvelopeType ttoken
 
+writeFileWithOwnerPermissions
+  :: FilePath
+  -> ByteString
+  -> IO (Either (FileError ()) ())
+writeFileWithOwnerPermissions targetPath a = do
+  let (targetDir, targetFile) = splitFileName targetPath
+  Exception.bracketOnError
+    (openTempFile targetDir $ targetFile <.> "tmp")
+    (\(tmpPath, fHandle) -> do
+      hClose fHandle >> removeFile tmpPath
+      return . Left $ FileErrorTempFile targetPath tmpPath fHandle)
+    (\(tmpPath, fHandle) -> do
+        BS.hPut fHandle a
+        hClose fHandle
+        renameFile tmpPath targetPath
+        return $ Right ())
 
 writeFileTextEnvelope :: HasTextEnvelope a
                       => FilePath
@@ -3138,31 +3145,21 @@ writeFileTextEnvelope path mbDescr a =
     runExceptT $ do
       handleIOExceptT (FileIOError path) $ BS.writeFile path content
   where
-    content = LBS.toStrict $ textEnvelopeToJSON mbDescr a
+    content = textEnvelopeToJSON mbDescr a
 
-writeTextEnvelopeFileWithOwnerPermissions
+writeFileTextEnvelopeWithOwnerPermissions
   :: HasTextEnvelope a
   => FilePath
   -> Maybe TextEnvelopeDescr
   -> a
   -> IO (Either (FileError ()) ())
-writeTextEnvelopeFileWithOwnerPermissions targetPath mbDescr a = do
+writeFileTextEnvelopeWithOwnerPermissions targetPath mbDescr a =
   let content = textEnvelopeToJSON mbDescr a
-      (targetDir, targetFile) = splitFileName targetPath
-  Exception.bracketOnError
-    (openTempFile targetDir $ targetFile <.> "tmp")
-    (\(tmpPath, fHandle) -> do
-      hClose fHandle >> removeFile tmpPath
-      return . Left $ FileErrorTempFile targetPath tmpPath fHandle)
-    (\(tmpPath, fHandle) -> do
-        LBS.hPut fHandle content
-        hClose fHandle
-        renameFile tmpPath targetPath
-        return $ Right ())
+  in writeFileWithOwnerPermissions targetPath content
 
-textEnvelopeToJSON :: HasTextEnvelope a =>  Maybe TextEnvelopeDescr -> a -> LBS.ByteString
+textEnvelopeToJSON :: HasTextEnvelope a =>  Maybe TextEnvelopeDescr -> a -> ByteString
 textEnvelopeToJSON mbDescr a  =
-  encodePretty' TextView.textViewJSONConfig (serialiseToTextEnvelope mbDescr a) <> "\n"
+  LBS.toStrict $ encodePretty' TextView.textViewJSONConfig (serialiseToTextEnvelope mbDescr a) <> "\n"
 
 readFileTextEnvelope :: HasTextEnvelope a
                      => AsType a

cardano-cli/src/Cardano/CLI/Shelley/Run/Node.hs

@@ -7,7 +7,6 @@ module Cardano.CLI.Shelley.Run.Node
 import           Cardano.Prelude hiding ((<.>))
 import           Prelude (id)
 
-import           Control.Monad.Trans.Except (ExceptT)
 import           Control.Monad.Trans.Except.Extra (firstExceptT, hoistEither, newExceptT)
 import qualified Data.ByteString.Char8 as BS
 import qualified Data.Text as Text
@@ -18,7 +17,6 @@ import           Cardano.CLI.Shelley.Commands
 import           Cardano.CLI.Shelley.Key (InputDecodeError, VerificationKeyOrFile,
                      readSigningKeyFileAnyOf, readVerificationKeyOrFile)
 import           Cardano.CLI.Types (SigningKeyFile (..), VerificationKeyFile (..))
-import           Control.Monad.Trans.Except.Extra (firstExceptT, hoistEither, newExceptT)
 
 {- HLINT ignore "Reduce duplication" -}
 
@@ -118,7 +116,7 @@ runNodeKeyGenVRF (VerificationKeyFile vkeyPath) (SigningKeyFile skeyPath) = do
     let vkey = getVerificationKey skey
     firstExceptT ShelleyNodeCmdWriteFileError
       . newExceptT
-      $ writeTextEnvelopeFileWithOwnerPermissions skeyPath (Just skeyDesc) skey
+      $ writeFileTextEnvelopeWithOwnerPermissions skeyPath (Just skeyDesc) skey
     firstExceptT ShelleyNodeCmdWriteFileError
       . newExceptT
       $ writeFileTextEnvelope vkeyPath (Just vkeyDesc) vkey

cardano-node/test/Test/Cardano/Node/FilePermissions.hs

@@ -13,18 +13,23 @@ module Test.Cardano.Node.FilePermissions
 import           Cardano.Prelude
 
 import           System.Directory (removeFile)
-import           System.Posix.Files
-import           System.Posix.IO (closeFd, createFile)
-import           System.Posix.Types (FileMode)
 
 import           Cardano.API
 import           Cardano.Node.Run (checkVRFFilePermissions)
-import           Cardano.Node.Types (VRFPrivateKeyFilePermissionError (..))
-import           Hedgehog (Gen, Property, PropertyT, classify, discover, forAll, property, success)
+import           Hedgehog (Property, PropertyT, property, success)
 import qualified Hedgehog
-import qualified Hedgehog.Gen as Gen
-import           Hedgehog.Internal.Property (failWith)
+import           Hedgehog.Internal.Property (Group (..), failWith)
+
+#ifdef UNIX
+import           Cardano.Node.Types (VRFPrivateKeyFilePermissionError (..))
 
+import           System.Posix.Files
+import           System.Posix.IO (closeFd, createFile)
+import           System.Posix.Types (FileMode)
+
+import           Hedgehog (Gen, classify, forAll)
+import qualified Hedgehog.Gen as Gen
+#endif
 
 prop_createVRFFileWithOwnerPermissions :: Property
 prop_createVRFFileWithOwnerPermissions =
@@ -40,7 +45,7 @@ prop_createVRFFileWithOwnerPermissions =
 
 createFileWithOwnerPermissions :: HasTextEnvelope a => FilePath -> a -> PropertyT IO ()
 createFileWithOwnerPermissions targetfp value = do
-  result <- liftIO $ writeTextEnvelopeFileWithOwnerPermissions targetfp Nothing value
+  result <- liftIO $ writeFileTextEnvelopeWithOwnerPermissions targetfp Nothing value
   case result of
     Left err -> failWith Nothing $ displayError err
     Right () -> return ()
@@ -131,4 +136,11 @@ genOtherPermissions =
 
 tests :: IO Bool
 tests =
-  Hedgehog.checkParallel $$discover
+  Hedgehog.checkParallel $ Group "Test.Cardano.Node.FilePermissons"
+#ifdef UNIX
+    [ ("prop_createVRFFileWithOwnerPermissions", prop_createVRFFileWithOwnerPermissions)
+    , ("prop_sanityCheck_checkVRFFilePermissions", prop_sanityCheck_checkVRFFilePermissions)
+    ]
+#else
+    [("prop_createVRFFileWithOwnerPermissions", prop_createVRFFileWithOwnerPermissions)]
+#endif