diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,5 @@ +# Changelog for galois-field + +## 0.1.0 + +* Initial release. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,19 @@ +Copyright (c) 2019 Adjoint Inc. + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, +DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR +OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE +OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,196 @@ +

+ +

+ +[![CircleCI](https://circleci.com/gh/adjoint-io/galois-field.svg?style=svg)](https://circleci.com/gh/adjoint-io/galois-field) + +# Galois Field + +An efficient implementation of Galois fields used in cryptography research. + +## Technical background + +A **Galois field** GF(pq), for prime p and positive q, is a *field* (GF(pq), +, \*, 0, 1) of finite *order*. Explicitly, +- (GF(pq), +, 0) is an abelian group, +- (GF(pq) \\ \{0\}, \*, 1) is an abelian group, +- \* is distributive over +, and +- \#GF(pq) is finite. + +### Prime fields + +Any Galois field has a unique *characteristic* p, the minimum positive p such that p(1) = 1 + ... + 1 = 0, and p is prime. The smallest Galois field of characteristic p is a **prime field**, and any Galois field of characteristic p is a *finite-dimensional vector space* over its prime subfield. + +For example, GF(4) is a Galois field of characteristic 2 that is a two-dimensional vector space over the prime subfield GF(2) = Z / 2Z. + +### Extension fields + +Any Galois field has order a prime power pq for prime p and positive q, and there is a Galois field GF(pq) of any prime power order pq that is *unique up to non-unique isomorphism*. Any Galois field GF(pq) can be constructed as an **extension field** over a smaller Galois subfield GF(pr), through the identification GF(pq) = GF(pr)[X] / \ for an *irreducible monic splitting polynomial* f(X) of degree q - r + 1 in the *polynomial ring* GF(pr)[X]. + +For example, GF(4) has order 22 and can be constructed as an extension field GF(2)[X] / \ where f(X) = X2 + X + 1 is an irreducible monic splitting quadratic polynomial in GF(2)[X]. + +## Example usage + +Include the following required language extensions. +```haskell +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +``` +Import the following functions at minimum. +```haskell +import PrimeField (PrimeField) +import ExtensionField (ExtensionField, IrreducibleMonic(split), fromList, t, x) +``` + +### Prime fields + +The following type declaration creates a prime field of a given characteristic. +```haskell +type Fq = PrimeField 21888242871839275222246405745257275088696311157297823662689037894645226208583 +``` +Note that the characteristic given *must* be prime. + +Galois field arithmetic can then be performed in this prime field. +```haskell +fq :: Fq +fq = 5216004179354450092383934373463611881445186046129513844852096383579774061693 + +fq' :: Fq +fq' = 10757805228921058098980668000791497318123219899766237205512608761387909753942 + +arithmeticFq :: (Fq, Fq, Fq, Fq) +arithmeticFq = (fq + fq', fq - fq', fq * fq', fq / fq') +``` + +### Extension fields + +The following data type declaration creates a splitting polynomial given an irreducible monic polynomial. +```haskell +data P2 +instance IrreducibleMonic Fq P2 + where split _ = x^2 + 1 +``` +The following type declaration then creates an extension field with this splitting polynomial. +```haskell +type Fq2 = ExtensionField Fq P2 +``` +Note that the splitting polynomial given *must* be irreducible and monic in the prime field. + +Similarly, further extension fields can be constructed iteratively as follows. +```haskell +data P6 +instance IrreducibleMonic Fq2 P6 where + split _ = x^3 - (9 + t x) + +type Fq6 = ExtensionField Fq2 P6 + +data P12 +instance IrreducibleMonic Fq6 P12 where + split _ = x^2 - t x + +type Fq12 = ExtensionField Fq6 P12 +``` +Note that `x` accesses the current indeterminate variable and `t` descends the tower of indeterminate variables. + +Galois field arithmetic can then be performed in this extension field. +```haskell +fq12 :: Fq12 +fq12 = fromList + [ fromList + [ fromList + [ 4025484419428246835913352650763180341703148406593523188761836807196412398582 + , 5087667423921547416057913184603782240965080921431854177822601074227980319916 + ] + , fromList + [ 8868355606921194740459469119392835913522089996670570126495590065213716724895 + , 12102922015173003259571598121107256676524158824223867520503152166796819430680 + ] + , fromList + [ 92336131326695228787620679552727214674825150151172467042221065081506740785 + , 5482141053831906120660063289735740072497978400199436576451083698548025220729 + ] + ] + , fromList + [ fromList + [ 7642691434343136168639899684817459509291669149586986497725240920715691142493 + , 1211355239100959901694672926661748059183573115580181831221700974591509515378 + ] + , fromList + [ 20725578899076721876257429467489710434807801418821512117896292558010284413176 + , 17642016461759614884877567642064231230128683506116557502360384546280794322728 + ] + , fromList + [ 17449282511578147452934743657918270744212677919657988500433959352763226500950 + , 1205855382909824928004884982625565310515751070464736233368671939944606335817 + ] + ] + ] + +fq12' :: Fq12 +fq12' = fromList + [ fromList + [ fromList + [ 495492586688946756331205475947141303903957329539236899715542920513774223311 + , 9283314577619389303419433707421707208215462819919253486023883680690371740600 + ] + , fromList + [ 11142072730721162663710262820927009044232748085260948776285443777221023820448 + , 1275691922864139043351956162286567343365697673070760209966772441869205291758 + ] + , fromList + [ 20007029371545157738471875537558122753684185825574273033359718514421878893242 + , 9839139739201376418106411333971304469387172772449235880774992683057627654905 + ] + ] + , fromList + [ fromList + [ 9503058454919356208294350412959497499007919434690988218543143506584310390240 + , 19236630380322614936323642336645412102299542253751028194541390082750834966816 + ] + , fromList + [ 18019769232924676175188431592335242333439728011993142930089933693043738917983 + , 11549213142100201239212924317641009159759841794532519457441596987622070613872 + ] + , fromList + [ 9656683724785441232932664175488314398614795173462019188529258009817332577664 + , 20666848762667934776817320505559846916719041700736383328805334359135638079015 + ] + ] + ] + +arithmeticFq12 :: (Fq12, Fq12, Fq12, Fq12) +arithmeticFq12 = (fq12 + fq12', fq12 - fq12', fq12 * fq12', fq12 / fq12') +``` +Note that +``` +a + bx + (c + dx)y + (e + fx)y^2 + (g + hx + (i + jx)y + (k + lx)y^2)z +``` +where `x, y, z` is a tower of indeterminate variables is constructed by +```haskell +fromList [ fromList [fromList [a, b], fromList [c, d], fromList [e, f]] + , fromList [fromList [g, h], fromList [i, j], fromList [k, l]] ] :: Fq12 +``` + +## License + +``` +Copyright (c) 2019 Adjoint Inc. + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, +DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR +OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE +OR OTHER DEALINGS IN THE SOFTWARE. +``` diff --git a/benchmarks/Benchmarks.hs b/benchmarks/Benchmarks.hs new file mode 100644 --- /dev/null +++ b/benchmarks/Benchmarks.hs @@ -0,0 +1,184 @@ +module Benchmarks where + +import Protolude + +import Criterion.Main + +import ExtensionField +import PrimeField + +type Fq = PrimeField 21888242871839275222246405745257275088696311157297823662689037894645226208583 + +fq :: Fq +fq = 5216004179354450092383934373463611881445186046129513844852096383579774061693 + +fq' :: Fq +fq' = 10757805228921058098980668000791497318123219899766237205512608761387909753942 + +data Pu +instance IrreducibleMonic Fq Pu where split _ = x^2 + 1 +type Fq2 = ExtensionField Fq Pu + +fq2 :: Fq2 +fq2 = fromList + [ 19908898611787582971615951530393785823319364696376311494770162270472288380562 + , 2444690988583914246674870181013910409542697083717824402984851238236041783759 + ] + +fq2' :: Fq2 +fq2' = fromList + [ 176307305890807650390915550856467756101144733976249050387177647283239486934 + , 9913547941088878400547309488585076816688958962210000330808066250849942240036 + ] + +data Pv +instance IrreducibleMonic Fq2 Pv where split _ = x^3 - (9 + t x) +type Fq6 = ExtensionField Fq2 Pv + +fq6 :: Fq6 +fq6 = fromList + [ fromList + [ 8727269669017421992537561450387212506711577304101544328736696625792447584819 + , 14548604791762199086915107662335514800873255588931510951007415299299859294564 + ] + , fromList + [ 12226353852518517213098257637254082040554292743096797524265221809863992104040 + , 12690801089710533803594523982915673248220237967492611523932652691226365708512 + ] + , fromList + [ 18336930404004840796680535059992401039831316705513753839479258873269709495858 + , 21634580953983557175729336703450663797341055784728343534694506874757389871868 + ] + ] + +fq6' :: Fq6 +fq6' = fromList + [ fromList + [ 21427158918811764040959407626476119248515601360702754918240300689672054041331 + , 12750457256357562507331331307761996193149796736574153338180573114576232473092 + ] + , fromList + [ 19307896751125425658868292427117755307914453765471505616446813557567103424424 + , 11511704315039881938763578963465960361806962511008317843374696569679546862720 + ] + , fromList + [ 16856354813335682789816416666746807604324955216244680818919639213184967817815 + , 10563739714379631354612735346769824530666877338817980746884577737330686430079 + ] + ] + +data Pw +instance IrreducibleMonic Fq6 Pw where split _ = x^2 - t x +type Fq12 = ExtensionField Fq6 Pw + +fq12 :: Fq12 +fq12 = fromList + [ fromList + [ fromList + [ 4025484419428246835913352650763180341703148406593523188761836807196412398582 + , 5087667423921547416057913184603782240965080921431854177822601074227980319916 + ] + , fromList + [ 8868355606921194740459469119392835913522089996670570126495590065213716724895 + , 12102922015173003259571598121107256676524158824223867520503152166796819430680 + ] + , fromList + [ 92336131326695228787620679552727214674825150151172467042221065081506740785 + , 5482141053831906120660063289735740072497978400199436576451083698548025220729 + ] + ] + , fromList + [ fromList + [ 7642691434343136168639899684817459509291669149586986497725240920715691142493 + , 1211355239100959901694672926661748059183573115580181831221700974591509515378 + ] + , fromList + [ 20725578899076721876257429467489710434807801418821512117896292558010284413176 + , 17642016461759614884877567642064231230128683506116557502360384546280794322728 + ] + , fromList + [ 17449282511578147452934743657918270744212677919657988500433959352763226500950 + , 1205855382909824928004884982625565310515751070464736233368671939944606335817 + ] + ] + ] + +fq12' :: Fq12 +fq12' = fromList + [ fromList + [ fromList + [ 495492586688946756331205475947141303903957329539236899715542920513774223311 + , 9283314577619389303419433707421707208215462819919253486023883680690371740600 + ] + , fromList + [ 11142072730721162663710262820927009044232748085260948776285443777221023820448 + , 1275691922864139043351956162286567343365697673070760209966772441869205291758 + ] + , fromList + [ 20007029371545157738471875537558122753684185825574273033359718514421878893242 + , 9839139739201376418106411333971304469387172772449235880774992683057627654905 + ] + ] + , fromList + [ fromList + [ 9503058454919356208294350412959497499007919434690988218543143506584310390240 + , 19236630380322614936323642336645412102299542253751028194541390082750834966816 + ] + , fromList + [ 18019769232924676175188431592335242333439728011993142930089933693043738917983 + , 11549213142100201239212924317641009159759841794532519457441596987622070613872 + ] + , fromList + [ 9656683724785441232932664175488314398614795173462019188529258009817332577664 + , 20666848762667934776817320505559846916719041700736383328805334359135638079015 + ] + ] + ] + +benchmarks :: Benchmark +benchmarks = bgroup "GaloisField" + [ bgroup "PrimeField" + [ bgroup "Fq" + [ bench "Addition" + $ whnf (uncurry (+)) (fq, fq') + , bench "Subtraction" + $ whnf (uncurry (-)) (fq, fq') + , bench "Multiplication" + $ whnf (uncurry (*)) (fq, fq') + , bench "Division" + $ whnf (uncurry (/)) (fq, fq') + ] + ] + , bgroup "ExtensionField" + [ bgroup "Fq2" + [ bench "Addition" + $ whnf (uncurry (+)) (fq2, fq2') + , bench "Subtraction" + $ whnf (uncurry (-)) (fq2, fq2') + , bench "Multiplication" + $ whnf (uncurry (*)) (fq2, fq2') + , bench "Division" + $ whnf (uncurry (/)) (fq2, fq2') + ] + , bgroup "Fq6" + [ bench "Addition" + $ whnf (uncurry (+)) (fq6, fq6') + , bench "Subtraction" + $ whnf (uncurry (-)) (fq6, fq6') + , bench "Multiplication" + $ whnf (uncurry (*)) (fq6, fq6') + , bench "Division" + $ whnf (uncurry (/)) (fq6, fq6') + ] + , bgroup "Fq12" + [ bench "Addition" + $ whnf (uncurry (+)) (fq12, fq12') + , bench "Subtraction" + $ whnf (uncurry (-)) (fq12, fq12') + , bench "Multiplication" + $ whnf (uncurry (*)) (fq12, fq12') + , bench "Division" + $ whnf (uncurry (/)) (fq12, fq12') + ] + ] + ] diff --git a/benchmarks/Main.hs b/benchmarks/Main.hs new file mode 100644 --- /dev/null +++ b/benchmarks/Main.hs @@ -0,0 +1,10 @@ +module Main where + +import Protolude + +import Criterion.Main + +import Benchmarks + +main :: IO () +main = defaultMain [benchmarks] diff --git a/galois-field.cabal b/galois-field.cabal new file mode 100644 --- /dev/null +++ b/galois-field.cabal @@ -0,0 +1,97 @@ +-- This file has been generated from package.yaml by hpack version 0.28.2. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 86cbd60c516785b91dbc82303018451a9a632edd09640a077a30faab5d3b4991 + +name: galois-field +version: 0.1.0 +synopsis: Galois field +description: Finite field library +category: Cryptography +homepage: https://github.com/adjoint-io/galois-field#readme +bug-reports: https://github.com/adjoint-io/galois-field/issues +maintainer: Adjoint Inc (info@adjoint.io) +license: MIT +license-file: LICENSE +build-type: Simple +cabal-version: >= 1.10 +extra-source-files: + ChangeLog.md + README.md + +source-repository head + type: git + location: https://github.com/adjoint-io/galois-field + +flag optimized + description: Perform compiler optimizations + manual: False + default: False + +flag static + description: Emit statically-linked binary + manual: False + default: False + +library + exposed-modules: + GaloisField + PrimeField + ExtensionField + other-modules: + PolynomialRing + hs-source-dirs: + src + default-extensions: LambdaCase RecordWildCards OverloadedStrings NoImplicitPrelude FlexibleInstances FlexibleContexts ScopedTypeVariables RankNTypes DataKinds DeriveGeneric GeneralizedNewtypeDeriving KindSignatures MultiParamTypeClasses + ghc-options: -Wall + build-depends: + base >=4.7 && <5 + , integer-gmp + , protolude >=0.2 + default-language: Haskell2010 + +test-suite tests + type: exitcode-stdio-1.0 + main-is: Main.hs + other-modules: + GaloisField + PrimeField + PolynomialRing + ExtensionField + GaloisFieldTests + PrimeFieldTests + PolynomialRingTests + ExtensionFieldTests + hs-source-dirs: + src + tests + default-extensions: LambdaCase RecordWildCards OverloadedStrings NoImplicitPrelude FlexibleInstances FlexibleContexts ScopedTypeVariables RankNTypes DataKinds DeriveGeneric GeneralizedNewtypeDeriving KindSignatures MultiParamTypeClasses + build-depends: + base >=4.7 && <5 + , integer-gmp + , protolude >=0.2 + , tasty + , tasty-discover + , tasty-quickcheck + default-language: Haskell2010 + +benchmark benchmarks + type: exitcode-stdio-1.0 + main-is: Main.hs + other-modules: + GaloisField + PrimeField + PolynomialRing + ExtensionField + Benchmarks + hs-source-dirs: + src + benchmarks + default-extensions: LambdaCase RecordWildCards OverloadedStrings NoImplicitPrelude FlexibleInstances FlexibleContexts ScopedTypeVariables RankNTypes DataKinds DeriveGeneric GeneralizedNewtypeDeriving KindSignatures MultiParamTypeClasses + build-depends: + base >=4.7 && <5 + , criterion + , integer-gmp + , protolude >=0.2 + default-language: Haskell2010 diff --git a/src/ExtensionField.hs b/src/ExtensionField.hs new file mode 100644 --- /dev/null +++ b/src/ExtensionField.hs @@ -0,0 +1,68 @@ +module ExtensionField + ( ExtensionField + , IrreducibleMonic(..) + , fromField + , fromList + , t + , x + ) where + +import Protolude + +import GaloisField (GaloisField(..)) +import PolynomialRing (Polynomial(..), polyDiv, polyInv, toPoly) + +-- | Extension fields @GF(p^q)[X]/@ for @p@ prime, @q@ positive, and +-- @f(X)@ irreducible monic in @GF(p^q)[X]@ +newtype ExtensionField k im = EF (Polynomial k) + deriving (Eq, Generic, NFData, Show) + +-- | Irreducible monic splitting polynomial of extension field +class IrreducibleMonic k im where + split :: (k, im) -> Polynomial k + +-- | Extension fields are fields +instance (GaloisField k, IrreducibleMonic k im) + => Fractional (ExtensionField k im) where + recip (EF y) = case polyInv y (split (witness :: (k, im))) of + Just z -> EF z + _ -> panic "no multiplicative inverse." + {-# INLINE recip #-} + fromRational (y:%z) = fromInteger y / fromInteger z + +-- | Extension fields are Galois fields +instance (GaloisField k, IrreducibleMonic k im) + => GaloisField (ExtensionField k im) where + char = const (char (witness :: k)) + +-- | Extension fields are rings +instance (GaloisField k, IrreducibleMonic k im) + => Num (ExtensionField k im) where + EF y + EF z = EF (y + z) + EF y * EF z = EF (snd (polyDiv (y * z) (split (witness :: (k, im))))) + EF y - EF z = EF (y - z) + negate (EF y) = EF (-y) + fromInteger = EF . fromInteger + abs = panic "not implemented." + signum = panic "not implemented." + +-- | List from field +fromField :: ExtensionField k im -> [k] +fromField (EF (X ks)) = ks +{-# INLINE fromField #-} + +-- | Field from list +fromList :: forall k im . (GaloisField k, IrreducibleMonic k im) + => [k] -> ExtensionField k im +fromList = EF . snd . flip polyDiv (split (witness :: (k, im))) . toPoly +{-# INLINE fromList #-} + +-- | Current indeterminate variable +x :: GaloisField k => Polynomial k +x = X [0, 1] +{-# INLINE x #-} + +-- | Descend variable tower +t :: Polynomial k -> Polynomial (ExtensionField k im) +t = X . return . EF +{-# INLINE t #-} diff --git a/src/GaloisField.hs b/src/GaloisField.hs new file mode 100644 --- /dev/null +++ b/src/GaloisField.hs @@ -0,0 +1,11 @@ +module GaloisField + ( GaloisField(..) + ) where + +import Protolude + +-- | Galois fields @GF(p^q)@ for @p@ prime and @q@ non-negative +class (Eq k, Fractional k, Show k) => GaloisField k where + {-# MINIMAL char #-} + -- | Characteristic of field + char :: k -> Integer diff --git a/src/PolynomialRing.hs b/src/PolynomialRing.hs new file mode 100644 --- /dev/null +++ b/src/PolynomialRing.hs @@ -0,0 +1,97 @@ +module PolynomialRing + ( Polynomial(..) + , degree + , last + , polyDiv + , polyInv + , toPoly + ) where + +import Protolude + +import GaloisField (GaloisField(..)) + +-- | Polynomial rings +newtype Polynomial k = X [k] + deriving (Eq, Generic, NFData, Show) + +-- | Polynomial rings are rings +instance GaloisField k => Num (Polynomial k) where + X xs + X ys = X (polyAdd xs ys) + X xs * X ys = X (polyMul xs ys) + negate (X xs) = X (map negate xs) + fromInteger = fromInt + abs = panic "not implemented." + signum = panic "not implemented." + +-- | Polynomial addition +polyAdd :: GaloisField k => [k] -> [k] -> [k] +polyAdd [] xs = xs +polyAdd xs [] = xs +polyAdd (x:xs) (y:ys) = if z == 0 && null zs then [] else z : zs + where + z = x + y + zs = polyAdd xs ys +{-# INLINE polyAdd #-} + +-- | Polynomial multiplication +polyMul :: GaloisField k => [k] -> [k] -> [k] +polyMul [] _ = [] +polyMul _ [] = [] +polyMul (x:xs) ys = if null xs then ws else polyAdd ws (0 : zs) + where + ws = map (* x) ys + zs = polyMul xs ys +{-# INLINE polyMul #-} + +-- | Polynomial from integer +fromInt :: GaloisField k => Integer -> Polynomial k +fromInt n = X (let m = fromInteger n in if m == 0 then [] else [m]) +{-# INLINE fromInt #-} + +-- | Polynomial degree +degree :: Polynomial k -> Int +degree (X xs) = length xs +{-# INLINE degree #-} + +-- | Polynomial leading coefficient +last :: GaloisField k => Polynomial k -> k +last (X []) = 0 +last (X [x]) = x +last (X (_:xs)) = last (X xs) +{-# INLINE last #-} + +-- | Polynomial division +polyDiv :: forall k . GaloisField k + => Polynomial k -> Polynomial k -> (Polynomial k, Polynomial k) +polyDiv ns ds = polyQR (0, ns) + where + polyQR :: (Polynomial k, Polynomial k) -> (Polynomial k, Polynomial k) + polyQR qr@(qs, rs) + | degree rs < degree ds = qr + | otherwise = polyQR (qs + ts, rs - ts * ds) + where + ts = X (replicate (degree rs - degree ds) 0 ++ [last rs / last ds]) +{-# INLINE polyDiv #-} + +-- | Polynomial inversion +polyInv :: forall k . GaloisField k + => Polynomial k -> Polynomial k -> Maybe (Polynomial k) +polyInv (X [x]) _ = Just (X [recip x]) +polyInv xs ps = case extGCD ps xs of + (X [y], (X ys, _)) -> Just (X (map (/ y) ys)) + _ -> Nothing + where + extGCD :: Polynomial k -> Polynomial k + -> (Polynomial k, (Polynomial k, Polynomial k)) + extGCD y 0 = (y, (0, 1)) + extGCD y x = (g, (t - s * q, s)) + where + (q, r) = polyDiv y x + (g, (s, t)) = extGCD x r +{-# INLINE polyInv #-} + +-- | List to polynomial +toPoly :: GaloisField k => [k] -> Polynomial k +toPoly = X . reverse . dropWhile (== 0) . reverse +{-# INLINE toPoly #-} diff --git a/src/PrimeField.hs b/src/PrimeField.hs new file mode 100644 --- /dev/null +++ b/src/PrimeField.hs @@ -0,0 +1,49 @@ +module PrimeField + ( PrimeField + , toInt + ) where + +import Protolude + +import GHC.Integer.GMP.Internals (recipModInteger) + +import GaloisField (GaloisField(..)) + +-- | Prime fields @GF(p)@ for @p@ prime +newtype PrimeField (p :: Nat) = PF Integer + deriving (Eq, Generic, NFData, Show) + +-- | Prime fields are fields +instance KnownNat p => Fractional (PrimeField p) where + recip y@(PF x) = PF (recipModInteger x (natVal y)) + fromRational (x:%y) = fromInteger x / fromInteger y + +-- | Prime fields are Galois fields +instance KnownNat p => GaloisField (PrimeField p) where + char = natVal + +-- | Prime fields are rings +instance KnownNat p => Num (PrimeField p) where + z@(PF x) + PF y = PF (if xy >= p then xy - p else xy) + where + xy = x + y + p = natVal z + {-# INLINE (+) #-} + z@(PF x) * PF y = PF (rem (x * y) (natVal z)) + z@(PF x) - PF y = PF (if xy >= 0 then xy else xy + natVal z) + where + xy = x - y + {-# INLINE (-) #-} + negate y@(PF x) = PF (if x == 0 then 0 else -x + natVal y) + fromInteger x = PF (if y >= 0 then y else y + p) + where + y = rem x p + p = natVal (witness :: PrimeField p) + {-# INLINE fromInteger #-} + abs = panic "not implemented." + signum = panic "not implemented." + +-- | Embed to integers +toInt :: PrimeField p -> Integer +toInt (PF x) = x +{-# INLINE toInt #-} diff --git a/tests/ExtensionFieldTests.hs b/tests/ExtensionFieldTests.hs new file mode 100644 --- /dev/null +++ b/tests/ExtensionFieldTests.hs @@ -0,0 +1,83 @@ +module ExtensionFieldTests where + +import Protolude + +import Test.Tasty +import Test.Tasty.QuickCheck + +import ExtensionField +import GaloisField +import GaloisFieldTests +import PolynomialRing +import PolynomialRingTests +import PrimeField +import PrimeFieldTests + +instance (Arbitrary k, GaloisField k, IrreducibleMonic k ps) + => Arbitrary (ExtensionField k ps) where + arbitrary = fromList <$> sized (const poly) + where + poly = choose (1, degree (split (witness :: (k, ps))) - 1) + >>= mapM (const arbitrary) . enumFromTo 1 + +type F2 = PrimeField 2 +data P11; instance IrreducibleMonic F2 P11 where split _ = x^2 + x + 1 +test_4 = fieldAxioms (Proxy :: Proxy (ExtensionField F2 P11)) "F4" +data P110; instance IrreducibleMonic F2 P110 where split _ = x^3 + x + 1 +test_8 = fieldAxioms (Proxy :: Proxy (ExtensionField F2 P110)) "F8" +data P101; instance IrreducibleMonic F2 P101 where split _ = x^3 + x^2 + 1 +test_8' = fieldAxioms (Proxy :: Proxy (ExtensionField F2 P110)) "F8'" + +type F3 = PrimeField 3 +data P10; instance IrreducibleMonic F3 P10 where split _ = x^2 + 1 +test_9 = fieldAxioms (Proxy :: Proxy (ExtensionField F3 P10)) "F9" +data P21; instance IrreducibleMonic F3 P21 where split _ = x^2 + x - 1 +test_9' = fieldAxioms (Proxy :: Proxy (ExtensionField F3 P21)) "F9'" +data P22; instance IrreducibleMonic F3 P22 where split _ = x^2 - x - 1 +test_9'' = fieldAxioms (Proxy :: Proxy (ExtensionField F3 P22)) "F9''" + +type FA = PrimeField 2147483647 +instance IrreducibleMonic FA P10 where split _ = x^2 + 1 +test_A = fieldAxioms (Proxy :: Proxy (ExtensionField FA P10)) "FA2" + +type FB = PrimeField 2305843009213693951 +instance IrreducibleMonic FB P10 where split _ = x^2 + 1 +test_B = fieldAxioms (Proxy :: Proxy (ExtensionField FB P10)) "FB2" + +type FC = PrimeField 618970019642690137449562111 +instance IrreducibleMonic FC P10 where split _ = x^2 + 1 +test_C = fieldAxioms (Proxy :: Proxy (ExtensionField FC P10)) "FC2" + +type FD = PrimeField 162259276829213363391578010288127 +instance IrreducibleMonic FD P10 where split _ = x^2 + 1 +test_D = fieldAxioms (Proxy :: Proxy (ExtensionField FD P10)) "FD2" + +type FE = PrimeField 170141183460469231731687303715884105727 +instance IrreducibleMonic FE P10 where split _ = x^2 + 1 +test_E = fieldAxioms (Proxy :: Proxy (ExtensionField FE P10)) "FE2" + +type FV = PrimeField 20988936657440586486151264256610222593863921 +instance IrreducibleMonic FV P10 where split _ = x^2 + 1 +test_V = fieldAxioms (Proxy :: Proxy (ExtensionField FV P10)) "FV2" + +type FX = PrimeField 5210644015679228794060694325390955853335898483908056458352183851018372555735221 +instance IrreducibleMonic FX P10 where split _ = x^2 + 1 +test_X = fieldAxioms (Proxy :: Proxy (ExtensionField FX P10)) "FX2" + +type FZ = PrimeField 741640062627530801524787141901937474059940781097519023905821316144415759504705008092818711693940737 +instance IrreducibleMonic FZ P10 where split _ = x^2 + 1 +test_Z = fieldAxioms (Proxy :: Proxy (ExtensionField FZ P10)) "FZ2" + +type Fq = PrimeField 21888242871839275222246405745257275088696311157297823662689037894645226208583 +data Pu +instance IrreducibleMonic Fq Pu where split _ = x^2 + 1 +type Fq2 = ExtensionField Fq Pu +test_Fq2 = fieldAxioms (Proxy :: Proxy Fq2) "Fq2" +data Pv +instance IrreducibleMonic Fq2 Pv where split _ = x^3 - (9 + t x) +type Fq6 = ExtensionField Fq2 Pv +test_Fq6 = fieldAxioms (Proxy :: Proxy Fq6) "Fq6" +data Pw +instance IrreducibleMonic Fq6 Pw where split _ = x^2 - t x +type Fq12 = ExtensionField Fq6 Pw +test_Fq12 = fieldAxioms (Proxy :: Proxy Fq12) "Fq12" diff --git a/tests/GaloisFieldTests.hs b/tests/GaloisFieldTests.hs new file mode 100644 --- /dev/null +++ b/tests/GaloisFieldTests.hs @@ -0,0 +1,51 @@ +module GaloisFieldTests where + +import Protolude + +import Test.Tasty +import Test.Tasty.QuickCheck + +associativity :: Eq a => (a -> a -> a) -> a -> a -> a -> Bool +associativity op x y z = op x (op y z) == op (op x y) z + +commutativity :: Eq a => (a -> a -> a) -> a -> a -> Bool +commutativity op x y = op x y == op y x + +distributivity :: Eq a => (a -> a -> a) -> (a -> a -> a) -> a -> a -> a -> Bool +distributivity op op' x y z = op (op' x y) z == op' (op x z) (op y z) + && op x (op' y z) == op' (op x y) (op x z) + +identities :: Eq a => (a -> a -> a) -> a -> a -> Bool +identities op e x = op x e == x && op e x == x + +inverses :: Eq a => (a -> a -> a) -> (a -> a) -> a -> a -> Bool +inverses op inv e x = op x (inv x) == e && op (inv x) x == e + +ringAxioms :: forall r . (Arbitrary r, Eq r, Num r, Show r) + => Proxy r -> TestName -> TestTree +ringAxioms _ str = testGroup ("Test ring axioms of " <> str) + [ testProperty "commutativity of addition" + $ commutativity ((+) :: r -> r -> r) + , testProperty "commutativity of multiplication" + $ commutativity ((*) :: r -> r -> r) + , testProperty "associativity of addition" + $ associativity ((+) :: r -> r -> r) + , testProperty "associativity of multiplication" + $ associativity ((*) :: r -> r -> r) + , testProperty "distributivity of multiplication over addition" + $ distributivity ((*) :: r -> r -> r) (+) + , testProperty "additive identity" + $ identities ((+) :: r -> r -> r) 0 + , testProperty "multiplicative identity" + $ identities ((*) :: r -> r -> r) 1 + , testProperty "additive inverses" + $ inverses ((+) :: r -> r -> r) negate 0 + ] + +fieldAxioms :: forall k . (Arbitrary k, Eq k, Fractional k, Show k) + => Proxy k -> TestName -> TestTree +fieldAxioms p str = testGroup ("Test field axioms of " <> str) + [ ringAxioms p str + , testProperty "multiplicative inverses" + $ \n -> n /= 0 ==> inverses ((*) :: k -> k -> k) recip 1 n + ] diff --git a/tests/Main.hs b/tests/Main.hs new file mode 100644 --- /dev/null +++ b/tests/Main.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --tree-display #-} diff --git a/tests/PolynomialRingTests.hs b/tests/PolynomialRingTests.hs new file mode 100644 --- /dev/null +++ b/tests/PolynomialRingTests.hs @@ -0,0 +1,38 @@ +module PolynomialRingTests where + +import Protolude + +import Test.Tasty.QuickCheck + +import GaloisField +import GaloisFieldTests +import PolynomialRing +import PrimeField +import PrimeFieldTests + +instance (Arbitrary k, GaloisField k) => Arbitrary (Polynomial k) where + arbitrary = toPoly <$> arbitrary + +test_S2X = ringAxioms (Proxy :: Proxy (Polynomial (PrimeField 2))) "FS2[X]" + +test_S3X = ringAxioms (Proxy :: Proxy (Polynomial (PrimeField 3))) "FS3[X]" + +test_S5X = ringAxioms (Proxy :: Proxy (Polynomial (PrimeField 5))) "FS5[X]" + +test_S7X = ringAxioms (Proxy :: Proxy (Polynomial (PrimeField 7))) "FS7[X]" + +test_M0X = ringAxioms (Proxy :: Proxy (Polynomial (PrimeField 2147483647))) "FM0[X]" + +test_M1X = ringAxioms (Proxy :: Proxy (Polynomial (PrimeField 2305843009213693951))) "FM1[X]" + +test_M2X = ringAxioms (Proxy :: Proxy (Polynomial (PrimeField 618970019642690137449562111))) "FM2[X]" + +test_M3X = ringAxioms (Proxy :: Proxy (Polynomial (PrimeField 162259276829213363391578010288127))) "FM3[X]" + +test_M4X = ringAxioms (Proxy :: Proxy (Polynomial (PrimeField 170141183460469231731687303715884105727))) "FM4[X]" + +test_VLX = ringAxioms (Proxy :: Proxy (Polynomial (PrimeField 20988936657440586486151264256610222593863921))) "FVL[X]" + +test_XLX = ringAxioms (Proxy :: Proxy (Polynomial (PrimeField 5210644015679228794060694325390955853335898483908056458352183851018372555735221))) "FXL[X]" + +test_ZLX = ringAxioms (Proxy :: Proxy (Polynomial (PrimeField 741640062627530801524787141901937474059940781097519023905821316144415759504705008092818711693940737))) "FZL[X]" diff --git a/tests/PrimeFieldTests.hs b/tests/PrimeFieldTests.hs new file mode 100644 --- /dev/null +++ b/tests/PrimeFieldTests.hs @@ -0,0 +1,35 @@ +module PrimeFieldTests where + +import Protolude + +import Test.Tasty.QuickCheck + +import PrimeField +import GaloisFieldTests + +instance KnownNat p => Arbitrary (PrimeField p) where + arbitrary = fromInteger <$> arbitrary + +test_S2 = fieldAxioms (Proxy :: Proxy (PrimeField 2)) "FS2" + +test_S3 = fieldAxioms (Proxy :: Proxy (PrimeField 3)) "FS3" + +test_S5 = fieldAxioms (Proxy :: Proxy (PrimeField 5)) "FS5" + +test_S7 = fieldAxioms (Proxy :: Proxy (PrimeField 7)) "FS7" + +test_M0 = fieldAxioms (Proxy :: Proxy (PrimeField 2147483647)) "FM0" + +test_M1 = fieldAxioms (Proxy :: Proxy (PrimeField 2305843009213693951)) "FM1" + +test_M2 = fieldAxioms (Proxy :: Proxy (PrimeField 618970019642690137449562111)) "FM2" + +test_M3 = fieldAxioms (Proxy :: Proxy (PrimeField 162259276829213363391578010288127)) "FM3" + +test_M4 = fieldAxioms (Proxy :: Proxy (PrimeField 170141183460469231731687303715884105727)) "FM4" + +test_VL = fieldAxioms (Proxy :: Proxy (PrimeField 20988936657440586486151264256610222593863921)) "FVL" + +test_XL = fieldAxioms (Proxy :: Proxy (PrimeField 5210644015679228794060694325390955853335898483908056458352183851018372555735221)) "FXL" + +test_ZL = fieldAxioms (Proxy :: Proxy (PrimeField 741640062627530801524787141901937474059940781097519023905821316144415759504705008092818711693940737)) "FZL"