cryptopals

Matasano's cryptopals challenges (cryptopals.com).
git clone git://git.jtobin.io/cryptopals.git
Log | Files | Refs | README | LICENSE

DSA.hs (4431B)

      1 module Cryptopals.DSA (
      2     Params(..)
      3   , defaultParams
      4 
      5   , Keypair(..)
      6   , Key(..)
      7   , keygen
      8 
      9   , Sig(..)
     10   , sign
     11   , sign'
     12   , verify
     13 
     14   , unsafeSign
     15   , unsafeVerify
     16   ) where
     17 
     18 import Control.Monad.Primitive
     19 import qualified Cryptopals.Digest.Pure.SHA as CS
     20 import qualified Cryptopals.DH as DH
     21 import qualified Cryptopals.RSA as RSA
     22 import qualified Data.ByteString as BS
     23 import qualified Data.ByteString.Lazy as BL
     24 import Numeric.Natural
     25 import qualified System.Random.MWC as MWC
     26 
     27 fi :: (Integral a, Num b) => a -> b
     28 fi = fromIntegral
     29 
     30 data Params = Params {
     31     dsap :: Natural
     32   , dsaq :: Natural
     33   , dsag :: Natural
     34   } deriving (Eq, Show)
     35 
     36 p :: Natural
     37 p = 0x800000000000000089e1855218a0e7dac38136ffafa72eda7859f2171e25e65eac698c1702578b07dc2a1076da241c76c62d374d8389ea5aeffd3226a0530cc565f3bf6b50929139ebeac04f48c3c84afb796d61e5a4f9a8fda812ab59494232c7d2b4deb50aa18ee9e132bfa85ac4374d7f9091abc3d015efc871a584471bb1
     38 
     39 q :: Natural
     40 q = 0xf4f47f05794b256174bba6e9b396a7707e563c5b
     41 
     42 g :: Natural
     43 g = 0x5958c9d3898b224b12672c0b98e06c60df923cb8bc999d119458fef538b8fa4046c8db53039db620c094c9fa077ef389b5322a559946a71903f990f1f7e0e025e2d7f7cf494aff1a0470f5b64c36b625a097f1651fe775323556fe00b3608c887892878480e99041be601a62166ca6894bdd41a7054ec89f756ba9fc95302291
     44 
     45 defaultParams :: Params
     46 defaultParams = Params p q g
     47 
     48 data Keypair = Keypair {
     49     sec :: Key
     50   , pub :: Key
     51   } deriving (Eq, Show)
     52 
     53 data Key =
     54     Pub Natural
     55   | Sec Natural
     56   deriving (Eq, Show)
     57 
     58 keygen :: PrimMonad m => Params -> MWC.Gen (PrimState m) -> m Keypair
     59 keygen Params {..} gen = do
     60   x <- MWC.uniformRM (1, dsaq - 1) gen
     61   let y = DH.modexp dsag x dsap
     62   pure $ Keypair (Sec x) (Pub y)
     63 
     64 data Sig = Sig {
     65     sigr :: Natural
     66   , sigs :: Natural
     67   } deriving (Eq, Show)
     68 
     69 sign
     70   :: PrimMonad m
     71   => Params
     72   -> Key
     73   -> BS.ByteString
     74   -> MWC.Gen (PrimState m)
     75   -> m Sig
     76 sign ps@Params {..} key msg gen = case key of
     77   Pub {} -> error "sign: need secret key"
     78   Sec x  -> do
     79     k <- MWC.uniformRM (1, dsaq - 1) gen
     80     let r = DH.modexp dsag k p `rem` dsaq
     81     if   r == 0
     82     then sign ps key msg gen
     83     else do
     84       let h = fi . CS.integerDigest . CS.sha1 $ BL.fromStrict msg
     85           s = (RSA.modinv' k dsaq * (h + x * r)) `rem` dsaq
     86       if   s == 0
     87       then sign ps key msg gen
     88       else pure (Sig r s)
     89 
     90 -- sign with provided subkey/nonce
     91 sign'
     92   :: Params
     93   -> Key
     94   -> Natural
     95   -> BS.ByteString
     96   -> Sig
     97 sign' ps@Params {..} key k msg = case key of
     98   Pub {} -> error "sign: need secret key"
     99   Sec x  ->
    100     let r = DH.modexp dsag k p `rem` dsaq
    101     in  if   r == 0
    102         then error "sign': invalid nonce (r)"
    103         else
    104           let h = fi . CS.integerDigest . CS.sha1 $ BL.fromStrict msg
    105               s = (RSA.modinv' k dsaq * (h + x * r)) `rem` dsaq
    106           in  if   s == 0
    107               then error "sign': invalid nonce (s)"
    108               else Sig r s
    109 
    110 -- don't check for bad signature values
    111 unsafeSign
    112   :: PrimMonad m
    113   => Params
    114   -> Key
    115   -> BS.ByteString
    116   -> MWC.Gen (PrimState m)
    117   -> m Sig
    118 unsafeSign ps@Params {..} key msg gen = case key of
    119   Pub {} -> error "sign: need secret key"
    120   Sec x  -> do
    121     k <- MWC.uniformRM (1, dsaq - 1) gen
    122     let r = DH.modexp dsag k p `rem` dsaq
    123         h = fi . CS.integerDigest . CS.sha1 $ BL.fromStrict msg
    124         s = (RSA.modinv' k dsaq * (h + x * r)) `rem` dsaq
    125     pure (Sig r s)
    126 
    127 verify
    128   :: Params
    129   -> Key
    130   -> BS.ByteString
    131   -> Sig
    132   -> Bool
    133 verify Params {..} key msg Sig {..} = case key of
    134   Sec {} -> error "verify: need public key"
    135   Pub y
    136     | or [sigr == 0, sigr >= dsaq, sigs == 0, sigs >= dsaq] -> False
    137     | otherwise ->
    138         let w  = RSA.modinv' sigs dsaq
    139             h  = fi . CS.integerDigest . CS.sha1 $ BL.fromStrict msg
    140             u1 = (h * w) `rem` dsaq
    141             u2 = (sigr * w) `rem` dsaq
    142             v  = (((DH.modexp dsag u1 dsap) * (DH.modexp y u2 dsap)) `rem` dsap)
    143                    `rem` dsaq
    144         in  v == sigr
    145 
    146 -- don't check for bad signature parameters
    147 unsafeVerify
    148   :: Params
    149   -> Key
    150   -> BS.ByteString
    151   -> Sig
    152   -> Bool
    153 unsafeVerify Params {..} key msg Sig {..} = case key of
    154   Sec {} -> error "verify: need public key"
    155   Pub y  ->
    156     let w  = RSA.modinv' sigs dsaq
    157         h  = fi . CS.integerDigest . CS.sha1 $ BL.fromStrict msg
    158         u1 = (h * w) `rem` dsaq
    159         u2 = (sigr * w) `rem` dsaq
    160         v  = (((DH.modexp dsag u1 dsap) * (DH.modexp y u2 dsap)) `rem` dsap)
    161                `rem` dsaq
    162     in  v == sigr
    163