    {-# LANGUAGE CPP #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE FlexibleContexts      #-}

    -- | This module defines combinators, types and instances for defining
    -- timing safe equality checks.
    module Raaz.Core.Types.Equality
           ( -- * Timing safe equality checking.
             -- $timingSafeEquality$
             Equality(..), (===)
           , Result
           ) where

    import           Control.Monad               ( liftM )
    import           Data.Bits

    #if !MIN_VERSION_base(4,8,0)
    import Data.Monoid  -- Import only when base < 4.8.0
    #endif

    import qualified Data.Vector.Generic         as G
    import qualified Data.Vector.Generic.Mutable as GM
    import           Data.Vector.Unboxed         ( MVector(..), Vector, Unbox )
    import           Data.Word

    -- $timingSafeEquality$
    --
    -- Many cryptographic setting require comparing two secrets and such
    -- comparisons should be timing safe, i.e. the time taken to make the
    -- comparison should not depend on the actual values that are
    -- compared. Unfortunately, the equality comparison of may Haskell
    -- types like `ByteString`, provided via the class `Eq` is /not/
    -- timing safe. In raaz we take special care in defining the `Eq`
    -- instance of all cryptographically sensitive types which make them
    -- timing safe . For example, if we compare two digests @dgst1 ==
    -- dgst2@, the `Eq` instance is defined in such a way that the time
    -- taken is constant irrespective of the actual values. We also give a
    -- mechanism to build timing safe equality for more complicated types
    -- that user might need to define in her use cases as we now describe.
    --
    -- The starting point of defining such timing safe equality is the
    -- class `Equality` which plays the role `Eq`. The member function
    -- `eq` playing the role of (`==`) with an important difference.  The
    -- comparison function `eq` returns the type type `Result` instead of
    -- `Bool` and it is timing safe. The `Eq` instance is then defined by
    -- making use of the operator (`===`). Thus a user of the library can
    -- stick to the familiar `Eq` class and get the benefits of timing
    -- safe comparison
    --
    -- == Building timing safe equality for Custom types.
    --
    -- For basic types like `Word32`, `Word64` this module defines
    -- instances of `Equality`. The `Tuple` type inherits the `Equality`
    -- instance from its base type. As a developer, new crypto-primitives
    -- or protocols often need to define timing safe equality for types
    -- other than those exported here. This is done in two stages.
    --
    -- 1. Define an instance of `Equality`.
    --
    -- 2. Make use of the above instance to define `Eq` instance as follows.
    --
    -- > data SomeSensitiveType = ...
    -- >
    -- > instance Equality SomeSensitiveType where
    -- >          eq a b = ...
    -- >
    -- > instance Eq SomeSensitiveType where
    -- >      (==) a b = a === b
    --
    -- === Combining multiple comparisons using Monoid operations
    --
    -- The `Result` type is an opaque type and does not allow inspection
    -- via a pattern match or conversion to `Bool`. However, while
    -- defining the `Equality` instance, we often need to perform an AND
    -- of multiple comparison (think of comparing a tuple). This is where
    -- the monoid instance of `Result` is useful. If @r1@ and @r2@ are the
    -- results of two comparisons then @r1 `mappend` r2@ essentially takes
    -- the AND of these results. However, unlike in the case of AND-ing in
    -- `Bool`, `mappend` on the `Result` type does not short-circuit.  In
    -- fact, the whole point of using `Result` type instead of `Bool` is
    -- to avoid this short circuiting.
    --
    -- To illustrate, we have the following code fragment
    --
    -- > data Foo = Foo Word32 Word64
    -- >
    -- > instance Equality Foo where
    -- >    eq (Foo a b) (Foo c d) = eq a c `mapped` eq b d
    -- >
    -- > instance Eq Foo where
    -- >    (=) = (===)
    --
    -- == Automatic deriving of `Equality` instances.
    --
    -- We often find ourselves wrapping existing types in new types
    -- keeping in line with the philosophy of distinguishing sematically
    -- distinct data with their types. It would be tedious to repeat the
    -- above process for each such type. Often, we can get away by just
    -- deriving these instances thereby saving a lot of boilerplate. For
    -- example, consider a data type that needs to keep a 128-byte
    -- secret. A simple deriving class would work in such cases.
    --
    -- >
    -- > newtype Secret = Secret (Tuple 128 Word8) deriving (Equality, Eq)
    -- >
    --
    -- The `Eq` instance here would be timing safe because it is
    -- essentially the `Eq` instance of tuples. The deriving `Equality` is
    -- not strictly required here. However, we suggest keeping it so that
    -- on can define timing safe equality for other types that contain a
    -- component of type `Secret`.
    --
    -- === Beware: deriving clause can be dangerous
    --
    -- The deriving clause that we defined above while convenient, hides a
    -- danger when not used properly. For example, consider the following
    -- definitions.
    --
    -- > data    Bad      = Bad Bar Biz deriving Eq
    -- > newtype BadAgain = BadAgain (Bar, Biz) deriving (Eq, Equality)
    -- >
    --
    -- The comparison for the elements of the type `Bad` would leak some
    -- timing information /even/ when `Bar` and `Biz` are instances of
    -- `Equality` and thus have timing safe equalities themselves. This is
    -- because the automatic derivation of `Eq` instances in the above two
    -- cases performs a component by component comparison and combines the
    -- result using @`and`@. Due to boolean short circuiting, this
    -- will lead to timing information being leaked.
    --
    -- For product types, we can safely derive the `Equality` instance and use
    -- it to define the @Eq@ instance as follows
    --
    -- >
    -- > newtype Okey2 = Okey (Foo, Bar) deriving Equality
    -- >
    -- > instance Eq Okey2 where
    -- >    (=) = (===)
    -- >
    --
    --

    -- | All types that support timing safe equality are instances of this class.
    class Equality a where
      eq :: a -> a -> Result

    -- | Check whether two values are equal using the timing safe `eq`
    -- function. Use this function when defining the `Eq` instance for a
    -- Sensitive data type.
    (===) :: Equality a => a -> a -> Bool
    (===) a b = isSuccessful $ eq a b

    instance Equality Word where
      eq a b = Result $ a `xor` b

    instance Equality Word8 where
      eq w1 w2 = Result $ fromIntegral $ xor w1 w2

    instance Equality Word16 where
      eq w1 w2 = Result $ fromIntegral $ xor w1 w2

    instance Equality Word32 where
      eq w1 w2 = Result $ fromIntegral $ xor w1 w2

    #include "MachDeps.h"
    instance Equality Word64 where
    -- It assumes that Word size is atleast 32 Bits
    #if WORD_SIZE_IN_BITS < 64
      eq w1 w2 = eq w11 w21 `mappend` eq w12 w22
        where
          w11 :: Word
          w12 :: Word
          w21 :: Word
          w22 :: Word
          w11 = fromIntegral $ w1 `shiftR` 32
          w12 = fromIntegral w1
          w21 = fromIntegral $ w2 `shiftR` 32
          w22 = fromIntegral w2
    #else
      eq w1 w2 = Result $ fromIntegral $ xor w1 w2
    #endif

    -- Now comes the boring instances for tuples.

    instance ( Equality a
             , Equality b
             ) => Equality (a , b) where
      eq (a1,a2) (b1,b2) = eq a1 b1 `mappend` eq a2 b2

    instance ( Equality a
             , Equality b
             , Equality c
             ) => Equality (a , b, c) where
      eq (a1,a2,a3) (b1,b2,b3) = eq a1 b1 `mappend`
                                 eq a2 b2 `mappend`
                                 eq a3 b3

    instance ( Equality a
             , Equality b
             , Equality c
             , Equality d
             ) => Equality (a , b, c, d) where
      eq (a1,a2,a3,a4) (b1,b2,b3,b4) = eq a1 b1 `mappend`
                                       eq a2 b2 `mappend`
                                       eq a3 b3 `mappend`
                                       eq a4 b4

    instance ( Equality a
             , Equality b
             , Equality c
             , Equality d
             , Equality e
             ) => Equality (a , b, c, d, e) where
      eq (a1,a2,a3,a4,a5) (b1,b2,b3,b4,b5) = eq a1 b1 `mappend`
                                             eq a2 b2 `mappend`
                                             eq a3 b3 `mappend`
                                             eq a4 b4 `mappend`
                                             eq a5 b5

    instance ( Equality a
             , Equality b
             , Equality c
             , Equality d
             , Equality e
             , Equality f
             ) => Equality (a , b, c, d, e, f) where
      eq (a1,a2,a3,a4,a5,a6) (b1,b2,b3,b4,b5,b6) = eq a1 b1 `mappend`
                                                   eq a2 b2 `mappend`
                                                   eq a3 b3 `mappend`
                                                   eq a4 b4 `mappend`
                                                   eq a5 b5 `mappend`
                                                   eq a6 b6

    instance ( Equality a
             , Equality b
             , Equality c
             , Equality d
             , Equality e
             , Equality f
             , Equality g
             ) => Equality (a , b, c, d, e, f, g) where
      eq (a1,a2,a3,a4,a5,a6,a7) (b1,b2,b3,b4,b5,b6,b7) = eq a1 b1 `mappend`
                                                         eq a2 b2 `mappend`
                                                         eq a3 b3 `mappend`
                                                         eq a4 b4 `mappend`
                                                         eq a5 b5 `mappend`
                                                         eq a6 b6 `mappend`
                                                         eq a7 b7

    -- | The result of a comparison. This is an opaque type and the monoid instance essentially takes
    -- AND of two comparisons in a timing safe way.
    newtype Result =  Result { unResult :: Word }

    #if MIN_VERSION_base(4,11,0)
    instance Semigroup Result where
        (<>) a b = Result (unResult a .|. unResult b)
    #endif

    instance Monoid Result where
      mempty      = Result 0
      mappend a b = Result (unResult a .|. unResult b)
      {-# INLINE mempty  #-}
      {-# INLINE mappend #-}

    -- | Checks whether a given equality comparison is successful.
    isSuccessful :: Result -> Bool
    {-# INLINE isSuccessful #-}
    isSuccessful = (==0) . unResult

    -- | MVector for Results.
    newtype instance MVector s Result = MV_Result (MVector s Word)
    -- | Vector of Results.
    newtype instance Vector    Result = V_Result  (Vector Word)

    instance Unbox Result

    instance GM.MVector MVector Result where
      {-# INLINE basicLength #-}
      {-# INLINE basicUnsafeSlice #-}
      {-# INLINE basicOverlaps #-}
      {-# INLINE basicUnsafeNew #-}
      {-# INLINE basicUnsafeReplicate #-}
      {-# INLINE basicUnsafeRead #-}
      {-# INLINE basicUnsafeWrite #-}
      {-# INLINE basicClear #-}
      {-# INLINE basicSet #-}
      {-# INLINE basicUnsafeCopy #-}
      {-# INLINE basicUnsafeGrow #-}
      basicLength          (MV_Result v)            = GM.basicLength v
      basicUnsafeSlice i n (MV_Result v)            = MV_Result $ GM.basicUnsafeSlice i n v
      basicOverlaps (MV_Result v1) (MV_Result v2)   = GM.basicOverlaps v1 v2

      basicUnsafeRead  (MV_Result v) i              = Result `liftM` GM.basicUnsafeRead v i
      basicUnsafeWrite (MV_Result v) i (Result x)   = GM.basicUnsafeWrite v i x

      basicClear (MV_Result v)                      = GM.basicClear v
      basicSet   (MV_Result v)         (Result x)   = GM.basicSet v x

      basicUnsafeNew n                              = MV_Result `liftM` GM.basicUnsafeNew n
      basicUnsafeReplicate n     (Result x)         = MV_Result `liftM` GM.basicUnsafeReplicate n x
      basicUnsafeCopy (MV_Result v1) (MV_Result v2) = GM.basicUnsafeCopy v1 v2
      basicUnsafeGrow (MV_Result v)   n             = MV_Result `liftM` GM.basicUnsafeGrow v n

    #if MIN_VERSION_vector(0,11,0)
      basicInitialize (MV_Result v)               = GM.basicInitialize v
    #endif

    instance G.Vector Vector Result where
      {-# INLINE basicUnsafeFreeze #-}
      {-# INLINE basicUnsafeThaw #-}
      {-# INLINE basicLength #-}
      {-# INLINE basicUnsafeSlice #-}
      {-# INLINE basicUnsafeIndexM #-}
      {-# INLINE elemseq #-}
      basicUnsafeFreeze (MV_Result v)             = V_Result  `liftM` G.basicUnsafeFreeze v
      basicUnsafeThaw (V_Result v)                = MV_Result `liftM` G.basicUnsafeThaw v
      basicLength (V_Result v)                    = G.basicLength v
      basicUnsafeSlice i n (V_Result v)           = V_Result $ G.basicUnsafeSlice i n v
      basicUnsafeIndexM (V_Result v) i            = Result   `liftM`  G.basicUnsafeIndexM v i

      basicUnsafeCopy (MV_Result mv) (V_Result v) = G.basicUnsafeCopy mv v
      elemseq _ (Result x)                        = G.elemseq (undefined :: Vector a) x