Skip to content

Commit dd1c612

Browse files
cptrodolfoxcptrodolfox
committed
Add binary mode functions for Text
1 parent 11cc517 commit dd1c612

File tree

3 files changed

+196
-0
lines changed

3 files changed

+196
-0
lines changed

‎atomic-write.cabal

+2
Original file line numberDiff line numberDiff line change
@@ -58,6 +58,7 @@ library
5858
, System.AtomicWrite.Writer.String
5959
, System.AtomicWrite.Writer.String.Binary
6060
, System.AtomicWrite.Writer.Text
61+
, System.AtomicWrite.Writer.Text.Binary
6162
, System.AtomicWrite.Writer.LazyText
6263
, System.AtomicWrite.Writer.LazyText.Binary
6364

@@ -89,6 +90,7 @@ test-suite atomic-write-test
8990
, System.AtomicWrite.Writer.StringSpec
9091
, System.AtomicWrite.Writer.String.BinarySpec
9192
, System.AtomicWrite.Writer.TextSpec
93+
, System.AtomicWrite.Writer.Text.BinarySpec
9294
, System.AtomicWrite.Writer.LazyTextSpec
9395
, System.AtomicWrite.Writer.LazyText.BinarySpec
9496

‎spec/System/AtomicWrite/Writer/Text/BinarySpec.hs

+139
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,139 @@
1+
module System.AtomicWrite.Writer.Text.BinarySpec (spec) where
2+
3+
import Test.Hspec (Spec, describe, it,
4+
shouldBe)
5+
6+
import System.AtomicWrite.Writer.Text.Binary (atomicWriteFile,
7+
atomicWriteFileWithMode)
8+
9+
import System.FilePath.Posix (joinPath)
10+
import System.IO.Temp (withSystemTempDirectory)
11+
import System.PosixCompat.Files (fileMode, getFileStatus,
12+
setFileCreationMask,
13+
setFileMode)
14+
15+
import Data.Text (pack)
16+
17+
spec :: Spec
18+
spec = do
19+
describe "atomicWriteFile" $ do
20+
it "writes contents to a file" $
21+
withSystemTempDirectory "atomicFileTest" $ \tmpDir -> do
22+
23+
let path = joinPath [ tmpDir, "writeTest.tmp" ]
24+
25+
atomicWriteFile path $ pack "just testing"
26+
contents <- readFile path
27+
28+
contents `shouldBe` "just testing"
29+
it "preserves the permissions of original file, regardless of umask" $
30+
withSystemTempDirectory "atomicFileTest" $ \tmpDir -> do
31+
let filePath = joinPath [tmpDir, "testFile"]
32+
33+
writeFile filePath "initial contents"
34+
setFileMode filePath 0o100644
35+
36+
newStat <- getFileStatus filePath
37+
fileMode newStat `shouldBe` 0o100644
38+
39+
-- New files are created with 100600 perms.
40+
_ <- setFileCreationMask 0o100066
41+
42+
-- Create a new file once different mask is set and make sure that mask
43+
-- is applied.
44+
writeFile (joinPath [tmpDir, "sanityCheck"]) "with sanity check mask"
45+
sanityCheckStat <- getFileStatus $ joinPath [tmpDir, "sanityCheck"]
46+
fileMode sanityCheckStat `shouldBe` 0o100600
47+
48+
-- Since we move, this makes the new file assume the filemask of 0600
49+
atomicWriteFile filePath $ pack "new contents"
50+
51+
resultStat <- getFileStatus filePath
52+
53+
-- reset mask to not break subsequent specs
54+
_ <- setFileCreationMask 0o100022
55+
56+
-- Fails when using atomic mv command unless apply perms on initial file
57+
fileMode resultStat `shouldBe` 0o100644
58+
59+
60+
it "creates a new file with permissions based on active umask" $
61+
withSystemTempDirectory "atomicFileTest" $ \tmpDir -> do
62+
let
63+
filePath = joinPath [tmpDir, "testFile"]
64+
sampleFilePath = joinPath [tmpDir, "sampleFile"]
65+
66+
-- Set somewhat distinctive defaults for test
67+
_ <- setFileCreationMask 0o100171
68+
69+
-- We don't know what the default file permissions are, so create a
70+
-- file to sample them.
71+
writeFile sampleFilePath "I'm being written to sample permissions"
72+
73+
newStat <- getFileStatus sampleFilePath
74+
fileMode newStat `shouldBe` 0o100606
75+
76+
atomicWriteFile filePath $ pack "new contents"
77+
78+
resultStat <- getFileStatus filePath
79+
80+
-- reset mask to not break subsequent specs
81+
_ <- setFileCreationMask 0o100022
82+
83+
-- The default tempfile permissions are 0600, so this fails unless we
84+
-- make sure that the default umask is relied on for creation of the
85+
-- tempfile.
86+
fileMode resultStat `shouldBe` 0o100606
87+
describe "atomicWriteFileWithMode" $ do
88+
it "writes contents to a file" $
89+
withSystemTempDirectory "atomicFileTest" $ \tmpDir -> do
90+
91+
let path = joinPath [ tmpDir, "writeTest.tmp" ]
92+
93+
atomicWriteFileWithMode 0o100777 path $ pack "just testing"
94+
95+
contents <- readFile path
96+
97+
contents `shouldBe` "just testing"
98+
99+
100+
it "changes the permissions of a previously created file, regardless of umask" $
101+
withSystemTempDirectory "atomicFileTest" $ \tmpDir -> do
102+
let filePath = joinPath [tmpDir, "testFile"]
103+
104+
writeFile filePath "initial contents"
105+
setFileMode filePath 0o100644
106+
107+
newStat <- getFileStatus filePath
108+
fileMode newStat `shouldBe` 0o100644
109+
110+
-- New files are created with 100600 perms.
111+
_ <- setFileCreationMask 0o100066
112+
113+
-- Create a new file once different mask is set and make sure that mask
114+
-- is applied.
115+
writeFile (joinPath [tmpDir, "sanityCheck"]) "with sanity check mask"
116+
sanityCheckStat <- getFileStatus $ joinPath [tmpDir, "sanityCheck"]
117+
fileMode sanityCheckStat `shouldBe` 0o100600
118+
119+
-- Since we move, this makes the new file assume the filemask of 0600
120+
atomicWriteFileWithMode 0o100655 filePath $ pack "new contents"
121+
122+
resultStat <- getFileStatus filePath
123+
124+
-- reset mask to not break subsequent specs
125+
_ <- setFileCreationMask 0o100022
126+
127+
-- Fails when using atomic mv command unless apply perms on initial file
128+
fileMode resultStat `shouldBe` 0o100655
129+
130+
131+
it "creates a new file with specified permissions" $
132+
withSystemTempDirectory "atomicFileTest" $ \tmpDir -> do
133+
let
134+
filePath = joinPath [tmpDir, "testFile"]
135+
atomicWriteFileWithMode 0o100606 filePath $ pack "new contents"
136+
137+
resultStat <- getFileStatus filePath
138+
139+
fileMode resultStat `shouldBe` 0o100606

‎src/System/AtomicWrite/Writer/Text/Binary.hs

+55
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,55 @@
1+
-- |
2+
-- Module : System.AtomicWrite.Writer.Text.Binary
3+
-- Copyright : © 2015-2017 Stack Builders Inc.
4+
-- License : MIT
5+
--
6+
-- Maintainer : Stack Builders <[email protected]>
7+
-- Stability : experimental
8+
-- Portability : portable
9+
--
10+
-- Provides functionality to dump the contents of a Text
11+
-- to a file in binary mode.
12+
13+
module System.AtomicWrite.Writer.Text.Binary (atomicWriteFile, atomicWriteFileWithMode) where
14+
15+
import System.AtomicWrite.Internal (closeAndRename, maybeSetFileMode,
16+
tempFileFor)
17+
18+
import Data.Text (Text)
19+
20+
import Data.Text.IO (hPutStr)
21+
22+
import System.Posix.Types (FileMode)
23+
24+
import System.IO (hSetBinaryMode)
25+
26+
-- | Creates a file atomically on POSIX-compliant
27+
-- systems while preserving permissions.
28+
atomicWriteFile ::
29+
FilePath -- ^ The path where the file will be updated or created
30+
-> Text -- ^ The content to write to the file
31+
-> IO ()
32+
atomicWriteFile =
33+
atomicWriteFileMaybeMode Nothing
34+
35+
-- | Creates or modifies a file atomically on
36+
-- POSIX-compliant systems and updates permissions
37+
atomicWriteFileWithMode ::
38+
FileMode -- ^ The mode to set the file to
39+
-> FilePath -- ^ The path where the file will be updated or created
40+
-> Text -- ^ The content to write to the file
41+
-> IO ()
42+
atomicWriteFileWithMode mode =
43+
atomicWriteFileMaybeMode $ Just mode
44+
45+
-- Helper Function
46+
atomicWriteFileMaybeMode ::
47+
Maybe FileMode -- ^ The mode to set the file to
48+
-> FilePath -- ^ The path where the file will be updated or created
49+
-> Text -- ^ The content to write to the file
50+
-> IO ()
51+
atomicWriteFileMaybeMode mmode path text =
52+
tempFileFor path >>= \(tmpPath, h) -> hSetBinaryMode h True
53+
>> hPutStr h text
54+
>> closeAndRename h tmpPath path
55+
>> maybeSetFileMode path mmode

0 commit comments

Comments
 (0)