module Codec.Encryption.OpenPGP.S2K
( string2Key
, skesk2Key
) where
import Codec.Encryption.OpenPGP.BlockCipher (keySize)
import Codec.Encryption.OpenPGP.Types
import Control.Monad.Loops (untilM_)
import Control.Monad.Trans.State.Lazy (execState, get, put)
import qualified Crypto.Hash as CH
import qualified Data.ByteArray as BA
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
string2Key :: S2K -> Int -> BL.ByteString -> B.ByteString
string2Key :: S2K -> Int -> ByteString -> ByteString
string2Key (Simple HashAlgorithm
ha) Int
ksz ByteString
bs = Int -> ByteString -> ByteString
B.take (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ksz) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ HashAlgorithm -> Int -> ByteString -> ByteString
hashpp HashAlgorithm
ha Int
ksz ByteString
bs
string2Key (Salted HashAlgorithm
ha Salt
salt) Int
ksz ByteString
bs =
S2K -> Int -> ByteString -> ByteString
string2Key (HashAlgorithm -> S2K
Simple HashAlgorithm
ha) Int
ksz (ByteString -> ByteString -> ByteString
BL.append (ByteString -> ByteString
BL.fromStrict (Salt -> ByteString
unSalt Salt
salt)) ByteString
bs)
string2Key (IteratedSalted HashAlgorithm
ha Salt
salt IterationCount
cnt) Int
ksz ByteString
bs =
S2K -> Int -> ByteString -> ByteString
string2Key
(HashAlgorithm -> S2K
Simple HashAlgorithm
ha)
Int
ksz
(Int64 -> ByteString -> ByteString
BL.take (IterationCount -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral IterationCount
cnt) (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.cycle (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
ByteString -> ByteString -> ByteString
BL.append (ByteString -> ByteString
BL.fromStrict (Salt -> ByteString
unSalt Salt
salt)) ByteString
bs)
string2Key S2K
_ Int
_ ByteString
_ = [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"FIXME: unimplemented S2K type"
skesk2Key :: SKESK -> BL.ByteString -> B.ByteString
skesk2Key :: SKESK -> ByteString -> ByteString
skesk2Key (SKESK PacketVersion
4 SymmetricAlgorithm
sa S2K
s2k Maybe ByteString
Nothing) ByteString
pass = S2K -> Int -> ByteString -> ByteString
string2Key S2K
s2k (SymmetricAlgorithm -> Int
keySize SymmetricAlgorithm
sa) ByteString
pass
skesk2Key SKESK
_ ByteString
_ = [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"FIXME"
hashpp :: HashAlgorithm -> Int -> BL.ByteString -> B.ByteString
hashpp :: HashAlgorithm -> Int -> ByteString -> ByteString
hashpp HashAlgorithm
ha Int
keysize ByteString
pp =
(Int, ByteString) -> ByteString
forall a b. (a, b) -> b
snd (State (Int, ByteString) ()
-> (Int, ByteString) -> (Int, ByteString)
forall s a. State s a -> s -> s
execState (State (Int, ByteString) ()
hashround State (Int, ByteString) ()
-> StateT (Int, ByteString) Identity Bool
-> State (Int, ByteString) ()
forall (m :: * -> *) a. Monad m => m a -> m Bool -> m ()
`untilM_` StateT (Int, ByteString) Identity Bool
forall {a}. StateT (a, ByteString) Identity Bool
bigEnough) (Int
0, ByteString
B.empty))
where
hashround :: State (Int, ByteString) ()
hashround =
StateT (Int, ByteString) Identity (Int, ByteString)
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT (Int, ByteString) Identity (Int, ByteString)
-> ((Int, ByteString) -> State (Int, ByteString) ())
-> State (Int, ByteString) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Int
ctr, ByteString
bs) ->
(Int, ByteString) -> State (Int, ByteString) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Int
ctr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, ByteString
bs ByteString -> ByteString -> ByteString
`B.append` HashAlgorithm -> ByteString -> ByteString
hf HashAlgorithm
ha (Int -> ByteString
nulpad Int
ctr ByteString -> ByteString -> ByteString
`BL.append` ByteString
pp))
nulpad :: Int -> ByteString
nulpad = [PacketVersion] -> ByteString
BL.pack ([PacketVersion] -> ByteString)
-> (Int -> [PacketVersion]) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> PacketVersion -> [PacketVersion])
-> PacketVersion -> Int -> [PacketVersion]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> PacketVersion -> [PacketVersion]
forall a. Int -> a -> [a]
replicate PacketVersion
0
bigEnough :: StateT (a, ByteString) Identity Bool
bigEnough = StateT (a, ByteString) Identity (a, ByteString)
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT (a, ByteString) Identity (a, ByteString)
-> ((a, ByteString) -> StateT (a, ByteString) Identity Bool)
-> StateT (a, ByteString) Identity Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(a
_, ByteString
bs) -> Bool -> StateT (a, ByteString) Identity Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
keysize)
hf :: HashAlgorithm -> BL.ByteString -> B.ByteString
hf :: HashAlgorithm -> ByteString -> ByteString
hf HashAlgorithm
SHA1 ByteString
bs = Digest SHA1 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ByteString -> Digest SHA1
forall a. HashAlgorithm a => ByteString -> Digest a
CH.hashlazy ByteString
bs :: CH.Digest CH.SHA1)
hf HashAlgorithm
SHA512 ByteString
bs = Digest SHA512 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ByteString -> Digest SHA512
forall a. HashAlgorithm a => ByteString -> Digest a
CH.hashlazy ByteString
bs :: CH.Digest CH.SHA512)
hf HashAlgorithm
_ ByteString
_ = [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"FIXME: unimplemented S2K hash"