Modified.hs

{-# LANGUAGE DeriveDataTypeable #-}

-- |
-- Module      : Crypto.PubKey.Rabin.Modified
-- License     : BSD-style
-- Maintainer  : Carlos Rodriguez-Vega <crodveg@yahoo.es>
-- Stability   : experimental
-- Portability : unknown
--
-- Modified-Rabin public-key digital signature algorithm.
-- See algorithm 11.30 in "Handbook of Applied Cryptography" by Alfred J. Menezes et al.
-- The Jacobi symbols here are taken modulo the public modulus, not the
-- private primes, so what "Crypto.PubKey.Rabin.Basic" says about that does
-- not apply; the note there about 'Integer' arithmetic does.
module Crypto.PubKey.Rabin.Modified (
    PublicKey (..),
    PrivateKey (..),
    generate,
    sign,
    verify,
) where

import Crypto.Debug (DebugShow (..))
import Data.ByteString
import Data.Data

import Crypto.Hash
import Crypto.Number.ModArithmetic (expSafe, jacobi)
import Crypto.Number.Serialize (os2ip)
import Crypto.PubKey.Rabin.Types
import Crypto.Random.Types

-- | Represent a Modified-Rabin public key.
data PublicKey = PublicKey
    { public_size :: Int
    -- ^ size of key in bytes
    , public_n :: Integer
    -- ^ public p*q
    }
    deriving (Show, Read, Eq, Data)

-- | Represent a Modified-Rabin private key.
data PrivateKey = PrivateKey
    { private_pub :: PublicKey
    , private_p :: Integer
    -- ^ p prime number
    , private_q :: Integer
    -- ^ q prime number
    , private_d :: Integer
    }
    deriving (Read, Eq, Data)

-- | The public part is shown; the secret fields are not.  Use
-- 'Crypto.Debug.debugShow' to see them.
instance Show PrivateKey where
    showsPrec d k =
        showParen (d > 10) $
            showString "PrivateKey {private_pub = "
                . shows (private_pub k)
                . showString ", private_p = <secret>, private_q = <secret>, private_d = <secret>}"

instance DebugShow PrivateKey where
    debugShow k =
        showString "PrivateKey {private_pub = "
            . shows (private_pub k)
            . showString ", private_p = "
            . shows (private_p k)
            . showString ", private_q = "
            . shows (private_q k)
            . showString ", private_d = "
            . shows (private_d k)
            . showChar '}'
            $ ""

-- | Generate a pair of (private, public) key of size in bytes.
-- Prime p is congruent 3 mod 8 and prime q is congruent 7 mod 8.
generate
    :: MonadRandom m
    => Int
    -> m (PublicKey, PrivateKey)
generate size = do
    (p, q) <- generatePrimes size (\p -> p `mod` 8 == 3) (\q -> q `mod` 8 == 7)
    return $ generateKeys p q
  where
    generateKeys p q =
        let n = p * q
            d = (n - p - q + 5) `div` 8
            publicKey =
                PublicKey
                    { public_size = size
                    , public_n = n
                    }
            privateKey =
                PrivateKey
                    { private_pub = publicKey
                    , private_p = p
                    , private_q = q
                    , private_d = d
                    }
         in (publicKey, privateKey)

-- | Sign message using hash algorithm and private key.
sign
    :: HashAlgorithm hash
    => PrivateKey
    -- ^ private key
    -> hash
    -- ^ hash function
    -> ByteString
    -- ^ message to sign
    -> Either Error Integer
sign pk hashAlg m =
    let d = private_d pk
        n = public_n $ private_pub pk
        h = os2ip $ hashWith hashAlg m
        limit = (n - 6) `div` 16
     in if h > limit
            then Left MessageTooLong
            else
                let h' = 16 * h + 6
                 in case jacobi h' n of
                        Just 1 -> Right $ expSafe h' d n
                        Just (-1) -> Right $ expSafe (h' `div` 2) d n
                        _ -> Left InvalidParameters

-- | Verify signature using hash algorithm and public key.
verify
    :: HashAlgorithm hash
    => PublicKey
    -- ^ public key
    -> hash
    -- ^ hash function
    -> ByteString
    -- ^ message
    -> Integer
    -- ^ signature
    -> Bool
verify pk hashAlg m s
    -- squaring works modulo n, so s + n and -s would verify wherever s does
    | s < 0 || s >= n = False
    | otherwise = go
  where
    n = public_n pk
    go =
        let h = os2ip $ hashWith hashAlg m
            s' = expSafe s 2 n
            s'' = case s' `mod` 8 of
                6 -> s'
                3 -> 2 * s'
                7 -> n - s'
                2 -> 2 * (n - s')
                _ -> 0
         in case s'' `mod` 16 of
                6 ->
                    let h' = (s'' - 6) `div` 16
                     in h' == h
                _ -> False