1{- git-annex import types
2 -
3 - Copyright 2019 Joey Hess <id@joeyh.name>
4 -
5 - Licensed under the GNU AGPL version 3 or higher.
6 -}
7
8{-# LANGUAGE DeriveGeneric #-}
9
10module Types.Import where
11
12import qualified Data.ByteString as S
13import Data.Char
14import Control.DeepSeq
15import GHC.Generics
16
17import Types.Export
18import Utility.QuickCheck
19import Utility.FileSystemEncoding
20
21{- Location of content on a remote that can be imported.
22 - This is just an alias to ExportLocation, because both are referring to a
23 - location on the remote. -}
24type ImportLocation = ExportLocation
25
26mkImportLocation :: RawFilePath -> ImportLocation
27mkImportLocation = mkExportLocation
28
29fromImportLocation :: ImportLocation -> RawFilePath
30fromImportLocation = fromExportLocation
31
32{- An identifier for content stored on a remote that has been imported into
33 - the repository. It should be reasonably short since it is stored in the
34 - git-annex branch.
35 -
36 - Since other things than git-annex can modify files on import remotes,
37 - and git-annex then be used to import those modifications, the
38 - ContentIdentifier needs to change when a file gets changed in such a
39 - way. Device, inode, and size is one example of a good content
40 - identifier. Or a hash if the remote's interface exposes hashes.
41 -}
42newtype ContentIdentifier = ContentIdentifier S.ByteString
43	deriving (Eq, Ord, Show, Generic)
44
45instance NFData ContentIdentifier
46
47instance Arbitrary ContentIdentifier where
48	-- Avoid non-ascii ContentIdentifiers because fully arbitrary
49	-- strings may not be encoded using the filesystem
50	-- encoding, which is normally applied to all input.
51	arbitrary = ContentIdentifier . encodeBS
52		<$> arbitrary `suchThat` all isAscii
53
54{- List of files that can be imported from a remote, each with some added
55 - information. -}
56data ImportableContents info = ImportableContents
57	{ importableContents :: [(ImportLocation, info)]
58	, importableHistory :: [ImportableContents info]
59	-- ^ Used by remotes that support importing historical versions of
60	-- files that are stored in them. This is equivilant to a git
61	-- commit history.
62	--
63	-- When retrieving a historical version of a file,
64	-- old ImportLocations from importableHistory are not used;
65	-- the content is no longer expected to be present at those
66	-- locations. So, if a remote does not support Key/Value access,
67	-- it should not populate the importableHistory.
68	}
69	deriving (Show, Generic)
70
71instance NFData info => NFData (ImportableContents info)
72