Pasta.hs

{-|
Module      : Crypto.PastaCurves.Pasta (internal)
Description : Pasta-specific instantiation of parameterized curves and fields.
Copyright   : (c) Eric Schorn, 2022
Maintainer  : eric.schorn@nccgroup.com
Stability   : experimental
Portability : GHC
SPDX-License-Identifier: MIT

This internal module instantiates the specific curves and fields specific to Pasta. It
also includes `hashToPallas` and `hashToVesta` functionality (which in turn includes
two isogenous curves, mapping functionality, and coefficient vectors). The algorithms 
are NOT constant time; Safety and simplicity are the top priorities.
-}

{-# LANGUAGE DataKinds, NoImplicitPrelude, Safe #-}

module Pasta (Fp, Fq, Num(..), Pallas, Vesta, Curve(..), CurvePt(..), Field(..), 
  hashToPallas, hashToVesta, pallasPrime, vestaPrime) where

import Prelude
import Curves (Curve(..), CurvePt(..), Point(..))
import Fields (Fz, Field(..))
import Data.ByteString.UTF8 (ByteString)


-- | `Fp` is the field element used as a coordinate in the Pallas elliptic curve.
-- It is a type synonym for the internal `Fields.Fz` type, parameterized with the 
-- correct modulus. It is also typically used as a scalar to multiply a Vesta elliptic
-- curve point. Note that pointMul does not enforce specific scalar/point combinations.
type Fp  = Fz 0x40000000000000000000000000000000224698fc094cf91b992d30ed00000001


-- | `Pallas` represents a point on the Pallas elliptic curve using `Fp` coordinates.
-- The curve was designed to have the some order as the `Fq` element\'s modulus. It is
-- a type synonym for the internal `Curves.Point` type, parameterized with the curve\s 
-- @a@ and @b@ values and the affine base point as @base_x@ and @base_y@. The underlying
-- point is of type @Point a b base_x base_y field@.
type Pallas = (Point 0 5 1 0x248b4a5cf5ed6c83ac20560f9c8711ab92e13d27d60fb1aa7f5db6c93512d546 Fp)


-- | `Fq` is the field element used as a coordinate in the Vesta elliptic curve.
-- It is a type synonym for the internal `Fields.Fz` type, parameterized with the 
-- correct modulus. It is also typically used as a scalar to multiply a Pallas elliptic 
-- curve point. Note that pointMul does not enforce specific scalar/point combinations.
type Fq = Fz 0x40000000000000000000000000000000224698fc0994a8dd8c46eb2100000001


-- | `Vesta` represents a point on the Vesta elliptic curve using `Fq` coordinates.
-- The curve was designed to have the some order as the `Fp` element\'s modulus.  It is
-- a type synonym for the internal `Curves.Point` type, parameterized with the curve\s 
-- @a@ and @b@ values and the affine base point as @base_x@ and @base_y@.  The underlying
-- point is of type @Point a b base_x base_y field@.
type Vesta  = (Point 0 5 1 0x26bc999156dd5194ec49b1c551768ab375785e7ce00906d13e0361674fd8959f Fq)


-- This is a curve that is isogenous to Pallas, but with a*b != 0; base point params are unused
type IsoPallas = (Point 0x18354a2eb0ea8c9c49be2d7258370742b74134581a27a59f92bb4b0b657a014b 1265 0 0 Fp)


-- This is a curve that is isogenous to Vesta, but with a*b != 0; base point params are unused
type IsoVesta = (Point 0x267f9b2ee592271a81639c4d96f787739673928c7d01b212c515ad7242eaa6b1 1265 0 0 Fq)


-- | The `hashToPallas` function takes an arbitrary `ByteString` and maps it to a valid 
-- point on the Pallas elliptic curve (of unknown relation to the base point).
hashToPallas :: ByteString -> Pallas
hashToPallas msg = result 
  where
    (fe0, fe1) = hash2Field msg "z.cash:test" "pallas" :: (Fp, Fp)
    q0 = mapToCurveSimpleSwu fe0 (fromInteger (-13)) :: IsoPallas  -- -13 is Pasta specific magic constant
    q1 = mapToCurveSimpleSwu fe1 (fromInteger (-13)) :: IsoPallas
    (Projective xp yp zp) = pointAdd q0 q1 :: IsoPallas
    x = xp * inv0 zp ;  y = yp * inv0 zp
    xTop = head isoPallasVecs * x ^ (3::Integer) + isoPallasVecs !! 1 * x ^ (2::Integer) + isoPallasVecs !! 2 * x + isoPallasVecs !! 3
    xBot = x ^ (2::Integer) + isoPallasVecs !! 4 * x + isoPallasVecs !! 5
    yTop = isoPallasVecs !! 6 * x ^ (3::Integer) + isoPallasVecs !! 7 * x ^ (2::Integer) + isoPallasVecs !! 8 * x + isoPallasVecs !! 9
    yBot = x ^ (3::Integer) + isoPallasVecs !! 10 * x ^ (2::Integer) + isoPallasVecs !! 11 * x + isoPallasVecs !! 12 
    proposed = Projective (xTop * inv0 xBot) (y * yTop * inv0 yBot) 1 :: Pallas
    result = if isOnCurve proposed then proposed else error "hashed to Pallas non-point"


-- | The `hashToVesta` function takes an arbitrary `ByteString` and maps it to a valid 
-- point on the Vesta elliptic curve (of unknown relation to the base point).
hashToVesta :: ByteString -> Vesta
hashToVesta msg = result 
  where
    (fe0, fe1) = hash2Field msg "z.cash:test" "vesta" :: (Fq, Fq)
    q0 = mapToCurveSimpleSwu fe0 (fromInteger (-13)) :: IsoVesta
    q1 = mapToCurveSimpleSwu fe1 (fromInteger (-13)) :: IsoVesta
    (Projective xp yp zp) = pointAdd q0 q1 :: IsoVesta
    x = xp * inv0 zp ;  y = yp * inv0 zp
    xTop = head isoVestaVecs * x ^ (3::Integer) + isoVestaVecs !! 1 * x ^ (2::Integer) + isoVestaVecs !! 2 * x + isoVestaVecs !! 3
    xBot = x ^ (2::Integer) + isoVestaVecs !! 4 * x + isoVestaVecs !! 5
    yTop = isoVestaVecs !! 6 * x ^ (3::Integer) + isoVestaVecs !! 7 * x ^ (2::Integer) + isoVestaVecs !! 8 * x + isoVestaVecs !! 9
    yBot = x ^ (3::Integer) + isoVestaVecs !! 10 * x ^ (2::Integer) + isoVestaVecs !! 11 * x + isoVestaVecs !! 12 
    proposed = Projective (xTop * inv0 xBot) (y * yTop * inv0 yBot) 1 :: Vesta
    result = if isOnCurve proposed then proposed else error "hashed to Vesta non-point"


-- | The Pallas field modulus https://neuromancer.sk/std/other/Pallas
pallasPrime :: Integer
pallasPrime = 0x40000000000000000000000000000000224698fc094cf91b992d30ed00000001


-- | The Vesta field modulus https://neuromancer.sk/std/other/Vesta
vestaPrime :: Integer
vestaPrime = 0x40000000000000000000000000000000224698fc0994a8dd8c46eb2100000001


-- Vectors to map isogenous curve (with a*b != 0) point to Pallas
-- See https://github.com/zcash/pasta_curves/blob/21fd9e2c1bbd2d049bfe95588d77cb884e9f93ab/src/curves.rs#L1017-L1096
isoPallasVecs :: [Fp]
isoPallasVecs = [
  0x0e38e38e38e38e38e38e38e38e38e38e4081775473d8375b775f6034aaaaaaab,
  0x3509afd51872d88e267c7ffa51cf412a0f93b82ee4b994958cf863b02814fb76,
  0x17329b9ec525375398c7d7ac3d98fd13380af066cfeb6d690eb64faef37ea4f7,
  0x1c71c71c71c71c71c71c71c71c71c71c8102eea8e7b06eb6eebec06955555580,
  0x1d572e7ddc099cff5a607fcce0494a799c434ac1c96b6980c47f2ab668bcd71f,
  0x325669becaecd5d11d13bf2a7f22b105b4abf9fb9a1fc81c2aa3af1eae5b6604,
  0x1a12f684bda12f684bda12f684bda12f7642b01ad461bad25ad985b5e38e38e4,
  0x1a84d7ea8c396c47133e3ffd28e7a09507c9dc17725cca4ac67c31d8140a7dbb,
  0x3fb98ff0d2ddcadd303216cce1db9ff11765e924f745937802e2be87d225b234,
  0x025ed097b425ed097b425ed097b425ed0ac03e8e134eb3e493e53ab371c71c4f,
  0x0c02c5bcca0e6b7f0790bfb3506defb65941a3a4a97aa1b35a28279b1d1b42ae,
  0x17033d3c60c68173573b3d7f7d681310d976bbfabbc5661d4d90ab820b12320a,
  0x40000000000000000000000000000000224698fc094cf91b992d30ecfffffde5]


-- Vectors to map isogenous curve (with a*b != 0) point to Vesta
-- Curve isogenous to Vesta, with a*b != 0
-- See https://github.com/zcash/pasta_curves/blob/21fd9e2c1bbd2d049bfe95588d77cb884e9f93ab/src/curves.rs#L1117-L1196
isoVestaVecs :: [Fq]
isoVestaVecs = [
  0x38e38e38e38e38e38e38e38e38e38e390205dd51cfa0961a43cd42c800000001,
  0x1d935247b4473d17acecf10f5f7c09a2216b8861ec72bd5d8b95c6aaf703bcc5,
  0x18760c7f7a9ad20ded7ee4a9cdf78f8fd59d03d23b39cb11aeac67bbeb586a3d,
  0x31c71c71c71c71c71c71c71c71c71c71e1c521a795ac8356fb539a6f0000002b,
  0x0a2de485568125d51454798a5b5c56b2a3ad678129b604d3b7284f7eaf21a2e9,
  0x14735171ee5427780c621de8b91c242a30cd6d53df49d235f169c187d2533465,
  0x12f684bda12f684bda12f684bda12f685601f4709a8adcb36bef1642aaaaaaab,
  0x2ec9a923da239e8bd6767887afbe04d121d910aefb03b31d8bee58e5fb81de63,
  0x19b0d87e16e2578866d1466e9de10e6497a3ca5c24e9ea634986913ab4443034,
  0x1ed097b425ed097b425ed097b425ed098bc32d36fb21a6a38f64842c55555533,
  0x2f44d6c801c1b8bf9e7eb64f890a820c06a767bfc35b5bac58dfecce86b2745e,
  0x3d59f455cafc7668252659ba2b546c7e926847fb9ddd76a1d43d449776f99d2f,
  0x40000000000000000000000000000000224698fc0994a8dd8c46eb20fffffde5]