diff options
Diffstat (limited to 'Annex/URLClaim.hs')
-rw-r--r-- | Annex/URLClaim.hs | 29 |
1 files changed, 29 insertions, 0 deletions
diff --git a/Annex/URLClaim.hs b/Annex/URLClaim.hs new file mode 100644 index 000000000..3acb28e29 --- /dev/null +++ b/Annex/URLClaim.hs @@ -0,0 +1,29 @@ +{- Url claim checking. + - + - Copyright 2013-2014 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Annex.URLClaim ( + URLClaim(..), + urlClaim +) where + +import Common.Annex +import Types.URLClaim +import Logs.Web +import Remote +import qualified Types.Remote as Remote + +urlClaim :: URLString -> Annex (Remote, URLClaim) +urlClaim url = do + rs <- remoteList + -- The web special remote claims urls by default. + let web = Prelude.head $ filter (\r -> uuid r == webUUID) rs + fromMaybe (web, URLClaimed) <$> getM (\r -> ret r <$> checkclaim r) rs + where + checkclaim = maybe (pure Nothing) (flip id url) . Remote.claimUrl + + ret _ Nothing = Nothing + ret r (Just c) = Just (r, c) |