Adding 'MustExist' constructor to assert a file is assumed to exist

fs-api/src-unix/System/FS/IO/Unix.hs

@@ -73,19 +73,16 @@ open fp openMode = Posix.openFd fp posixOpenMode fileFlags
       AppendMode    ex -> ( Posix.WriteOnly
                           , defaultFileFlags { Posix.append = True
                                              , Posix.exclusive = isExcl ex
-                                             , Posix.creat = Just Posix.stdFileMode }
+                                             , Posix.creat = creat ex }
                           )
       ReadWriteMode ex -> ( Posix.ReadWrite
                           , defaultFileFlags { Posix.exclusive = isExcl ex
-                                             , Posix.creat = Just Posix.stdFileMode }
+                                             , Posix.creat = creat ex }
                           )
       WriteMode     ex -> ( Posix.ReadWrite
                           , defaultFileFlags { Posix.exclusive = isExcl ex
-                                             , Posix.creat = Just Posix.stdFileMode }
+                                             , Posix.creat = creat ex }
                           )
-
-    isExcl AllowExisting = False
-    isExcl MustBeNew     = True
 # else
 open fp openMode = Posix.openFd fp posixOpenMode fileMode fileFlags
   where
@@ -95,22 +92,26 @@ open fp openMode = Posix.openFd fp posixOpenMode fileMode fileFlags
                           , defaultFileFlags
                           )
       AppendMode    ex -> ( Posix.WriteOnly
-                          , Just Posix.stdFileMode
+                          , creat x
                           , defaultFileFlags { Posix.append = True
                                              , Posix.exclusive = isExcl ex }
                           )
       ReadWriteMode ex -> ( Posix.ReadWrite
-                          , Just Posix.stdFileMode
+                          , creat x
                           , defaultFileFlags { Posix.exclusive = isExcl ex }
                           )
       WriteMode     ex -> ( Posix.ReadWrite
-                          , Just Posix.stdFileMode
+                          , creat x
                           , defaultFileFlags { Posix.exclusive = isExcl ex }
                           )
-
+# endif
     isExcl AllowExisting = False
     isExcl MustBeNew     = True
-# endif
+    isExcl MustExist     = False
+
+    creat AllowExisting = Just Posix.stdFileMode
+    creat MustBeNew     = Just Posix.stdFileMode
+    creat MustExist     = Nothing
 
 -- | Writes the data pointed by the input 'Ptr Word8' into the input 'FHandle'.
 write :: FHandle -> Ptr Word8 -> Int64 -> IO Word32

fs-api/src-win32/System/FS/IO/Windows.hs

@@ -60,6 +60,7 @@ open filename openMode = do
       ReadWriteMode ex -> (gENERIC_READ .|. gENERIC_WRITE, createNew ex)
     createNew AllowExisting = oPEN_ALWAYS
     createNew MustBeNew     = cREATE_NEW
+    createNew MustExist     = oPEN_ALWAYS
 
 write :: FHandle -> Ptr Word8 -> Int64 -> IO Word32
 write fh data' bytes = withOpenHandle "write" fh $ \h ->

fs-api/src/System/FS/API/Types.hs

@@ -85,8 +85,11 @@ data AllowExisting
     -- ^ The file may already exist. If it does, it is reopened. If it
     -- doesn't, it is created.
   | MustBeNew
-    -- ^ The file may not yet exist. If it does, an error
+    -- ^ The file must not yet exist. If it does, an error
     -- ('FsResourceAlreadyExist') is thrown.
+  | MustExist
+    -- ^ The file must already exist. If it does not, an error
+    -- ('FsResourceDoesNotExist') is thrown.
   deriving (Eq, Show)
 
 allowExisting :: OpenMode -> AllowExisting
@@ -460,6 +463,7 @@ instance Condense SeekMode where
 instance Condense AllowExisting where
   condense AllowExisting = ""
   condense MustBeNew     = "!"
+  condense MustExist     = "+"
 
 instance Condense OpenMode where
     condense ReadMode           = "r"

fs-sim/src/System/FS/Sim/FsTree.hs

@@ -231,14 +231,21 @@ getDir fp =
   Specific file system functions
 -------------------------------------------------------------------------------}
 
--- | Open a file: create it if necessary or throw an error if it existed
--- already wile we were supposed to create it from scratch (when passed
--- 'MustBeNew').
+-- | Open a file: create it if necessary or throw an error if either:
+--    1. It existed already while we were supposed to create it from scratch
+--        (when passed 'MustBeNew').
+--    2. It did not already exists when we expected to (when passed 'MustExist').
 openFile :: Monoid a
          => FsPath -> AllowExisting -> FsTree a -> Either FsTreeError (FsTree a)
-openFile fp ex = alterFile fp Left (Right mempty) $ \a -> case ex of
-    AllowExisting -> Right a
-    MustBeNew     -> Left (FsExists fp)
+openFile fp ex = alterFile fp Left caseDoesNotExist caseAlreadyExist
+  where
+    caseAlreadyExist a = case ex of
+      MustBeNew -> Left (FsExists fp)
+      _         -> Right a
+
+    caseDoesNotExist = case ex of
+      MustExist -> Left (FsMissing fp (pathLast fp :| []))
+      _         -> Right mempty
 
 -- | Replace the contents of the specified file (which must exist)
 replace :: FsPath -> a -> FsTree a -> Either FsTreeError (FsTree a)

fs-sim/src/System/FS/Sim/MockFS.hs

@@ -479,7 +479,11 @@ hOpen fp openMode = do
       , fsLimitation  = True
       }
     modifyMockFS $ \fs -> do
-      let alreadyHasWriter =
+      let assumedExistance (WriteMode MustExist) = True
+          assumedExistance (AppendMode MustExist) = True
+          assumedExistance (ReadWriteMode MustExist) = True
+          assumedExistance _ = False
+          alreadyHasWriter =
             any (\hs -> openFilePath hs == fp && isWriteHandle hs) $
             openHandles fs
       when (openMode /= ReadMode && alreadyHasWriter) $
@@ -491,7 +495,7 @@ hOpen fp openMode = do
           , fsErrorStack  = prettyCallStack
           , fsLimitation  = True
           }
-      when (openMode == ReadMode) $ void $
+      when (openMode == ReadMode || assumedExistance openMode) $ void $
         checkFsTree $ FS.getFile fp (mockFiles fs)
       files' <- checkFsTree $ FS.openFile fp ex (mockFiles fs)
       return $ newHandle (fs { mockFiles = files' })

fs-sim/test/Test/System/FS/StateMachine.hs

@@ -676,7 +676,7 @@ generator Model{..} = oneof $ concat [
         (rf, wf) = if fileExists then (10,3) else (1,3)
 
     genAllowExisting :: Gen AllowExisting
-    genAllowExisting = elements [AllowExisting, MustBeNew]
+    genAllowExisting = elements [AllowExisting, MustBeNew, MustExist]
 
     genSeekMode :: Gen SeekMode
     genSeekMode = elements [
@@ -1055,6 +1055,7 @@ data Tag =
   -- > Get ..
   | TagPutSeekNegGet
 
+
   -- Open with MustBeNew (O_EXCL flag), but the file already existed.
   --
   -- > h <- Open fp (AppendMode _)
@@ -1063,6 +1064,13 @@ data Tag =
   | TagExclusiveFail
 
 
+  -- Open with MustExist, but the file does not exist.
+  --
+  -- > DoesFileExist fp
+  -- > h <- Open fp (AppendMode _)
+  | TagAssumeExists
+
+
   -- Reading returns an empty bytestring when EOF
   --
   -- > h <- open fp ReadMode
@@ -1136,6 +1144,7 @@ tag = C.classify [
     , tagPutSeekGet Set.empty Set.empty
     , tagPutSeekNegGet Set.empty Set.empty
     , tagExclusiveFail
+--    , tagAssumeExistsFail -- Set.empty
     , tagReadEOF
     , tagPread
     , tagPutGetBuf Set.empty
@@ -1481,6 +1490,23 @@ tag = C.classify [
             Left TagExclusiveFail
         _otherwise -> Right tagExclusiveFail
 
+    tagAssumeExistsFail :: EventPred
+    tagAssumeExistsFail = C.predicate $ \ev ->
+{-      
+    tagClosedTwice closed = successful $ \ev _suc ->
+      case eventMockCmd ev of
+        Close (Handle h _) | Set.member h closed -> Left TagClosedTwice
+        Close (Handle h _) -> Right $ tagClosedTwice $ Set.insert h closed
+        _otherwise -> Right $ tagClosedTwice closed
+        (DoesFileExist _, Bool False) -> Left TagDoesFileExistKO
+-}
+      case (eventMockCmd ev, eventMockResp ev) of
+        (Open _ mode, Resp (Left fsError))
+          | MustExist <- allowExisting mode
+          , fsErrorType fsError == FsResourceDoesNotExist ->
+            Left TagAssumeExists
+        _otherwise -> Right tagAssumeExistsFail
+
     tagReadEOF :: EventPred
     tagReadEOF = successful $ \ev suc ->
       case (eventMockCmd ev, suc) of