Core.hs (1869B)
1 module Cryptopals.DH.Core ( 2 Group(..) 3 , p 4 , g 5 6 , Keys(..) 7 8 , modexp 9 10 , genpair 11 , derivekey 12 , encodekey 13 ) where 14 15 import Control.Monad.Primitive 16 import qualified Cryptopals.Digest.Pure.SHA as CS 17 import Data.Binary as DB 18 import qualified Data.Bits as B 19 import qualified Data.ByteString as BS 20 import qualified Data.ByteString.Lazy as BL 21 import GHC.Generics (Generic) 22 import Numeric.Natural 23 import qualified System.Random.MWC as MWC 24 25 data Group = Group Natural Natural 26 deriving (Eq, Show, Generic) 27 28 instance DB.Binary Group 29 30 p :: Natural 31 p = 0xffffffffffffffffc90fdaa22168c234c4c6628b80dc1cd129024e088a67cc74020bbea63b139b22514a08798e3404ddef9519b3cd3a431b302b0a6df25f14374fe1356d6d51c245e485b576625e7ec6f44c42e9a637ed6b0bff5cb6f406b7edee386bfb5a899fa5ae9f24117c4b1fe649286651ece45b3dc2007cb8a163bf0598da48361c55d39a69163fa8fd24cf5f83655d23dca3ad961c62f356208552bb9ed529077096966d670c354e4abc9804f1746c08ca237327ffffffffffffffff 32 33 g :: Natural 34 g = 2 35 36 data Keys = Keys { 37 pub :: Natural 38 , sec :: Natural 39 } 40 41 -- modified from https://gist.github.com/trevordixon/6788535 42 modexp :: Natural -> Natural -> Natural -> Natural 43 modexp b e m 44 | e == 0 = 1 45 | otherwise = 46 let t = if B.testBit e 0 then b `mod` m else 1 47 in t * modexp ((b * b) `mod` m) (B.shiftR e 1) m `mod` m 48 49 -- generate public, private keypair 50 genpair 51 :: PrimMonad m 52 => Group 53 -> MWC.Gen (PrimState m) 54 -> m Keys 55 genpair (Group p g) gen = do 56 sk <- fmap (`mod` p) (MWC.uniformRM (1, p - 1) gen) 57 let pk = modexp g sk p 58 pure $ Keys pk sk 59 60 -- derive shared key from secret and other public 61 derivekey :: Group -> Keys -> Natural -> BS.ByteString 62 derivekey (Group p _) Keys {..} pk = 63 let nat = modexp pk sec p 64 in encodekey nat 65 66 encodekey :: Natural -> BS.ByteString 67 encodekey = 68 BS.take 16 69 . BL.toStrict 70 . CS.bytestringDigest 71 . CS.sha1 72 . DB.encode 73