-----------------------------------------------------------------------------
-- |
-- Module      :  Crypto.Common
-- Copyright   :  (c) Marcel Fourné 20[09..]
-- License     :  BSD3
-- Maintainer  :  Marcel Fourné (haskell@marcelfourne.de)
-- Stability   :  experimental
-- Portability :  Good
--
-- ECC Base algorithms & point formats for NIST Curves as specified in NISTReCur.pdf[http://csrc.nist.gov/groups/ST/toolkit/documents/dss/NISTReCur.pdf]
-- Re Timing-Attacks: We depend on (==) being resistant for Integer.
-- 
-----------------------------------------------------------------------------

{-# OPTIONS_GHC -O2 -feager-blackholing #-}
{-# LANGUAGE Trustworthy, NoImplicitPrelude, MagicHash #-}

module Crypto.Common ( wordMax
                     , wordSize
                     , sizeinWords
{-                     , zero
                     , one
                     , two
                     , three -}
                     , log2len
                     , testcond
                     )
       where

import safe Prelude (Num(..),Int,($),(+),(-),fromInteger,Integral,Integer,(>),toInteger,maxBound,quotRem)
import safe qualified Data.Bits as B (Bits(..),FiniteBits(..))
import safe qualified Data.Word as W (Word)
-- import qualified Data.Vector.Unboxed as V
import GHC.Exts
import GHC.Integer.Logarithms

-- | return the maximum value storable in a Word
wordMax :: (Integral a) => a
wordMax :: a
wordMax = Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer -> a) -> Integer -> a
forall a b. (a -> b) -> a -> b
$ Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word
forall a. Bounded a => a
maxBound::W.Word)

-- | return the bitSize of a Word
wordSize :: Int
wordSize :: Int
wordSize = Word -> Int
forall b. FiniteBits b => b -> Int
B.finiteBitSize (Word
0::W.Word)
{-# INLINE wordSize #-}

-- | determine the needed storage for a bitlength in Words
sizeinWords :: Int -> Int
sizeinWords :: Int -> Int
sizeinWords Int
0 = Int
1 -- or error? 0 bit len?!
sizeinWords Int
t = let (Int
w,Int
r) = Int -> Int
forall a. Num a => a -> a
abs Int
t Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
wordSize
                in if Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 else Int
w

{-                                            
-- constant vectors for comparisons etc.
-- | a vector of zeros of requested length
zero :: Int -> V.Vector W.Word
zero l = V.replicate (sizeinWords l) 0
-- | a vector of zeros of requested length, but least significant word 1
one :: Int -> V.Vector W.Word
one l = V.singleton 1 V.++ V.replicate (sizeinWords l - 1)  0
-- | a vector of zeros of requested length, but least significant word 2
two :: Int -> V.Vector W.Word
two l = V.singleton 2 V.++ V.replicate (sizeinWords l - 1)  0
-- | a vector of zeros of requested length, but least significant word 3
three :: Int -> V.Vector W.Word
three l = V.singleton 3 V.++ V.replicate (sizeinWords l - 1) 0
-}

-- returning the binary length of an Integer, not sidechannel secure!
-- | returning the binary length of an Integer, uses integer-gmp directly
log2len :: Integer -> Int
{-
log2len 0 = 1
log2len n = length (takeWhile (<=n) (iterate (*2) 1))
-- -}
log2len :: Integer -> Int
log2len Integer
x = (Int# -> Int
I# (Integer -> Int#
integerLog2# Integer
x)) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
{-# INLINABLE log2len #-}

-- | we want word w at position i to result in a word to multiply by, eliminating branching
testcond :: W.Word -> Int -> W.Word
testcond :: Word -> Int -> Word
testcond Word
w Int
i = Word -> Int -> Word
forall a. Bits a => a -> Int -> a
B.shift (Word -> Int -> Word
forall a. Bits a => a -> Int -> a
B.shift Word
w (Int
wordSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) (-(Int
wordSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))