more OsPath conversion

Sponsored-by: mycroft
This commit is contained in:
Joey Hess 2025-01-28 15:46:00 -04:00
parent 917c43f31f
commit 22c2451e26
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
11 changed files with 46 additions and 44 deletions

View file

@ -24,11 +24,11 @@ import qualified Git
import Git.Sha import Git.Sha
import qualified Utility.SimpleProtocol as Proto import qualified Utility.SimpleProtocol as Proto
import qualified Utility.FileIO as F import qualified Utility.FileIO as F
import qualified Utility.OsString as OS
import Control.Concurrent import Control.Concurrent
import Control.Concurrent.STM import Control.Concurrent.STM
import Control.Concurrent.STM.TBMChan import Control.Concurrent.STM.TBMChan
import qualified System.FilePath.ByteString as P
newtype ChangedRefs = ChangedRefs [Git.Ref] newtype ChangedRefs = ChangedRefs [Git.Ref]
deriving (Show) deriving (Show)
@ -82,7 +82,7 @@ watchChangedRefs = do
g <- gitRepo g <- gitRepo
let gittop = Git.localGitDir g let gittop = Git.localGitDir g
let refdir = gittop P.</> "refs" let refdir = gittop </> literalOsPath "refs"
liftIO $ createDirectoryUnder [gittop] refdir liftIO $ createDirectoryUnder [gittop] refdir
let notifyhook = Just $ notifyHook chan let notifyhook = Just $ notifyHook chan
@ -93,18 +93,17 @@ watchChangedRefs = do
if canWatch if canWatch
then do then do
h <- liftIO $ watchDir h <- liftIO $ watchDir refdir
(fromRawFilePath refdir)
(const False) True hooks id (const False) True hooks id
return $ Just $ ChangedRefsHandle h chan return $ Just $ ChangedRefsHandle h chan
else return Nothing else return Nothing
notifyHook :: TBMChan Git.Sha -> FilePath -> Maybe FileStatus -> IO () notifyHook :: TBMChan Git.Sha -> OsPath -> Maybe FileStatus -> IO ()
notifyHook chan reffile _ notifyHook chan reffile _
| ".lock" `isSuffixOf` reffile = noop | literalOsPath ".lock" `OS.isSuffixOf` reffile = noop
| otherwise = void $ do | otherwise = void $ do
sha <- catchDefaultIO Nothing $ sha <- catchDefaultIO Nothing $
extractSha <$> F.readFile' (toOsPath (toRawFilePath reffile)) extractSha <$> F.readFile' reffile
-- When the channel is full, there is probably no reader -- When the channel is full, there is probably no reader
-- running, or ref changes have been occurring very fast, -- running, or ref changes have been occurring very fast,
-- so it's ok to not write the change to it. -- so it's ok to not write the change to it.

View file

@ -29,14 +29,14 @@ annexAttrs =
, "annex.mincopies" , "annex.mincopies"
] ]
checkAttr :: Git.Attr -> RawFilePath -> Annex String checkAttr :: Git.Attr -> OsPath -> Annex String
checkAttr attr file = withCheckAttrHandle $ \h -> do checkAttr attr file = withCheckAttrHandle $ \h -> do
r <- liftIO $ Git.checkAttr h attr file r <- liftIO $ Git.checkAttr h attr file
if r == Git.unspecifiedAttr if r == Git.unspecifiedAttr
then return "" then return ""
else return r else return r
checkAttrs :: [Git.Attr] -> RawFilePath -> Annex [String] checkAttrs :: [Git.Attr] -> OsPath -> Annex [String]
checkAttrs attrs file = withCheckAttrHandle $ \h -> checkAttrs attrs file = withCheckAttrHandle $ \h ->
liftIO $ Git.checkAttrs h attrs file liftIO $ Git.checkAttrs h attrs file

2
Key.hs
View file

@ -86,7 +86,7 @@ instance Arbitrary KeyData where
instance Arbitrary AssociatedFile where instance Arbitrary AssociatedFile where
arbitrary = AssociatedFile arbitrary = AssociatedFile
. fmap (toRawFilePath . fromTestableFilePath) . fmap (toOsPath . fromTestableFilePath)
<$> arbitrary <$> arbitrary
instance Arbitrary Key where instance Arbitrary Key where

View file

@ -190,7 +190,7 @@ endResult False = "failed"
toplevelMsg :: (Semigroup t, IsString t) => t -> t toplevelMsg :: (Semigroup t, IsString t) => t -> t
toplevelMsg s = fromString "git-annex: " <> s toplevelMsg s = fromString "git-annex: " <> s
toplevelFileProblem :: Bool -> MessageId -> StringContainingQuotedPath -> String -> RawFilePath -> Maybe Key -> SeekInput -> Annex () toplevelFileProblem :: Bool -> MessageId -> StringContainingQuotedPath -> String -> OsPath -> Maybe Key -> SeekInput -> Annex ()
toplevelFileProblem makeway messageid msg action file mkey si = do toplevelFileProblem makeway messageid msg action file mkey si = do
maybeShowJSON' $ JSON.start action (Just file) mkey si maybeShowJSON' $ JSON.start action (Just file) mkey si
maybeShowJSON' $ JSON.messageid messageid maybeShowJSON' $ JSON.messageid messageid

View file

@ -50,7 +50,7 @@ import Key
import Utility.Metered import Utility.Metered
import Utility.Percentage import Utility.Percentage
import Utility.Aeson import Utility.Aeson
import Utility.FileSystemEncoding import Utility.OsPath
import Types.Messages import Types.Messages
-- A global lock to avoid concurrent threads emitting json at the same time. -- A global lock to avoid concurrent threads emitting json at the same time.
@ -76,7 +76,7 @@ type JSONBuilder = Maybe (Object, Bool) -> Maybe (Object, Bool)
none :: JSONBuilder none :: JSONBuilder
none = id none = id
start :: String -> Maybe RawFilePath -> Maybe Key -> SeekInput -> JSONBuilder start :: String -> Maybe OsPath -> Maybe Key -> SeekInput -> JSONBuilder
start command file key si _ = case j of start command file key si _ = case j of
Object o -> Just (o, False) Object o -> Just (o, False)
_ -> Nothing _ -> Nothing
@ -84,7 +84,7 @@ start command file key si _ = case j of
j = toJSON' $ JSONActionItem j = toJSON' $ JSONActionItem
{ itemCommand = Just command { itemCommand = Just command
, itemKey = key , itemKey = key
, itemFile = fromRawFilePath <$> file , itemFile = fromOsPath <$> file
, itemUUID = Nothing , itemUUID = Nothing
, itemFields = Nothing :: Maybe Bool , itemFields = Nothing :: Maybe Bool
, itemSeekInput = si , itemSeekInput = si
@ -98,7 +98,7 @@ startActionItem command ai si _ = case j of
j = toJSON' $ JSONActionItem j = toJSON' $ JSONActionItem
{ itemCommand = Just command { itemCommand = Just command
, itemKey = actionItemKey ai , itemKey = actionItemKey ai
, itemFile = fromRawFilePath <$> actionItemFile ai , itemFile = fromOsPath <$> actionItemFile ai
, itemUUID = actionItemUUID ai , itemUUID = actionItemUUID ai
, itemFields = Nothing :: Maybe Bool , itemFields = Nothing :: Maybe Bool
, itemSeekInput = si , itemSeekInput = si

View file

@ -55,7 +55,7 @@ instance MeterSize KeySource where
- This allows uploads of keys without size to still have progress - This allows uploads of keys without size to still have progress
- displayed. - displayed.
-} -}
data KeySizer = KeySizer Key (Annex (Maybe RawFilePath)) data KeySizer = KeySizer Key (Annex (Maybe OsPath))
instance MeterSize KeySizer where instance MeterSize KeySizer where
getMeterSize (KeySizer k getsrcfile) = case fromKey keySize k of getMeterSize (KeySizer k getsrcfile) = case fromKey keySize k of
@ -171,7 +171,7 @@ metered' st setclear othermeterupdate msize bwlimit showoutput a = go st
minratelimit = min consoleratelimit jsonratelimit minratelimit = min consoleratelimit jsonratelimit
{- Poll file size to display meter. -} {- Poll file size to display meter. -}
meteredFile :: RawFilePath -> Maybe MeterUpdate -> Key -> (MeterUpdate -> Annex a) -> Annex a meteredFile :: OsPath -> Maybe MeterUpdate -> Key -> (MeterUpdate -> Annex a) -> Annex a
meteredFile file combinemeterupdate key a = meteredFile file combinemeterupdate key a =
metered combinemeterupdate key Nothing $ \_ p -> metered combinemeterupdate key Nothing $ \_ p ->
watchFileSize file p a watchFileSize file p a

View file

@ -17,9 +17,9 @@ import Utility.Url (URLString)
#ifdef mingw32_HOST_OS #ifdef mingw32_HOST_OS
import Utility.Split import Utility.Split
#endif #endif
import Utility.FileSystemEncoding import Utility.OsPath
import System.FilePath.Posix -- for manipulating url paths import qualified System.FilePath.Posix as UrlPath
import Network.Protocol.HTTP.DAV (inDAVLocation, DAVT) import Network.Protocol.HTTP.DAV (inDAVLocation, DAVT)
import Control.Monad.IO.Class (MonadIO) import Control.Monad.IO.Class (MonadIO)
import Network.URI import Network.URI
@ -30,28 +30,29 @@ type DavLocation = String
{- Runs action with a new location relative to the current location. -} {- Runs action with a new location relative to the current location. -}
inLocation :: (MonadIO m) => DavLocation -> DAVT m a -> DAVT m a inLocation :: (MonadIO m) => DavLocation -> DAVT m a -> DAVT m a
inLocation d = inDAVLocation (</> d') inLocation d = inDAVLocation (UrlPath.</> d')
where where
d' = escapeURIString isUnescapedInURI d d' = escapeURIString isUnescapedInURI d
{- The directory where files(s) for a key are stored. -} {- The directory where files(s) for a key are stored. -}
keyDir :: Key -> DavLocation keyDir :: Key -> DavLocation
keyDir k = addTrailingPathSeparator $ hashdir </> fromRawFilePath (keyFile k) keyDir k = UrlPath.addTrailingPathSeparator $
hashdir UrlPath.</> fromOsPath (keyFile k)
where where
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS
hashdir = fromRawFilePath $ hashDirLower def k hashdir = fromOsPath $ hashDirLower def k
#else #else
hashdir = replace "\\" "/" (fromRawFilePath $ hashDirLower def k) hashdir = replace "\\" "/" (fromOsPath $ hashDirLower def k)
#endif #endif
keyLocation :: Key -> DavLocation keyLocation :: Key -> DavLocation
keyLocation k = keyDir k ++ fromRawFilePath (keyFile k) keyLocation k = keyDir k ++ fromOsPath (keyFile k)
{- Paths containing # or ? cannot be represented in an url, so fails on {- Paths containing # or ? cannot be represented in an url, so fails on
- those. -} - those. -}
exportLocation :: ExportLocation -> Either String DavLocation exportLocation :: ExportLocation -> Either String DavLocation
exportLocation l = exportLocation l =
let p = fromRawFilePath $ fromExportLocation l let p = fromOsPath $ fromExportLocation l
in if any (`elem` p) illegalinurl in if any (`elem` p) illegalinurl
then Left ("Cannot store file containing '#' or '?' on webdav: " ++ p) then Left ("Cannot store file containing '#' or '?' on webdav: " ++ p)
else Right p else Right p
@ -60,7 +61,7 @@ exportLocation l =
{- Where we store temporary data for a key as it's being uploaded. -} {- Where we store temporary data for a key as it's being uploaded. -}
keyTmpLocation :: Key -> DavLocation keyTmpLocation :: Key -> DavLocation
keyTmpLocation = tmpLocation . fromRawFilePath . keyFile keyTmpLocation = tmpLocation . fromOsPath . keyFile
{- Where we store temporary data for a file as it's being exported. {- Where we store temporary data for a file as it's being exported.
- -
@ -72,10 +73,11 @@ keyTmpLocation = tmpLocation . fromRawFilePath . keyFile
-} -}
exportTmpLocation :: ExportLocation -> Key -> DavLocation exportTmpLocation :: ExportLocation -> Key -> DavLocation
exportTmpLocation l k exportTmpLocation l k
| length (splitDirectories p) > 1 = takeDirectory p </> keyTmpLocation k | length (UrlPath.splitDirectories p) > 1 =
UrlPath.takeDirectory p UrlPath.</> keyTmpLocation k
| otherwise = keyTmpLocation k | otherwise = keyTmpLocation k
where where
p = fromRawFilePath (fromExportLocation l) p = fromOsPath (fromExportLocation l)
tmpLocation :: FilePath -> DavLocation tmpLocation :: FilePath -> DavLocation
tmpLocation f = "git-annex-webdav-tmp-" ++ f tmpLocation f = "git-annex-webdav-tmp-" ++ f
@ -86,7 +88,7 @@ locationParent loc
| otherwise = Just parent | otherwise = Just parent
where where
tops = ["/", "", "."] tops = ["/", "", "."]
parent = takeDirectory loc parent = UrlPath.takeDirectory loc
locationUrl :: URLString -> DavLocation -> URLString locationUrl :: URLString -> DavLocation -> URLString
locationUrl baseurl loc = baseurl </> loc locationUrl baseurl loc = baseurl UrlPath.</> loc

View file

@ -18,14 +18,14 @@ import Types.UUID
import Types.FileMatcher import Types.FileMatcher
import Git.FilePath import Git.FilePath
import Git.Quote (StringContainingQuotedPath(..)) import Git.Quote (StringContainingQuotedPath(..))
import Utility.FileSystemEncoding import Utility.OsPath
data ActionItem data ActionItem
= ActionItemAssociatedFile AssociatedFile Key = ActionItemAssociatedFile AssociatedFile Key
| ActionItemKey Key | ActionItemKey Key
| ActionItemBranchFilePath BranchFilePath Key | ActionItemBranchFilePath BranchFilePath Key
| ActionItemFailedTransfer Transfer TransferInfo | ActionItemFailedTransfer Transfer TransferInfo
| ActionItemTreeFile RawFilePath | ActionItemTreeFile OsPath
| ActionItemUUID UUID StringContainingQuotedPath | ActionItemUUID UUID StringContainingQuotedPath
-- ^ UUID with a description or name of the repository -- ^ UUID with a description or name of the repository
| ActionItemOther (Maybe StringContainingQuotedPath) | ActionItemOther (Maybe StringContainingQuotedPath)
@ -46,10 +46,10 @@ instance MkActionItem (AssociatedFile, Key) where
instance MkActionItem (Key, AssociatedFile) where instance MkActionItem (Key, AssociatedFile) where
mkActionItem = uncurry $ flip ActionItemAssociatedFile mkActionItem = uncurry $ flip ActionItemAssociatedFile
instance MkActionItem (Key, RawFilePath) where instance MkActionItem (Key, OsPath) where
mkActionItem (key, file) = ActionItemAssociatedFile (AssociatedFile (Just file)) key mkActionItem (key, file) = ActionItemAssociatedFile (AssociatedFile (Just file)) key
instance MkActionItem (RawFilePath, Key) where instance MkActionItem (OsPath, Key) where
mkActionItem (file, key) = mkActionItem (key, file) mkActionItem (file, key) = mkActionItem (key, file)
instance MkActionItem Key where instance MkActionItem Key where
@ -97,7 +97,7 @@ actionItemKey (ActionItemUUID _ _) = Nothing
actionItemKey (ActionItemOther _) = Nothing actionItemKey (ActionItemOther _) = Nothing
actionItemKey (OnlyActionOn _ ai) = actionItemKey ai actionItemKey (OnlyActionOn _ ai) = actionItemKey ai
actionItemFile :: ActionItem -> Maybe RawFilePath actionItemFile :: ActionItem -> Maybe OsPath
actionItemFile (ActionItemAssociatedFile (AssociatedFile af) _) = af actionItemFile (ActionItemAssociatedFile (AssociatedFile af) _) = af
actionItemFile (ActionItemTreeFile f) = Just f actionItemFile (ActionItemTreeFile f) = Just f
actionItemFile (ActionItemUUID _ _) = Nothing actionItemFile (ActionItemUUID _ _) = Nothing

View file

@ -14,7 +14,7 @@ import Types.Mime
import Types.RepoSize (LiveUpdate) import Types.RepoSize (LiveUpdate)
import Utility.Matcher (Matcher, Token, MatchDesc) import Utility.Matcher (Matcher, Token, MatchDesc)
import Utility.FileSize import Utility.FileSize
import Utility.FileSystemEncoding import Utility.OsPath
import Control.Monad.IO.Class import Control.Monad.IO.Class
import qualified Data.Map as M import qualified Data.Map as M
@ -27,10 +27,10 @@ data MatchInfo
| MatchingUserInfo UserProvidedInfo | MatchingUserInfo UserProvidedInfo
data FileInfo = FileInfo data FileInfo = FileInfo
{ contentFile :: RawFilePath { contentFile :: OsPath
-- ^ path to a file containing the content, for operations -- ^ path to a file containing the content, for operations
-- that examine it -- that examine it
, matchFile :: RawFilePath , matchFile :: OsPath
-- ^ filepath to match on; may be relative to top of repo or cwd, -- ^ filepath to match on; may be relative to top of repo or cwd,
-- depending on how globs in preferred content expressions -- depending on how globs in preferred content expressions
-- are intended to be matched -- are intended to be matched
@ -39,7 +39,7 @@ data FileInfo = FileInfo
} }
data ProvidedInfo = ProvidedInfo data ProvidedInfo = ProvidedInfo
{ providedFilePath :: Maybe RawFilePath { providedFilePath :: Maybe OsPath
-- ^ filepath to match on, should not be accessed from disk. -- ^ filepath to match on, should not be accessed from disk.
, providedKey :: Maybe Key , providedKey :: Maybe Key
, providedFileSize :: Maybe FileSize , providedFileSize :: Maybe FileSize
@ -48,7 +48,7 @@ data ProvidedInfo = ProvidedInfo
, providedLinkType :: Maybe LinkType , providedLinkType :: Maybe LinkType
} }
keyMatchInfoWithoutContent :: Key -> RawFilePath -> MatchInfo keyMatchInfoWithoutContent :: Key -> OsPath -> MatchInfo
keyMatchInfoWithoutContent key file = MatchingInfo $ ProvidedInfo keyMatchInfoWithoutContent key file = MatchingInfo $ ProvidedInfo
{ providedFilePath = Just file { providedFilePath = Just file
, providedKey = Just key , providedKey = Just key

View file

@ -28,6 +28,8 @@ module Types.Key (
parseKeyVariety, parseKeyVariety,
) where ) where
import Utility.OsPath
import qualified Data.ByteString as S import qualified Data.ByteString as S
import qualified Data.ByteString.Short as S (ShortByteString, toShort, fromShort) import qualified Data.ByteString.Short as S (ShortByteString, toShort, fromShort)
import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Char8 as S8
@ -36,7 +38,6 @@ import Data.ByteString.Builder
import Data.ByteString.Builder.Extra import Data.ByteString.Builder.Extra
import qualified Data.Attoparsec.ByteString as A import qualified Data.Attoparsec.ByteString as A
import qualified Data.Attoparsec.ByteString.Char8 as A8 import qualified Data.Attoparsec.ByteString.Char8 as A8
import Utility.FileSystemEncoding
import Data.List import Data.List
import Data.Char import Data.Char
import System.Posix.Types import System.Posix.Types
@ -202,7 +203,7 @@ splitKeyNameExtension' :: S.ByteString -> (S.ByteString, S.ByteString)
splitKeyNameExtension' keyname = S8.span (/= '.') keyname splitKeyNameExtension' keyname = S8.span (/= '.') keyname
{- A filename may be associated with a Key. -} {- A filename may be associated with a Key. -}
newtype AssociatedFile = AssociatedFile (Maybe RawFilePath) newtype AssociatedFile = AssociatedFile (Maybe OsPath)
deriving (Show, Eq, Ord) deriving (Show, Eq, Ord)
{- There are several different varieties of keys. -} {- There are several different varieties of keys. -}

View file

@ -19,7 +19,7 @@ import Types.Direction
import Utility.PID import Utility.PID
import Utility.QuickCheck import Utility.QuickCheck
import Utility.Url import Utility.Url
import Utility.FileSystemEncoding import Utility.OsPath
import Data.Time.Clock.POSIX import Data.Time.Clock.POSIX
import Control.Concurrent import Control.Concurrent
@ -99,7 +99,7 @@ class Transferrable t where
descTransfrerrable :: t -> Maybe String descTransfrerrable :: t -> Maybe String
instance Transferrable AssociatedFile where instance Transferrable AssociatedFile where
descTransfrerrable (AssociatedFile af) = fromRawFilePath <$> af descTransfrerrable (AssociatedFile af) = fromOsPath <$> af
instance Transferrable URLString where instance Transferrable URLString where
descTransfrerrable = Just descTransfrerrable = Just