{-| Module : Crypto.Lol.Cyclotomic.Tensor.CPP.Extension Description : Embedding/twacing in various bases for CPP. Copyright : (c) Eric Crockett, 2011-2017 Chris Peikert, 2011-2017 License : GPL-3 Maintainer : ecrockett0@email.com Stability : experimental Portability : POSIX CPP Tensor-specific functions for embedding/twacing in various bases. -} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} module Crypto.Lol.Cyclotomic.Tensor.CPP.Extension ( embedPow', embedDec', embedCRT' , twacePowDec', twaceCRT' , coeffs', powBasisPow' , crtSetDec' , backpermute' ) where import Crypto.Lol.CRTrans import Crypto.Lol.Cyclotomic.Tensor as T import Crypto.Lol.Cyclotomic.Tensor.CPP.Instances () import Crypto.Lol.Prelude as LP hiding (lift, null) import Crypto.Lol.Reflects import Crypto.Lol.Types.FiniteField import Crypto.Lol.Types.Unsafe.ZqBasic hiding (ZqB, unZqB) import Crypto.Lol.Types.ZmStar import Control.Applicative hiding (empty) import Control.Monad.Trans (lift) import Data.Maybe import Data.Reflection (reify) import qualified Data.Vector as V import Data.Vector.Storable as SV import qualified Data.Vector.Unboxed as U -- | /O(n)/ Yield the vector obtained by replacing each element @i@ of the -- index vector by @xs'!'i@. This is equivalent to @'map' (xs'!') is@ but is -- often much more efficient. -- -- > backpermute <0,3,2,3,1,0> = backpermute' :: (Storable a) => U.Vector Int -- ^ @is@ index vector (of length @n@) -> Vector a -- ^ @xs@ value vector -> Vector a {-# INLINABLE backpermute' #-} backpermute' is v = generate (U.length is) (\i -> v ! (is U.! i)) embedPow', embedDec' :: forall m m' r . (Additive r, Storable r, m `Divides` m') => Tagged '(m, m') (Vector r -> Vector r) {-# INLINABLE embedPow' #-} {-# INLINABLE embedDec' #-} -- | Embeds an vector in the powerful basis of the @m@th cyclotomic -- ring to a vector in the powerful basis of the @m'@th cyclotomic -- ring embedPow' = tag $ (\indices arr -> generate (U.length indices) $ \idx -> let (j0,j1) = indices U.! idx in if j0 == 0 then arr ! j1 else zero) $ baseIndicesPow @m @m' -- | Same as 'embedPow'', but for the decoding basis. embedDec' = tag $ (\indices arr -> generate (U.length indices) (\idx -> maybe LP.zero (\(sh,b) -> if b then negate (arr ! sh) else arr ! sh) (indices U.! idx))) $ baseIndicesDec @m @m' -- | Embeds an vector in the CRT basis of the the mth cyclotomic ring -- to an vector in the CRT basis of the m'th cyclotomic ring when @m | m'@ embedCRT' :: forall m m' mon r . (CRTrans mon r, Storable r, m `Divides` m') => TaggedT '(m, m') mon (Vector r -> Vector r) embedCRT' = lift (proxyT crtInfo (Proxy::Proxy m') :: mon (CRTInfo r)) >> tagT (pure $ backpermute' $ baseIndicesCRT @m @m') -- | maps a vector in the powerful/decoding basis, representing an -- O_m' element, to a vector of arrays representing O_m elements in -- the same type of basis coeffs' :: forall m m' r . (Storable r, m `Divides` m') => Tagged '(m, m') (Vector r -> [Vector r]) coeffs' = tag $ flip (\x -> V.toList . V.map (`backpermute'` x)) $ extIndicesCoeffs @m @m' -- | The "tweaked trace" function in either the powerful or decoding -- basis of the m'th cyclotomic ring to the mth cyclotomic ring when -- @m | m'@. twacePowDec' :: forall m m' r . (Storable r, m `Divides` m') => Tagged '(m, m') (Vector r -> Vector r) {-# INLINABLE twacePowDec' #-} twacePowDec' = tag $ backpermute' $ extIndicesPowDec @m @m' kronToVec :: forall m r . (Fact m, Ring r, Storable r) => Kron r -> Vector r kronToVec v = generate (totientFact @m) (flip (indexK v) 0) twaceCRT' :: forall mon m m' r . (Storable r, CRTrans mon r, m `Divides` m') => TaggedT '(m, m') mon (Vector r -> Vector r) {-# INLINABLE twaceCRT' #-} twaceCRT' = tagT $ do g' <- kronToVec @m' <$> gCRTK @m' gInv <- kronToVec @m <$> gInvCRTK @m embed <- untagT $ embedCRT' @m @m' (_, m'hatinv) <- proxyT crtInfo (Proxy::Proxy m') let phi = totientFact @m phi' = totientFact @m' mhat = fromIntegral $ valueHatFact @m hatRatioInv = m'hatinv * mhat reltot = phi' `div` phi -- tweak = mhat * g' / (m'hat * g) tweak = SV.map (* hatRatioInv) $ SV.zipWith (*) (embed gInv) g' indices = extIndicesCRT @m @m' return $ \ arr -> -- take true trace after mul-by-tweak let v = backpermute' indices (SV.zipWith (*) tweak arr) in generate phi $ \i -> foldl1' (+) $ SV.unsafeSlice (i*reltot) reltot v -- | The powerful extension basis, wrt the powerful basis. -- Outputs a list of vectors in O_m' that are an O_m basis for O_m' powBasisPow' :: forall m m' r . (m `Divides` m', Ring r, SV.Storable r) => Tagged '(m, m') [SV.Vector r] powBasisPow' = do let (_, phi, phi', _) = indexInfo @m @m' idxs = baseIndicesPow @m @m' return $ LP.map (\k -> generate phi' $ \j -> let (j0,j1) = idxs U.! j in if j0==k && j1==0 then one else zero) [0..phi' `div` phi - 1] -- | A list of vectors representing the mod-p CRT set of the -- extension O_m'/O_m crtSetDec' :: forall m m' p . (m `Divides` m', Prime p, Coprime (PToF p) m', Reflects p Int64, IrreduciblePoly (ZqBasic p Int64)) -- previously: ToInteger z, Enum z, SV.Storable z, NFData z => Tagged '(m, m') [SV.Vector (ZqBasic p Int64)] {-# INLINABLE crtSetDec' #-} crtSetDec' = let p = valuePrime @p phi = totientFact @m' d = order @m' p h :: Int = valueHatFact @m' hinv = recip $ fromIntegral h in reify d $ \(_::Proxy d) -> do let twCRTs' :: Kron (GF (ZqBasic p Int64) d) = fromMaybe (error "internal error: crtSetDec': twCRTs") $ twCRTs @m' zmsToIdx = T.zmsToIndexFact @m' elt j i = indexK twCRTs' j (zmsToIdx i) cosets = partitionCosets @m @m' p return $ LP.map (\is -> generate phi (\j -> hinv * trace (LP.sum $ LP.map (elt j) is))) cosets