├── Elliptic.hs └── README.md /Elliptic.hs: -------------------------------------------------------------------------------- 1 | module Elliptic where 2 | 3 | import System.Random (RandomGen , randomR) 4 | import Data.Ix (inRange) 5 | import Control.Applicative ((<$>) , empty) 6 | import Control.Monad.Reader 7 | import Control.Monad.State 8 | import Control.Monad.Trans.Maybe 9 | 10 | --The modular multiplicative inverse via the extended Euclidean algorithm 11 | --When p is prime, then (x * inv x p) `mod` p == 1 12 | inv :: Integer -> Integer -> Integer 13 | inv = xEuclid 1 0 0 1 where 14 | xEuclid x0 y0 x1 y1 u v 15 | | v == 0 = x0 16 | | otherwise = let (q , r) = u `divMod` v 17 | in xEuclid x1 y1 (x0-q*x1) (y0-q*y1) v r 18 | 19 | --Data Structures and Operations on Elliptic Curves 20 | 21 | --Data 22 | 23 | --A point on an elliptic curve either is a pair Point x y or is the point at Infinity 24 | data Point = Point Integer Integer | Infinity deriving (Show,Eq) 25 | 26 | --An elliptic curve is (y^2 - x^3 - a*x^2 - b) `mod` p == 0 with parameters: base point g of order n and cofactor h 27 | data Curve = Curve {aParameter :: Integer, 28 | bParameter :: Integer, 29 | pParameter :: Integer, 30 | gParameter :: Point, 31 | nParameter :: Integer, 32 | hParameter :: Integer} 33 | 34 | --The Standards for Efficient Cryptography recommended elliptic curve domain parameters 35 | secp192k1,secp192r1,secp224k1,secp224r1,secp256k1,secp256r1,secp384r1,secp521r1::Curve 36 | 37 | secp192k1 = Curve 38 | {aParameter = 0x0, 39 | bParameter = 0x3, 40 | pParameter = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFEE37, 41 | gParameter = Point 42 | 0xDB4FF10EC057E9AE26B07D0280B7F4341DA5D1B1EAE06C7D 43 | 0x9B2F2F6D9C5628A7844163D015BE86344082AA88D95E2F9D, 44 | nParameter = 0xFFFFFFFFFFFFFFFFFFFFFFFE26F2FC170F69466A74DEFD8D, 45 | hParameter = 0x1} 46 | 47 | secp192r1 = Curve 48 | {aParameter = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFC, 49 | bParameter = 0x64210519E59C80E70FA7E9AB72243049FEB8DEECC146B9B1, 50 | pParameter = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFF, 51 | gParameter = Point 52 | 0x188DA80EB03090F67CBF20EB43A18800F4FF0AFD82FF1012 53 | 0x07192B95FFC8DA78631011ED6B24CDD573F977A11E794811, 54 | nParameter = 0xFFFFFFFFFFFFFFFFFFFFFFFF99DEF836146BC9B1B4D22831, 55 | hParameter = 0x1} 56 | 57 | secp224k1 = Curve 58 | {aParameter = 0x0, 59 | bParameter = 0x5, 60 | pParameter = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFE56D, 61 | gParameter = Point 62 | 0xA1455B334DF099DF30FC28A169A467E9E47075A90F7E650EB6B7A45C 63 | 0x7E089FED7FBA344282CAFBD6F7E319F7C0B0BD59E2CA4BDB556D61A5, 64 | nParameter = 0x10000000000000000000000000001DCE8D2EC6184CAF0A971769FB1F7, 65 | hParameter = 0x1} 66 | 67 | secp224r1 = Curve 68 | {aParameter = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFFFE, 69 | bParameter = 0xB4050A850C04B3ABF54132565044B0B7D7BFD8BA270B39432355FFB4, 70 | pParameter = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000000000000001, 71 | gParameter = Point 72 | 0xB70E0CBD6BB4BF7F321390B94A03C1D356C21122343280D6115C1D21 73 | 0xBD376388B5F723FB4C22DFE6CD4375A05A07476444D5819985007E34, 74 | nParameter = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFF16A2E0B8F03E13DD29455C5C2A3D, 75 | hParameter = 0x1} 76 | 77 | secp256k1 = Curve 78 | {aParameter = 0x0, 79 | bParameter = 0x7, 80 | pParameter = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFC2F, 81 | gParameter = Point 82 | 0x79BE667EF9DCBBAC55A06295CE870B07029BFCDB2DCE28D959F2815B16F81798 83 | 0x483ADA7726A3C4655DA4FBFC0E1108A8FD17B448A68554199C47D08FFB10D4B8, 84 | nParameter = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364141, 85 | hParameter = 0x1} 86 | 87 | secp256r1 = Curve 88 | {aParameter = 0xFFFFFFFF00000001000000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFC, 89 | bParameter = 0x5AC635D8AA3A93E7B3EBBD55769886BC651D06B0CC53B0F63BCE3C3E27D2604B, 90 | pParameter = 0xFFFFFFFF00000001000000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFF, 91 | gParameter = Point 92 | 0x6B17D1F2E12C4247F8BCE6E563A440F277037D812DEB33A0F4A13945D898C296 93 | 0x4FE342E2FE1A7F9B8EE7EB4A7C0F9E162BCE33576B315ECECBB6406837BF51F5, 94 | nParameter = 0xFFFFFFFF00000000FFFFFFFFFFFFFFFFBCE6FAADA7179E84F3B9CAC2FC632551, 95 | hParameter = 0x1} 96 | 97 | secp384r1 = Curve 98 | {aParameter = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFFFF0000000000000000FFFFFFFC, 99 | bParameter = 0xB3312FA7E23EE7E4988E056BE3F82D19181D9C6EFE8141120314088F5013875AC656398D8A2ED19D2A85C8EDD3EC2AEF, 100 | pParameter = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFFFF0000000000000000FFFFFFFF, 101 | gParameter = Point 102 | 0xAA87CA22BE8B05378EB1C71EF320AD746E1D3B628BA79B9859F741E082542A385502F25DBF55296C3A545E3872760AB7 103 | 0x3617DE4A96262C6F5D9E98BF9292DC29F8F41DBD289A147CE9DA3113B5F0B8C00A60B1CE1D7E819D7A431D7C90EA0E5F, 104 | nParameter = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC7634D81F4372DDF581A0DB248B0A77AECEC196ACCC52973, 105 | hParameter = 0x1} 106 | 107 | secp521r1 = Curve 108 | {aParameter = 0x01FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC, 109 | bParameter = 0x0051953EB9618E1C9A1F929A21A0B68540EEA2DA725B99B315F3B8B489918EF109E156193951EC7E937B1652C0BD3BB1BF073573DF883D2C34F1EF451FD46B503F00, 110 | pParameter = 0x01FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF, 111 | gParameter = Point 112 | 0x00C6858E06B70404E9CD9E3ECB662395B4429C648139053FB521F828AF606B4D3DBAA14B5E77EFE75928FE1DC127A2FFA8DE3348B3C1856A429BF97E7E31C2E5BD66 113 | 0x011839296A789A3BC0045C8A5FB42C7D1BD998F54449579B446817AFBD17273E662C97EE72995EF42640C550B9013FAD0761353C7086A272C24088BE94769FD16650, 114 | nParameter = 0x01FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFA51868783BF2F966B7FCC0148F709A5D03BB5C9B8899C47AEBB6FB71E91386409, 115 | hParameter = 0x1} 116 | 117 | --Operations use the Reader monad to express their dependence on choice of Curve. 118 | 119 | --Addition of two Points pt1 .+ pt2 120 | (.+) :: Point -> Point -> Reader Curve Point 121 | Infinity .+ pt = return pt 122 | pt .+ Infinity = return pt 123 | (Point x1 y1) .+ (Point x2 y2) 124 | = do p <- reader pParameter 125 | if (x1-x2) `mod` p == 0 && (y1+y2) `mod` p == 0 -- case of additive inverses pt1 .+ pt2 == Infinity 126 | then return Infinity 127 | else do a <- reader aParameter 128 | let m = if (x1-x2) `mod` p == 0 && (y1-y2) `mod` p == 0 -- case of pt1 == pt2 129 | then (3*x1^2+a) * inv (2*y1) p -- slope of tangent at pt1 == pt2 130 | else (y2-y1) * inv (x2-x1) p -- slope of secant for pt1 /= pt2 131 | x3 = (m^2-x1-x2) `mod` p 132 | y3 = (m*(x1-x3)-y1) `mod` p 133 | return (Point x3 y3) 134 | 135 | double :: Point -> Reader Curve Point 136 | double pt = pt .+ pt 137 | 138 | --Point negation reflects across the x-axis 139 | neg :: Point -> Reader Curve Point 140 | neg Infinity = return Infinity 141 | neg (Point x y) = do 142 | p <- reader pParameter 143 | return (Point x (p - y)) 144 | 145 | --Linear combination, algorithm uses double-and-add method 146 | --comb [(n1 , pt1),..,(nk , ptk)] == n1 .* pt1 .+ .. .+ nk .* ptk 147 | --O(log(|n1| + .. + |nk|)) complexity 148 | comb :: [(Integer , Point)] -> Reader Curve Point 149 | comb = combPos <=< positives 150 | where 151 | 152 | positives = traverse $ \ (n , pt) -> 153 | if n >= 0 then return (n , pt) else do 154 | let n' = negate n 155 | pt' <- neg pt 156 | return (n' , pt') 157 | 158 | combPos [] = return Infinity 159 | combPos xs = do 160 | halved <- combPos [(n `div` 2 , pt) | (n , pt) <- xs , n > 1] 161 | doubled <- double halved 162 | andAdded <- foldM (.+) Infinity [pt | (n , pt) <- xs , odd n] 163 | doubled .+ andAdded 164 | 165 | --Scalar multiplication of a Point k .* pt 166 | (.*) :: Integer -> Point -> Reader Curve Point 167 | k .* pt = comb [(k , pt)] 168 | 169 | --Digital signature data structures and operations 170 | type PrivateKey = Integer 171 | type PublicKey = Point 172 | type KeyPair = (PrivateKey , PublicKey) 173 | type Message = Integer 174 | type Signature = (Integer , Integer) 175 | 176 | --unprivate is the "one-way" function; it's also a homomorphism of Abelian groups! 177 | unprivate :: PrivateKey -> Reader Curve PublicKey 178 | unprivate private = (private .*) =<< reader gParameter 179 | 180 | --Operations use the monad transformer RandomGen rg => StateT rg to express their dependence on pseudorandomness 181 | 182 | --Randomly generate a new PrivateKey 183 | newPrivateKey :: RandomGen rg => StateT rg (Reader Curve) PrivateKey 184 | newPrivateKey = do n <- lift (reader nParameter) 185 | state (randomR (1 , n-1)) 186 | 187 | --Randomly generate a new KeyPair 188 | newKeyPair :: RandomGen rg => StateT rg (Reader Curve) KeyPair 189 | newKeyPair = do private <- newPrivateKey 190 | public <- lift (unprivate private) 191 | return (private , public) 192 | 193 | --Digitally sign a Message with a PrivateKey 194 | sign :: RandomGen rg => PrivateKey -> Message -> StateT rg (Reader Curve) Signature 195 | sign d e = do n <- lift (reader nParameter) 196 | (k , pt) <- newKeyPair 197 | case pt of 198 | Infinity -> sign d e 199 | (Point x y) -> do 200 | let r = x `mod` n 201 | s = (inv k n * (e + d*r)) `mod` n 202 | if r == 0 || s == 0 203 | then sign d e 204 | else return (r , s) 205 | 206 | --Operations using the monad transfomer MaybeT are composable validity checkers 207 | 208 | check :: (Functor m , Monad m) => Bool -> MaybeT m () 209 | check True = return () 210 | check False = empty 211 | 212 | validate :: Maybe () -> Bool 213 | validate Nothing = True 214 | validate (Just ()) = False 215 | 216 | checkPublicKey :: PublicKey -> MaybeT (Reader Curve) () 217 | checkPublicKey Infinity = return () 218 | checkPublicKey (Point x y) = do p <- lift (reader pParameter) 219 | a <- lift (reader aParameter) 220 | b <- lift (reader bParameter) 221 | check $ (y^2 - x^3 - a*x^2 - b) `mod` p == 0 222 | 223 | validateCurve :: Curve -> Bool 224 | validateCurve = validate . runReader (runMaybeT checkCurveProperties) 225 | where 226 | checkCurveProperties = do 227 | g <- reader gParameter 228 | checkPublicKey g 229 | n <- reader nParameter 230 | inf <- lift $ n .* g 231 | check $ inf == Infinity 232 | 233 | checkKeyPair :: KeyPair -> MaybeT (Reader Curve) () 234 | checkKeyPair (private , public) = do checkPublicKey public 235 | pub <- lift (unprivate private) 236 | check $ pub == public 237 | 238 | --Check validity of a Signature on a Message with a PublicKey 239 | checkSig :: PublicKey -> Message -> Signature -> MaybeT (Reader Curve) () 240 | checkSig q e (r , s) = do checkPublicKey q 241 | n <- lift (reader nParameter) 242 | check $ all (inRange (1 , n-1)) [r , s] 243 | let w = inv s n 244 | u1 = (e * w) `mod` n 245 | u2 = (r * w) `mod` n 246 | g <- lift (reader gParameter) 247 | pt <- lift (comb [(u1 , g) , (u2 , q)]) 248 | check $ pt /= Infinity 249 | let Point x _ = pt 250 | v = x `mod` n 251 | check $ v == r 252 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | elliptic 2 | ======== 3 | 4 | Elliptic Curve Cryptography in Haskell --------------------------------------------------------------------------------