lol 0.3.0.0 → 0.4.0.0

raw patch · 47 files changed

+756/−468 lines, 47 filesdep ~arithmoidep ~basesetup-changedPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: arithmoi, base

API changes (from Hackage documentation)

Files

• CHANGES.md +7/−0
• Crypto/Lol.hs +43/−10
• Crypto/Lol/CRTrans.hs +22/−19
• Crypto/Lol/Cyclotomic/Cyc.hs +40/−33
• Crypto/Lol/Cyclotomic/Linear.hs +13/−11
• Crypto/Lol/Cyclotomic/RescaleCyc.hs +3/−1
• Crypto/Lol/Cyclotomic/Tensor.hs +121/−106
• Crypto/Lol/Cyclotomic/Tensor/CTensor.hs +32/−22
• Crypto/Lol/Cyclotomic/Tensor/CTensor/Backend.hs +61/−24
• Crypto/Lol/Cyclotomic/Tensor/CTensor/Extension.hs +12/−6
• Crypto/Lol/Cyclotomic/Tensor/CTensor/g.cpp +10/−0
• Crypto/Lol/Cyclotomic/Tensor/CTensor/types.h +23/−0
• Crypto/Lol/Cyclotomic/Tensor/RepaTensor.hs +1/−1
• Crypto/Lol/Cyclotomic/Tensor/RepaTensor/CRT.hs +16/−13
• Crypto/Lol/Cyclotomic/Tensor/RepaTensor/Extension.hs +14/−6
• Crypto/Lol/Cyclotomic/Tensor/RepaTensor/GL.hs +6/−5
• Crypto/Lol/Cyclotomic/Tensor/RepaTensor/RTCommon.hs +7/−7
• Crypto/Lol/Cyclotomic/UCyc.hs +38/−33
• Crypto/Lol/Factored.hs +3/−1
• Crypto/Lol/FactoredDefs.hs +22/−20
• Crypto/Lol/Gadget.hs +23/−4
• Crypto/Lol/PosBinDefs.hs +8/−4
• Crypto/Lol/Prelude.hs +25/−18
• Crypto/Lol/RLWE/Continuous.hs +9/−8
• Crypto/Lol/RLWE/Discrete.hs +6/−7
• Crypto/Lol/RLWE/RLWR.hs +3/−3
• Crypto/Lol/Types.hs +19/−0
• Crypto/Lol/Types/Complex.hs +2/−2
• Crypto/Lol/Types/FiniteField.hs +12/−11
• Crypto/Lol/Types/IrreducibleChar2.hs +1/−2
• Crypto/Lol/Types/Numeric.hs +27/−17
• Crypto/Lol/Types/RRq.hs +6/−5
• Crypto/Lol/Types/Random.hs +1/−1
• Crypto/Lol/Types/ZPP.hs +3/−2
• Crypto/Lol/Types/ZmStar.hs +7/−6
• Crypto/Lol/Types/ZqBasic.hs +16/−14
• README +44/−24
• Setup.hs +2/−0
• benchmarks/CycBenches.hs +7/−7
• benchmarks/TensorBenches.hs +1/−0
• benchmarks/UCycBenches.hs +1/−0
• lol.cabal +6/−3
• tests/CycTests.hs +1/−0
• tests/TensorTests.hs +3/−2
• tests/ZqTests.hs +1/−1
• utils/Apply/Cyc.hs +23/−5
• utils/Utils.hs +5/−4

@@ -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

@@ -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

@@ -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.

@@ -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))

@@ -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

@@ -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 

@@ -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

@@ -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

@@ -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 ()

@@ -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

@@ -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);
+}

@@ -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;
 }
 

@@ -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

@@ -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 #-}

@@ -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)

@@ -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 #-}

@@ -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))

@@ -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

@@ -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.

@@ -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 

@@ -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 @\<g, x\> = 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'),

@@ -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--- @<pfx>n@ as the type @f n@.+-- @\<pfx\>@\(n\) as the type @f n@. intDec :: String               -- ^ @pfx@        -> (Int -> TypeQ)       -- ^ @f@        -> Int                  -- ^ @n@

@@ -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 #-}

@@ -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

@@ -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

@@ -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'

@@ -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

@@ -37,7 +37,7 @@ import Test.QuickCheck  -- | Newtype wrapper (with slightly different instances) for--- <https://hackage.haskell.org/package/numeric-prelude-0.4.2/docs/Number-Complex.html numeric-prelude Complex>.+-- @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 

@@ -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) 

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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 

@@ -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\'}^* \/ \<p>@+-- | Given \(p\), returns a partition of the cosets of \(\Z_{m'}^* / <p>\) -- (specified by representatives), where the cosets in each component--- are in bijective correspondence with the cosets of @Z_m^* \/ \<p>@ under--- the natural (@mod m@) homomorphism.+-- are in bijective correspondence with the cosets of \(\Z_m^* / <p>\) under+-- the natural (\(\bmod m\)) homomorphism. partitionCosets :: forall m m' . (m `Divides` m')   => Int -> Tagged '(m, m') [[Int]] partitionCosets p =

@@ -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 =

@@ -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.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -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 

@@ -11,6 +11,7 @@  import Crypto.Lol import Crypto.Lol.Cyclotomic.Tensor+import Crypto.Lol.Types  tensorBenches :: IO Benchmark tensorBenches = benchGroup "Tensor" [

@@ -11,6 +11,7 @@  import Crypto.Lol import Crypto.Lol.Cyclotomic.UCyc+import Crypto.Lol.Types  ucycBenches :: IO Benchmark ucycBenches = benchGroup "UCyc" [

@@ -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,

@@ -5,6 +5,7 @@ import Control.Monad (liftM2,join)  import Crypto.Lol+import Crypto.Lol.Types import Crypto.Lol.Types.ZPP  import Utils

@@ -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

@@ -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

@@ -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]

@@ -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