export some always failing methods for readonly remotes

This commit is contained in:
Joey Hess 2015-08-17 11:21:38 -04:00
parent fb9d851258
commit 99b9a3f277

View file

@ -1,14 +1,21 @@
{- Adds readonly support to remotes. {- Adds readonly support to remotes.
- -
- Copyright 2013 Joey Hess <id@joeyh.name> - Copyright 2013, 2015 Joey Hess <id@joeyh.name>
- -
- Licensed under the GNU GPL version 3 or higher. - Licensed under the GNU GPL version 3 or higher.
-} -}
module Remote.Helper.ReadOnly (adjustReadOnly) where module Remote.Helper.ReadOnly
( adjustReadOnly
, readonlyStoreKey
, readonlyStorer
, readonlyRemoveKey
) where
import Common.Annex import Common.Annex
import Types.Remote import Types.Remote
import Types.StoreRetrieve
import Utility.Metered
{- Adds support for read-only remotes, by replacing the {- Adds support for read-only remotes, by replacing the
- methods that write to a remote with dummies that fail. - methods that write to a remote with dummies that fail.
@ -18,12 +25,22 @@ import Types.Remote
adjustReadOnly :: Remote -> Remote adjustReadOnly :: Remote -> Remote
adjustReadOnly r adjustReadOnly r
| remoteAnnexReadOnly (gitconfig r) = r | remoteAnnexReadOnly (gitconfig r) = r
{ storeKey = \_ _ _ -> failbool { storeKey = readonlyStoreKey
, removeKey = \_ -> failbool , removeKey = readonlyRemoveKey
, repairRepo = Nothing , repairRepo = Nothing
} }
| otherwise = r | otherwise = r
where
failbool = do readonlyStoreKey :: Key -> AssociatedFile -> MeterUpdate -> Annex Bool
warning "this remote is readonly" readonlyStoreKey _ _ _ = readonlyFail
return False
readonlyRemoveKey :: Key -> Annex Bool
readonlyRemoveKey _ = readonlyFail
readonlyStorer :: Storer
readonlyStorer _ _ _ = readonlyFail
readonlyFail :: Annex Bool
readonlyFail = do
warning "this remote is readonly"
return False