diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -1,6 +1,13 @@ Changelog for lol project ================================ +0.4.0.0 +---- + * Added support for GHC 8.0, also compatible with 7.10.3 + * Converted documentation to MathJax + * Renamed Tensor.Matrix -> Tensor.Kron + * Added Crypto.Lol.Types interface file + 0.3.0.0 ----- * Support for protocol-buffers diff --git a/Crypto/Lol.hs b/Crypto/Lol.hs --- a/Crypto/Lol.hs +++ b/Crypto/Lol.hs @@ -1,16 +1,49 @@ --- | Re-exports primary interfaces. +-- | \( \def\Z{\mathbb{Z}} \) +-- \( \def\C{\mathbb{C}} \) +-- \( \def\Q{\mathbb{Q}} \) +-- \( \def\R{\mathbb{R}} \) +-- \( \def\F{\mathbb{F}} \) +-- \( \def\O{\mathcal{O}} \) +-- +-- This module re-exports primary interfaces, and should be the only import +-- needed for most cryptographic application implmenetations. To instantiate an +-- application with concrete types, you will also need to import +-- "Crypto.Lol.Types". +-- +-- Below is a brief mathematical background which serves as reference +-- material for reading the documentation. +-- +-- * \( \Z \) denotes the ring of integers, \( \Q \) is the rational numbers, +-- \( \R \) denotes the real numbers, and \( \C \) represents the complex +-- numbers. +-- +-- * \( \Z_q = \Z/(q\Z) \) is the integers mod \( q \). \( \Z_q \) is +-- implemented in "Crypto.Lol.Types.ZqBasic". +-- +-- * The finite field of order \( p \) is denoted \( \F_{p} \), and is +-- implemented in "Crypto.Lol.Types.FiniteField". +-- +-- * \( \zeta_m \in R \) is an arbitrary element of order \( m \) in a +-- ring \( R \). +-- +-- * Throughout, \( m \) denotes a cyclotomic /index/. In code, the cyclotomic +-- index is represented by the type parameter @m :: 'Factored'@. +-- +-- * The ring \( R=\O_m=\Z[\zeta_m] \) is the \( m \)th cyclotomic ring. +-- We denote the quotient ring \( \Z_q[\zeta_m]) \) by \( R_q \). +-- We refer to \( \Z \) or \( \Z_q \) as the /base ring/. +-- Cyclotomic rings are encapsulated by "Crypto.Lol.Cyclotomic.Cyc". +-- +-- * \( n=\varphi(m) \) is the totient function of the cyclotomic index. +-- This is the dimension of a cyclotomic ring over the base ring. module Crypto.Lol ( module X ) where -import Crypto.Lol.Cyclotomic.Cyc as X -import Crypto.Lol.Gadget as X -import Crypto.Lol.Prelude as X - -import Crypto.Lol.Cyclotomic.Tensor.CTensor as X -import Crypto.Lol.Cyclotomic.Tensor.RepaTensor as X -import Crypto.Lol.Types.IrreducibleChar2 as X () -import Crypto.Lol.Types.RRq as X -import Crypto.Lol.Types.ZqBasic as X +import Crypto.Lol.Cyclotomic.Cyc as X +import Crypto.Lol.Cyclotomic.Linear as X +import Crypto.Lol.Cyclotomic.RescaleCyc as X +import Crypto.Lol.Gadget as X +import Crypto.Lol.Prelude as X diff --git a/Crypto/Lol/CRTrans.hs b/Crypto/Lol/CRTrans.hs --- a/Crypto/Lol/CRTrans.hs +++ b/Crypto/Lol/CRTrans.hs @@ -6,7 +6,9 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} --- | Classes and helper methods for the Chinese remainder transform +-- | \( \def\C{\mathbb{C}} \) +-- +-- Classes and helper methods for the Chinese remainder transform -- and ring extensions. module Crypto.Lol.CRTrans @@ -20,38 +22,39 @@ import Control.Arrow -- | Information that characterizes the (invertible) Chinese remainder --- transformation over a ring @r@, namely: +-- transformation over a ring \(R\) (represented by the type @r@), namely: -- --- (1) a function that returns the @i@th power of some /principal/ --- @m@th root of unity (for any integer @i@) +-- (1) a function that returns the \(i\)th power of some +-- /principal/ \(m\)th root of unity +-- (for any integer \(i\)) -- --- (2) the multiplicative inverse of @\\hat{m}@ in @r@. +-- (2) the multiplicative inverse of \(\hat{m}\in R\). type CRTInfo r = (Int -> r, r) -- | A ring that (possibly) supports invertible Chinese remainder -- transformations of various indices. --- | The values of 'crtInfo' for different indices @m@ should be --- consistent, in the sense that if @omega@, @omega'@ are respectively --- the roots of unity used for @m@, @m'@ where @m@ divides @m'@, then --- it should be the case that @omega'^(m'/m)=omega@. +-- | The values of 'crtInfo' for different indices \(m\) should be +-- consistent, in the sense that if \(\omega_m\), \(\omega_{m'}\) are respectively +-- \(m\)th, \(m'\)th roots of unity where \(m\) divides \(m'\), then +-- it should be the case that \(\omega_{m'}^{m'/m}=\omega_m\). class (Monad mon, Ring r) => CRTrans mon r where - -- | 'CRTInfo' for a given index @m@. The method itself may be + -- | 'CRTInfo' for a given index \(m\). The method itself may be -- slow, but the function it returns should be fast, e.g., via -- internal memoization. crtInfo :: Reflects m Int => TaggedT m mon (CRTInfo r) --- | A ring with a ring embedding into some ring @CRTExt r@ that has --- an invertible CRT transformation for /every/ positive index @m@. +-- | A ring with a ring embedding into some ring @'CRTExt' r@ that has +-- an invertible CRT transformation for /every/ positive index \(m\). class (Ring r, Ring (CRTExt r)) => CRTEmbed r where type CRTExt r - -- | Embeds from @r@ to @CRTExt r@ + -- | Embeds from @r@ to @'CRTExt' r@ toExt :: r -> CRTExt r - -- | Projects from @CRTExt r@ to @r@ + -- | Projects from @'CRTExt' r@ to @r@ fromExt :: CRTExt r -> r -- | Product ring @@ -67,7 +70,7 @@ toExt = toExt *** toExt fromExt = fromExt *** fromExt --- | Complex numbers have 'CRTrans' for any index @m@ +-- | Complex numbers have 'CRTrans' for any index \(m\) instance (Monad mon, Transcendental a) => CRTrans mon (Complex a) where crtInfo = crtInfoC @@ -96,25 +99,25 @@ instance CRTrans Maybe Integer where crtInfo = tagT Nothing -- can also do for Int8, Int16, Int32 etc. --- | Embeds into complex numbers +-- | Embeds into the complex numbers \(\C\). instance CRTEmbed Double where type CRTExt Double = Complex Double toExt = fromReal . realToField fromExt = realToField . real --- | Embeds into complex numbers +-- | Embeds into the complex numbers \(\C\). instance CRTEmbed Int where type CRTExt Int = Complex Double toExt = fromIntegral fromExt = fst . roundComplex --- | Embeds into complex numbers +-- | Embeds into the complex numbers \(\C\). instance CRTEmbed Int64 where type CRTExt Int64 = Complex Double toExt = fromIntegral fromExt = fst . roundComplex --- | Embeds into complex numbers. (May not have sufficient +-- | Embeds into the complex numbers \(\C\). (May not have sufficient -- precision.) instance CRTEmbed Integer where -- CJP: sufficient precision? Not in general. diff --git a/Crypto/Lol/Cyclotomic/Cyc.hs b/Crypto/Lol/Cyclotomic/Cyc.hs --- a/Crypto/Lol/Cyclotomic/Cyc.hs +++ b/Crypto/Lol/Cyclotomic/Cyc.hs @@ -12,14 +12,21 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} --- | An implementation of cyclotomic rings that hides the +-- | \( \def\Z{\mathbb{Z}} \) +-- \( \def\F{\mathbb{F}} \) +-- \( \def\Q{\mathbb{Q}} \) +-- \( \def\Tw{\text{Tw}} \) +-- \( \def\Tr{\text{Tr}} \) +-- \( \def\O{\mathcal{O}} \) +-- +-- An implementation of cyclotomic rings that hides the -- internal representations of ring elements (e.g., the choice of -- basis), and also offers more efficient storage and operations on -- subring elements (including elements from the base ring itself). -- -- For an implementation that allows (and requires) the programmer to -- control the underlying representation, see --- 'Crypto.Lol.Cyclotomic.UCyc.UCyc'. +-- "Crypto.Lol.Cyclotomic.UCyc". -- -- __WARNING:__ as with all fixed-point arithmetic, the functions -- associated with 'Cyc' may result in overflow (and thereby @@ -44,8 +51,6 @@ , tGaussian, errorRounded, errorCoset -- * Sub/extension rings , embed, twace, coeffsCyc, coeffsPow, coeffsDec, powBasis, crtSet --- * Rescaling cyclotomic elements -, R.RescaleCyc(..), R.Basis(..) ) where import qualified Algebra.Additive as Additive (C) @@ -67,22 +72,23 @@ import Crypto.Lol.Types.Proto import Crypto.Lol.Types.ZPP -import Control.Applicative hiding ((*>)) +import Control.Applicative hiding ((*>)) import Control.Arrow import Control.DeepSeq -import Control.Monad.Identity -- GHC warning is wrong: https://ghc.haskell.org/trac/ghc/ticket/12067 +-- GHC warning is wrong: https://ghc.haskell.org/trac/ghc/ticket/12067 +import Control.Monad.Identity import Control.Monad.Random import Data.Coerce import Data.Traversable import Test.QuickCheck - --- | Represents a cyclotomic ring such as @Z[zeta]@, --- @Zq[zeta]@, and @Q(zeta)@ in an explicit representation: @t@ is the +-- | Represents a cyclotomic ring such as \(\Z[\zeta_m]\), +-- \(\Z_q[\zeta_m]\), and \(\Q[\zeta_m]\) in an explicit +-- representation: @t@ is the -- 'Tensor' type for storing coefficient tensors; @m@ is the -- cyclotomic index; @r@ is the base ring of the coefficients (e.g., --- @Z@, @Zq@). +-- \(\Z\), \(\Z_q\)). data Cyc t m r where Pow :: !(UCyc t m P r) -> Cyc t m r Dec :: !(UCyc t m D r) -> Cyc t m r @@ -276,9 +282,9 @@ -- ELSE: work in appropriate CRT rep c1 * c2 = toCRT' c1 * toCRT' c2 --- | @Rp@ is an @F_{p^d}@-module when @d@ divides @phi(m)@, by --- applying @d@-dimensional @Fp@-linear transform on @d@-dim chunks of --- powerful basis coeffs +-- | \(R_p\) is an \(\F_{p^d}\)-module when \(d\) divides \(\varphi(m)\), by +-- applying \(d\)-dimensional \(\F_p\)-linear transform on \(d\)-dim chunks of +-- powerful basis coeffs. instance (GFCtx fp d, Fact m, CElt t fp) => Module.C (GF fp d) (Cyc t m fp) where -- CJP: optimize for Scalar if we can: r *> (Scalar c) is the tensor -- that has the coeffs of (r*c), followed by zeros. (This assumes @@ -309,7 +315,8 @@ -- other values. adviseCRT = toCRT' --- | Multiply by the special element @g@ of the @m@th cyclotomic. +-- | Multiply by the special element \(g\) of the \(m\)th +-- cyclotomic. mulG :: (Fact m, CElt t r) => Cyc t m r -> Cyc t m r {-# INLINABLE mulG #-} mulG (Pow u) = Pow $ U.mulG u @@ -318,7 +325,7 @@ mulG c@(Scalar _) = mulG $ toCRT' c mulG (Sub c) = mulG $ embed' c -- must go to full ring --- | Divide by @g@, returning 'Nothing' if not evenly divisible. +-- | Divide by \(g\), returning 'Nothing' if not evenly divisible. -- WARNING: this implementation is not a constant-time algorithm, so -- information about the argument may be leaked through a timing -- channel. @@ -331,17 +338,17 @@ divG c@(Scalar _) = divG $ toCRT' c divG (Sub c) = divG $ embed' c -- must go to full ring --- | Sample from the "tweaked" Gaussian error distribution @t*D@ in --- the decoding basis, where @D@ has scaled variance @v@. +-- | Sample from the "tweaked" Gaussian error distribution \(t\cdot D\) in +-- the decoding basis, where \(D\) has scaled variance \(v\). tGaussian :: (Fact m, OrdFloat q, Random q, Tensor t, TElt t q, ToRational v, MonadRandom rnd) => v -> rnd (Cyc t m q) tGaussian = (Dec <$>) . U.tGaussian {-# INLINABLE tGaussian #-} --- | Yield the scaled squared norm of @g_m \cdot e@ under +-- | Yield the scaled squared norm of \(g_m \cdot e\) under -- the canonical embedding, namely, --- @\hat{m}^{ -1 } \cdot || \sigma(g_m \cdot e) ||^2@ . +-- \(\hat{m}^{-1} \cdot \| \sigma(g_m \cdot e) \|^2\). gSqNorm :: forall t m r . (Fact m, CElt t r) => Cyc t m r -> r {-# INLINABLE gSqNorm #-} gSqNorm (Dec u) = U.gSqNorm u @@ -350,7 +357,7 @@ -- | Generate an LWE error term with given scaled variance, -- deterministically rounded with respect to the decoding basis. -- (Note: This --- implementation uses Double precision to generate the Gaussian +-- implementation uses 'Double' precision to generate the Gaussian -- sample, which may not be sufficient for rigorous proof-based -- security.) errorRounded :: (ToInteger z, Tensor t, Fact m, TElt t z, @@ -358,15 +365,15 @@ {-# INLINABLE errorRounded #-} errorRounded = (Dec <$>) . U.errorRounded --- | Generate an LWE error term with given scaled variance @* p^2@ over +-- | Generate an LWE error term with given scaled variance \(v \cdot p^2\) over -- the given coset, deterministically rounded with respect to the -- decoding basis. (Note: This --- implementation uses Double precision to generate the Gaussian +-- implementation uses 'Double' precision to generate the Gaussian -- sample, which may not be sufficient for rigorous proof-based -- security.) errorCoset :: (Mod zp, z ~ ModRep zp, Lift zp z, Fact m, - CElt t zp, TElt t z, ToRational v, MonadRandom rnd) + CElt t zp, ToRational v, MonadRandom rnd) => v -> Cyc t m zp -> rnd (Cyc t m z) errorCoset v = (Dec <$>) . U.errorCoset v . uncycDec {-# INLINABLE errorCoset #-} @@ -392,8 +399,8 @@ \\ transDivides (Proxy::Proxy k) (Proxy::Proxy l) (Proxy::Proxy m) -- | The "tweaked trace" (twace) function --- @Tw(x) = (mhat \/ m'hat) * Tr(g' \/ g * x)@, --- which fixes @R@ pointwise (i.e., @twace . embed == id@). +-- \(\Tw(x) = (\hat{m} / \hat{m}') \cdot \Tr((g' / g) \cdot x)\), +-- which fixes \(R\) pointwise (i.e., @twace . embed == id@). twace :: forall t m m' r . (m `Divides` m', CElt t r) => Cyc t m' r -> Cyc t m r {-# INLINABLE twace #-} @@ -406,7 +413,8 @@ -- | Return the given element's coefficient vector with respect to -- the (relative) powerful/decoding basis of the cyclotomic --- extension @O_m' / O_m@. See also 'coeffsPow', 'coeffsDec'. +-- extension \(\O_{m'} / \O_m\). +-- See also 'coeffsPow', 'coeffsDec'. coeffsCyc :: (m `Divides` m', CElt t r) => R.Basis -> Cyc t m' r -> [Cyc t m r] {-# INLINABLE coeffsCyc #-} coeffsCyc R.Pow c' = Pow <$> U.coeffsPow (uncycPow c') @@ -415,12 +423,12 @@ coeffsPow, coeffsDec :: (m `Divides` m', CElt t r) => Cyc t m' r -> [Cyc t m r] {-# INLINABLE coeffsPow #-} {-# INLINABLE coeffsDec #-} --- | Specialized version of @coeffsCyc@ for powerful basis. +-- | Specialized version of 'coeffsCyc' for powerful basis. coeffsPow = coeffsCyc R.Pow --- | Specialized version of @coeffsCyc@ for decoding basis. +-- | Specialized version of 'coeffsCyc' for decoding basis. coeffsDec = coeffsCyc R.Dec --- | The relative powerful basis of @O_m' / O_m@. +-- | The relative powerful basis of \(\O_{m'} / \O_m\). powBasis :: (m `Divides` m', CElt t r) => Tagged m [Cyc t m' r] powBasis = (Pow <$>) <$> U.powBasis {-# INLINABLE powBasis #-} @@ -435,7 +443,7 @@ ---------- Lattice operations and instances ---------- instance (Reduce a b, Fact m, CElt t a, CElt t b) - -- CJP: need these specific constraints to get Reduce instance for Sub case + -- CJP: need these specific constraints to get Reduce instance for Sub case => Reduce (Cyc t m a) (Cyc t m b) where {-# INLINABLE reduce #-} reduce (Pow u) = Pow $ reduce u @@ -472,7 +480,7 @@ liftDec c = Dec $ lift $ uncycDec c -- | Unzip for a pair base ring. -unzipCyc :: (Tensor t, Fact m, CElt t (a,b), CElt t a, CElt t b) +unzipCyc :: (Fact m, CElt t (a,b), CElt t a, CElt t b) => Cyc t m (a,b) -> (Cyc t m a, Cyc t m b) {-# INLINABLE unzipCyc #-} unzipCyc (Pow u) = Pow *** Pow $ U.unzipPow u @@ -482,7 +490,6 @@ unzipCyc (Scalar c) = Scalar *** Scalar $ c unzipCyc (Sub c) = Sub *** Sub $ unzipCyc c --- | generic instance instance {-# OVERLAPS #-} (Rescale a b, CElt t a, TElt t b) => R.RescaleCyc (Cyc t) a b where @@ -496,7 +503,7 @@ rescaleCyc R.Dec c = Dec $ fmapDec rescale $ uncycDec c {-# INLINABLE rescaleCyc #-} --- | specialized instance for product rings of @Zq@s: ~2x faster +-- | specialized instance for product rings of \(\Z_q\)s: ~2x faster -- algorithm instance (Mod a, Field b, Lift a (ModRep a), Reduce (LiftOf a) b, CElt t (a,b), CElt t a, CElt t b, CElt t (LiftOf a)) diff --git a/Crypto/Lol/Cyclotomic/Linear.hs b/Crypto/Lol/Cyclotomic/Linear.hs --- a/Crypto/Lol/Cyclotomic/Linear.hs +++ b/Crypto/Lol/Cyclotomic/Linear.hs @@ -12,7 +12,9 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} --- | Functions from one cyclotomic ring to another that are linear +-- | \( \def\lcm{\text{lcm}} \) +-- +-- Functions from one cyclotomic ring to another that are linear -- over a common subring. module Crypto.Lol.Cyclotomic.Linear @@ -28,7 +30,7 @@ import Control.Applicative import Control.DeepSeq --- | An @E@-linear function from @R@ to @S@. +-- | An \(E\)-linear function from \(R\) to \(S\). -- CJP: also have constructor for relative Pow basis of R/E? So far -- not needed. @@ -39,8 +41,8 @@ -- some params are phantom but matter for safety type role Linear representational nominal representational representational nominal --- | Construct an @E@-linear function given a list of its output values --- (in @S@) on the relative decoding basis of @R/E@. The number of +-- | Construct an \(E\)-linear function given a list of its output values +-- (in \(S\)) on the relative decoding basis of \(R/E\). The number of -- elements in the list must not exceed the size of the basis. linearDec :: forall t z e r s . (e `Divides` r, e `Divides` s, CElt t z) @@ -56,7 +58,7 @@ (e `Divides` r, e `Divides` s, CElt t z) => Linear t z e r s -> Cyc t r z -> Cyc t s z evalLin (RD ys) r = sum (zipWith (*) ys $ - embed <$> (coeffsCyc Dec r :: [Cyc t e z])) + embed <$> (coeffsDec r :: [Cyc t e z])) instance Additive (Cyc t s z) => Additive.C (Linear t z e r s) where zero = RD [] @@ -77,7 +79,7 @@ -- | lifts with respect to powerful basis, for best geometry instance (CElt t zp, CElt t z, z ~ LiftOf zp, Lift zp z, Fact s) => Lift' (Linear t zp e r s) where - lift (RD ys) = RD $ liftCyc Pow <$> ys + lift (RD ys) = RD $ liftPow <$> ys -- | A convenient constraint synonym for extending a linear function -- to larger rings. @@ -85,12 +87,12 @@ (Fact r, e ~ FGCD r e', r' ~ FLCM r e', -- these imply R'=R\otimes_E E' e' `Divides` s', s `Divides` s') -- lcm(s,e')|s' <=> (S+E') \subseteq S' --- | Extend an @E@-linear function @R->S@ to an @E'@-linear function --- @R\'->S\'@. (Mathematically, such extension only requires --- @lcm(r,e\') | r\'@ (not equality), but this generality would +-- | Extend an \(E\)-linear function \(R\to S\) to an \(E'\)-linear +-- function \(R'\to S'\). (Mathematically, such extension only requires +-- \(\lcm(r,e') | r'\) (not equality), but this generality would -- significantly complicate the implementation, and for our purposes --- there's no reason to use any larger @r'@.) -extendLin :: (ExtendLinIdx e r s e' r' s', CElt t z) +-- there's no reason to use any larger \(r'\).) +extendLin :: (ExtendLinIdx e r s e' r' s') => Linear t z e r s -> Linear t z e' r' s' -- CJP: this simple implementation works because R/E and R'/E' have -- identical decoding bases, because R' \cong R \otimes_E E'. If we diff --git a/Crypto/Lol/Cyclotomic/RescaleCyc.hs b/Crypto/Lol/Cyclotomic/RescaleCyc.hs --- a/Crypto/Lol/Cyclotomic/RescaleCyc.hs +++ b/Crypto/Lol/Cyclotomic/RescaleCyc.hs @@ -1,6 +1,8 @@ {-# LANGUAGE MultiParamTypeClasses #-} --- | A class and helper functions for rescaling cycltomic ring elements. +-- | \( \def\Z{\mathbb{Z}} \) +-- +-- A class and helper functions for rescaling cycltomic ring elements. module Crypto.Lol.Cyclotomic.RescaleCyc where diff --git a/Crypto/Lol/Cyclotomic/Tensor.hs b/Crypto/Lol/Cyclotomic/Tensor.hs --- a/Crypto/Lol/Cyclotomic/Tensor.hs +++ b/Crypto/Lol/Cyclotomic/Tensor.hs @@ -1,17 +1,27 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +#if __GLASGOW_HASKELL__ >= 800 +{-# LANGUAGE UndecidableSuperClasses #-} +#endif --- | Interface for cyclotomic tensors, and helper functions for tensor +-- | \( \def\Z{\mathbb{Z}} \) +-- \( \def\Tw{\text{Tw}} \) +-- \( \def\Tr{\text{Tr}} \) +-- \( \def\CRT{\text{CRT}} \) +-- \( \def\O{\mathcal{O}} \) +-- +-- Interface for cyclotomic tensors, and helper functions for tensor -- indexing. module Crypto.Lol.Cyclotomic.Tensor @@ -20,7 +30,7 @@ , hasCRTFuncs , scalarCRT, mulGCRT, divGCRT, crt, crtInv, twaceCRT, embedCRT -- * Special vectors/matrices -, Matrix, indexM, gCRTM, gInvCRTM, twCRTs +, Kron, indexK, gCRTK, gInvCRTK, twCRTs -- * Tensor indexing , zmsToIndexFact , indexInfo @@ -48,11 +58,11 @@ -- for cyclotomic ring arithmetic. -- | The type @t m r@ represents a cyclotomic coefficient tensor of --- index @m@ over base ring @r@. Most of the methods represent linear +-- index \(m\) over base ring \(r\). Most of the methods represent linear -- transforms corresponding to operations in particular bases. -- CRT-related methods are wrapped in 'Maybe' because they are --- well-defined only when a CRT basis exists over the ring @r@ for --- index @m@. +-- well-defined only when a CRT basis exists over the ring \(r\) for +-- index \(m\). -- | The superclass constraints are for convenience, to ensure that we -- can sample error tensors of 'Double's. @@ -72,19 +82,22 @@ -- | Properties that hold for any index. Use with '\\'. entailIndexT :: Tagged (t m r) (Fact m :- (Applicative (t m), Traversable (t m))) - - -- | Properties that hold for any (legal) fully-applied tensor. Use - -- with '\\'. + -- | Holds for any (legal) fully-applied tensor. Use with '\\'. entailEqT :: Tagged (t m r) ((Eq r, Fact m, TElt t r) :- Eq (t m r)) + -- | Holds for any (legal) fully-applied tensor. Use with '\\'. entailZTT :: Tagged (t m r) ((ZeroTestable r, Fact m, TElt t r) :- ZeroTestable (t m r)) + -- | Holds for any (legal) fully-applied tensor. Use with '\\'. entailNFDataT :: Tagged (t m r) ((NFData r, Fact m, TElt t r) :- NFData (t m r)) + -- | Holds for any (legal) fully-applied tensor. Use with '\\'. entailRandomT :: Tagged (t m r) ((Random r, Fact m, TElt t r) :- Random (t m r)) + -- | Holds for any (legal) fully-applied tensor. Use with '\\'. entailShowT :: Tagged (t m r) ((Show r, Fact m, TElt t r) :- Show (t m r)) + -- | Holds for any (legal) fully-applied tensor. Use with '\\'. entailModuleT :: Tagged (GF fp d, t m fp) ((GFCtx fp d, Fact m, TElt t fp) :- Module (GF fp d) (t m fp)) @@ -95,12 +108,12 @@ -- powerful-basis representation; 'lInv' is its inverse. l, lInv :: (Additive r, Fact m, TElt t r) => t m r -> t m r - -- | Multiply by @g@ in the powerful/decoding basis + -- | Multiply by \(g_m\) in the powerful/decoding basis mulGPow, mulGDec :: (Ring r, Fact m, TElt t r) => t m r -> t m r - -- | Divide by @g@ in the powerful/decoding basis. The 'Maybe' + -- | Divide by \(g_m\) in the powerful/decoding basis. The 'Maybe' -- output indicates that the operation may fail, which happens - -- exactly when the input is not divisible by @g@. + -- exactly when the input is not divisible by \(g_m\). divGPow, divGDec :: (ZeroTestable r, IntegralDomain r, Fact m, TElt t r) => t m r -> Maybe (t m r) @@ -116,16 +129,16 @@ t m r -> t m r, -- crt t m r -> t m r) -- crtInv - -- | Sample from the "tweaked" Gaussian error distribution @t*D@ - -- in the decoding basis, where @D@ has scaled variance @v@. + -- | Sample from the "tweaked" Gaussian error distribution \(t\cdot D\) + -- in the decoding basis, where \(D\) has scaled variance \(v\). tGaussianDec :: (OrdFloat q, Random q, TElt t q, ToRational v, Fact m, MonadRandom rnd) => v -> rnd (t m q) - -- | Given the coefficient tensor of @e@ with respect to the - -- decoding basis of @R@, yield the (scaled) squared norm of @g_m - -- \cdot e@ under the canonical embedding, namely, - -- @\hat{m}^{ -1 } \cdot || \sigma(g_m \cdot e) ||^2@ . + -- | Given the coefficient tensor of \(e\) with respect to the + -- decoding basis of \(R\), yield the (scaled) squared norm of + -- \(g_m \cdot e\) under the canonical embedding, namely, + -- \(\hat{m}^{-1} \cdot \| \sigma(g_m \cdot e) \|^2\). gSqNormDec :: (Ring r, Fact m, TElt t r) => t m r -> r -- | The @twace@ linear transformation, which is the same in both the @@ -147,21 +160,19 @@ t m r -> t m' r) -- embedCRT -- | Map a tensor in the powerful\/decoding\/CRT basis, representing - -- an @O_m'@ element, to a vector of tensors representing @O_m@ - -- elements in the same kind of basis. + -- an \(\O_{m'}\) element, to a vector of tensors representing + -- \(\O_m\) elements in the same kind of basis. coeffs :: (Ring r, m `Divides` m', TElt t r) => t m' r -> [t m r] -- | The powerful extension basis w.r.t. the powerful basis. powBasisPow :: (Ring r, TElt t r, m `Divides` m') => Tagged m [t m' r] - -- | A list of tensors representing the mod-@p@ CRT set of the - -- extension. + -- | A list of tensors representing the mod-@p@ CRT set of the extension. crtSetDec :: (m `Divides` m', PrimeField fp, Coprime (PToF (CharOf fp)) m', TElt t fp) => Tagged m [t m' fp] - -- | Potentially optimized version of 'fmap' for types that satisfy - -- 'TElt'. + -- | Potentially optimized version of 'fmap' for types that satisfy 'TElt'. fmapT :: (Fact m, TElt t a, TElt t b) => (a -> b) -> t m a -> t m b -- | Potentially optimized monadic 'fmap'. fmapTM :: (Monad mon, Fact m, TElt t a, TElt t b) @@ -202,10 +213,10 @@ {-# INLINABLE crt #-} {-# INLINABLE crtInv #-} --- | Multiply by @g@ in the CRT basis. (This function is simply an +-- | Multiply by \(g_m\) in the CRT basis. (This function is simply an -- appropriate entry from 'crtFuncs'.) mulGCRT = (\(_,f,_,_,_) -> f) <$> crtFuncs --- | Divide by @g@ in the CRT basis. (This function is simply an +-- | Divide by \(g_m\) in the CRT basis. (This function is simply an -- appropriate entry from 'crtFuncs'.) divGCRT = (\(_,_,f,_,_) -> f) <$> crtFuncs -- | The CRT transform. (This function is simply an appropriate entry @@ -216,8 +227,8 @@ crtInv = (\(_,_,_,_,f) -> f) <$> crtFuncs -- | The "tweaked trace" function for tensors in the CRT basis: --- For cyclotomic indices m | m', --- @Tw(x) = (mhat\/m\'hat) * Tr(g\'\/g * x)@. +-- For cyclotomic indices \(m \mid m'\), +-- \(\Tw(x) = (\hat{m}/\hat{m}') \cdot \Tr((g'/g) \cdot x)\). -- (This function is simply an appropriate entry from 'crtExtFuncs'.) twaceCRT :: forall t m m' mon r . (CRTrans mon r, Tensor t, m `Divides` m', TElt t r) => mon (t m' r -> t m r) @@ -225,8 +236,8 @@ proxyT hasCRTFuncs (Proxy::Proxy (t m r)) *> (fst <$> crtExtFuncs) --- | Embed a tensor with index @m@ in the CRT basis to a tensor with --- index @m'@ in the CRT basis. +-- | Embed a tensor with index \(m\) in the CRT basis to a tensor with +-- index \(m'\) in the CRT basis. -- (This function is simply an appropriate entry from 'crtExtFuncs'.) embedCRT :: forall t m m' mon r . (CRTrans mon r, Tensor t, m `Divides` m', TElt t r) => mon (t m r -> t m' r) @@ -234,11 +245,11 @@ proxyT hasCRTFuncs (Proxy::Proxy (t m r)) *> (snd <$> crtExtFuncs) -fMatrix :: forall m r mon . (Fact m, Monad mon, Ring r) - => (forall pp . (PPow pp) => TaggedT pp mon (MatrixC r)) - -> TaggedT m mon (Matrix r) -fMatrix mat = tagT $ go $ sUnF (sing :: SFactored m) - where go :: Sing (pplist :: [PrimePower]) -> mon (Matrix r) +fKron :: forall m r mon . (Fact m, Monad mon) + => (forall pp . (PPow pp) => TaggedT pp mon (KronC r)) + -> TaggedT m mon (Kron r) +fKron mat = tagT $ go $ sUnF (sing :: SFactored m) + where go :: Sing (pplist :: [PrimePower]) -> mon (Kron r) go spps = case spps of SNil -> return MNil (SCons spp rest) -> do @@ -246,13 +257,13 @@ mat' <- withWitnessT mat spp return $ MKron rest' mat' --- | For a prime power @p^e@, converts any matrix @M@ for --- prime @p@ to @1_(p^{e-1}) \otimes M@, where @1@ denotes the all-1s --- vector. -ppMatrix :: forall pp r mon . (PPow pp, Monad mon, Ring r) - => (forall p . (Prime p) => TaggedT p mon (MatrixC r)) - -> TaggedT pp mon (MatrixC r) -ppMatrix mat = tagT $ case (sing :: SPrimePower pp) of +-- | For a prime power \(p^e\), converts any matrix \(M\) for +-- prime \(p\) to \(\vece{1}_(p^{e-1}) \otimes M\), where \(\vece{1}\) +-- denotes the all-1s vector. +ppKron :: forall pp r mon . (PPow pp, Monad mon) + => (forall p . (Prime p) => TaggedT p mon (KronC r)) + -> TaggedT pp mon (KronC r) +ppKron mat = tagT $ case (sing :: SPrimePower pp) of pp@(SPP (STuple2 sp _)) -> do (MC h w f) <- withWitnessT mat sp let d = withWitness valuePPow pp `div` withWitness valuePrime sp @@ -260,35 +271,37 @@ -- deeply embedded DSL for Kronecker products of matrices -data MatrixC r = +data KronC r = MC Int Int -- dims (Int -> Int -> r) -- yields element i,j -- | A Kronecker product of zero of more matrices over @r@. -data Matrix r = MNil | MKron (Matrix r) (MatrixC r) -- snoc list +data Kron r = MNil | MKron (Kron r) (KronC r) -- snoc list --- | Extract the @(i,j)@ element of a 'Matrix'. -indexM :: Ring r => Matrix r -> Int -> Int -> r -indexM MNil 0 0 = LP.one -indexM (MKron m (MC r c mc)) i j = +-- | Extract the @(i,j)@ element of a 'Kron'. +indexK :: Ring r => Kron r -> Int -> Int -> r +indexK MNil 0 0 = LP.one +indexK (MKron m (MC r c mc)) i j = let (iq,ir) = i `divMod` r (jq,jr) = j `divMod` c - in indexM m iq jq * mc ir jr + in indexK m iq jq * mc ir jr -gCRTM, gInvCRTM :: (Fact m, CRTrans mon r) => TaggedT m mon (Matrix r) --- | A @tot(m)@-by-1 matrix of the CRT coefficients of @g_m@, for @m@th --- cyclotomic. -gCRTM = fMatrix gCRTPPow --- | A @tot(m)@-by-1 matrix of the inverse CRT coefficients of @g_m@, for @m@th --- cyclotomic. -gInvCRTM = fMatrix gInvCRTPPow +gCRTK, gInvCRTK :: (Fact m, CRTrans mon r) => TaggedT m mon (Kron r) +-- | A \(\varphi(m)\)-by-1 matrix of the CRT coefficients of \(g_m\), for +-- \(m\)th cyclotomic. +gCRTK = fKron gCRTPPow +-- | A \(\varphi(m)\)-by-1 matrix of the inverse CRT coefficients of \(g_m\), +-- for \(m\)th cyclotomic. +gInvCRTK = fKron gInvCRTPPow --- | The "tweaked" CRT^* matrix: @CRT^* . diag(sigma(g_m))@. -twCRTs :: (Fact m, CRTrans mon r) => TaggedT m mon (Matrix r) -twCRTs = fMatrix twCRTsPPow +-- | The "tweaked" \(\CRT^*\) matrix: +-- \(\CRT^* \cdot \text{diag}(\sigma(g_m))\). +twCRTs :: (Fact m, CRTrans mon r) => TaggedT m mon (Kron r) +twCRTs = fKron twCRTsPPow --- | The "tweaked" CRT^* matrix (for prime powers): @CRT^* * diag(sigma(g_p))@. -twCRTsPPow :: (PPow pp, CRTrans mon r) => TaggedT pp mon (MatrixC r) +-- | The "tweaked" \(\CRT^*\) matrix (for prime powers): +-- \(\CRT^* \cdot \text{diag}(\sigma(g_p))\). +twCRTsPPow :: (PPow pp, CRTrans mon r) => TaggedT pp mon (KronC r) twCRTsPPow = do phi <- pureT totientPPow iToZms <- pureT indexToZmsPPow @@ -298,22 +311,22 @@ return $ MC phi phi (\j i -> wPow (jToPow j * negate (iToZms i)) * gCRT i 0) -gCRTPPow, gInvCRTPPow :: (PPow pp, CRTrans mon r) => TaggedT pp mon (MatrixC r) -gCRTPPow = ppMatrix gCRTPrime -gInvCRTPPow = ppMatrix gInvCRTPrime +gCRTPPow, gInvCRTPPow :: (PPow pp, CRTrans mon r) => TaggedT pp mon (KronC r) +gCRTPPow = ppKron gCRTPrime +gInvCRTPPow = ppKron gInvCRTPrime -gCRTPrime, gInvCRTPrime :: (Prime p, CRTrans mon r) => TaggedT p mon (MatrixC r) +gCRTPrime, gInvCRTPrime :: (Prime p, CRTrans mon r) => TaggedT p mon (KronC r) --- | A @(p-1)@-by-1 matrix of the CRT coefficients of @g_p@, for @p@th --- cyclotomic. +-- | A \((p-1)\)-by-1 matrix of the CRT coefficients of \(g_p\), for +-- \(p\)th cyclotomic. gCRTPrime = do p <- pureT valuePrime (wPow, _) <- crtInfo return $ MC (p-1) 1 $ if p == 2 then const $ const one else (\i _ -> one - wPow (i+1)) --- | A @(p-1)@-by-1 matrix of the inverse CRT coefficients of @g_p@, --- for the @p@th cyclotomic. +-- | A \((p-1)\)-by-1 matrix of the inverse CRT coefficients of \(g_p\), +-- for the \(p\)th cyclotomic. gInvCRTPrime = do p <- pureT valuePrime (wPow, phatinv) <- crtInfo @@ -324,7 +337,7 @@ -- Reindexing functions --- | Base-p digit reversal; input and output are in @[p^e]@. +-- | Base-\(p\) digit reversal; input and output are in \([p^e]\). digitRev :: PP -> Int -> Int digitRev (_,0) 0 = 0 -- CJP: use accumulator to avoid multiple exponentiations? @@ -336,24 +349,24 @@ indexToPowPPow = indexToPow <$> ppPPow indexToZmsPPow = indexToZms <$> ppPPow --- | Convert a @Z_m^*@ index to a linear tensor index in @[m]@. +-- | Convert a \(\Z_m^*\) index to a linear tensor index in \([m]\). zmsToIndexFact :: Fact m => Tagged m (Int -> Int) zmsToIndexFact = zmsToIndex <$> ppsFact --- | For a prime power @p^e@, map a tensor index to the corresponding --- power j in @[phi(p^e)]@, as in the powerful basis. +-- | For a prime power \(p^e\), map a tensor index to the corresponding +-- power \(j \in [\varphi(p^e)]\), as in the powerful basis. indexToPow :: PP -> Int -> Int -- CJP: use accumulator to avoid multiple exponentiations? indexToPow (p,e) j = let (jq,jr) = j `divMod` (p-1) in p^(e-1)*jr + digitRev (p,e-1) jq --- | For a prime power @p^e@, map a tensor index to the corresponding --- element i in @Z_{p^e}^*@. +-- | For a prime power \(p^e\), map a tensor index to the corresponding +-- element \(i \in \Z_{p^e}^*\). indexToZms :: PP -> Int -> Int indexToZms (p,_) i = let (i1,i0) = i `divMod` (p-1) in p*i1 + i0 + 1 --- | Convert a Z_m^* index to a linear tensor index. +-- | Convert a \(\Z_m^*\) index to a linear tensor index. zmsToIndex :: [PP] -> Int -> Int zmsToIndex [] _ = 0 zmsToIndex (pp:rest) i = zmsToIndexPP pp (i `mod` valuePP pp) @@ -366,11 +379,12 @@ -- Index correspondences for ring extensions --- | Correspondences between the linear indexes into a basis of O_m', --- and pair indices into (extension basis) \otimes (basis of O_m). --- The work the same for Pow,Dec,CRT bases because all these bases --- have that factorization. The first argument is the list of --- @(phi(m),phi(m'))@ pairs for the (merged) prime powers of @m@,@m'@. +-- | Correspondences between the linear indexes into a basis of +-- \(\O_{m'}\), and pair indices into (extension basis) \(\otimes\) +-- (basis of \(\O_m\)). The work the same for Pow, Dec, and CRT bases +-- because all these bases have that factorization. The first argument is the +-- list of \((\varphi(m),\varphi(m'))\) pairs for the (merged) prime powers +-- of \(m\),\(m'\). toIndexPair :: [(Int,Int)] -> Int -> (Int,Int) fromIndexPair :: [(Int,Int)] -> (Int,Int) -> Int @@ -389,11 +403,11 @@ in (i0r + i1r*phi) + i*phi' -- | A collection of useful information for working with tensor --- extensions. The first component is a list of triples @(p,e,e')@ --- where @e@, @e'@ are respectively the exponents of prime @p@ in @m@, --- @m'@. The next two components are @phi(m)@ and @phi(m')@. The --- final component is a pair @(phi(p^e), phi(p^e'))@ for each triple --- in the first component. +-- extensions. The first component is a list of triples \((p,e,e')\) +-- where \(e\), \(e'\) are respectively the exponents of prime \(p\) in \(m\), +-- \(m'\). The next two components are \(\varphi(m)\) and \(\varphi(m')\). The +-- final component is a pair \( ( \varphi(p^e), \varphi(p^{e'}))\) for each +-- triple in the first component. indexInfo :: forall m m' . (m `Divides` m') => Tagged '(m, m') ([(Int,Int,Int)], Int, Int, [(Int,Int)]) indexInfo = let pps = proxy ppsFact (Proxy::Proxy m) @@ -404,18 +418,18 @@ tots = totients mpps in tag (mpps, phi, phi', tots) --- | A vector of @phi(m)@ entries, where the @i@th entry is the index --- into the powerful\/decoding basis of @O_m'@ of the --- @i@th entry of the powerful\/decoding basis of @O_m@. +-- | A vector of \(\varphi(m)\) entries, where the \(i\)th entry is +-- the index into the powerful\/decoding basis of \(\O_{m'}\) of the +-- \(i\)th entry of the powerful/decoding basis of \(\O_m\). extIndicesPowDec :: (m `Divides` m') => Tagged '(m, m') (U.Vector Int) extIndicesPowDec = do (_, phi, _, tots) <- indexInfo return $ U.generate phi (fromIndexPair tots . (0,)) --- | A vector of @phi(m)@ blocks of @phi(m')\/phi(m)@ consecutive +-- | A vector of \(\varphi(m)\) blocks of \(\varphi(m')/\varphi(m)\) consecutive -- entries. Each block contains all those indices into the CRT basis --- of @O_m'@ that "lie above" the corresponding index into the CRT --- basis of @O_m@. +-- of \(\O_{m'}\) that "lie above" the corresponding index into the CRT +-- basis of \(\O_m\). extIndicesCRT :: forall m m' . (m `Divides` m') => Tagged '(m, m') (U.Vector Int) extIndicesCRT = do @@ -430,10 +444,10 @@ (mpps, _, phi', _) <- indexInfo return $ U.generate phi' (f mpps) --- | A lookup table for 'toIndexPair' applied to indices @[phi(m')]@. +-- | A lookup table for 'toIndexPair' applied to indices \([\varphi(m')]\). baseIndicesPow :: forall m m' . (m `Divides` m') => Tagged '(m, m') (U.Vector (Int,Int)) --- | A lookup table for 'baseIndexDec' applied to indices @[phi(m')]@. +-- | A lookup table for 'baseIndexDec' applied to indices \([\varphi(m')]\). baseIndicesDec :: forall m m' . (m `Divides` m') => Tagged '(m, m') (U.Vector (Maybe (Int,Bool))) @@ -451,7 +465,8 @@ baseWrapper (\pps -> snd . toIndexPair (totients pps)) --- | The @i0@th entry of the @i1@th vector is 'fromIndexPair' @(i1,i0)@. +-- | The \(i_0\)th entry of the \(i_1\)th vector is +-- 'fromIndexPair' \((i_1,i_0)\). extIndicesCoeffs :: forall m m' . (m `Divides` m') => Tagged '(m, m') (V.Vector (U.Vector Int)) extIndicesCoeffs = do diff --git a/Crypto/Lol/Cyclotomic/Tensor/CTensor.hs b/Crypto/Lol/Cyclotomic/Tensor/CTensor.hs --- a/Crypto/Lol/Cyclotomic/Tensor/CTensor.hs +++ b/Crypto/Lol/Cyclotomic/Tensor/CTensor.hs @@ -1,10 +1,23 @@ -{-# LANGUAGE ConstraintKinds, DataKinds, FlexibleContexts, - FlexibleInstances, GADTs, GeneralizedNewtypeDeriving, - InstanceSigs, MultiParamTypeClasses, NoImplicitPrelude, - PolyKinds, RankNTypes, RebindableSyntax, RoleAnnotations, - ScopedTypeVariables, StandaloneDeriving, TupleSections, - TypeFamilies, TypeOperators, TypeSynonymInstances, - UndecidableInstances #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RebindableSyntax #-} +{-# LANGUAGE RoleAnnotations #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE UndecidableInstances #-} -- | Wrapper for a C++ implementation of the 'Tensor' interface. @@ -169,7 +182,7 @@ -- CJP: Additive, Ring are not necessary when we use zipWithT -- EAC: This has performance implications for the CT backend, -- which used a (very fast) C function for (*) and (+) -instance (Additive r, Storable r, Fact m, Dispatch r) +instance (Additive r, Storable r, Fact m) => Additive.C (CT m r) where (CT (CT' a)) + (CT (CT' b)) = CT $ CT' $ SV.zipWith (+) a b a + b = toCT a + toCT b @@ -186,7 +199,7 @@ fromInteger = CT . repl . fromInteger -} -instance (ZeroTestable r, Storable r, Fact m) +instance (ZeroTestable r, Storable r) => ZeroTestable.C (CT m r) where --{-# INLINABLE isZero #-} isZero (CT (CT' a)) = SV.foldl' (\ b x -> b && isZero x) True a @@ -320,18 +333,15 @@ -- | Useful coersion for defining @coeffs@ in the @Tensor@ -- interface. Using 'coerce' alone is insufficient for type inference. -coerceCoeffs :: (Fact m, Fact m') - => Tagged '(m,m') (Vector r -> [Vector r]) -> CT' m' r -> [CT' m r] +coerceCoeffs :: Tagged '(m,m') (Vector r -> [Vector r]) -> CT' m' r -> [CT' m r] coerceCoeffs = coerce -- | Useful coersion for defining @powBasisPow@ and @crtSetDec@ in the @Tensor@ -- interface. Using 'coerce' alone is insufficient for type inference. -coerceBasis :: - (Fact m, Fact m') - => Tagged '(m,m') [Vector r] -> Tagged m [CT' m' r] +coerceBasis :: Tagged '(m,m') [Vector r] -> Tagged m [CT' m' r] coerceBasis = coerce -mulGPow' :: (TElt CT r, Fact m, Additive r) => CT' m r -> CT' m r +mulGPow' :: (TElt CT r, Fact m) => CT' m r -> CT' m r mulGPow' = untag $ basicDispatch dmulgpow divGPow' :: (TElt CT r, Fact m, IntegralDomain r, ZeroTestable r) @@ -352,12 +362,12 @@ f pout totm pfac numFacts)) CT' <$> unsafeFreeze yout -basicDispatch :: (Storable r, Fact m, Additive r) +basicDispatch :: (Storable r, Fact m) => (Ptr r -> Int64 -> Ptr CPP -> Int16 -> IO ()) -> Tagged m (CT' m r -> CT' m r) basicDispatch f = return $ unsafePerformIO . withBasicArgs f -gSqNormDec' :: (Storable r, Fact m, Additive r, Dispatch r) +gSqNormDec' :: (Storable r, Fact m, Dispatch r) => Tagged m (CT' m r -> r) gSqNormDec' = return $ (!0) . unCT . unsafePerformIO . withBasicArgs dnorm @@ -390,7 +400,7 @@ divIfDivis num den = let (q,r) = num `divMod` den in if isZero r then Just q else Nothing -cZipDispatch :: (Storable r, Fact m, Additive r) +cZipDispatch :: (Storable r, Fact m) => (Ptr r -> Ptr r -> Int64 -> IO ()) -> Tagged m (CT' m r -> CT' m r -> CT' m r) cZipDispatch f = do -- in Tagged m @@ -477,16 +487,16 @@ pureT ppsFact wrapVector :: forall mon m r . (Monad mon, Fact m, Ring r, Storable r) - => TaggedT m mon (Matrix r) -> mon (CT' m r) + => TaggedT m mon (Kron r) -> mon (CT' m r) wrapVector v = do vmat <- proxyT v (Proxy::Proxy m) let n = proxy totientFact (Proxy::Proxy m) - return $ CT' $ generate n (flip (indexM vmat) 0) + return $ CT' $ generate n (flip (indexK vmat) 0) gCRT, gInvCRT :: (Storable r, CRTrans mon r, Fact m) => mon (CT' m r) -gCRT = wrapVector gCRTM -gInvCRT = wrapVector gInvCRTM +gCRT = wrapVector gCRTK +gInvCRT = wrapVector gInvCRTK -- we can't put this in Extension with the rest of the twace/embed -- functions because it needs access to the C backend diff --git a/Crypto/Lol/Cyclotomic/Tensor/CTensor/Backend.hs b/Crypto/Lol/Cyclotomic/Tensor/CTensor/Backend.hs --- a/Crypto/Lol/Cyclotomic/Tensor/CTensor/Backend.hs +++ b/Crypto/Lol/Cyclotomic/Tensor/CTensor/Backend.hs @@ -1,6 +1,17 @@ -{-# LANGUAGE ConstraintKinds, FlexibleContexts, FlexibleInstances, - MultiParamTypeClasses, PolyKinds, ScopedTypeVariables, - TypeFamilies, UndecidableInstances #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +#if __GLASGOW_HASKELL__ >= 800 +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-} +#endif -- | This module contains the functions to transform Haskell types into their -- C counterpart, and to transform polymorphic Haskell functions into C funtion @@ -40,12 +51,16 @@ import Foreign.Storable (Storable (..)) import qualified Foreign.Storable.Record as Store +#if __GLASGOW_HASKELL__ >= 800 +import GHC.TypeLits -- for error message +#endif + -- | Convert a list of prime powers to a suitable C representation. marshalFactors :: [PP] -> Vector CPP marshalFactors = SV.fromList . LP.map (\(p,e) -> CPP (fromIntegral p) (fromIntegral e)) -- http://stackoverflow.com/questions/6517387/vector-vector-foo-ptr-ptr-foo-io-a-io-a --- | Evaluates a C function that takes a @a** ptr@ on a list of Vectors. +-- | Evaluates a C function that takes an "a** ptr" on a list of Vectors. withPtrArray :: (Storable a) => [Vector a] -> (Ptr (Ptr a) -> IO b) -> IO b withPtrArray v f = do let vs = LP.map SV.unsafeToForeignPtr0 v @@ -73,10 +88,7 @@ instance Show CPP where show (CPP p e) = "(" LP.++ show p LP.++ "," LP.++ show e LP.++ ")" -instance (Storable a, Storable b, - CTypeOf a ~ CTypeOf b) - -- enforces right associativity and that each type of - -- the tuple has the same C repr, so using an array repr is safe +instance (Storable a, Storable b) => Storable (a,b) where sizeOf _ = sizeOf (undefined :: a) + sizeOf (undefined :: b) alignment _ = max (alignment (undefined :: a)) (alignment (undefined :: b)) @@ -99,13 +111,31 @@ data RRqD type family CTypeOf x where - CTypeOf (a,b) = CTypeOf a + CTypeOf (a,b) = EqCType a b (CTypeOf a) (CTypeOf b) CTypeOf (ZqBasic (q :: k) Int64) = ZqB64D CTypeOf Double = DoubleD CTypeOf Int64 = Int64D CTypeOf (Complex Double) = ComplexD CTypeOf (RRq (q :: k) Double) = RRqD +#if __GLASGOW_HASKELL__ >= 800 + -- EAC: this doesn't display like I had hoped when there is a tuple involved... + CTypeOf (ZqBasic (q :: k) i) = TypeError (Text "Unsupported C type: " :<>: ShowType (ZqBasic q i) :$$: Text "Use Int64 as the base ring") + CTypeOf (Complex i) = TypeError (Text "Unsupported C type: " :<>: ShowType (Complex i) :$$: Text "Use Double as the base ring") + CTypeOf (RRq (q :: k) i) = TypeError (Text "Unsupported C type: " :<>: ShowType (RRq q i) :$$: Text "Use Double as the base ring") + CTypeOf a = TypeError (Text "Unsupported C type: " :<>: ShowType a) +#endif +type family EqCType a b c d where + EqCType a b ZqB64D ZqB64D = ZqB64D + EqCType a b RRqD RRqD = RRqD + EqCType a b ComplexD ComplexD = ComplexD +#if __GLASGOW_HASKELL__ >= 800 + EqCType a b c c = TypeError (Text "Cannot call C code on a tuple of type " :<>: ShowType a) + EqCType a b c d = TypeError (Text "You are trying to use CTensor on a tuple," :<>: + Text " but the tuple contains two different C types: " :$$: + ShowType a :<>: Text " and " :<>: ShowType b) +#endif + -- returns the modulus as a nested list of moduli class (Tuple a) => ZqTuple a where type ModPairs a @@ -228,6 +258,7 @@ mulRq numPairs (castPtr aout) (castPtr bout) totm (castPtr qsptr) dgaussdec = error "cannot call CT gaussianDec on type ZqBasic" +-- products of Complex correspond to CRTExt of a Zq product instance (Tuple r, CTypeOf r ~ ComplexD) => Dispatch' ComplexD r where dcrt ruptr pout totm pfac numFacts = tensorCRTC (proxy numComponents (Proxy::Proxy r)) (castPtr pout) totm pfac numFacts (castPtr ruptr) @@ -240,47 +271,51 @@ dnorm = error "cannot call CT normSq on type Complex Double" dmulgpow pout = tensorGPowC (proxy numComponents (Proxy::Proxy r)) (castPtr pout) - dmulgdec = error "cannot call CT mulGDec on type Complex Double" + dmulgdec pout = + tensorGDecC (proxy numComponents (Proxy::Proxy r)) (castPtr pout) dginvpow pout = tensorGInvPowC (proxy numComponents (Proxy::Proxy r)) (castPtr pout) - dginvdec = error "cannot call CT divGDec on type Complex Double" + dginvdec pout = + tensorGInvDecC (proxy numComponents (Proxy::Proxy r)) (castPtr pout) dmul aout bout = mulC (proxy numComponents (Proxy::Proxy r)) (castPtr aout) (castPtr bout) dgaussdec = error "cannot call CT gaussianDec on type Comple Double" -instance (Tuple r, CTypeOf r ~ DoubleD) => Dispatch' DoubleD r where +-- no support for products of Double +instance Dispatch' DoubleD Double where dcrt = error "cannot call CT Crt on type Double" dcrtinv = error "cannot call CT CrtInv on type Double" dl pout = - tensorLDouble (proxy numComponents (Proxy::Proxy r)) (castPtr pout) + tensorLDouble 1 (castPtr pout) dlinv pout = - tensorLInvDouble (proxy numComponents (Proxy::Proxy r)) (castPtr pout) - dnorm pout = tensorNormSqD (proxy numComponents (Proxy::Proxy r)) (castPtr pout) + tensorLInvDouble 1 (castPtr pout) + dnorm pout = tensorNormSqD 1 (castPtr pout) dmulgpow = error "cannot call CT mulGPow on type Double" dmulgdec = error "cannot call CT mulGDec on type Double" dginvpow = error "cannot call CT divGPow on type Double" dginvdec = error "cannot call CT divGDec on type Double" dmul = error "cannot call CT (*) on type Double" dgaussdec ruptr pout totm pfac numFacts = - tensorGaussianDec (proxy numComponents (Proxy::Proxy r)) (castPtr pout) totm pfac numFacts (castPtr ruptr) + tensorGaussianDec 1 (castPtr pout) totm pfac numFacts (castPtr ruptr) -instance (Tuple r, CTypeOf r ~ Int64D) => Dispatch' Int64D r where +-- no support for products of Z +instance Dispatch' Int64D Int64 where dcrt = error "cannot call CT Crt on type Int64" dcrtinv = error "cannot call CT CrtInv on type Int64" dl pout = - tensorLR (proxy numComponents (Proxy::Proxy r)) (castPtr pout) + tensorLR 1 (castPtr pout) dlinv pout = - tensorLInvR (proxy numComponents (Proxy::Proxy r)) (castPtr pout) + tensorLInvR 1 (castPtr pout) dnorm pout = - tensorNormSqR (proxy numComponents (Proxy::Proxy r)) (castPtr pout) + tensorNormSqR 1 (castPtr pout) dmulgpow pout = - tensorGPowR (proxy numComponents (Proxy::Proxy r)) (castPtr pout) + tensorGPowR 1 (castPtr pout) dmulgdec pout = - tensorGDecR (proxy numComponents (Proxy::Proxy r)) (castPtr pout) + tensorGDecR 1 (castPtr pout) dginvpow pout = - tensorGInvPowR (proxy numComponents (Proxy::Proxy r)) (castPtr pout) + tensorGInvPowR 1 (castPtr pout) dginvdec pout = - tensorGInvDecR (proxy numComponents (Proxy::Proxy r)) (castPtr pout) + tensorGInvDecR 1 (castPtr pout) dmul = error "cannot call CT (*) on type Int64" dgaussdec = error "cannot call CT gaussianDec on type Int64" @@ -301,11 +336,13 @@ foreign import ccall unsafe "tensorGPowC" tensorGPowC :: Int16 -> Ptr (Complex Double) -> Int64 -> Ptr CPP -> Int16 -> IO () foreign import ccall unsafe "tensorGDecR" tensorGDecR :: Int16 -> Ptr Int64 -> Int64 -> Ptr CPP -> Int16 -> IO () foreign import ccall unsafe "tensorGDecRq" tensorGDecRq :: Int16 -> Ptr (ZqBasic q Int64) -> Int64 -> Ptr CPP -> Int16 -> Ptr Int64 -> IO () +foreign import ccall unsafe "tensorGDecC" tensorGDecC :: Int16 -> Ptr (Complex Double) -> Int64 -> Ptr CPP -> Int16 -> IO () foreign import ccall unsafe "tensorGInvPowR" tensorGInvPowR :: Int16 -> Ptr Int64 -> Int64 -> Ptr CPP -> Int16 -> IO () foreign import ccall unsafe "tensorGInvPowRq" tensorGInvPowRq :: Int16 -> Ptr (ZqBasic q Int64) -> Int64 -> Ptr CPP -> Int16 -> Ptr Int64 -> IO () foreign import ccall unsafe "tensorGInvPowC" tensorGInvPowC :: Int16 -> Ptr (Complex Double) -> Int64 -> Ptr CPP -> Int16 -> IO () foreign import ccall unsafe "tensorGInvDecR" tensorGInvDecR :: Int16 -> Ptr Int64 -> Int64 -> Ptr CPP -> Int16 -> IO () foreign import ccall unsafe "tensorGInvDecRq" tensorGInvDecRq :: Int16 -> Ptr (ZqBasic q Int64) -> Int64 -> Ptr CPP -> Int16 -> Ptr Int64 -> IO () +foreign import ccall unsafe "tensorGInvDecC" tensorGInvDecC :: Int16 -> Ptr (Complex Double) -> Int64 -> Ptr CPP -> Int16 -> IO () foreign import ccall unsafe "tensorCRTRq" tensorCRTRq :: Int16 -> Ptr (ZqBasic q Int64) -> Int64 -> Ptr CPP -> Int16 -> Ptr (Ptr (ZqBasic q Int64)) -> Ptr Int64 -> IO () foreign import ccall unsafe "tensorCRTC" tensorCRTC :: Int16 -> Ptr (Complex Double) -> Int64 -> Ptr CPP -> Int16 -> Ptr (Ptr (Complex Double)) -> IO () diff --git a/Crypto/Lol/Cyclotomic/Tensor/CTensor/Extension.hs b/Crypto/Lol/Cyclotomic/Tensor/CTensor/Extension.hs --- a/Crypto/Lol/Cyclotomic/Tensor/CTensor/Extension.hs +++ b/Crypto/Lol/Cyclotomic/Tensor/CTensor/Extension.hs @@ -1,7 +1,13 @@ -{-# LANGUAGE ConstraintKinds, DataKinds, FlexibleContexts, - MultiParamTypeClasses, NoImplicitPrelude, PolyKinds, - RebindableSyntax, ScopedTypeVariables, TypeFamilies, - TypeOperators #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RebindableSyntax #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} -- | CT-specific functions for embedding/twacing in various bases @@ -111,10 +117,10 @@ h :: Int = proxy valueHatFact m'p hinv = recip $ fromIntegral h in reify d $ \(_::Proxy d) -> do - let twCRTs' :: Matrix (GF fp d) + let twCRTs' :: Kron (GF fp d) = fromMaybe (error "internal error: crtSetDec': twCRTs") $ proxyT twCRTs m'p zmsToIdx = proxy T.zmsToIndexFact m'p - elt j i = indexM twCRTs' j (zmsToIdx i) + elt j i = indexK twCRTs' j (zmsToIdx i) trace' = trace :: GF fp d -> fp -- to avoid recomputing powTraces cosets <- partitionCosets p return $ LP.map (\is -> generate phi diff --git a/Crypto/Lol/Cyclotomic/Tensor/CTensor/g.cpp b/Crypto/Lol/Cyclotomic/Tensor/CTensor/g.cpp --- a/Crypto/Lol/Cyclotomic/Tensor/CTensor/g.cpp +++ b/Crypto/Lol/Cyclotomic/Tensor/CTensor/g.cpp @@ -139,6 +139,11 @@ canonicalizeZq(y,tupSize,totm,qs); } +extern "C" void tensorGDecC (hShort_t tupSize, Complex* y, hDim_t totm, PrimeExponent* peArr, hShort_t sizeOfPE) +{ + tensorFuserPrime (y, tupSize, gDec, totm, peArr, sizeOfPE, (hInt_t*)0); +} + extern "C" void tensorGInvPowR (hShort_t tupSize, hInt_t* y, hDim_t totm, PrimeExponent* peArr, hShort_t sizeOfPE) { tensorFuserPrime (y, tupSize, gInvPow, totm, peArr, sizeOfPE, (hInt_t*)0); @@ -165,3 +170,8 @@ tensorFuserPrime (y, tupSize, gInvDec, totm, peArr, sizeOfPE, qs); canonicalizeZq(y,tupSize,totm,qs); } + +extern "C" void tensorGInvDecC (hShort_t tupSize, Complex* y, hDim_t totm, PrimeExponent* peArr, hShort_t sizeOfPE) +{ + tensorFuserPrime (y, tupSize, gInvDec, totm, peArr, sizeOfPE, (hInt_t*)0); +} diff --git a/Crypto/Lol/Cyclotomic/Tensor/CTensor/types.h b/Crypto/Lol/Cyclotomic/Tensor/CTensor/types.h --- a/Crypto/Lol/Cyclotomic/Tensor/CTensor/types.h +++ b/Crypto/Lol/Cyclotomic/Tensor/CTensor/types.h @@ -117,7 +117,25 @@ this->imag = (a*b.imag)+(this->imag*b.real); return *this; } + Complex& operator/=(const Complex& b) + { + Complex bconj; + bconj.real = b.real; + bconj.imag = -b.imag; + *this *= bconj; + double den = (b.real*b.real+b.imag*b.imag); + this->real /= den; + this->imag /= den; + return *this; + } }; +inline char operator==(Complex a, const Complex& b) +{ + // This is only used in divGDec, where we do a divisiblity check. + // The divisibility check should always succeed for Complex since \C is a field, + // however if we actually implement equality, it would fail due to roundoff. + return 1; +} inline Complex operator+(Complex a, const Complex& b) { a += b; @@ -131,6 +149,11 @@ inline Complex operator*(Complex a, const Complex& b) { a *= b; + return a; +} +inline Complex operator/(Complex a, const Complex& b) +{ + a /= b; return a; } diff --git a/Crypto/Lol/Cyclotomic/Tensor/RepaTensor.hs b/Crypto/Lol/Cyclotomic/Tensor/RepaTensor.hs --- a/Crypto/Lol/Cyclotomic/Tensor/RepaTensor.hs +++ b/Crypto/Lol/Cyclotomic/Tensor/RepaTensor.hs @@ -4,7 +4,7 @@ RoleAnnotations, ScopedTypeVariables, StandaloneDeriving, TypeFamilies, TypeOperators, UndecidableInstances #-} --- | A pure, repa-based implementation of the Tensor interface. +-- | A pure, repa-based implementation of the 'Tensor' interface. module Crypto.Lol.Cyclotomic.Tensor.RepaTensor ( RT ) where diff --git a/Crypto/Lol/Cyclotomic/Tensor/RepaTensor/CRT.hs b/Crypto/Lol/Cyclotomic/Tensor/RepaTensor/CRT.hs --- a/Crypto/Lol/Cyclotomic/Tensor/RepaTensor/CRT.hs +++ b/Crypto/Lol/Cyclotomic/Tensor/RepaTensor/CRT.hs @@ -1,6 +1,9 @@ -{-# LANGUAGE ConstraintKinds, FlexibleContexts, GADTs, - MultiParamTypeClasses, NoImplicitPrelude, ScopedTypeVariables - #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ScopedTypeVariables #-} -- | Functions to support the chinese remainder transform on Repa arrays @@ -30,32 +33,32 @@ in pure $ Arr . force . fromFunction sz . const -- | Multiply by @g_m@ in the CRT basis (when it exists). -mulGCRT' :: (Fact m, CRTrans mon r, Unbox r, Elt r) +mulGCRT' :: (Fact m, CRTrans mon r, Unbox r) => mon (Arr m r -> Arr m r) {-# INLINABLE mulGCRT' #-} mulGCRT' = (coerce (\x -> force . RT.zipWith (*) x) `asTypeOf` asTypeOf) <$> gCRT -- | Divide by @g@ in the CRT basis (when it exists). -divGCRT' :: (Fact m, CRTrans mon r, Unbox r, Elt r) => mon (Arr m r -> Arr m r) +divGCRT' :: (Fact m, CRTrans mon r, Unbox r) => mon (Arr m r -> Arr m r) {-# INLINABLE divGCRT' #-} divGCRT' = (coerce (\x -> force . RT.zipWith (*) x) `asTypeOf` asTypeOf) <$> gInvCRT -wrapVector :: forall mon m r . (Monad mon, Fact m, Ring r, Unbox r, Elt r) - => TaggedT m mon (Matrix r) -> mon (Arr m r) +wrapVector :: forall mon m r . (Monad mon, Fact m, Ring r, Unbox r) + => TaggedT m mon (Kron r) -> mon (Arr m r) wrapVector v = do vmat <- proxyT v (Proxy::Proxy m) let n = proxy totientFact (Proxy::Proxy m) return $ coerce $ force $ RT.fromFunction (Z:.n) - (\(Z:.i) -> indexM vmat i 0) + (\(Z:.i) -> indexK vmat i 0) -gCRT, gInvCRT :: (Fact m, CRTrans mon r, Unbox r, Elt r) => mon (Arr m r) +gCRT, gInvCRT :: (Fact m, CRTrans mon r, Unbox r) => mon (Arr m r) {-# INLINABLE gCRT #-} {-# INLINABLE gInvCRT #-} -- | The coefficient vector of @g@ in the CRT basis (when it exists). -gCRT = wrapVector gCRTM +gCRT = wrapVector gCRTK -- | The coefficient vector of @g^{ -1 }@ in the CRT basis (when it exists). -gInvCRT = wrapVector gInvCRTM +gInvCRT = wrapVector gInvCRTK fCRT, fCRTInv :: forall mon m r . (Fact m, CRTrans mon r, Unbox r, Elt r) @@ -132,7 +135,7 @@ (Id (dim pp'dftInv') @* pcrtInv') .* pptwidInv .* (pp'dftInv' @* Id (dim pcrtInv')) -butterfly :: (Additive r, Unbox r, Elt r) => Trans r +butterfly :: (Additive r) => Trans r butterfly = trans 2 $ \arr -> fromFunction (extent arr) $ \(sh:.j) -> case j of @@ -188,7 +191,7 @@ -- twiddle factors for DFT_pp and CRT_pp decompositions ppTwid, ppTwidHat :: - forall mon pp r . (PPow pp, CRTrans mon r, Unbox r, Elt r) + forall mon pp r . (PPow pp, CRTrans mon r, Unbox r) => Bool -> TaggedT pp mon (Trans r) {-# INLINABLE ppTwid #-} diff --git a/Crypto/Lol/Cyclotomic/Tensor/RepaTensor/Extension.hs b/Crypto/Lol/Cyclotomic/Tensor/RepaTensor/Extension.hs --- a/Crypto/Lol/Cyclotomic/Tensor/RepaTensor/Extension.hs +++ b/Crypto/Lol/Cyclotomic/Tensor/RepaTensor/Extension.hs @@ -1,7 +1,15 @@ -{-# LANGUAGE BangPatterns, ConstraintKinds, DataKinds, FlexibleContexts, - FlexibleInstances, MultiParamTypeClasses, NoImplicitPrelude, - PolyKinds, ScopedTypeVariables, TemplateHaskell, - TypeFamilies, TypeOperators #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} -- | RT-specific functions for embedding/twacing in various bases @@ -136,10 +144,10 @@ h :: Int = proxy valueHatFact m'p hinv = recip $ fromIntegral h in reify d $ \(_::Proxy d) -> - let twCRTs' :: T.Matrix (GF fp d) + let twCRTs' :: T.Kron (GF fp d) = fromMaybe (error "internal error: crtSetDec': twCRTs") $ proxyT T.twCRTs m'p zmsToIdx = proxy T.zmsToIndexFact m'p - elt j i = T.indexM twCRTs' j (zmsToIdx i) + elt j i = T.indexK twCRTs' j (zmsToIdx i) trace' = trace :: GF fp d -> fp cosets = proxy (partitionCosets p) (Proxy::Proxy '(m,m')) in LP.map (\is -> Arr $ force $ fromFunction (Z :. phi) diff --git a/Crypto/Lol/Cyclotomic/Tensor/RepaTensor/GL.hs b/Crypto/Lol/Cyclotomic/Tensor/RepaTensor/GL.hs --- a/Crypto/Lol/Cyclotomic/Tensor/RepaTensor/GL.hs +++ b/Crypto/Lol/Cyclotomic/Tensor/RepaTensor/GL.hs @@ -12,8 +12,10 @@ import Crypto.Lol.Prelude as LP import Data.Coerce -fL, fLInv, fGPow, fGDec :: (Fact m, Additive r, Unbox r, Elt r) +fLInv, fGPow :: (Fact m, Additive r, Unbox r) => Arr m r -> Arr m r +fL, fGDec :: (Fact m, Additive r, Unbox r, Elt r) + => Arr m r -> Arr m r {-# INLINABLE fL #-} {-# INLINABLE fLInv #-} {-# INLINABLE fGPow #-} @@ -45,7 +47,7 @@ fGInvDec = wrapGInv' pGInvDec' wrapGInv' :: forall m r . - (Fact m, IntegralDomain r, ZeroTestable r, Unbox r, Elt r) + (Fact m, IntegralDomain r, ZeroTestable r, Unbox r) => (forall p . Prime p => Tagged p (Trans r)) -> Arr m r -> Maybe (Arr m r) wrapGInv' ginv = @@ -76,9 +78,8 @@ {-# INLINABLE pWrap #-} -pL, pLInv, pGPow, pGDec :: (Prime p, Additive r, Unbox r, Elt r) - => Tagged p (Trans r) - +pLInv, pGPow :: (Prime p, Additive r) => Tagged p (Trans r) +pL, pGDec :: (Prime p, Additive r, Elt r, Unbox r) => Tagged p (Trans r) pGInvPow', pGInvDec' :: (Prime p, Ring r, Unbox r, Elt r) => Tagged p (Trans r) {-# INLINABLE pL #-} diff --git a/Crypto/Lol/Cyclotomic/Tensor/RepaTensor/RTCommon.hs b/Crypto/Lol/Cyclotomic/Tensor/RepaTensor/RTCommon.hs --- a/Crypto/Lol/Cyclotomic/Tensor/RepaTensor/RTCommon.hs +++ b/Crypto/Lol/Cyclotomic/Tensor/RepaTensor/RTCommon.hs @@ -65,7 +65,7 @@ in fmap (Arr . fromUnboxed (Z:.n)) . U.replicateM n {-# INLINABLE replM #-} -instance (Fact m, Additive r, Unbox r, Elt r) => Additive.C (Arr m r) where +instance (Fact m, Additive r, Unbox r) => Additive.C (Arr m r) where zero = repl zero (Arr a) + (Arr b) = Arr $ force $ R.zipWith (+) a b negate (Arr a) = Arr $ force $ R.map negate a @@ -73,7 +73,7 @@ {-# INLINABLE (+) #-} {-# INLINABLE negate #-} -instance (Fact m, Ring r, Unbox r, Elt r) => Ring.C (Arr m r) where +instance (Fact m, Ring r, Unbox r) => Ring.C (Arr m r) where one = repl one (Arr a) * (Arr b) = Arr $ force $ R.zipWith (*) a b fromInteger = repl . fromInteger @@ -81,7 +81,7 @@ {-# INLINABLE (*) #-} {-# INLINABLE fromInteger #-} -instance (Fact m, ZeroTestable r, Unbox r, Elt r) => ZeroTestable.C (Arr m r) where +instance (ZeroTestable r, Unbox r, Elt r) => ZeroTestable.C (Arr m r) where -- not using 'zero' to avoid Additive r constraint isZero (Arr a) = isZero $ foldAllS (\ x y -> if isZero x then y else x) (a R.! (Z:.0)) a @@ -104,7 +104,7 @@ -- | For a factored index, tensors up any function defined for (and -- tagged by) any prime power -fTensor :: forall m r mon . (Fact m, Monad mon, Unbox r) +fTensor :: forall m r mon . (Fact m, Monad mon) => (forall pp . (PPow pp) => TaggedT pp mon (Trans r)) -> TaggedT m mon (Trans r) @@ -202,7 +202,7 @@ -- | maps the innermost dimension to a 2-dim array with innermost dim d, -- for performing a I_l \otimes f_d \otimes I_r transformation -expose :: (Source r1 r, Unbox r) +expose :: (Source r1 r) => Int -> Int -> Array r1 DIM1 r -> Array D DIM2 r expose !d !r !arr = let (Z :. sz) = extent arr @@ -212,7 +212,7 @@ {-# INLINABLE expose #-} -- | inverse of expose -unexpose :: (Source r1 r, Unbox r) => Int -> Array r1 DIM2 r -> Array D DIM1 r +unexpose :: (Source r1 r) => Int -> Array r1 DIM2 r -> Array D DIM1 r unexpose !r !arr = let (Z :. sz :. d) = extent arr f (Z :. i) = let (idivr,imodr) = i `divMod` r @@ -233,7 +233,7 @@ {-# INLINABLE mulMat #-} -- | multiplication by a diagonal matrix along innermost dim -mulDiag :: (Source r1 r, Source r2 r, Ring r, Unbox r, Elt r) +mulDiag :: (Source r1 r, Source r2 r, Ring r) => Array r1 DIM1 r -> Array r2 DIM2 r -> Array D DIM2 r mulDiag !diag !arr = fromFunction (extent arr) f where f idx@(_ :. i) = (arr ! idx) * (diag ! (Z:.i)) diff --git a/Crypto/Lol/Cyclotomic/UCyc.hs b/Crypto/Lol/Cyclotomic/UCyc.hs --- a/Crypto/Lol/Cyclotomic/UCyc.hs +++ b/Crypto/Lol/Cyclotomic/UCyc.hs @@ -14,7 +14,12 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} --- | A low-level implementation of cyclotomic rings that allows (and +-- | \( \def\Z{\mathbb{Z}} \) +-- \( \def\F{\mathbb{F}} \) +-- \( \def\Q{\mathbb{Q}} \) +-- \( \def\O{\mathcal{O}} \) +-- +-- A low-level implementation of cyclotomic rings that allows (and -- requires) the programmer to control the underlying representation -- of ring elements, i.e., powerful, decoding, or CRT basis. -- @@ -86,11 +91,11 @@ -- | Convenient synonym for either CRT representation. type UCycEC t m r = Either (UCyc t m E r) (UCyc t m C r) --- | Represents a cyclotomic ring such as @Z[zeta]@, --- @Zq[zeta]@, and @Q(zeta)@ in an explicit representation: @t@ is the --- 'Tensor' type for storing coefficient tensors; @m@ is the --- cyclotomic index; @rep@ is the representation ('P', 'D', or 'C'); --- @r@ is the base ring of the coefficients (e.g., @Z@, @Zq@). +-- | Represents a cyclotomic ring such as \(\Z[\zeta_m]\), +-- \(\Z_q[\zeta_m]\), and \(\Q(\zeta_m)\) in an explicit +-- representation: @t@ is the 'Tensor' type for storing coefficient tensors; +-- @m@ is the cyclotomic index; @rep@ is the representation ('P', 'D', or 'C'); +-- @r@ is the base ring of the coefficients (e.g., \(\Z\), \(\Z_q\)). -- -- The 'Functor', 'Applicative', 'Foldable' and 'Traversable' -- instances all work coefficient-wise (in the specified basis). @@ -234,9 +239,9 @@ r *> (Left (CRTE s v)) = Left $ CRTE s $ fmapT (toExt r *) v {-# INLINABLE (*>) #-} --- | @Rp@ is an @F_{p^d}@-module when @d@ divides @phi(m)@, by --- applying @d@-dimensional @Fp@-linear transform on @d@-dim chunks of --- powerful basis coeffs +-- | \(R_p\) is an \(\F_{p^d}\)-module when \(d\) divides \(\varphi(m)\), by +-- applying \(d\)-dimensional \(\F_p\)-linear transform on \(d\)-dim chunks of +-- powerful basis coeffs. instance (GFCtx fp d, Fact m, Tensor t, TElt t fp) => Module.C (GF fp d) (UCyc t m P fp) where -- can use any r-basis to define module mult, but must be @@ -320,7 +325,7 @@ -- | Unzip in the CRT basis over the base ring. The output components -- are 'Either' because each target base ring may not support 'C'. -unzipCRTC :: (Tensor t, Fact m, UCRTElt t (a,b), UCRTElt t a, UCRTElt t b) +unzipCRTC :: (Fact m, UCRTElt t (a,b), UCRTElt t a, UCRTElt t b) => UCyc t m C (a,b) -> (Either (UCyc t m P a) (UCyc t m C a), Either (UCyc t m P b) (UCyc t m C b)) @@ -333,7 +338,7 @@ -- | Unzip in the CRT basis over the extension of the base ring. The -- output components are 'Either' because each target base might -- instead support 'C'. -unzipCRTE :: (Tensor t, Fact m, UCRTElt t (a,b), UCRTElt t a, UCRTElt t b) +unzipCRTE :: (Fact m, UCRTElt t (a,b), UCRTElt t a, UCRTElt t b) => UCyc t m E (a,b) -> (Either (UCyc t m P a) (UCyc t m E a), Either (UCyc t m P b) (UCyc t m E b)) @@ -345,19 +350,19 @@ fromMaybe (Left bp) (Right <$> (CRTE <$> crtESentinel <*> pure be))) --- | Multiply by the special element @g@. -mulG :: (Tensor t, Fact m, UCRTElt t r) => UCyc t m rep r -> UCyc t m rep r +-- | Multiply by the special element \(g_m\). +mulG :: (Fact m, UCRTElt t r) => UCyc t m rep r -> UCyc t m rep r {-# INLINABLE mulG #-} mulG (Pow v) = Pow $ mulGPow v mulG (Dec v) = Dec $ mulGDec v mulG (CRTC s v) = CRTC s $ mulGCRTCS s v mulG (CRTE s v) = CRTE s $ runIdentity mulGCRT v --- | Divide by the special element @g@. +-- | Divide by the special element \(g_m\). -- WARNING: this implementation is not a constant-time algorithm, so -- information about the argument may be leaked through a timing -- channel. -divG :: (Tensor t, Fact m, UCRTElt t r, ZeroTestable r, IntegralDomain r) +divG :: (Fact m, UCRTElt t r, ZeroTestable r, IntegralDomain r) => UCyc t m rep r -> Maybe (UCyc t m rep r) {-# INLINABLE divG #-} divG (Pow v) = Pow <$> divGPow v @@ -365,15 +370,15 @@ divG (CRTC s v) = Just $ CRTC s $ divGCRTCS s v divG (CRTE s v) = Just $ CRTE s $ runIdentity divGCRT v --- | Yield the scaled squared norm of @g_m \cdot e@ under +-- | Yield the scaled squared norm of \(g_m \cdot e\) under -- the canonical embedding, namely, --- @\hat{m}^{ -1 } \cdot || \sigma(g_m \cdot e) ||^2@ . +-- \(\hat{m}^{-1} \cdot \| \sigma(g_m \cdot e) \|^2\) . gSqNorm :: (Ring r, Tensor t, Fact m, TElt t r) => UCyc t m D r -> r gSqNorm (Dec v) = gSqNormDec v {-# INLINABLE gSqNorm #-} --- | Sample from the "tweaked" Gaussian error distribution @t*D@ in --- the decoding basis, where @D@ has scaled variance @v@. +-- | Sample from the "tweaked" Gaussian error distribution \(t\cdot D\) in +-- the decoding basis, where \(D\) has scaled variance \(v\). tGaussian :: (Tensor t, Fact m, OrdFloat q, Random q, TElt t q, ToRational v, MonadRandom rnd) => v -> rnd (UCyc t m D q) @@ -383,7 +388,7 @@ -- | Generate an LWE error term from the "tweaked" Gaussian with given -- scaled variance, deterministically rounded using the decoding -- basis. (Note: This --- implementation uses Double precision to generate the Gaussian +-- implementation uses 'Double' precision to generate the Gaussian -- sample, which may not be sufficient for rigorous proof-based -- security.) errorRounded :: forall v rnd t m z . @@ -395,14 +400,14 @@ Dec . fmapT (roundMult one) <$> (tGaussianDec svar :: rnd (t m Double)) -- | Generate an LWE error term from the "tweaked" Gaussian with --- scaled variance @v * p^2@, deterministically rounded to the given --- coset of @R_p@ using the decoding basis. (Note: This --- implementation uses Double precision to generate the Gaussian +-- scaled variance \(v \cdot p^2\), deterministically rounded to the given +-- coset of \(R_p\) using the decoding basis. (Note: This +-- implementation uses 'Double' precision to generate the Gaussian -- sample, which may not be sufficient for rigorous proof-based -- security.) errorCoset :: forall t m zp z v rnd . (Mod zp, z ~ ModRep zp, Lift zp z, Tensor t, Fact m, - TElt t zp, TElt t z, ToRational v, MonadRandom rnd) + ToRational v, MonadRandom rnd) => v -> UCyc t m D zp -> rnd (UCyc t m D z) {-# INLINABLE errorCoset #-} errorCoset = @@ -481,29 +486,29 @@ Left s -> Right $ CRTE s $ runIdentity T.twaceCRT v Right _ -> Left $ twacePow $ toPow x --- | Yield the @O_m@-coefficients of an @O_m'@-element, with respect to --- the relative powerful @O_m@-basis. +-- | Yield the \(\O_m\)-coefficients of an \(\O_{m'}\)-element, +-- with respect to the relative powerful \(\O_m\)-basis. coeffsPow :: (Ring r, Tensor t, m `Divides` m', TElt t r) => UCyc t m' P r -> [UCyc t m P r] {-# INLINABLE coeffsPow #-} coeffsPow (Pow v) = LP.map Pow $ coeffs v --- | Yield the @O_m@-coefficients of an @O_m'@ element, with respect to --- the relative decoding @O_m@-basis. +-- | Yield the \(\O_m\)-coefficients of an \(\O_{m'}\) element, +-- with respect to the relative decoding \(\O_m\)-basis. coeffsDec :: (Ring r, Tensor t, m `Divides` m', TElt t r) => UCyc t m' D r -> [UCyc t m D r] {-# INLINABLE coeffsDec #-} coeffsDec (Dec v) = LP.map Dec $ coeffs v --- | The relative powerful basis of @O_m' / O_m@. +-- | The relative powerful basis of \(\O_{m'} / \O_m\). powBasis :: (Ring r, Tensor t, m `Divides` m', TElt t r) => Tagged m [UCyc t m' P r] {-# INLINABLE powBasis #-} powBasis = (Pow <$>) <$> powBasisPow --- | The relative mod-@r@ CRT set of @O_m' / O_m@, represented with --- respect to the powerful basis (which seems to be the best choice --- for typical use cases). +-- | The relative mod-\(r\) CRT set of \(\O_{m'} / \O_m\), +-- represented with respect to the powerful basis (which seems to be +-- the best choice for typical use cases). crtSet :: forall t m m' r p mbar m'bar . (m `Divides` m', ZPP r, p ~ CharOf (ZpOf r), mbar ~ PFree p m, m'bar ~ PFree p m', @@ -794,7 +799,7 @@ rnf (CRTC _ x) = rnf x \\ witness entailNFDataT x rnf (CRTE _ x) = rnf x \\ witness entailNFDataT x -instance (Fact m, Protoable (t m r)) => Protoable (UCyc t m D r) where +instance (Protoable (t m r)) => Protoable (UCyc t m D r) where type ProtoType (UCyc t m D r) = ProtoType (t m r) toProto (Dec t) = toProto t fromProto t = Dec <$> fromProto t diff --git a/Crypto/Lol/Factored.hs b/Crypto/Lol/Factored.hs --- a/Crypto/Lol/Factored.hs +++ b/Crypto/Lol/Factored.hs @@ -1,6 +1,8 @@ {-# LANGUAGE DataKinds, TemplateHaskell, TupleSections #-} --- | This module defines types and operations for type-level +-- | \( \def\lcm{\text{lcm}} \) +-- +-- This module defines types and operations for type-level -- representation and manipulation of natural numbers, as represented -- by their prime-power factorizations. It relies on Template -- Haskell, so parts of the documentation may be difficult to read. diff --git a/Crypto/Lol/FactoredDefs.hs b/Crypto/Lol/FactoredDefs.hs --- a/Crypto/Lol/FactoredDefs.hs +++ b/Crypto/Lol/FactoredDefs.hs @@ -1,8 +1,11 @@ -{-# LANGUAGE ConstraintKinds, DataKinds, ExplicitNamespaces, GADTs, +{-# LANGUAGE ConstraintKinds, CPP, DataKinds, ExplicitNamespaces, GADTs, InstanceSigs, KindSignatures, PolyKinds, ScopedTypeVariables, RankNTypes, TemplateHaskell, TypeFamilies, TypeOperators, UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-unused-binds #-} +#if __GLASGOW_HASKELL__ >= 800 +{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} +#endif -- | This sub-module exists only because we can't define and use -- template Haskell splices in the same module. @@ -201,10 +204,10 @@ else pp : (go ps) |] --- | Type (family) synonym for division of 'Factored' types +-- | Type (family) synonym for division of 'Factored' types. type a / b = FDiv a b --- | Type (family) synonym for multiplication of 'Factored' types +-- | Type (family) synonym for multiplication of 'Factored' types. type a * b = FMul a b -- convenience aliases: enforce kind, hide SingI @@ -268,13 +271,13 @@ coerceGCD _ _ _ = Sub $ unsafeCoerce (Dict :: Dict ()) -- | Entails constraint for transitivity of division, i.e. --- if @k|l@ and @l|m@, then @k|m@. +-- if \( k \mid l \) and \( l \mid m \), then \( k \mid m \). transDivides :: forall k l m . Proxy k -> Proxy l -> Proxy m -> ((k `Divides` l, l `Divides` m) :- (k `Divides` m)) transDivides k _ m = Sub Dict \\ coerceFDivs k m -- | Entailment for divisibility by GCD: --- if @g=GCD(m1,m2)@ then @g|m1@ and @g|m2@. +-- if \( g=\gcd(m_1,m_2) \) then \( g \mid m_1 \) and \( g \mid m_2 \). gcdDivides :: forall m1 m2 g . Proxy m1 -> Proxy m2 -> ((Fact m1, Fact m2, g ~ FGCD m1 m2) :- (g `Divides` m1, g `Divides` m2)) @@ -284,7 +287,7 @@ \\ coerceFDivs (Proxy::Proxy g) m2 -- | Entailment for LCM divisibility: --- if @l=LCM(m1,m2)@ then @m1|l@ and @m2|l@. +-- if \( l=\lcm(m_1,m_2) \) then \( m_1 \mid l \) and \( m_2 \mid l \). lcmDivides :: forall m1 m2 l . Proxy m1 -> Proxy m2 -> ((Fact m1, Fact m2, l ~ FLCM m1 m2) :- (m1 `Divides` l, m2 `Divides` l)) @@ -294,7 +297,7 @@ \\ coerceFDivs m2 (Proxy::Proxy l) -- | Entailment for LCM divisibility: --- the LCM of two divisors of @m@ also divides @m@. +-- the LCM of two divisors of \( m \) also divides \( m \). lcm2Divides :: forall m1 m2 l m . Proxy m1 -> Proxy m2 -> Proxy m -> ((m1 `Divides` m, m2 `Divides` m, l ~ FLCM m1 m2) :- (m1 `Divides` l, m2 `Divides` l, (FLCM m1 m2) `Divides` m)) @@ -302,9 +305,9 @@ Sub $ withSingI (sFLCM (sing :: SFactored m1) (sing :: SFactored m2)) Dict \\ coerceFDivs (Proxy::Proxy (FLCM m1 m2)) m \\ lcmDivides m1 m2 --- | Entailment for @p@-free division: --- if @f@ is @m@ after removing all @p@-factors, then @f|m@ and --- @gcd(f,p)=1@. +-- | Entailment for \( p \)-free division: +-- if \( f \) is \(m \) after removing all \( p \)-factors, then \( f \mid m \) +-- and \( \gcd(f,p)=1 \). pSplitTheorems :: forall p m f . Proxy p -> Proxy m -> ((Prime p, Fact m, f ~ PFree p m) :- (f `Divides` m, Coprime (PToF p) f)) @@ -313,8 +316,8 @@ Dict \\ coerceFDivs (Proxy::Proxy f) m \\ coerceGCD (Proxy::Proxy (PToF p)) (Proxy::Proxy f) (Proxy::Proxy F1) --- | Entailment for @p@-free division: --- if @m|m'@, then @p-free(m) | p-free(m')@. +-- | Entailment for \( p \)-free division: +-- if \( m \mid m' \), then \( \text{p-free}(m) \mid \text{p-free}(m') \). pFreeDivides :: forall p m m' . Proxy p -> Proxy m -> Proxy m' -> ((Prime p, m `Divides` m') :- ((PFree p m) `Divides` (PFree p m'))) @@ -340,14 +343,13 @@ totientFact = totientPPs <$> ppsFact -- | The "hat" of a 'Factored' type's value: --- @\hat{m}@ is @m@ if @m@ is odd, and @m/2@ otherwise. +-- \( \hat{m} = \begin{cases} m & \mbox{if } m \text{ is odd} \\ m/2 & \text{otherwise} \end{cases} \). valueHatFact = valueHat <$> valueFact -- | The radical (product of prime divisors) of a 'Factored' type. radicalFact = radicalPPs <$> ppsFact --- | The odd radical (product of odd prime divisors) of a 'Factored' --- type. +-- | The odd radical (product of odd prime divisors) of a 'Factored' type. oddRadicalFact = oddRadicalPPs <$> ppsFact -- | Reflect a 'PrimePower' type to a 'PP' value. @@ -368,7 +370,7 @@ valuePrime :: forall p . Prime p => Tagged p Int valuePrime = tag $ binToInt $ unP $ fromSing (sing :: SPrimeBin p) --- | Return @m@ if @m@ is odd, and @m/2@ otherwise. +-- | Return \( m \) if \( m \) is odd, and \( m/2 \) otherwise. valueHat :: Integral i => i -> i valueHat m = if m `mod` 2 == 0 then m `div` 2 else m @@ -407,7 +409,7 @@ -- given positive prime integer. (Uses 'prime' to enforce primality -- of the base, so should only be used on small-to-moderate-sized -- arguments.) This is the preferred (and only) way of constructing a --- concrete 'PrimeBin' type (and is used to define the @Primep@ type +-- concrete 'PrimeBin' type (and is used to define the @Prime@\(p\) type -- synonyms). pType :: Int -> TypeQ pType p @@ -433,17 +435,17 @@ promotedNilT $ factorize n) -- | Template Haskell splice that defines the 'PrimeBin' type synonym --- @Primep@ for a positive prime integer @p@. +-- @Prime@\(p\) for a positive prime integer \( p \). pDec :: Int -> DecQ pDec p = tySynD (mkName $ "Prime" ++ show p) [] $ pType p -- | Template Haskell splice that defines the 'PrimePower' type synonym --- @PPn@, where @n=p^e@. +-- @PP@\(n\), where \( n=p^e \). ppDec :: PP -> DecQ ppDec pp@(p,e) = tySynD (mkName $ "PP" ++ show (p^e)) [] $ ppType pp -- | Template Haskell splice that defines the 'Factored' type synonym --- @Fn@ for a positive integer @n@. +-- @F@\(n\) for a positive integer \(n\). fDec :: Int -> DecQ fDec n = tySynD (mkName $ 'F' : show n) [] $ fType n diff --git a/Crypto/Lol/Gadget.hs b/Crypto/Lol/Gadget.hs --- a/Crypto/Lol/Gadget.hs +++ b/Crypto/Lol/Gadget.hs @@ -14,17 +14,21 @@ module Crypto.Lol.Gadget ( Gadget(..), Decompose(..), Correct(..) +, decomposeT, decomposeList, decomposeMatrix , TrivGad, BaseBGad ) where import Crypto.Lol.Prelude +import MathObj.Matrix hiding (one, zero, zipWith) + import Control.Applicative import Control.Arrow +import Data.Traversable --- | Dummy type representing the gadget @[1]@. +-- | Dummy type representing the gadget \( [1] \). data TrivGad --- | Dummy type representing the gadget @[1,b,b^2,...]@. +-- | Dummy type representing the gadget \( [1,b,b^2,\ldots] \). data BaseBGad b -- | "Gadget" vectors, parameterized by an index type. @@ -46,11 +50,26 @@ -- | The ring that @u@ decomposes over. type DecompOf u - -- | Yield a short vector @x@ such that @\ = u@. + -- | Yield a short vector \( x \) such that \( \langle g, x\rangle = u \). decompose :: u -> Tagged gad [DecompOf u] --- | Error correction relative to a gadget. +-- | Alternative to 'decompose'. +decomposeT :: Decompose gad u => u -> TaggedT gad [] (DecompOf u) +decomposeT = peelT . decompose +-- | Decompose a list entry-wise. +decomposeList :: Decompose gad u => [u] -> Tagged gad [DecompOf u] +decomposeList = fmap concat . traverse decompose + +-- | Decompose a matrix entry-wise. +decomposeMatrix :: forall gad u . (Decompose gad u) + => Matrix u -> Tagged gad (Matrix (DecompOf u)) +decomposeMatrix m = do + l <- length <$> (gadget :: Tagged gad [u]) -- CJP: avoid scoped type vars? + fromColumns (l * numRows m) (numColumns m) <$> + traverse decomposeList (columns m) + +-- | Error correction relative to a gadget. class Gadget gad u => Correct gad u where -- | Error-correct a "noisy" encoding of an element (see 'encode'), diff --git a/Crypto/Lol/PosBinDefs.hs b/Crypto/Lol/PosBinDefs.hs --- a/Crypto/Lol/PosBinDefs.hs +++ b/Crypto/Lol/PosBinDefs.hs @@ -1,7 +1,11 @@ -{-# LANGUAGE ConstraintKinds, DataKinds, GADTs, InstanceSigs, +{-# LANGUAGE ConstraintKinds, CPP, DataKinds, GADTs, InstanceSigs, KindSignatures, NoImplicitPrelude, PolyKinds, RankNTypes, RebindableSyntax, ScopedTypeVariables, TemplateHaskell, TypeFamilies, UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-duplicate-exports #-} +#if __GLASGOW_HASKELL__ >= 800 +{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} +#endif -- | This sub-module exists only because we can't define and use -- template Haskell splices in the same module. @@ -139,13 +143,13 @@ _ -> fail "internal error in PosBinTH.bin" posDec, binDec :: Int -> DecQ --- | Template Haskell splice that defines the 'Pos' type synonym @Pn@. +-- | Template Haskell splice that defines the 'Pos' type synonym @P@\(n\). posDec = intDec "P" posType --- | Template Haskell splice that defines the 'Bin' type synonym @Bn@. +-- | Template Haskell splice that defines the 'Bin' type synonym @B@\(n\). binDec = intDec "B" binType -- | Template Haskell splice that declares a type synonym --- @n@ as the type @f n@. +-- @\@\(n\) as the type @f n@. intDec :: String -- ^ @pfx@ -> (Int -> TypeQ) -- ^ @f@ -> Int -- ^ @n@ diff --git a/Crypto/Lol/Prelude.hs b/Crypto/Lol/Prelude.hs --- a/Crypto/Lol/Prelude.hs +++ b/Crypto/Lol/Prelude.hs @@ -1,4 +1,5 @@ {-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} @@ -16,7 +17,10 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} --- | A substitute for the Prelude that is more suitable for Lol. This +-- | \( \def\Z{\mathbb{Z}} \) +-- \( \def\C{\mathbb{C}} \) +-- +-- A substitute for the Prelude that is more suitable for Lol. This -- module exports most of the Numeric Prelude and other frequently -- used modules, plus some low-level classes, missing instances, and -- assorted utility functions. @@ -62,12 +66,13 @@ import Data.Proxy import Data.Singletons --- for Unbox instance of Maybe a +-- for Unbox instance of `Maybe a` import qualified Data.Vector.Unboxed as U import Data.Vector.Unboxed.Deriving +#if __GLASGOW_HASKELL__ < 800 instance NFData (Proxy (a :: k)) where rnf Proxy = () - +#endif deriving instance NFData (m a) => NFData (TaggedT s m a) deriving instance (MonadRandom m) => MonadRandom (TaggedT (tag :: k) m) @@ -141,7 +146,7 @@ in \x -> let (quot',_) = divModCent (q'val * lift x) qval in fromIntegral quot' --- | Deterministically round to a nearby value in the desired coset +-- | Deterministically round to a nearby value in the desired coset. roundCoset :: forall zp z r . (Mod zp, z ~ ModRep zp, Lift zp z, RealField r) => zp -> r -> z {-# INLINABLE roundCoset #-} @@ -153,7 +158,7 @@ type instance LiftOf (a,b) = Integer --- | Lift product ring of @Zq@s to 'Integer' +-- | Lift product ring of \(\Z_q\)s to 'Integer' instance (Mod a, Mod b, Lift' a, Lift' b, Reduce Integer (a,b), ToInteger (LiftOf a), ToInteger (LiftOf b)) => Lift' (a,b) where @@ -196,7 +201,7 @@ in ((da,db), (ra,rb)) {-# INLINABLE divMod #-} --- | Product ring of @Zq@s as a @Zq@ (with 'Integer' modulus) +-- | Product ring of \(\Z_q\)s as a \(\Z_q\) (with 'Integer' modulus) instance (Mod a, Mod b) => Mod (a,b) where type ModRep (a,b) = Integer @@ -209,7 +214,7 @@ reduce x = (reduce x, reduce x) {-# INLINABLE reduce #-} --- | Rescale a product ring of @Zq@s +-- | Rescale a product ring of \(\Z_q\)s instance (Mod a, Field b, Lift a (ModRep a), Reduce (LiftOf a) b) => Rescale (a,b) b where rescale = let q1val = proxy modulus (Proxy::Proxy a) @@ -217,7 +222,7 @@ in \(x1,x2) -> q1inv * (x2 - reduce (lift x1)) {-# INLINABLE rescale #-} --- | Rescale a product ring of @Zq@s +-- | Rescale a product ring of \(\Z_q\)s instance (Mod b, Field a, Lift b (ModRep b), Reduce (LiftOf b) a) => Rescale (a,b) a where rescale = let q2val = proxy modulus (Proxy::Proxy b) @@ -225,26 +230,28 @@ in \(x1,x2) -> q2inv * (x1 - reduce (lift x2)) {-# INLINABLE rescale #-} --- | Rescale a (multi-)product ring of @Zq@s -instance (Rescale (a,(b,c)) (b,c), Rescale (b,c) c) +-- | Rescale a (multi-)product ring of \(\Z_q\)s +instance (Rescale (a,(b,c)) (b,c), Rescale (b,c) c, + Additive a, Additive c) => Rescale (a,(b,c)) c where rescale = (rescale :: (b,c) -> c) . rescale {-# INLINABLE rescale #-} --- | Rescale a (multi-)product ring of @Zq@s -instance (Rescale ((a,b),c) (a,b), Rescale (a,b) a) +-- | Rescale a (multi-)product ring of \(\Z_q\)s +instance (Rescale ((a,b),c) (a,b), Rescale (a,b) a, + Additive a, Additive c) => Rescale ((a,b),c) a where rescale = (rescale :: (a,b) -> a) . rescale {-# INLINABLE rescale #-} --- | Rescale /up/ to a product ring of @Zq@s +-- | Rescale /up/ to a product ring of \(\Z_q\)s instance (Ring a, Mod b, Reduce (ModRep b) a) => Rescale a (a,b) where -- multiply by q2 rescale = let q2val = reduce $ proxy modulus (Proxy::Proxy b) in \x -> (q2val * x, zero) {-# INLINABLE rescale #-} --- | Rescale /up/ to a product ring of @Zq@s +-- | Rescale /up/ to a product ring of \(\Z_q\)s instance (Ring b, Mod a, Reduce (ModRep a) b) => Rescale b (a,b) where -- multiply by q1 rescale = let q1val = reduce $ proxy modulus (Proxy::Proxy a) @@ -275,19 +282,19 @@ fromJust' :: String -> Maybe a -> a fromJust' str = fromMaybe (error str) --- | Apply any applicative to a Tagged value. +-- | Apply any applicative to a 'Tagged' value. pureT :: Applicative f => Tagged t a -> TaggedT t f a pureT = mapTaggedT (pure . runIdentity) --- | Expose the monad of a tagged value. +-- | Expose the monad of a 'Tagged' value. peelT :: Tagged t (f a) -> TaggedT t f a peelT = coerce --- | Hide the monad of a tagged value. +-- | Hide the monad of a 'Tagged' value. pasteT :: TaggedT t f a -> Tagged t (f a) pasteT = coerce --- | Use a singleton as a witness to extract a value from a tagged value. +-- | Use a singleton as a witness to extract a value from a 'Tagged' value. withWitness :: forall n r . (SingI n => Tagged n r) -> Sing n -> r withWitness t wit = withSingI wit $ proxy t (Proxy::Proxy n) {-# INLINABLE withWitness #-} diff --git a/Crypto/Lol/RLWE/Continuous.hs b/Crypto/Lol/RLWE/Continuous.hs --- a/Crypto/Lol/RLWE/Continuous.hs +++ b/Crypto/Lol/RLWE/Continuous.hs @@ -1,7 +1,9 @@ {-# LANGUAGE ConstraintKinds, FlexibleContexts, MultiParamTypeClasses, NoImplicitPrelude, RebindableSyntax, ScopedTypeVariables #-} --- | Functions and types for working with continuous ring-LWE samples. +-- | \( \def\Z{\mathbb{Z}} \) +-- \( \def\R{\mathbb{R}} \) +-- Functions and types for working with continuous ring-LWE samples. module Crypto.Lol.RLWE.Continuous where @@ -13,9 +15,9 @@ import Control.Applicative import Control.Monad.Random --- | A continuous RLWE sample @(a,b) \in R_q \times K/qR@. (The +-- | A continuous RLWE sample \( (a,b) \in R_q \times K/(qR)\). (The -- second component is a 'UCyc' because the base type @rrq@ --- representing @RR/qZ@, the reals modulo @qZ@, is an additive group +-- representing \(\R/(q\Z)\), is an additive group -- but not a ring, so we can't usefully work with a 'Cyc' over it.) type Sample t m zq rrq = (Cyc t m zq, UCyc t m D rrq) @@ -24,8 +26,7 @@ (Fact m, Ring zq, CElt t zq, Subgroup zq rrq, Lift' rrq, TElt t rrq, TElt t (LiftOf rrq)) --- | A continuous RLWE sample with the given scaled variance and --- secret. +-- | A continuous RLWE sample with the given scaled variance and secret. sample :: forall rnd v t m zq rrq . (RLWECtx t m zq rrq, Random zq, Random (LiftOf rrq), OrdFloat (LiftOf rrq), MonadRandom rnd, ToRational v) @@ -52,12 +53,12 @@ errorGSqNorm s = U.gSqNorm . errorTerm s -- | A bound such that the 'gSqNorm' of a continuous error generated --- by 'tGaussian' with scaled variance @v@ (over the @m@th cyclotomic +-- by 'tGaussian' with scaled variance \(v\) (over the \(m\)th cyclotomic -- field) is less than the bound except with probability approximately --- @eps@. +-- \(\epsilon\). errorBound :: (Ord v, Transcendental v, Fact m) => v -- ^ the scaled variance - -> v -- ^ @eps@ + -> v -- ^ \(\epsilon\) -> Tagged m v errorBound v eps = do n <- fromIntegral <$> totientFact diff --git a/Crypto/Lol/RLWE/Discrete.hs b/Crypto/Lol/RLWE/Discrete.hs --- a/Crypto/Lol/RLWE/Discrete.hs +++ b/Crypto/Lol/RLWE/Discrete.hs @@ -12,7 +12,7 @@ import Control.Applicative import Control.Monad.Random --- | A discrete RLWE sample @(a,b) \in R_q \times R_q@. +-- | A discrete RLWE sample \( (a,b) \in R_q \times R_q\). type Sample t m zq = (Cyc t m zq, Cyc t m zq) -- | Common constraints for working with discrete RLWE. @@ -20,8 +20,7 @@ (Fact m, Ring zq, Lift' zq, ToInteger (LiftOf zq), CElt t zq, CElt t (LiftOf zq)) --- | A discrete RLWE sample with the given scaled variance and --- secret. +-- | A discrete RLWE sample with the given scaled variance and secret. sample :: forall rnd v t m zq . (RLWECtx t m zq, Random zq, MonadRandom rnd, ToRational v) => v -> Cyc t m zq -> rnd (Sample t m zq) @@ -46,12 +45,12 @@ errorGSqNorm s = gSqNorm . errorTerm s -- | A bound such that the 'gSqNorm' of a discretized error term --- generated by 'errorRounded' with scaled variance @v@ (over the @m@th --- cyclotomic field) is less than the bound except with probability --- approximately @eps@. +-- generated by 'errorRounded' with scaled variance \(v\) +-- (over the \(m\)th cyclotomic field) is less than the +-- bound except with probability approximately \(\epsilon\). errorBound :: (RealRing v, Transcendental v, Fact m) => v -- ^ the scaled variance - -> v -- ^ @eps@ + -> v -- ^ \(\epsilon\) -> Tagged m Int64 errorBound v eps = do n <- fromIntegral <$> totientFact diff --git a/Crypto/Lol/RLWE/RLWR.hs b/Crypto/Lol/RLWE/RLWR.hs --- a/Crypto/Lol/RLWE/RLWR.hs +++ b/Crypto/Lol/RLWE/RLWR.hs @@ -9,7 +9,7 @@ import Control.Monad.Random --- | An RLWR sample @(a,b) \in R_q \times R_p@. +-- | An RLWR sample \( (a,b) \in R_q \times R_p\). type Sample t m zq zp = (Cyc t m zq, Cyc t m zp) -- | Common constraints for working with RLWR. @@ -23,8 +23,8 @@ a <- getRandom return (a, roundedProd s' a) --- | The @b@ component of an RLWR sample for secret @s@ and given @a@, --- produced by rounding @a*s@ in the decoding basis. +-- | The \(b\) component of an RLWR sample for secret \(s\) and given \(a\), +-- produced by rounding \(a\cdot s\) in the decoding basis. roundedProd :: (RLWRCtx t m zq zp) => Cyc t m zq -> Cyc t m zq -> Cyc t m zp {-# INLINABLE roundedProd #-} roundedProd s = let s' = adviseCRT s in \a -> rescaleCyc Dec $ a * s' diff --git a/Crypto/Lol/Types.hs b/Crypto/Lol/Types.hs new file mode 100644 --- /dev/null +++ b/Crypto/Lol/Types.hs @@ -0,0 +1,19 @@ + +-- | Exports concrete types needed to instantiate cryptographic applications. +-- Specifically: +-- +-- * "Crypto.Lol.Cyclotomic.Tensor.CTensor" +-- * "Crypto.Lol.Cyclotomic.Tensor.RepaTensor" +-- * "Crypto.Lol.Types.IrreducibleChar2" +-- * "Crypto.Lol.Types.Random" +-- * "Crypto.Lol.Types.RRq" +-- * "Crypto.Lol.Types.ZqBasic" + +module Crypto.Lol.Types ( module X ) where + +import Crypto.Lol.Cyclotomic.Tensor.CTensor as X +import Crypto.Lol.Cyclotomic.Tensor.RepaTensor as X +import Crypto.Lol.Types.IrreducibleChar2 as X () +import Crypto.Lol.Types.Random as X +import Crypto.Lol.Types.RRq as X +import Crypto.Lol.Types.ZqBasic as X diff --git a/Crypto/Lol/Types/Complex.hs b/Crypto/Lol/Types/Complex.hs --- a/Crypto/Lol/Types/Complex.hs +++ b/Crypto/Lol/Types/Complex.hs @@ -37,7 +37,7 @@ import Test.QuickCheck -- | Newtype wrapper (with slightly different instances) for --- . +-- @Number.Complex@. newtype Complex a = Complex (C.T a) deriving (Additive.C, Ring.C, ZeroTestable.C, Field.C, Storable, Eq, Show, Arbitrary) @@ -78,7 +78,7 @@ roundComplex :: (RealRing a, ToInteger b) => Complex a -> (b,b) roundComplex (Complex x) = (round $ C.real x, round $ C.imag x) --- | 'cis' @t@ is a complex value with magnitude 1 and phase t (modulo @2*Pi@). +-- | 'cis' \(t\) is a complex value with magnitude 1 and phase \(t \bmod 2\cdot\pi\)). cis :: Transcendental a => a -> Complex a cis = Complex . C.cis diff --git a/Crypto/Lol/Types/FiniteField.hs b/Crypto/Lol/Types/FiniteField.hs --- a/Crypto/Lol/Types/FiniteField.hs +++ b/Crypto/Lol/Types/FiniteField.hs @@ -14,7 +14,8 @@ -- CJP: need PolyKinds to allow d to have non-* kind --- | Basic (unoptimized) finite field arithmetic. +-- | \( \def\F{\mathbb{F}} \) +-- Basic (unoptimized) finite field arithmetic. module Crypto.Lol.Types.FiniteField ( GF -- export type but not constructor @@ -45,7 +46,7 @@ --import qualified Debug.Trace as DT --- | A finite field of given degree over @F_p@. +-- | A finite field of given degree over \(\F_p\). newtype GF fp d = GF (Polynomial fp) deriving (Eq, Show, Additive.C, ZeroTestable.C, NFData) @@ -100,8 +101,8 @@ (proxy value (Proxy::Proxy m) :: Int) -- | This wrapper for a list of coefficients is used to define a --- @GF(p^d)@-module structure for tensors over @F_p@ of dimension @n@, where --- @d | n@. +-- \(\F_{p^d}\)-module structure for tensors over \(\F_p\) of dimension +-- \(n\), where \(d \mid n\). newtype TensorCoeffs a = Coeffs {unCoeffs :: [a]} deriving (Additive.C) instance (Additive fp, Ring (GF fp d), Reflects d Int) @@ -121,14 +122,14 @@ | n > 0 = let (h,t) = splitAt n xs in h : chunksOf n t | otherwise = error "chunksOf: non-positive n" --- | Yield a list of length exactly @d@ (i.e., including trailing zeros) --- of the @fp@-coefficients with respect to the power basis. +-- | Yield a list of length exactly \(d\) (i.e., including trailing zeros) +-- of the \(\F_p\)-coefficients with respect to the power basis. toList :: forall fp d . (Reflects d Int, Additive fp) => GF fp d -> [fp] toList = let dval = proxy value (Proxy::Proxy d) in \(GF p) -> let l = coeffs p in l ++ replicate (dval - length l) zero --- | Yield a field element given up to @d@ coefficients with respect +-- | Yield a field element given up to \(d\) coefficients with respect -- to the power basis. fromList :: forall fp d . (Reflects d Int) => [fp] -> GF fp d fromList = let dval = proxy value (Proxy::Proxy d) @@ -140,7 +141,7 @@ sizePP = tag (proxy valuePrime (Proxy::Proxy (CharOf fp)), proxy value (Proxy::Proxy d)) --- | The order of the field: @size (GF fp d) = p^d@ +-- | The order of the field: @size (GF fp d) = @\( p^d \) size :: (GFCtx fp d) => Tagged (GF fp d) Int size = uncurry (^) <$> sizePP @@ -159,7 +160,7 @@ trace = let ts = proxy powTraces (Proxy::Proxy (GF fp d)) in \(GF f) -> dotp ts (coeffs f) --- | Traces of the power basis elements 1, x, x^2, ..., x^(d-1). +-- | Traces of the power basis elements \(\{1, x, x^2, \ldots, x^{d-1}\}\). powTraces :: forall fp d . (GFCtx fp d) => Tagged (GF fp d) [fp] powTraces = --DT.trace ("FiniteField.powTraces: p = " ++ @@ -179,8 +180,8 @@ -- | Represents fields over which we can get irreducible -- polynomials of desired degrees. (An instance of this class is --- defined in 'Crypto.Lol.Types.IrreducibleChar2' and exported from --- 'Crypto.Lol'.) +-- defined in "Crypto.Lol.Types.IrreducibleChar2" and exported from +-- "Crypto.Lol.Types".) class Field fp => IrreduciblePoly fp where irreduciblePoly :: (Reflects d Int) => Tagged d (Polynomial fp) diff --git a/Crypto/Lol/Types/IrreducibleChar2.hs b/Crypto/Lol/Types/IrreducibleChar2.hs --- a/Crypto/Lol/Types/IrreducibleChar2.hs +++ b/Crypto/Lol/Types/IrreducibleChar2.hs @@ -28,8 +28,7 @@ polyMap = fromList $ map (\xs -> (head xs, coeffsToPoly xs)) coeffs coeffsToPoly :: (Ring fp) => [Int] -> Polynomial fp -coeffsToPoly [a,b] = X^^a + X^^b + 1 -coeffsToPoly [a,b,c,d] = X^^a + X^^b + X^^c + X^^d + 1 +coeffsToPoly xs = (sum $ map (X^^) xs) + 1 -- The list below is small portion of the table -- "Table of Low-Weight binary Irreducible Polynomials" at diff --git a/Crypto/Lol/Types/Numeric.hs b/Crypto/Lol/Types/Numeric.hs --- a/Crypto/Lol/Types/Numeric.hs +++ b/Crypto/Lol/Types/Numeric.hs @@ -1,6 +1,12 @@ -{-# LANGUAGE ConstraintKinds, DataKinds, FlexibleInstances, GADTs, - MultiParamTypeClasses, NoImplicitPrelude, RebindableSyntax, - ScopedTypeVariables, TypeOperators #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE RebindableSyntax #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} -- we have some orphan instances here for instances of -- package classes with Prelude data types @@ -40,25 +46,26 @@ import qualified Algebra.ToRational (C, realToField) import qualified Algebra.Transcendental (C) import qualified Algebra.ZeroTestable (C) +import MathObj.Matrix hiding (one, zero) import MathObj.Polynomial import Data.Int (Int64) --- | The Prelude definition of 'max'. +-- | The Prelude definition of 'Prelude.max'. max :: Ord a => a -> a -> a max = Prelude.max --- | The Prelude definition of 'min'. +-- | The Prelude definition of 'Prelude.min'. min :: Ord a => a -> a -> a min = Prelude.min --- | The sane definition of 'abs' from +-- | The sane definition of 'NumericPrelude.Numeric.abs' from -- 'NumericPrelude.Numeric' -- rather than the default from 'NumericPrelude'. abs :: Absolute a => a -> a abs = NumericPrelude.Numeric.abs --- | The hidden NP function from 'Algebra.ToRational'. +-- | The hidden NP function from "Algebra.ToRational". realToField :: (Field b, ToRational a) => a -> b realToField = Algebra.ToRational.realToField @@ -112,7 +119,7 @@ type RealTranscendental a = (Algebra.RealTranscendental.C a) {- Transcendental, plus: == <= >= < > -} --- | Convenient synonym for @(Ord a, Transcendental a)@ +-- | Convenient synonym for @('Ord' a, 'Transcendental' a)@ type OrdFloat a = (Ord a, Transcendental a) {- ToRational and Ring, plus: toInteger div mod divmod quot rem quotrem -} @@ -131,13 +138,16 @@ -- | Sane synonym for 'MathObj.Polynomial.T'. type Polynomial a = MathObj.Polynomial.T a --- IntegralDomain instance for Double +-- | Sane synonym for 'MathObj.Matrix.T'. +type Matrix a = MathObj.Matrix.T a + +-- 'IntegralDomain' instance for 'Double' instance Algebra.IntegralDomain.C Double where _ `div` 0 = error "cannot divide Double by 0\n" a `div` b = a / b _ `mod` _ = 0 --- NFData instance for Polynomial, missing from NP +-- 'NFData' instance for 'Polynomial', missing from NP instance (NFData r) => NFData (Polynomial r) where rnf = rnf . coeffs @@ -165,7 +175,7 @@ | y == 1 = x * z | otherwise = g (x * x) ((y - 1) `quot` 2) (x * z) --- | Inverse of @a@ modulo @q@, in range @0..q-1@. (Argument order is +-- | Inverse of \(a\) modulo \(q\), in range \([0,q-1]\). (Argument order is -- infix-friendly.) modinv :: (PID i, Eq i) => i -> i -> Maybe i modinv a q = let (d, (_, inv)) = extendedGCD q a @@ -180,12 +190,12 @@ decomp (b:bs) v = let (q,r) = v `divModCent` b in r : decomp bs q --- | Deterministically round to the nearest multiple of @i@. +-- | Deterministically round to the nearest multiple of \( i \). roundMult :: (RealField r, ToInteger i) => i -> r -> i roundMult 1 r = round r roundMult i r = let r' = r / fromIntegral i in i * round r' --- | Randomly round to the nearest larger or smaller multiple of @i@, +-- | Randomly round to the nearest larger or smaller multiple of \( i \), -- where the round-off term has expectation zero. roundScalarCentered :: (RealField r, Random r, ToInteger i, MonadRandom mon) @@ -199,10 +209,10 @@ else floor x' -- | Variant of 'Algebra.IntegralDomain.divMod' in which the remainder --- is in the range @[-b\/2,b\/2)@. -divModCent :: (IntegralDomain i, Ord i) - => i -- ^ dividend @a@ - -> i -- ^ divisor @b@ +-- is in the range \([-b/2,b/2)\). +divModCent :: (IntegralDomain i) + => i -- ^ dividend \(a\) + -> i -- ^ divisor \(b\) -> (i,i) -- ^ (quotient, remainder) divModCent = flip (\b -> let shift = b `div` 2 diff --git a/Crypto/Lol/Types/RRq.hs b/Crypto/Lol/Types/RRq.hs --- a/Crypto/Lol/Types/RRq.hs +++ b/Crypto/Lol/Types/RRq.hs @@ -3,8 +3,9 @@ NoImplicitPrelude, PolyKinds, RebindableSyntax, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-} --- | An implementation of the additive quotient group @RR/qZ@, where @RR@ --- denotes the real numbers. +-- | \( \def\Z{\mathbb{Z}} \) +-- \( \def\R{\mathbb{R}} \) +-- An implementation of the additive quotient group \(\R/(q\Z)\). module Crypto.Lol.Types.RRq ( RRq @@ -31,8 +32,8 @@ import Foreign.Storable -- invariant: 0 <= x < q --- | The ring @RR_q@ of reals modulo 'q', using underlying floating --- type 'r'. +-- | The ring \(\R/(q\Z)\) of reals modulo 'q', using +-- underlying floating type 'r'. newtype RRq q r = RRq r deriving (Eq, Ord, ZeroTestable.C, E.Elt, Show, NFData, Storable) @@ -42,7 +43,7 @@ in \x -> RRq $ x - q * floor (x / q) -- puts value in range [-q/2, q/2) -decode' :: forall q r . (Reflects q r, Ord r, Additive r, Ring r) +decode' :: forall q r . (Reflects q r, Ord r, Ring r) => RRq q r -> r decode' = let qval = proxy value (Proxy::Proxy q) in \(RRq x) -> if x + x < qval then x else x - qval diff --git a/Crypto/Lol/Types/Random.hs b/Crypto/Lol/Types/Random.hs --- a/Crypto/Lol/Types/Random.hs +++ b/Crypto/Lol/Types/Random.hs @@ -3,7 +3,7 @@ -- | Defines a newtype wrapper 'CryptoRand' for crypto-api's -- 'CryptoRandomGen', and a corresponding 'RandomGen' wrapper -- instance. These are needed because 'CryptoRandomGen' generators --- can only be used to get 'ByteString's; the 'RandomGen' wrapper +-- can only be used to get "Data.ByteString"s; the 'RandomGen' wrapper -- instance allows them to be used to generate any 'Random' type. module Crypto.Lol.Types.Random (CryptoRand, evalCryptoRandIO) where diff --git a/Crypto/Lol/Types/ZPP.hs b/Crypto/Lol/Types/ZPP.hs --- a/Crypto/Lol/Types/ZPP.hs +++ b/Crypto/Lol/Types/ZPP.hs @@ -1,6 +1,7 @@ {-# LANGUAGE FlexibleContexts, TypeFamilies #-} --- | A class for integers mod a prime power. +-- | \( \def\Z{\mathbb{Z}} \) +-- A class for integers mod a prime power. module Crypto.Lol.Types.ZPP ( ZPP(..) @@ -18,6 +19,6 @@ -- | The prime and exponent of the modulus. modulusZPP :: Tagged zq PP - -- | Lift from @Z_p@ to a representative. + -- | Lift from \(\Z_p\) to a representative. liftZp :: ZpOf zq -> zq diff --git a/Crypto/Lol/Types/ZmStar.hs b/Crypto/Lol/Types/ZmStar.hs --- a/Crypto/Lol/Types/ZmStar.hs +++ b/Crypto/Lol/Types/ZmStar.hs @@ -3,7 +3,8 @@ RebindableSyntax, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-} --- | A collection of helper functions for working with @Z_m^*@ +-- | \( \def\Z{\mathbb{Z}} \) +-- A collection of helper functions for working with \(\Z_m^*\). module Crypto.Lol.Types.ZmStar ( order, partitionCosets @@ -19,8 +20,8 @@ import Data.Set as S (Set, difference, findMin, fromList, map, null) --- | The multiplicative order of @p@ (the argument) modulo @m@. --- Requires @gcd(p,m)=1@. +-- | The multiplicative order of \(p\) (the argument) modulo \(m\). +-- Requires \(\gcd(p,m)=1\). order :: forall m . (Reflects m Int) => Int -> Tagged m Int order p = tag $ let mval = proxy value (Proxy::Proxy m) @@ -48,10 +49,10 @@ -- CJP: could tag this by '(p,m,m') for safety/memoization. --- | Given @p@, returns a partition of the cosets of @Z_{m\'}^* \/ \

@ +-- | Given \(p\), returns a partition of the cosets of \(\Z_{m'}^* /

\) -- (specified by representatives), where the cosets in each component --- are in bijective correspondence with the cosets of @Z_m^* \/ \

@ under --- the natural (@mod m@) homomorphism. +-- are in bijective correspondence with the cosets of \(\Z_m^* /

\) under +-- the natural (\(\bmod m\)) homomorphism. partitionCosets :: forall m m' . (m `Divides` m') => Int -> Tagged '(m, m') [[Int]] partitionCosets p = diff --git a/Crypto/Lol/Types/ZqBasic.hs b/Crypto/Lol/Types/ZqBasic.hs --- a/Crypto/Lol/Types/ZqBasic.hs +++ b/Crypto/Lol/Types/ZqBasic.hs @@ -4,7 +4,9 @@ RebindableSyntax, RoleAnnotations, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-} --- | An implementation of the quotient ring Zq = Z/qZ. +-- | \( \def\Z{\mathbb{Z}} \) +-- \( \def\C{\mathbb{C}} \) +-- An implementation of the quotient ring \(\Z_q = \Z/(q\Z)\). -- EAC: It may help GHC do specialization at higher levels of the library -- if we "simplify" constraints in this module. For example, replace the @@ -51,7 +53,7 @@ import qualified Algebra.Ring as Ring (C) import qualified Algebra.ZeroTestable as ZeroTestable (C) --- | The ring @Z_q@ of integers modulo 'q', using underlying integer +-- | The ring \(\Z_q\) of integers modulo 'q', using underlying integer -- type 'z'. newtype ZqBasic q z = ZqB z deriving (Eq, Ord, ZeroTestable.C, E.Elt, Show, NFData, Storable) @@ -84,7 +86,7 @@ type instance CharOf (ZqBasic p z) = p instance (PPow pp, zq ~ ZqBasic pp z, - PrimeField (ZpOf zq), Ring zq, Ring (ZpOf zq)) + PrimeField (ZpOf zq), Ring zq) => ZPP (ZqBasic (pp :: PrimePower) z) where type ZpOf (ZqBasic pp z) = ZqBasic (PrimePP pp) z @@ -115,11 +117,11 @@ negqval :: z = negate $ proxy value (Proxy::Proxy q) in (reduce' negqval, recip $ reduce' pval) --- | Yield a /principal/ @m@th root of unity @omega_m \in @Z_q^*@. --- The implementation requires @q@ to be prime. It works by finding a --- generator of @Z_q^*@ and raising it to the @(q-1)/m@ power. --- Therefore, outputs for different values of @m@ are consistent, --- i.e., @omega_{m'}^(m'/m) = omega_m@. +-- | Yield a /principal/ \(m\)th root of unity \(\omega_m \in \Z_q^*\). +-- The implementation requires \(q\) to be prime. It works by finding a +-- generator of \(\Z_q^*\) and raising it to the \( (q-1)/m\) power. +-- Therefore, outputs for different values of \(m\) are consistent, +-- i.e., \(\omega_{m'}^(m'/m) = \omega_m\). principalRootUnity :: forall m q z . (Reflects m Int, Reflects q z, ToInteger z, Enumerable (ZqBasic q z)) => TaggedT m Maybe (Int -> ZqBasic q z) @@ -155,7 +157,7 @@ crtInfo = (,) <$> principalRootUnity <*> mhatInv --- | Embeds into complex numbers +-- | Embeds into the complex numbers \( \C \). instance (Reflects q z, ToInteger z, Ring (ZqBasic q z)) => CRTEmbed (ZqBasic q z) where type CRTExt (ZqBasic q z) = Complex Double @@ -203,10 +205,10 @@ divMod a b = (a/b, zero) -- Gadget-related instances -instance (Reflects q z, ToInteger z, Additive z) => Gadget TrivGad (ZqBasic q z) where +instance (Reflects q z, ToInteger z) => Gadget TrivGad (ZqBasic q z) where gadget = tag [one] -instance (Reflects q z, ToInteger z, Ring z) => Decompose TrivGad (ZqBasic q z) where +instance (Reflects q z, ToInteger z) => Decompose TrivGad (ZqBasic q z) where type DecompOf (ZqBasic q z) = z decompose x = tag [lift x] @@ -221,7 +223,7 @@ gadlen _ q | isZero q = 0 gadlen b q = 1 + gadlen b (q `div` b) --- | The base-@b@ gadget for modulus @q@, over integers (not mod +-- | The base-\(b\) gadget for modulus \(q\), over integers (not mod -- anything). gadgetZ :: (RealIntegral z) => z -> z -> [z] gadgetZ b q = take (gadlen b q) $ iterate (*b) one @@ -233,7 +235,7 @@ bval = proxy value (Proxy :: Proxy b) in tag $ reduce' <$> gadgetZ bval qval -instance (Reflects q z, ToInteger z, Ring z, ZeroTestable z, Reflects b z) +instance (Reflects q z, ToInteger z, Reflects b z) => Decompose (BaseBGad b) (ZqBasic q z) where type DecompOf (ZqBasic q z) = z decompose = let qval = proxy value (Proxy :: Proxy q) @@ -281,7 +283,7 @@ subLast [v0] [v'0] = let y = v0-v'0 in ([y], y) subLast (v0:vs) (v'0:v's) = first ((v0-v'0):) $ subLast vs v's -instance (Reflects q z, ToInteger z, Ring z, Reflects b z) +instance (Reflects q z, ToInteger z, Reflects b z) => Correct (BaseBGad b) (ZqBasic q z) where correct = diff --git a/README b/README --- a/README +++ b/README @@ -1,34 +1,54 @@ + +Most of the functionality in Lol is exported by two modules: + +* 'Crypto.Lol' exports the primary *interfaces* of Lol + +* 'Crypto.Lol.Types' exports concrete types that would be used by most + instantiations including tensors, base rings, and cryptographic + +For a brief introduction to relevant mathematical notation, see 'Crypto.Lol'. + Overview of key modules, roughly from highest- to lowest-level: -* Cyc.hs, which defines an interface for using cyclotomic fields, - rings R, and quotient rings Rq=R/qR; as well as many other - commonly used operations, e.g., converting +Cyclotomic layer: +* 'Crypto.Lol.Cyclotomic.Cyc', which defines an interface for using cyclotomic + fields, rings \( R \), and quotient rings \( R_q=R/qR \); as well as many + other commonly used operations, e.g., converting between rings, decoding and decomposing elements, modulus - reduction/rounding, etc. etc. Cyc is a safe wrapper around the - UCyc type, which exposes some representation-dependent operations. - UCyc (and hence Cyc) is implemented using a generic Tensor (described below). + reduction/rounding, etc. 'Cyc' is a safe wrapper around the + 'UCyc' type, which exposes some representation-dependent operations. + 'UCyc' (and hence 'Cyc') is implemented using a generic 'Tensor' + (described below). -* Tensor.hs, which defines a class that encapsulates all the necessary - linear transformations for operating on representations of R- and - Rq-elements, e.g., the CRT transform, converting between the - powerful and decoding bases, generating error terms, etc. -* RepaTensor.hs, which gives an - implementation of the Tensor class based on the "repa" +Tensor layer: +* 'Crypto.Lol.Cyclotomic.Tensor', which defines a class that encapsulates all + the necessary linear transformations for operating on representations of + \( R \)- and \( R_q \)-elements, e.g., the CRT transform, converting between + the powerful and decoding bases, generating error terms, etc. + +* 'Crypto.Lol.Cyclotomic.Tensor.RepaTensor', which gives an + implementation of the 'Tensor' class based on the "repa" package, a highly optimized and parallelizable array library. -* CTensor.hs, which gives an - implementation of the Tensor class using a C backend via Haskell's FFI. +* 'Crypto.Lol.Cyclotomic.Tensor.CTensor', which gives an + implementation of the 'Tensor' class using a C++ backend via Haskell's FFI. -* FiniteField.hs, which gives an unoptimized implementation of finite - field arithmetic. To use this module, you will need an instance of - IrreduciblePoly. These instances provide irreducible polynomials - for various degrees and base fields. One instance is provided for - characteristic 2 fields of size up to 2^32 in IrreducibleChar2.hs. -* ZqBasic.hs, which is a basic implementation of Zq=Z/qZ arithmetic. +Base ring layer: +* 'Crypto.Lol.Types.FiniteField', which gives an unoptimized implementation of + finite field arithmetic. To use this module, you will need an instance of + 'IrreduciblePoly'. These instances provide irreducible polynomials + for various degrees and base fields. One (orphan) instance is provided for + characteristic 2 fields of size up to 2^128 in + 'Crypto.Lol.Types.IrreducibleChar2', and is exported by 'Crypto.Lol.Types'. + If you need to use an unsupported finite field, define your own + instance of 'IrreduciblePoly' and do **not** import 'IrreducibleChar2'. -* Factored.hs, which contains support code for "reifying" - runtime-chosen integers as static types (mainly, the types q and m - that are floating around as parameters of many other data types), - and "reflecting" those types as integers back to the code. +* 'Crypto.Lol.Types.ZqBasic', which is a basic implementation of + \( \Z_q=\Z/q\Z \) arithmetic. + +* 'Crypto.Lol.Factored', which contains type-level support code for + factored integers. It also supports "reifying" 'Int's at runtime as static + types and "reflecting" those types as integers back to the code.. + 'Factored' types are mainly used to represent cyclotomic indices. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/benchmarks/CycBenches.hs b/benchmarks/CycBenches.hs --- a/benchmarks/CycBenches.hs +++ b/benchmarks/CycBenches.hs @@ -12,7 +12,7 @@ import Control.Monad.Random import Crypto.Lol -import Crypto.Lol.Types.Random +import Crypto.Lol.Types import Crypto.Random.DRBG import Data.Singletons @@ -21,8 +21,8 @@ cycBenches :: IO Benchmark cycBenches = benchGroup "Cyc" [ - benchGroup "unzipCycPow" $ applyBasic allParams $ hideArgs bench_unzipCycPow, - benchGroup "unzipCycCRT" $ applyBasic allParams $ hideArgs bench_unzipCycCRT, + benchGroup "unzipCycPow" $ applyUnzip allParams $ hideArgs bench_unzipCycPow, + benchGroup "unzipCycCRT" $ applyUnzip allParams $ hideArgs bench_unzipCycCRT, benchGroup "*" $ applyBasic allParams $ hideArgs bench_mul, benchGroup "crt" $ applyBasic allParams $ hideArgs bench_crt, benchGroup "crtInv" $ applyBasic allParams $ hideArgs bench_crtInv, @@ -35,12 +35,12 @@ benchGroup "embed" $ applyTwoIdx twoIdxParams $ hideArgs bench_embedPow ] -bench_unzipCycPow :: (BasicCtx t m r, BasicCtx t m (r,r)) => Cyc t m (r,r) -> Bench '(t,m,r) +bench_unzipCycPow :: (UnzipCtx t m r) => Cyc t m (r,r) -> Bench '(t,m,r) bench_unzipCycPow a = let a' = advisePow a in bench unzipCyc a' -bench_unzipCycCRT :: (BasicCtx t m r, BasicCtx t m (r,r)) => Cyc t m (r,r) -> Bench '(t,m,r) +bench_unzipCycCRT :: (UnzipCtx t m r) => Cyc t m (r,r) -> Bench '(t,m,r) bench_unzipCycCRT a = let a' = adviseCRT a in bench unzipCyc a' @@ -111,11 +111,11 @@ ] -- EAC: must be careful where we use Nub: apparently TypeRepStar doesn't work well with the Tensor constructors -type AllParams = ( '(,) <$> Tensors) <*> (Nub (Map RemoveM MM'RCombos)) +type AllParams = ( '(,) <$> Tensors) <*> MRCombos allParams :: Proxy AllParams allParams = Proxy -type LiftParams = ( '(,) <$> Tensors) <*> (Nub (Filter Liftable (Map RemoveM MM'RCombos))) +type LiftParams = ( '(,) <$> Tensors) <*> MRCombos liftParams :: Proxy LiftParams liftParams = Proxy diff --git a/benchmarks/TensorBenches.hs b/benchmarks/TensorBenches.hs --- a/benchmarks/TensorBenches.hs +++ b/benchmarks/TensorBenches.hs @@ -11,6 +11,7 @@ import Crypto.Lol import Crypto.Lol.Cyclotomic.Tensor +import Crypto.Lol.Types tensorBenches :: IO Benchmark tensorBenches = benchGroup "Tensor" [ diff --git a/benchmarks/UCycBenches.hs b/benchmarks/UCycBenches.hs --- a/benchmarks/UCycBenches.hs +++ b/benchmarks/UCycBenches.hs @@ -11,6 +11,7 @@ import Crypto.Lol import Crypto.Lol.Cyclotomic.UCyc +import Crypto.Lol.Types ucycBenches :: IO Benchmark ucycBenches = benchGroup "UCyc" [ diff --git a/lol.cabal b/lol.cabal --- a/lol.cabal +++ b/lol.cabal @@ -5,7 +5,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.3.0.0 +version: 0.4.0.0 synopsis: A library for lattice cryptography. homepage: https://github.com/cpeikert/Lol Bug-Reports: https://github.com/cpeikert/Lol/issues @@ -88,7 +88,7 @@ exposed-modules: Crypto.Lol - Crypto.Lol.PosBin + Crypto.Lol.Types Crypto.Lol.Factored Crypto.Lol.Reflects Crypto.Lol.CRTrans @@ -125,6 +125,7 @@ other-modules: + Crypto.Lol.PosBin Crypto.Lol.FactoredDefs Crypto.Lol.PosBinDefs Crypto.Lol.GaussRandom @@ -143,7 +144,7 @@ build-depends: arithmoi >= 0.4.1.3 && <0.5, - base==4.8.*, + base>=4.8 && <5, binary, bytestring, constraints, @@ -181,6 +182,7 @@ ghc-options: -threaded -rtsopts build-depends: + arithmoi, base, constraints, deepseq, @@ -210,6 +212,7 @@ -- ghc-options: -fno-liberate-case -funfolding-use-threshold1000 -funfolding-keeness-factor1000 build-depends: + arithmoi, base, criterion, deepseq, diff --git a/tests/CycTests.hs b/tests/CycTests.hs --- a/tests/CycTests.hs +++ b/tests/CycTests.hs @@ -5,6 +5,7 @@ import Control.Monad (liftM2,join) import Crypto.Lol +import Crypto.Lol.Types import Crypto.Lol.Types.ZPP import Utils diff --git a/tests/TensorTests.hs b/tests/TensorTests.hs --- a/tests/TensorTests.hs +++ b/tests/TensorTests.hs @@ -13,6 +13,7 @@ import Crypto.Lol import Crypto.Lol.CRTrans import Crypto.Lol.Cyclotomic.Tensor +import Crypto.Lol.Types import Control.Applicative @@ -118,8 +119,8 @@ -- tests that gSqNormDec of two "random-looking" vectors agrees for RT and CT -- t is a dummy param -prop_gsqnorm :: forall t m r . - (NormWrapCtx m r, NormCtx t m r) +prop_gsqnorm :: forall (t :: Factored -> * -> *) m r . + (NormWrapCtx m r) => r -> Test '(t,m,r) prop_gsqnorm x = test $ let crtCT = fromJust crt diff --git a/tests/ZqTests.hs b/tests/ZqTests.hs --- a/tests/ZqTests.hs +++ b/tests/ZqTests.hs @@ -30,7 +30,7 @@ prop_recip (Invertible x) = test $ one == (x * recip x) -- tests that multiplication in the extension ring matches CRT multiplication -prop_mul_ext :: forall r . (CRTEmbed r, Ring r, Eq r) +prop_mul_ext :: forall r . (CRTEmbed r, Eq r) => Invertible r -> Invertible r -> Test r prop_mul_ext (Invertible x) (Invertible y) = test $ let z = x * y diff --git a/utils/Apply/Cyc.hs b/utils/Apply/Cyc.hs --- a/utils/Apply/Cyc.hs +++ b/utils/Apply/Cyc.hs @@ -19,6 +19,7 @@ import Crypto.Lol import Crypto.Lol.Cyclotomic.Tensor +import Crypto.Lol.Types import Crypto.Lol.Types.ZPP import Crypto.Random.DRBG @@ -28,20 +29,37 @@ data BasicCtxD type BasicCtx t m r = - (CElt t r, Fact m, IntegralDomain r, Random r, Eq r, NFElt r, ShowType '(t,m,r), Random (t m r), m `Divides` m, NFData (t m r)) + (CElt t r, Fact m, IntegralDomain r, Random r, Eq r, NFElt r, ShowType '(t,m,r), + Random (t m r), m `Divides` m, NFData (t m r)) data instance ArgsCtx BasicCtxD where - BC :: (BasicCtx t m r, BasicCtx t m (r,r)) => Proxy '(t,m,r) -> ArgsCtx BasicCtxD -instance (params `Satisfy` BasicCtxD, BasicCtx t m r, BasicCtx t m (r,r)) + BC :: (BasicCtx t m r) => Proxy '(t,m,r) -> ArgsCtx BasicCtxD +instance (params `Satisfy` BasicCtxD, BasicCtx t m r) => ( '(t, '(m,r)) ': params) `Satisfy` BasicCtxD where run _ f = f (BC (Proxy::Proxy '(t,m,r))) : run (Proxy::Proxy params) f applyBasic :: (params `Satisfy` BasicCtxD, MonadRandom rnd) => Proxy params - -> (forall t m r . (BasicCtx t m r, BasicCtx t m (r,r), Generatable rnd r, Generatable rnd (t m r)) + -> (forall t m r . (BasicCtx t m r, Generatable rnd r, Generatable rnd (t m r)) => Proxy '(t,m,r) -> rnd res) -> [rnd res] applyBasic params g = run params $ \(BC p) -> g p +data UnzipCtxD +type UnzipCtx t m r = + (Fact m, CElt t (r,r), Random (t m (r,r)), CElt t r, ShowType '(t,m,r), NFElt r, Random r) +data instance ArgsCtx UnzipCtxD where + UzC :: (UnzipCtx t m r) => Proxy '(t,m,r) -> ArgsCtx UnzipCtxD +instance (params `Satisfy` UnzipCtxD, UnzipCtx t m r) + => ( '(t, '(m,r)) ': params) `Satisfy` UnzipCtxD where + run _ f = f (UzC (Proxy::Proxy '(t,m,r))) : run (Proxy::Proxy params) f + +applyUnzip :: (params `Satisfy` UnzipCtxD, MonadRandom rnd) => + Proxy params + -> (forall t m r . (UnzipCtx t m r, Generatable rnd (t m (r,r))) + => Proxy '(t,m,r) -> rnd res) + -> [rnd res] +applyUnzip params g = run params $ \(UzC p) -> g p + -- r is Liftable data LiftCtxD type LiftCtx t m r = @@ -70,7 +88,7 @@ => ( '(gen, '(t, '(m,r))) ': params) `Satisfy` ErrorCtxD where run _ f = f (EC (Proxy::Proxy '(t,m,r,gen))) : run (Proxy::Proxy params) f -applyError :: (params `Satisfy` ErrorCtxD, Monad rnd) => +applyError :: (params `Satisfy` ErrorCtxD) => Proxy params -> (forall t m r gen . (ErrorCtx t m r gen) => Proxy '(t,m,r,gen) -> rnd res) -> [rnd res] diff --git a/utils/Utils.hs b/utils/Utils.hs --- a/utils/Utils.hs +++ b/utils/Utils.hs @@ -10,17 +10,19 @@ ,type (<*>) ,module Data.Promotion.Prelude.List - +,goodQs ,showType ,ShowType) where -import Crypto.Lol (Int64,Fact,valueFact,Mod(..), Proxy(..), proxy, RT, CT, TrivGad, BaseBGad) +import Crypto.Lol (Int64,Fact,valueFact,Mod(..), Proxy(..), proxy, TrivGad, BaseBGad) import Crypto.Lol.Reflects +import Crypto.Lol.Cyclotomic.Tensor.RepaTensor +import Crypto.Lol.Cyclotomic.Tensor.CTensor import Crypto.Lol.Types.ZqBasic import Crypto.Random.DRBG import Data.Promotion.Prelude.List -{- + import Math.NumberTheory.Primes.Testing (isPrime) -- an infinite list of primes greater than the input and congruent to @@ -30,7 +32,6 @@ where checkVal v = if (isPrime (fromIntegral v :: Integer)) then v : checkVal (v+m) else checkVal (v+m) --} infixr 9 ** data a ** b