    -- 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"