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 ha :: HashAlgorithm
ha) ksz :: Int
ksz bs :: 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 ha :: HashAlgorithm
ha salt :: Salt
salt) ksz :: Int
ksz bs :: 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 ha :: HashAlgorithm
ha salt :: Salt
salt cnt :: IterationCount
cnt) ksz :: Int
ksz bs :: 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 _ _ _ = [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error "FIXME: unimplemented S2K type"
skesk2Key :: SKESK -> BL.ByteString -> B.ByteString
skesk2Key :: SKESK -> ByteString -> ByteString
skesk2Key (SKESK 4 sa :: SymmetricAlgorithm
sa s2k :: S2K
s2k Nothing) pass :: ByteString
pass = S2K -> Int -> ByteString -> ByteString
string2Key S2K
s2k (SymmetricAlgorithm -> Int
keySize SymmetricAlgorithm
sa) ByteString
pass
skesk2Key _ _ = [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error "FIXME"
hashpp :: HashAlgorithm -> Int -> BL.ByteString -> B.ByteString
hashpp :: HashAlgorithm -> Int -> ByteString -> ByteString
hashpp ha :: HashAlgorithm
ha keysize :: Int
keysize pp :: 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) (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
>>= \(ctr :: Int
ctr, bs :: 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
+ 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 = [Word8] -> ByteString
BL.pack ([Word8] -> ByteString) -> (Int -> [Word8]) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Word8 -> [Word8]) -> Word8 -> Int -> [Word8]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Word8 -> [Word8]
forall a. Int -> a -> [a]
replicate 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
>>= \(_, bs :: 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 SHA1 bs :: 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 SHA512 bs :: 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 _ _ = [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error "FIXME: unimplemented S2K hash"