Copyright | (c) Marcel Fourné 20[14..] |
---|---|
License | BSD3 |
Maintainer | Marcel Fourné (haskell@marcelfourne.de) |
Stability | alpha |
Portability | Bad |
Safe Haskell | Safe |
Language | Haskell98 |
This module contain the internal functions. It's use should be limited to the Sign module, which exports certain types without constructors, so the timing attack surface is only over the verified functions. In other words: If an external module imports this module or uses unsafecoerce, it may circumvent the verifications against timing attacks!
Short-time plan: custom field arithmetic TODO: optimal const time inversion in 25519, see eccss-20130911b.pdf TODO: convert code to portable, get rid of Integer
Synopsis
- newtype Point = Point (FPrime, FPrime, FPrime, FPrime)
- data SigOK = SigOK
- type VerifyResult = Either String SigOK
- type PubKey = ByteString
- type PubKeyPoint = Point
- newtype SecKey = SecKeyBytes ByteString
- newtype SecFPrime = SecNum FPrime
- type Signature = ByteString
- type Message = ByteString
- type SignedMessage = ByteString
- b :: Int
- q :: FPrime
- l :: FPrime
- d :: FPrime
- i :: FPrime
- h :: ByteString -> ByteString
- ph :: ByteString -> ByteString
- by :: FPrime
- inf :: Point
- null :: FPrime
- eins :: FPrime
- alleeins :: FPrime
- xrecover :: FPrime -> Integer -> FPrime
- bPoint :: Point
- pneg :: Point -> Point
- k :: FPrime
- padd :: Point -> Point -> Point
- pdouble :: Point -> Point
- pmul :: Point -> FPrime -> Point
- ison :: Point -> Bool
- scale :: Point -> Point
- pointtobs :: Point -> ByteString
- bstopoint :: ByteString -> Either String Point
- clamp :: ByteString -> Either String FPrime
- convertLE8ByteTo64BE :: ByteString -> Either String FPrime
- convert64BEtoLE8Byte :: FPrime -> ByteString
- getFPrime32 :: ByteString -> Either String FPrime
- getFPrime64 :: ByteString -> Either String FPrime
- putFPrime :: FPrime -> ByteString
Documentation
twisted Edwards curve point, extended point format (x,y,z,t), neutral element (0,1,1,0), c=1, a=-1 https://hyperelliptic.org/EFD/g1p/auto-twisted-extended-1.html, after "Twisted Edwards curves revisited" eprint 2008/522
clear signal that everything is ok
type VerifyResult = Either String SigOK Source #
Result of verifying a signature should only yield if it's good or bad, not more, but contains an error string if underlying primitives failed
type PubKey = ByteString Source #
just a newtype for the public key (string of 32 bytes, b=256 bit)
type PubKeyPoint = Point Source #
just a newtype for the public key as a point on the Edwards curve
just a wrapper for the secret key (string of 32 bytes, b=256 bit)
type Signature = ByteString Source #
just a newtype for the signature (string of 2*32 bytes, b=256 bit)
type Message = ByteString Source #
just a newtype for the message
type SignedMessage = ByteString Source #
just a newtype for the signature with appended message
h :: ByteString -> ByteString Source #
wrapper for our hash function
ph :: ByteString -> ByteString Source #
the prehash function, id in PureEdDSA
xrecover :: FPrime -> Integer -> FPrime Source #
recover the x coordinate from the y coordinate and a signum
pmul :: Point -> FPrime -> Point Source #
scalar multiplication, branchfree in k, pattern-matched branch on j (static known length of k)
pointtobs :: Point -> ByteString Source #
convert a point on the curve to a ByteString
clamp :: ByteString -> Either String FPrime Source #
clamping of a string of bytes to make it suitable for usage on the (clamped) Edwards curve in Ed25519, reduces cofactor [ b Bits ] 001..1000 010..0 BigEndian 01x..x000 ==> ((getFPrime N) .&. (2^254-1-(2^0+2^1+2^2)) .|. (2^254)) .&. 28948022309329048855892746252171976963317496166410141009864396001978282409976 .|. 28948022309329048855892746252171976963317496166410141009864396001978282409984
convertLE8ByteTo64BE :: ByteString -> Either String FPrime Source #
convert an 8 Byte little endian ByteString to either an error String (if too short) or a big endian FPrime
convert64BEtoLE8Byte :: FPrime -> ByteString Source #
convert a big endian FPrime to an 8 Byte little endian ByteString
getFPrime32 :: ByteString -> Either String FPrime Source #
converts 32 little endian bytes into one FPrime
getFPrime64 :: ByteString -> Either String FPrime Source #
converts 64 little endian bytes into one FPrime
putFPrime :: FPrime -> ByteString Source #
converts one FPrime into exactly 32 little endian bytes