2011-03-15 21:47:29 +00:00
|
|
|
{- git-annex Key data type
|
|
|
|
-
|
2024-02-29 17:26:06 +00:00
|
|
|
- Copyright 2011-2024 Joey Hess <id@joeyh.name>
|
2011-03-15 21:47:29 +00:00
|
|
|
-
|
2019-03-13 19:48:14 +00:00
|
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
2011-03-15 21:47:29 +00:00
|
|
|
-}
|
|
|
|
|
2019-10-29 19:16:15 +00:00
|
|
|
{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}
|
2018-03-15 15:16:00 +00:00
|
|
|
|
2019-11-22 20:24:04 +00:00
|
|
|
module Types.Key (
|
|
|
|
KeyData(..),
|
|
|
|
Key,
|
|
|
|
fromKey,
|
new protocol for transferkeys, with message serialization
Necessarily threw out the old protocol, so if an old git-annex assistant
is running, and starts a transferkeys from the new git-annex, it would
fail. But, that seems unlikely; the assistant starts up transferkeys
processes and then keeps them running. Still, may need to test that
scenario.
The new protocol is simple read/show and looks like this:
TransferRequest Download (Right "origin") (Key {keyName = "f8f8766a836fb6120abf4d5328ce8761404e437529e997aaa0363bdd4fecd7bb", keyVariety = SHA2Key (HashSize 256) (HasExt True), keySize = Just 30, keyMtime = Nothing, keyChunkSize = Nothing, keyChunkNum = Nothing}) (AssociatedFile (Just "foo"))
TransferOutput (ProgressMeter (Just 30) (MeterState {meterBytesProcessed = BytesProcessed 0, meterTimeStamp = 1.6070268727892535e9}) (MeterState {meterBytesProcessed = BytesProcessed 30, meterTimeStamp = 1.6070268728043e9}))
TransferOutput (OutputMessage "(checksum...) ")
TransferResult True
Granted, this is not optimally fast, but it seems good enough, and is
probably nearly as fast as the old protocol anyhow.
emitSerializedOutput for ProgressMeter is not yet implemented. It needs
to somehow start or update a progress meter. There may need to be a new
message that allocates a progress meter, and then have ProgressMeter
update it.
This commit was sponsored by Ethan Aubin
2020-12-03 20:21:20 +00:00
|
|
|
keyData,
|
2019-11-22 20:24:04 +00:00
|
|
|
mkKey,
|
|
|
|
alterKey,
|
|
|
|
isKeyPrefix,
|
|
|
|
splitKeyNameExtension,
|
|
|
|
keyParser,
|
|
|
|
keySerialization,
|
|
|
|
AssociatedFile(..),
|
|
|
|
KeyVariety(..),
|
|
|
|
HasExt(..),
|
|
|
|
HashSize(..),
|
|
|
|
hasExt,
|
|
|
|
sameExceptExt,
|
|
|
|
formatKeyVariety,
|
|
|
|
parseKeyVariety,
|
|
|
|
) where
|
2011-03-15 21:47:29 +00:00
|
|
|
|
2019-01-11 17:55:00 +00:00
|
|
|
import qualified Data.ByteString as S
|
2021-10-06 00:20:08 +00:00
|
|
|
import qualified Data.ByteString.Short as S (ShortByteString, toShort, fromShort)
|
2019-01-11 17:55:00 +00:00
|
|
|
import qualified Data.ByteString.Char8 as S8
|
2019-11-22 20:24:04 +00:00
|
|
|
import qualified Data.ByteString.Lazy as L
|
|
|
|
import Data.ByteString.Builder
|
|
|
|
import Data.ByteString.Builder.Extra
|
|
|
|
import qualified Data.Attoparsec.ByteString as A
|
|
|
|
import qualified Data.Attoparsec.ByteString.Char8 as A8
|
2019-11-26 19:27:22 +00:00
|
|
|
import Utility.FileSystemEncoding
|
2019-11-22 20:24:04 +00:00
|
|
|
import Data.List
|
2020-07-29 19:23:18 +00:00
|
|
|
import Data.Char
|
2011-03-16 01:34:13 +00:00
|
|
|
import System.Posix.Types
|
2019-11-22 20:24:04 +00:00
|
|
|
import Foreign.C.Types
|
2019-01-18 17:59:29 +00:00
|
|
|
import Data.Monoid
|
2019-11-22 20:24:04 +00:00
|
|
|
import Control.Applicative
|
2019-10-29 19:16:15 +00:00
|
|
|
import GHC.Generics
|
|
|
|
import Control.DeepSeq
|
2019-01-18 17:59:29 +00:00
|
|
|
import Prelude
|
2011-10-04 02:24:57 +00:00
|
|
|
|
2013-07-04 06:36:02 +00:00
|
|
|
{- A Key has a unique name, which is derived from a particular backend,
|
2011-03-16 01:34:13 +00:00
|
|
|
- and may contain other optional metadata. -}
|
2019-11-22 20:24:04 +00:00
|
|
|
data KeyData = Key
|
2021-10-06 00:20:08 +00:00
|
|
|
{ keyName :: S.ShortByteString
|
2017-02-24 19:16:56 +00:00
|
|
|
, keyVariety :: KeyVariety
|
2013-07-04 06:45:46 +00:00
|
|
|
, keySize :: Maybe Integer
|
|
|
|
, keyMtime :: Maybe EpochTime
|
2014-07-24 17:36:23 +00:00
|
|
|
, keyChunkSize :: Maybe Integer
|
|
|
|
, keyChunkNum :: Maybe Integer
|
2019-10-29 19:16:15 +00:00
|
|
|
} deriving (Eq, Ord, Read, Show, Generic)
|
|
|
|
|
2019-11-22 20:24:04 +00:00
|
|
|
instance NFData KeyData
|
|
|
|
|
2024-04-06 13:50:58 +00:00
|
|
|
{- Caching the serialization of a key is an optimization.
|
2019-11-22 20:24:04 +00:00
|
|
|
-
|
|
|
|
- This constructor is not exported, and all smart constructors maintain
|
|
|
|
- the serialization.
|
|
|
|
-}
|
|
|
|
data Key = MkKey
|
|
|
|
{ keyData :: KeyData
|
2021-10-06 00:20:08 +00:00
|
|
|
, keySerialization :: S.ShortByteString
|
2019-11-22 20:24:04 +00:00
|
|
|
} deriving (Show, Generic)
|
|
|
|
|
|
|
|
instance Eq Key where
|
2022-08-19 21:45:04 +00:00
|
|
|
-- comparing the serialization would be unnecessary work
|
2019-11-22 20:24:04 +00:00
|
|
|
a == b = keyData a == keyData b
|
|
|
|
|
|
|
|
instance Ord Key where
|
|
|
|
compare a b = compare (keyData a) (keyData b)
|
|
|
|
|
2019-10-29 19:16:15 +00:00
|
|
|
instance NFData Key
|
2011-03-15 21:47:29 +00:00
|
|
|
|
2019-11-22 20:24:04 +00:00
|
|
|
{- Access a field of data from the KeyData. -}
|
|
|
|
{-# INLINE fromKey #-}
|
|
|
|
fromKey :: (KeyData -> a) -> Key -> a
|
|
|
|
fromKey f = f . keyData
|
|
|
|
|
|
|
|
{- Smart constructor for a Key. The provided KeyData has all values empty. -}
|
|
|
|
mkKey :: (KeyData -> KeyData) -> Key
|
|
|
|
mkKey f =
|
|
|
|
let d = f stub
|
|
|
|
in MkKey d (mkKeySerialization d)
|
|
|
|
where
|
|
|
|
stub = Key
|
|
|
|
{ keyName = mempty
|
|
|
|
, keyVariety = OtherKey mempty
|
|
|
|
, keySize = Nothing
|
|
|
|
, keyMtime = Nothing
|
|
|
|
, keyChunkSize = Nothing
|
|
|
|
, keyChunkNum = Nothing
|
|
|
|
}
|
|
|
|
|
|
|
|
{- Alter a Key's data. -}
|
|
|
|
alterKey :: Key -> (KeyData -> KeyData) -> Key
|
|
|
|
alterKey k f =
|
|
|
|
let d = f (keyData k)
|
|
|
|
in MkKey d (mkKeySerialization d)
|
|
|
|
|
|
|
|
-- Checks if a string looks like at least the start of a key.
|
|
|
|
isKeyPrefix :: String -> Bool
|
|
|
|
isKeyPrefix s = [fieldSep, fieldSep] `isInfixOf` s
|
|
|
|
|
|
|
|
fieldSep :: Char
|
|
|
|
fieldSep = '-'
|
|
|
|
|
2021-10-06 00:20:08 +00:00
|
|
|
mkKeySerialization :: KeyData -> S.ShortByteString
|
|
|
|
mkKeySerialization = S.toShort . L.toStrict
|
2019-11-22 20:24:04 +00:00
|
|
|
. toLazyByteStringWith (safeStrategy 128 smallChunkSize) L.empty
|
|
|
|
. buildKeyData
|
|
|
|
|
|
|
|
{- Builds a ByteString from a KeyData.
|
|
|
|
-
|
|
|
|
- The name field is always shown last, separated by doubled fieldSeps,
|
|
|
|
- and is the only field allowed to contain the fieldSep.
|
|
|
|
-}
|
|
|
|
buildKeyData :: KeyData -> Builder
|
|
|
|
buildKeyData k = byteString (formatKeyVariety (keyVariety k))
|
|
|
|
<> 's' ?: (integerDec <$> keySize k)
|
|
|
|
<> 'm' ?: (integerDec . (\(CTime t) -> fromIntegral t) <$> keyMtime k)
|
|
|
|
<> 'S' ?: (integerDec <$> keyChunkSize k)
|
|
|
|
<> 'C' ?: (integerDec <$> keyChunkNum k)
|
2021-10-06 01:26:11 +00:00
|
|
|
<> sepbefore (sepbefore (shortByteString (keyName k)))
|
2019-11-22 20:24:04 +00:00
|
|
|
where
|
|
|
|
sepbefore s = char7 fieldSep <> s
|
|
|
|
c ?: (Just b) = sepbefore (char7 c <> b)
|
|
|
|
_ ?: Nothing = mempty
|
|
|
|
|
add equivilant key log for VURL keys
When downloading a VURL from the web, make sure that the equivilant key
log is populated.
Unfortunately, this does not hash the content while it's being
downloaded from the web. There is not an interface in Backend currently
for incrementally hash generation, only for incremental verification of an
existing hash. So this might add a noticiable delay, and it has to show
a "(checksum...") message. This could stand to be improved.
But, that separate hashing step only has to happen on the first download
of new content from the web. Once the hash is known, the VURL key can have
its hash verified incrementally while downloading except when the
content in the web has changed. (Doesn't happen yet because
verifyKeyContentIncrementally is not implemented yet for VURL keys.)
Note that the equivilant key log file is formatted as a presence log.
This adds a tiny bit of overhead (eg "1 ") per line over just listing the
urls. The reason I chose to use that format is it seems possible that
there will need to be a way to remove an equivilant key at some point in
the future. I don't know why that would be necessary, but it seemed wise
to allow for the possibility.
Downloads of VURL keys from other special remotes that claim urls,
like bittorrent for example, does not popilate the equivilant key log.
So for now, no checksum verification will be done for those.
Sponsored-by: Nicholas Golder-Manning on Patreon
2024-02-29 19:41:57 +00:00
|
|
|
{- This is a strict parser for security reasons; in addition to keyName,
|
|
|
|
- a key can contain only 4 fields, which all consist only of numbers.
|
2019-11-22 20:24:04 +00:00
|
|
|
- Any key containing other fields, or non-numeric data will fail
|
|
|
|
- to parse.
|
|
|
|
-
|
add equivilant key log for VURL keys
When downloading a VURL from the web, make sure that the equivilant key
log is populated.
Unfortunately, this does not hash the content while it's being
downloaded from the web. There is not an interface in Backend currently
for incrementally hash generation, only for incremental verification of an
existing hash. So this might add a noticiable delay, and it has to show
a "(checksum...") message. This could stand to be improved.
But, that separate hashing step only has to happen on the first download
of new content from the web. Once the hash is known, the VURL key can have
its hash verified incrementally while downloading except when the
content in the web has changed. (Doesn't happen yet because
verifyKeyContentIncrementally is not implemented yet for VURL keys.)
Note that the equivilant key log file is formatted as a presence log.
This adds a tiny bit of overhead (eg "1 ") per line over just listing the
urls. The reason I chose to use that format is it seems possible that
there will need to be a way to remove an equivilant key at some point in
the future. I don't know why that would be necessary, but it seemed wise
to allow for the possibility.
Downloads of VURL keys from other special remotes that claim urls,
like bittorrent for example, does not popilate the equivilant key log.
So for now, no checksum verification will be done for those.
Sponsored-by: Nicholas Golder-Manning on Patreon
2024-02-29 19:41:57 +00:00
|
|
|
- If a key contained other non-numeric fields, they could be used to
|
2019-11-22 20:24:04 +00:00
|
|
|
- embed data used in a SHA1 collision attack, which would be a
|
|
|
|
- problem since the keys are committed to git.
|
|
|
|
-}
|
|
|
|
keyParser :: A.Parser Key
|
|
|
|
keyParser = do
|
|
|
|
-- key variety cannot be empty
|
|
|
|
v <- (parseKeyVariety <$> A8.takeWhile1 (/= fieldSep))
|
|
|
|
s <- parsesize
|
|
|
|
m <- parsemtime
|
|
|
|
cs <- parsechunksize
|
|
|
|
cn <- parsechunknum
|
|
|
|
_ <- A8.char fieldSep
|
|
|
|
_ <- A8.char fieldSep
|
|
|
|
n <- A.takeByteString
|
|
|
|
if validKeyName v n
|
|
|
|
then
|
|
|
|
let d = Key
|
2021-10-06 00:20:08 +00:00
|
|
|
{ keyName = S.toShort n
|
2019-11-22 20:24:04 +00:00
|
|
|
, keyVariety = v
|
|
|
|
, keySize = s
|
|
|
|
, keyMtime = m
|
|
|
|
, keyChunkSize = cs
|
|
|
|
, keyChunkNum = cn
|
|
|
|
}
|
|
|
|
in pure $ MkKey d (mkKeySerialization d)
|
|
|
|
else fail "invalid keyName"
|
|
|
|
where
|
|
|
|
parseopt p = (Just <$> (A8.char fieldSep *> p)) <|> pure Nothing
|
|
|
|
parsesize = parseopt $ A8.char 's' *> A8.decimal
|
|
|
|
parsemtime = parseopt $ CTime <$> (A8.char 'm' *> A8.decimal)
|
|
|
|
parsechunksize = parseopt $ A8.char 'S' *> A8.decimal
|
|
|
|
parsechunknum = parseopt $ A8.char 'C' *> A8.decimal
|
|
|
|
|
|
|
|
{- Limits the length of the extension in the keyName to mitigate against
|
|
|
|
- SHA1 collision attacks.
|
|
|
|
-
|
|
|
|
- In such an attack, the extension of the key could be made to contain
|
|
|
|
- the collision generation data, with the result that a signed git commit
|
|
|
|
- including such keys would not be secure.
|
|
|
|
-
|
|
|
|
- The maximum extension length ever generated for such a key was 8
|
|
|
|
- characters, but they may be unicode which could use up to 4 bytes each,
|
|
|
|
- so 32 bytes. 64 bytes is used here to give a little future wiggle-room.
|
|
|
|
- The SHA1 common-prefix attack needs 128 bytes of data.
|
|
|
|
-}
|
|
|
|
validKeyName :: KeyVariety -> S.ByteString -> Bool
|
|
|
|
validKeyName kv name
|
|
|
|
| hasExt kv =
|
|
|
|
let ext = snd $ splitKeyNameExtension' name
|
|
|
|
in S.length ext <= 64
|
|
|
|
| otherwise = True
|
|
|
|
|
|
|
|
{- This splits any extension out of the keyName, returning the
|
|
|
|
- keyName minus extension, and the extension (including leading dot).
|
|
|
|
-}
|
|
|
|
splitKeyNameExtension :: Key -> (S.ByteString, S.ByteString)
|
2021-10-06 00:20:08 +00:00
|
|
|
splitKeyNameExtension = splitKeyNameExtension' . S.fromShort . keyName . keyData
|
2019-11-22 20:24:04 +00:00
|
|
|
|
|
|
|
splitKeyNameExtension' :: S.ByteString -> (S.ByteString, S.ByteString)
|
|
|
|
splitKeyNameExtension' keyname = S8.span (/= '.') keyname
|
|
|
|
|
2013-07-04 06:36:02 +00:00
|
|
|
{- A filename may be associated with a Key. -}
|
2019-11-26 19:27:22 +00:00
|
|
|
newtype AssociatedFile = AssociatedFile (Maybe RawFilePath)
|
new protocol for transferkeys, with message serialization
Necessarily threw out the old protocol, so if an old git-annex assistant
is running, and starts a transferkeys from the new git-annex, it would
fail. But, that seems unlikely; the assistant starts up transferkeys
processes and then keeps them running. Still, may need to test that
scenario.
The new protocol is simple read/show and looks like this:
TransferRequest Download (Right "origin") (Key {keyName = "f8f8766a836fb6120abf4d5328ce8761404e437529e997aaa0363bdd4fecd7bb", keyVariety = SHA2Key (HashSize 256) (HasExt True), keySize = Just 30, keyMtime = Nothing, keyChunkSize = Nothing, keyChunkNum = Nothing}) (AssociatedFile (Just "foo"))
TransferOutput (ProgressMeter (Just 30) (MeterState {meterBytesProcessed = BytesProcessed 0, meterTimeStamp = 1.6070268727892535e9}) (MeterState {meterBytesProcessed = BytesProcessed 30, meterTimeStamp = 1.6070268728043e9}))
TransferOutput (OutputMessage "(checksum...) ")
TransferResult True
Granted, this is not optimally fast, but it seems good enough, and is
probably nearly as fast as the old protocol anyhow.
emitSerializedOutput for ProgressMeter is not yet implemented. It needs
to somehow start or update a progress meter. There may need to be a new
message that allocates a progress meter, and then have ProgressMeter
update it.
This commit was sponsored by Ethan Aubin
2020-12-03 20:21:20 +00:00
|
|
|
deriving (Show, Read, Eq, Ord)
|
2017-02-24 19:16:56 +00:00
|
|
|
|
2019-01-16 20:33:08 +00:00
|
|
|
{- There are several different varieties of keys. -}
|
2017-02-24 19:16:56 +00:00
|
|
|
data KeyVariety
|
2019-01-16 20:33:08 +00:00
|
|
|
= SHA2Key HashSize HasExt
|
|
|
|
| SHA3Key HashSize HasExt
|
|
|
|
| SKEINKey HashSize HasExt
|
|
|
|
| Blake2bKey HashSize HasExt
|
2019-07-05 19:29:00 +00:00
|
|
|
| Blake2bpKey HashSize HasExt
|
2019-01-16 20:33:08 +00:00
|
|
|
| Blake2sKey HashSize HasExt
|
|
|
|
| Blake2spKey HashSize HasExt
|
|
|
|
| SHA1Key HasExt
|
|
|
|
| MD5Key HasExt
|
2017-02-24 19:16:56 +00:00
|
|
|
| WORMKey
|
|
|
|
| URLKey
|
2024-02-29 17:26:06 +00:00
|
|
|
| VURLKey
|
2024-05-07 17:42:12 +00:00
|
|
|
| GitBundleKey
|
2020-07-29 19:23:18 +00:00
|
|
|
-- A key that is handled by some external backend.
|
|
|
|
| ExternalKey S.ByteString HasExt
|
2017-02-24 19:16:56 +00:00
|
|
|
-- Some repositories may contain keys of other varieties,
|
|
|
|
-- which can still be processed to some extent.
|
2019-01-11 17:55:00 +00:00
|
|
|
| OtherKey S.ByteString
|
2019-10-29 19:16:15 +00:00
|
|
|
deriving (Eq, Ord, Read, Show, Generic)
|
|
|
|
|
|
|
|
instance NFData KeyVariety
|
2017-02-24 19:16:56 +00:00
|
|
|
|
|
|
|
{- Some varieties of keys may contain an extension at the end of the
|
|
|
|
- keyName -}
|
|
|
|
newtype HasExt = HasExt Bool
|
2019-10-29 19:16:15 +00:00
|
|
|
deriving (Eq, Ord, Read, Show, Generic)
|
|
|
|
|
|
|
|
instance NFData HasExt
|
2017-02-24 19:16:56 +00:00
|
|
|
|
|
|
|
newtype HashSize = HashSize Int
|
2019-10-29 19:16:15 +00:00
|
|
|
deriving (Eq, Ord, Read, Show, Generic)
|
|
|
|
|
|
|
|
instance NFData HashSize
|
2017-02-24 19:16:56 +00:00
|
|
|
|
|
|
|
hasExt :: KeyVariety -> Bool
|
2019-01-16 20:33:08 +00:00
|
|
|
hasExt (SHA2Key _ (HasExt b)) = b
|
|
|
|
hasExt (SHA3Key _ (HasExt b)) = b
|
|
|
|
hasExt (SKEINKey _ (HasExt b)) = b
|
|
|
|
hasExt (Blake2bKey _ (HasExt b)) = b
|
2019-07-05 19:29:00 +00:00
|
|
|
hasExt (Blake2bpKey _ (HasExt b)) = b
|
2019-01-16 20:33:08 +00:00
|
|
|
hasExt (Blake2sKey _ (HasExt b)) = b
|
|
|
|
hasExt (Blake2spKey _ (HasExt b)) = b
|
|
|
|
hasExt (SHA1Key (HasExt b)) = b
|
|
|
|
hasExt (MD5Key (HasExt b)) = b
|
2017-02-24 19:16:56 +00:00
|
|
|
hasExt WORMKey = False
|
|
|
|
hasExt URLKey = False
|
2024-02-29 17:26:06 +00:00
|
|
|
hasExt VURLKey = False
|
2024-05-07 17:42:12 +00:00
|
|
|
hasExt GitBundleKey = False
|
2020-07-29 19:23:18 +00:00
|
|
|
hasExt (ExternalKey _ (HasExt b)) = b
|
2019-01-11 17:55:00 +00:00
|
|
|
hasExt (OtherKey s) = (snd <$> S8.unsnoc s) == Just 'E'
|
2017-02-24 19:16:56 +00:00
|
|
|
|
|
|
|
sameExceptExt :: KeyVariety -> KeyVariety -> Bool
|
2019-01-16 20:33:08 +00:00
|
|
|
sameExceptExt (SHA2Key sz1 _) (SHA2Key sz2 _) = sz1 == sz2
|
|
|
|
sameExceptExt (SHA3Key sz1 _) (SHA3Key sz2 _) = sz1 == sz2
|
|
|
|
sameExceptExt (SKEINKey sz1 _) (SKEINKey sz2 _) = sz1 == sz2
|
|
|
|
sameExceptExt (Blake2bKey sz1 _) (Blake2bKey sz2 _) = sz1 == sz2
|
2019-07-05 19:29:00 +00:00
|
|
|
sameExceptExt (Blake2bpKey sz1 _) (Blake2bpKey sz2 _) = sz1 == sz2
|
2019-01-16 20:33:08 +00:00
|
|
|
sameExceptExt (Blake2sKey sz1 _) (Blake2sKey sz2 _) = sz1 == sz2
|
|
|
|
sameExceptExt (Blake2spKey sz1 _) (Blake2spKey sz2 _) = sz1 == sz2
|
|
|
|
sameExceptExt (SHA1Key _) (SHA1Key _) = True
|
|
|
|
sameExceptExt (MD5Key _) (MD5Key _) = True
|
2017-02-24 19:16:56 +00:00
|
|
|
sameExceptExt _ _ = False
|
|
|
|
|
2019-01-11 17:55:00 +00:00
|
|
|
formatKeyVariety :: KeyVariety -> S.ByteString
|
2017-02-24 19:16:56 +00:00
|
|
|
formatKeyVariety v = case v of
|
2019-01-16 20:33:08 +00:00
|
|
|
SHA2Key sz e -> adde e (addsz sz "SHA")
|
|
|
|
SHA3Key sz e -> adde e (addsz sz "SHA3_")
|
|
|
|
SKEINKey sz e -> adde e (addsz sz "SKEIN")
|
|
|
|
Blake2bKey sz e -> adde e (addsz sz "BLAKE2B")
|
2019-07-05 19:29:00 +00:00
|
|
|
Blake2bpKey sz e -> adde e (addsz sz "BLAKE2BP")
|
2019-01-16 20:33:08 +00:00
|
|
|
Blake2sKey sz e -> adde e (addsz sz "BLAKE2S")
|
|
|
|
Blake2spKey sz e -> adde e (addsz sz "BLAKE2SP")
|
|
|
|
SHA1Key e -> adde e "SHA1"
|
|
|
|
MD5Key e -> adde e "MD5"
|
2017-02-24 19:16:56 +00:00
|
|
|
WORMKey -> "WORM"
|
|
|
|
URLKey -> "URL"
|
2024-02-29 17:26:06 +00:00
|
|
|
VURLKey -> "VURL"
|
2024-05-07 17:42:12 +00:00
|
|
|
GitBundleKey -> "GITBUNDLE"
|
2020-07-29 19:23:18 +00:00
|
|
|
ExternalKey s e -> adde e ("X" <> s)
|
2017-02-24 19:16:56 +00:00
|
|
|
OtherKey s -> s
|
|
|
|
where
|
|
|
|
adde (HasExt False) s = s
|
2019-01-11 17:55:00 +00:00
|
|
|
adde (HasExt True) s = s <> "E"
|
2019-01-16 20:33:08 +00:00
|
|
|
addsz (HashSize n) s = s <> case n of
|
|
|
|
256 -> "256"
|
|
|
|
512 -> "512"
|
|
|
|
224 -> "224"
|
|
|
|
384 -> "384"
|
|
|
|
160 -> "160"
|
|
|
|
-- This is relatively slow, which is why the common hash
|
|
|
|
-- sizes are hardcoded above.
|
|
|
|
_ -> S8.pack (show n)
|
2017-02-24 19:16:56 +00:00
|
|
|
|
2019-01-11 17:55:00 +00:00
|
|
|
parseKeyVariety :: S.ByteString -> KeyVariety
|
2019-01-16 20:33:08 +00:00
|
|
|
parseKeyVariety "SHA256" = SHA2Key (HashSize 256) (HasExt False)
|
|
|
|
parseKeyVariety "SHA256E" = SHA2Key (HashSize 256) (HasExt True)
|
|
|
|
parseKeyVariety "SHA512" = SHA2Key (HashSize 512) (HasExt False)
|
|
|
|
parseKeyVariety "SHA512E" = SHA2Key (HashSize 512) (HasExt True)
|
|
|
|
parseKeyVariety "SHA224" = SHA2Key (HashSize 224) (HasExt False)
|
|
|
|
parseKeyVariety "SHA224E" = SHA2Key (HashSize 224) (HasExt True)
|
|
|
|
parseKeyVariety "SHA384" = SHA2Key (HashSize 384) (HasExt False)
|
|
|
|
parseKeyVariety "SHA384E" = SHA2Key (HashSize 384) (HasExt True)
|
|
|
|
parseKeyVariety "SHA3_512" = SHA3Key (HashSize 512) (HasExt False)
|
|
|
|
parseKeyVariety "SHA3_512E" = SHA3Key (HashSize 512) (HasExt True)
|
|
|
|
parseKeyVariety "SHA3_384" = SHA3Key (HashSize 384) (HasExt False)
|
|
|
|
parseKeyVariety "SHA3_384E" = SHA3Key (HashSize 384) (HasExt True)
|
|
|
|
parseKeyVariety "SHA3_256" = SHA3Key (HashSize 256) (HasExt False)
|
|
|
|
parseKeyVariety "SHA3_256E" = SHA3Key (HashSize 256) (HasExt True)
|
|
|
|
parseKeyVariety "SHA3_224" = SHA3Key (HashSize 224) (HasExt False)
|
|
|
|
parseKeyVariety "SHA3_224E" = SHA3Key (HashSize 224) (HasExt True)
|
|
|
|
parseKeyVariety "SKEIN512" = SKEINKey (HashSize 512) (HasExt False)
|
|
|
|
parseKeyVariety "SKEIN512E" = SKEINKey (HashSize 512) (HasExt True)
|
|
|
|
parseKeyVariety "SKEIN256" = SKEINKey (HashSize 256) (HasExt False)
|
|
|
|
parseKeyVariety "SKEIN256E" = SKEINKey (HashSize 256) (HasExt True)
|
|
|
|
parseKeyVariety "BLAKE2B160" = Blake2bKey (HashSize 160) (HasExt False)
|
|
|
|
parseKeyVariety "BLAKE2B160E" = Blake2bKey (HashSize 160) (HasExt True)
|
|
|
|
parseKeyVariety "BLAKE2B224" = Blake2bKey (HashSize 224) (HasExt False)
|
|
|
|
parseKeyVariety "BLAKE2B224E" = Blake2bKey (HashSize 224) (HasExt True)
|
|
|
|
parseKeyVariety "BLAKE2B256" = Blake2bKey (HashSize 256) (HasExt False)
|
|
|
|
parseKeyVariety "BLAKE2B256E" = Blake2bKey (HashSize 256) (HasExt True)
|
|
|
|
parseKeyVariety "BLAKE2B384" = Blake2bKey (HashSize 384) (HasExt False)
|
|
|
|
parseKeyVariety "BLAKE2B384E" = Blake2bKey (HashSize 384) (HasExt True)
|
|
|
|
parseKeyVariety "BLAKE2B512" = Blake2bKey (HashSize 512) (HasExt False)
|
|
|
|
parseKeyVariety "BLAKE2B512E" = Blake2bKey (HashSize 512) (HasExt True)
|
2019-07-05 19:29:00 +00:00
|
|
|
parseKeyVariety "BLAKE2BP512" = Blake2bpKey (HashSize 512) (HasExt False)
|
|
|
|
parseKeyVariety "BLAKE2BP512E" = Blake2bpKey (HashSize 512) (HasExt True)
|
2019-01-16 20:33:08 +00:00
|
|
|
parseKeyVariety "BLAKE2S160" = Blake2sKey (HashSize 160) (HasExt False)
|
|
|
|
parseKeyVariety "BLAKE2S160E" = Blake2sKey (HashSize 160) (HasExt True)
|
|
|
|
parseKeyVariety "BLAKE2S224" = Blake2sKey (HashSize 224) (HasExt False)
|
|
|
|
parseKeyVariety "BLAKE2S224E" = Blake2sKey (HashSize 224) (HasExt True)
|
|
|
|
parseKeyVariety "BLAKE2S256" = Blake2sKey (HashSize 256) (HasExt False)
|
|
|
|
parseKeyVariety "BLAKE2S256E" = Blake2sKey (HashSize 256) (HasExt True)
|
|
|
|
parseKeyVariety "BLAKE2SP224" = Blake2spKey (HashSize 224) (HasExt False)
|
|
|
|
parseKeyVariety "BLAKE2SP224E" = Blake2spKey (HashSize 224) (HasExt True)
|
|
|
|
parseKeyVariety "BLAKE2SP256" = Blake2spKey (HashSize 256) (HasExt False)
|
|
|
|
parseKeyVariety "BLAKE2SP256E" = Blake2spKey (HashSize 256) (HasExt True)
|
2020-07-29 19:23:18 +00:00
|
|
|
parseKeyVariety "SHA1" = SHA1Key (HasExt False)
|
|
|
|
parseKeyVariety "SHA1E" = SHA1Key (HasExt True)
|
|
|
|
parseKeyVariety "MD5" = MD5Key (HasExt False)
|
|
|
|
parseKeyVariety "MD5E" = MD5Key (HasExt True)
|
|
|
|
parseKeyVariety "WORM" = WORMKey
|
|
|
|
parseKeyVariety "URL" = URLKey
|
2024-02-29 17:26:06 +00:00
|
|
|
parseKeyVariety "VURL" = VURLKey
|
2024-05-07 17:42:12 +00:00
|
|
|
parseKeyVariety "GITBUNDLE" = GitBundleKey
|
2020-07-29 19:23:18 +00:00
|
|
|
parseKeyVariety b
|
|
|
|
| "X" `S.isPrefixOf` b =
|
|
|
|
let b' = S.tail b
|
2020-07-31 20:11:50 +00:00
|
|
|
in if not (S.null b') && S.last b' == fromIntegral (ord 'E')
|
2020-07-29 19:23:18 +00:00
|
|
|
then ExternalKey (S.init b') (HasExt True)
|
|
|
|
else ExternalKey b' (HasExt False)
|
|
|
|
| otherwise = OtherKey b
|