~shreyasminocha/haskell-crypto

62a9fbd59a7790e3a811c75a51e0df94031e6bb4 — Shreyas Minocha 6 months ago fa361b7 main
Replace Int with Integer
M Common.hs => Common.hs +2 -2
@@ 17,8 17,8 @@ toInt c = ord c - ord (base c)
fromInt :: Char -> Int -> Char
fromInt c i = chr $ i + ord (base c)

wmod :: Int -> Int -> Int
wmod :: Integer -> Integer -> Integer
wmod a b = (a + b) `mod` b

multMod :: Int -> Int -> Int -> Int
multMod :: Integer -> Integer -> Integer -> Integer
multMod n a b = ((a `mod` n) * (b `mod` n)) `mod` n

M Crt.hs => Crt.hs +1 -1
@@ 4,7 4,7 @@ import LinearCongruences (baseSolution)

-- solves a system of concurrences using the chinese remainder theorem
-- ama is a list of remainder-modulus tuples
crt :: [(Int, Int)] -> Int
crt :: [(Integer, Integer)] -> Integer
crt [(a, _)] = a
crt ama = c' + (product ms * p)
    where c' = crt ams

M EllipticCurves.hs => EllipticCurves.hs +9 -9
@@ 4,13 4,13 @@ import Data.List (elemIndex)
import Data.Maybe (fromJust)
import LinearCongruences (inverse)

type Point = (Int, Int)
type Curve = (Int, Int)
type Point = (Integer, Integer)
type Curve = (Integer, Integer)

ecdlpBruteforce :: (Int, Curve) -> Point -> Point -> Int
ecdlpBruteforce (p, c) a b = 1 + fromJust (b `elemIndex` pointMultiples (p, c) a)
ecdlpBruteforce :: (Integer, Curve) -> Point -> Point -> Integer
ecdlpBruteforce (p, c) a b = fromIntegral $ 1 + fromJust (b `elemIndex` pointMultiples (p, c) a)

scalePoint :: (Int, Curve) -> Point -> Int -> Point
scalePoint :: (Integer, Curve) -> Point -> Integer -> Point
scalePoint _ _ 0 = (0, 0)
scalePoint _ p1 1 = p1
scalePoint pc p1 n


@@ 22,10 22,10 @@ scalePoint pc p1 n
    where r = scalePoint pc p1 (n `div` 2)
          twiceR = addPoints pc r r

pointMultiples :: (Int, Curve) -> Point -> [Point]
pointMultiples :: (Integer, Curve) -> Point -> [Point]
pointMultiples (p, c) p1 = iterate (addPoints (p, c) p1) p1

addPoints :: (Int, Curve) -> Point -> Point -> Point
addPoints :: (Integer, Curve) -> Point -> Point -> Point
addPoints (p, (a, b)) p1@(x1, y1) p2@(x2, y2)
    | p1 == (0, 0) = p2
    | p2 == (0, 0) = p1


@@ 37,7 37,7 @@ addPoints (p, (a, b)) p1@(x1, y1) p2@(x2, y2)
              then modDiv p (y2 - y1) (x2 - x1)
              else modDiv p (3 * (x1^2) + a) (2 * y1)

canAddPoints :: (Int, Curve) -> Point -> Point -> Bool
canAddPoints :: (Integer, Curve) -> Point -> Point -> Bool
canAddPoints (p, (a, b)) p1@(x1, y1) p2@(x2, y2)
    | p1 == (0, 0) = True
    | p2 == (0, 0) = True


@@ 45,5 45,5 @@ canAddPoints (p, (a, b)) p1@(x1, y1) p2@(x2, y2)
    | p1 /= p2  = gcd p (x2 - x1) == 1
    | otherwise = gcd p (2 * y1) == 1

modDiv :: Int -> Int -> Int -> Int
modDiv :: Integer -> Integer -> Integer -> Integer
modDiv p a b = (a * (inverse p b)) `mod` p

M Factorize.hs => Factorize.hs +6 -6
@@ 1,27 1,27 @@
module Factorize (isPrime, factors, canonicalFactorization) where

isPrime :: Int -> Bool
isPrime :: Integer -> Bool
isPrime n
    | n == 1    = False
    | otherwise = length (factors n) == 1

factors :: Int -> [Int]
factors :: Integer -> [Integer]
factors 0 = [0]
factors 1 = [1]
factors 2 = [2]
factors n = factorsIter 2 n

factorsIter :: Int -> Int -> [Int]
factorsIter :: Integer -> Integer -> [Integer]
factorsIter _ 1 = []
factorsIter i m
    | i > csqrt m    = [m]
    | m `mod` i == 0 = i : factorsIter i (m `div` i)
    | otherwise      = factorsIter (i + 1) m

canonicalFactorization :: Int -> [(Int, Int)]
canonicalFactorization :: Integer -> [(Integer, Integer)]
canonicalFactorization n = cntify $ factors n

cntify :: [Int] -> [(Int, Int)]
cntify :: [Integer] -> [(Integer, Integer)]
cntify [] = []
cntify [n] = [(n, 1)]
cntify (n:ns)


@@ 29,5 29,5 @@ cntify (n:ns)
    | otherwise = (n, 1):(a, cnt):cnss
    where ((a, cnt):cnss) = cntify ns

csqrt :: Int -> Int
csqrt :: Integer -> Integer
csqrt = ceiling . sqrt . fromIntegral

M FactorizeDifferenceSquares.hs => FactorizeDifferenceSquares.hs +4 -4
@@ 1,17 1,17 @@
factorize :: Int -> (Int, Int)
factorize :: Integer -> (Integer, Integer)
factorize n = factorizeWithK n 1 1

factorizeWithK :: Int -> Int -> Int -> (Int, Int)
factorizeWithK :: Integer -> Integer -> Integer -> (Integer, Integer)
factorizeWithK n k bi = (gcd n (sqrtA + b), gcd n (sqrtA - b))
    where sqrtA = floor $ sqrt (fromIntegral a)
          a = (k * n) + b^2
          b = head $ filter (isPerfectSquare . ((k * n) +) . (^2)) [bi..]

isPerfectSquare :: Int -> Bool
isPerfectSquare :: Integer -> Bool
isPerfectSquare x = isInt $ sqrt (fromIntegral x)

isInt :: Float -> Bool
isInt x = x == (fromInteger $ floor x)

csqrt :: Int -> Int
csqrt :: Integer -> Integer
csqrt = ceiling . sqrt . fromIntegral

M FactorizePollards.hs => FactorizePollards.hs +2 -2
@@ 1,8 1,8 @@
import FastPowering (powMod)
import Common (multMod)

factorize :: Int -> Int -> Int
factorize :: Integer -> Integer -> Integer
factorize n a = head $
    filter (\i -> 1 < i && i < n) $
    map ((gcd n) . (subtract 1)) $
    take n $ iterate (multMod n a) a
    take (fromIntegral n) $ iterate (multMod n a) a

M FastPowering.hs => FastPowering.hs +2 -2
@@ 2,7 2,7 @@ module FastPowering where

import LinearCongruences (inverse)

powMod :: Int -> Int -> Int -> Int
powMod :: Integer -> Integer -> Integer -> Integer
powMod _ _ 0 = 1
powMod m x 1 = x `mod` m
powMod m x y


@@ 12,7 12,7 @@ powMod m x y
    where r = powMod m x (y `div` 2)
          t = (r * r) `mod` m

pow :: Int -> Int -> Int
pow :: Integer -> Integer -> Integer
pow _ 0 = 1
pow x 1 = x
pow x y

M Gcd.hs => Gcd.hs +3 -3
@@ 1,6 1,6 @@
module Gcd (egcd) where

gcd' :: Int -> Int -> Int
gcd' :: Integer -> Integer -> Integer
gcd' a 0 = a
gcd' a b
    | a' >= b'  = gcd' b' (a' `mod` b')


@@ 8,12 8,12 @@ gcd' a b
    where a' = abs a
          b' = abs b

lcm' :: Int -> Int -> Int
lcm' :: Integer -> Integer -> Integer
lcm' a b = (a * b) `div` gcd' a b

-- gcd, and int solutions to ax + by = gcd(a, b)
-- returns (gcd a b, x, y)
egcd :: Int -> Int -> (Int, Int, Int)
egcd :: Integer -> Integer -> (Integer, Integer, Integer)
egcd a 0 = (a, 1, 0)
egcd a b = (d', x, y)
    where (d', px, py) = egcd b (a `mod` b)

M Knapsack.hs => Knapsack.hs +3 -3
@@ 1,12 1,12 @@
import LinearCongruences (baseSolution, inverse)

publicToPrivateSequence :: [Int] -> Int -> Int -> [Int]
publicToPrivateSequence :: [Integer] -> Integer -> Integer -> [Integer]
publicToPrivateSequence m b a = map (flip (baseSolution b) a) m

decryptKnapsack :: [Int] -> Int -> Int -> Int -> [Int]
decryptKnapsack :: [Integer] -> Integer -> Integer -> Integer -> [Integer]
decryptKnapsack m b a s = solveKnapsack m (s * (inverse b a) `mod` b)

solveKnapsack :: [Int] -> Int -> [Int]
solveKnapsack :: [Integer] -> Integer -> [Integer]
solveKnapsack [] _ = []
solveKnapsack mm s = (solveKnapsack ms ss) ++ [x]
    where (ms, m) = (init mm, last mm)

M LinearCongruences.hs => LinearCongruences.hs +5 -5
@@ 4,25 4,25 @@ import Gcd (egcd)
import Common (wmod)

-- finds a-inverse modulo m
inverse :: Int -> Int -> Int
inverse :: Integer -> Integer -> Integer
inverse m = baseSolution m 1

-- finds solutions to ax \equiv b mod m
solutions :: Int -> Int -> Int -> [Int]
solutions :: Integer -> Integer -> Integer -> [Integer]
solutions m b a = [x0 + i * (m `div` d) | i <- [0..(d - 1)]]
    where d = gcd a m
          x0 = baseSolution a b m

-- finds a base solution to ax \equiv b mod m
baseSolution :: Int -> Int -> Int -> Int
baseSolution :: Integer -> Integer -> Integer -> Integer
baseSolution m b a = (fst $ solve a' (-m') b') `wmod` m'
    where [a', b', m'] = map (`div` (gcd a m)) [a, b, m]

-- finds solutions (x, y) to ax + by = c
solve :: Int -> Int -> Int -> (Int, Int)
solve :: Integer -> Integer -> Integer -> (Integer, Integer)
solve a b c = (x * (c `div` d), y * (c `div` d))
    where (d, x, y) = egcd a b

-- brute-forces solutions to ax \equiv b mod m
solutionsBf :: Int -> Int -> Int -> [Int]
solutionsBf :: Integer -> Integer -> Integer -> [Integer]
solutionsBf m b a = filter ((== b) . (`mod` m) . (a *)) [0..(m - 1)]

M MillerRabin.hs => MillerRabin.hs +4 -4
@@ 1,19 1,19 @@
import FastPowering (powMod, pow)

-- Miller-Rabin test on `n` with `a` as a witness
isWitness :: Int -> Int -> Bool
isWitness :: Integer -> Integer -> Bool
isWitness n a
    | n `mod` 2 == 0           = True
    | gcd n a `notElem` [1, n] = True
    | aToQ `mod` n == 1        = False
    | otherwise = (n - 1) `notElem` take k (iterate sqModN aToQ)
    | otherwise = (n - 1) `notElem` take (fromIntegral k) (iterate sqModN aToQ)
    where k = ord 2 (n - 1)
          q = n `div` (pow 2 k)
          aToQ = powMod n a q
          sqModN = flip (powMod n) 2

-- Returns the largest `k` such that b^k | n
ord :: Int -> Int -> Int
ord b n = length $
ord :: Integer -> Integer -> Integer
ord b n = fromIntegral $ length $
    takeWhile ((== 0) . (n `mod`)) $
    iterate (* b) b

M PohligHellman.hs => PohligHellman.hs +5 -5
@@ 2,7 2,7 @@ import Crt (crt)
import FastPowering (powMod)
import Factorize (canonicalFactorization)

pohligHellman :: Int -> Int -> Int -> Int
pohligHellman :: Integer -> Integer -> Integer -> Integer
pohligHellman p g h = crt $ zip yis qeis
    where n = ord p g
          qeis = (uncurry $ zipWith (powMod p)) (unzip $ canonicalFactorization n)


@@ 10,16 10,16 @@ pohligHellman p g h = crt $ zip yis qeis
          his = map (powMod p h . (n `div`)) qeis
          yis = zipWith (dlogBruteforce p) gis his

dlogBruteforce :: Int -> Int -> Int -> Int
dlogBruteforce :: Integer -> Integer -> Integer -> Integer
dlogBruteforce = dlogBruteforceIter 1

dlogBruteforceIter :: Int -> Int -> Int -> Int -> Int
dlogBruteforceIter :: Integer -> Integer -> Integer -> Integer -> Integer
dlogBruteforceIter i p g h
    | i == p = 0
    | powMod p g i == h = i
    | otherwise = dlogBruteforceIter (i + 1) p g h

ord :: Int -> Int -> Int
ord :: Integer -> Integer -> Integer
ord p g = head $
    filter ((== 1) . powMod p g) $
    filter ((== 0) . ((p - 1) `mod`)) [1..p - 1]
\ No newline at end of file
    filter ((== 0) . ((p - 1) `mod`)) [1..p - 1]

M QuadraticSieve.hs => QuadraticSieve.hs +6 -6
@@ 1,24 1,24 @@
import Factorize (isPrime)

quadraticSieve :: Int -> Int -> [Int] -> [(Int, Int)]
quadraticSieve :: Integer -> Integer -> [Integer] -> [(Integer, Integer)]
quadraticSieve n b ts = map (\i -> (i, f n i)) thatReduce
    where thatReduce = filter ((== 1) . (sieve (primePowersUpto b)) . (f n)) ts

sieve :: [Int] -> Int -> Int
sieve :: [Integer] -> Integer -> Integer
sieve fs x = foldl reduce x fs

reduce :: Int -> Int -> Int
reduce :: Integer -> Integer -> Integer
reduce n fac
    | n `mod` fac == 0 = reduce (n `div` fac) fac
    | otherwise = n

f :: Int -> Int -> Int
f :: Integer -> Integer -> Integer
f n t = t^2 - n

primePowersUpto :: Int -> [Int]
primePowersUpto :: Integer -> [Integer]
primePowersUpto b = foldl (++) [] $
    map ((takeWhile (<= b)) . powers) primes
    where primes = filter isPrime [1..b]

powers :: Int -> [Int]
powers :: Integer -> [Integer]
powers i = iterate (*i) i

M Rsa.hs => Rsa.hs +4 -4
@@ 1,9 1,9 @@
import FastPowering (powMod)

type PublicKey = (Int, Int)
type PrivateKey = (Int, Int)
type PlainText = Int
type CipherText = Int
type PublicKey = (Integer, Integer)
type PrivateKey = (Integer, Integer)
type PlainText = Integer
type CipherText = Integer

rsaEncrypt :: PublicKey -> PlainText -> CipherText
rsaEncrypt (n, e) m = powMod n m e

M SmoothNumbers.hs => SmoothNumbers.hs +2 -2
@@ 2,8 2,8 @@ import Data.List (all)
import Factorize (factors, canonicalFactorization)
import FastPowering (powMod)

isSmooth :: Int -> Int -> Bool
isSmooth :: Integer -> Integer -> Bool
isSmooth b m = all (<= b) $ factors m

isPowerSmooth :: Int -> Int -> Bool
isPowerSmooth :: Integer -> Integer -> Bool
isPowerSmooth b m = all (<= b) $ map (uncurry (^)) $ canonicalFactorization m