-- 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 (Simple ha) ksz bs = B.take (fromIntegral ksz) $ hashpp ha ksz bs
string2Key (Salted ha salt) ksz bs =
  string2Key (Simple ha) ksz (BL.append (BL.fromStrict (unSalt salt)) bs)
string2Key (IteratedSalted ha salt cnt) ksz bs =
  string2Key
    (Simple ha)
    ksz
    (BL.take (fromIntegral cnt) . BL.cycle $
     BL.append (BL.fromStrict (unSalt salt)) bs)
string2Key _ _ _ = error "FIXME: unimplemented S2K type"

skesk2Key :: SKESK -> BL.ByteString -> B.ByteString
skesk2Key (SKESK 4 sa s2k Nothing) pass = string2Key s2k (keySize sa) pass
skesk2Key _ _ = error "FIXME"

hashpp :: HashAlgorithm -> Int -> BL.ByteString -> B.ByteString
hashpp ha keysize pp =
  snd (execState (hashround `untilM_` bigEnough) (0, B.empty))
  where
    hashround =
      get >>= \(ctr, bs) ->
        put (ctr + 1, bs `B.append` hf ha (nulpad ctr `BL.append` pp))
    nulpad = BL.pack . flip replicate 0
    bigEnough = get >>= \(_, bs) -> return (B.length bs >= keysize)
    hf :: HashAlgorithm -> BL.ByteString -> B.ByteString
    hf SHA1 bs = BA.convert (CH.hashlazy bs :: CH.Digest CH.SHA1)
    hf SHA512 bs = BA.convert (CH.hashlazy bs :: CH.Digest CH.SHA512)
    hf _ _ = error "FIXME: unimplemented S2K hash"