-- S2K.hs: OpenPGP (RFC4880) string-to-key conversion
-- Copyright © 2013-2016  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).
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
. HasCallStack => ByteString -> ByteString
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 a b.
StateT (Int, ByteString) Identity a
-> (a -> StateT (Int, ByteString) Identity b)
-> StateT (Int, ByteString) Identity b
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 a b.
StateT (a, ByteString) Identity a
-> (a -> StateT (a, ByteString) Identity b)
-> StateT (a, ByteString) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(a
_, ByteString
bs) -> Bool -> StateT (a, ByteString) Identity Bool
forall a. a -> StateT (a, ByteString) Identity a
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"