-----------------------------------------------------------------------------
-- |
-- Module      :  Codec.Encryption.RSA.MGF
-- Copyright   :  (c) Dominic Steinitz 2003
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Stability   :  experimental
-- Portability :  portable
--
-- Implements the mask generation function as specified in:
-- <ftp://ftp.rsasecurity.com/pub/pkcs/pkcs-1/pkcs-1v2-1.pdf>
--
-----------------------------------------------------------------------------

module Codec.Encryption.RSA.MGF (
   -- * Function Types
   mgf) where

import Codec.Utils (Octet, i2osp)

-- | Take a hash function, a seed and the intended length of the
--   the mask and deliver a mask of the requested length.

mgf :: ([Octet] -> [Octet]) -> [Octet] -> Int -> [Octet]

mgf :: ([Octet] -> [Octet]) -> [Octet] -> Int -> [Octet]
mgf [Octet] -> [Octet]
hash [Octet]
z Int
l =
   forall a. Int -> [a] -> [a]
take Int
l forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ [[Octet]]
hashes
      where
         hashes :: [[Octet]]
hashes = forall a b. (a -> b) -> [a] -> [b]
map Int -> [Octet]
f [Int
0..(Int
l forall a. Integral a => a -> a -> a
`div` Int
hLen)]
         hLen :: Int
hLen   = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ Int -> [Octet]
f Int
0
         f :: Int -> [Octet]
f      = [Octet] -> [Octet]
hash forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Octet]
zforall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Integral a => Int -> a -> [Octet]
i2osp Int
4)