{-# OPTIONS_HADDOCK hide           #-}
{-# 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 qualified Data.Vector.Generic         as G
import qualified Data.Vector.Generic.Mutable as GM
import           Data.Vector.Unboxed         ( MVector(..), Vector, Unbox )
import           Raaz.Core.Prelude



-- $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 -> a -> Bool
(===) a
a a
b = Result -> Bool
isSuccessful (Result -> Bool) -> Result -> Bool
forall a b. (a -> b) -> a -> b
$ a -> a -> Result
forall a. Equality a => a -> a -> Result
eq a
a a
b

instance Equality Word where
  eq :: Word -> Word -> Result
eq Word
a Word
b = Word -> Result
Result (Word -> Result) -> Word -> Result
forall a b. (a -> b) -> a -> b
$ Word
a Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` Word
b

instance Equality Word8 where
  eq :: Word8 -> Word8 -> Result
eq Word8
w1 Word8
w2 = Word -> Result
Result (Word -> Result) -> Word -> Result
forall a b. (a -> b) -> a -> b
$ Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word) -> Word8 -> Word
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
xor Word8
w1 Word8
w2

instance Equality Word16 where
  eq :: Word16 -> Word16 -> Result
eq Word16
w1 Word16
w2 = Word -> Result
Result (Word -> Result) -> Word -> Result
forall a b. (a -> b) -> a -> b
$ Word16 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Word) -> Word16 -> Word
forall a b. (a -> b) -> a -> b
$ Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
xor Word16
w1 Word16
w2

instance Equality Word32 where
  eq :: Word32 -> Word32 -> Result
eq Word32
w1 Word32
w2 = Word -> Result
Result (Word -> Result) -> Word -> Result
forall a b. (a -> b) -> a -> b
$ Word32 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word) -> Word32 -> Word
forall a b. (a -> b) -> a -> b
$ Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
xor Word32
w1 Word32
w2

#ifndef __HLINT__
#include "MachDeps.h"
#endif
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 :: Word64 -> Word64 -> Result
eq Word64
w1 Word64
w2 = Word -> Result
Result (Word -> Result) -> Word -> Result
forall a b. (a -> b) -> a -> b
$ Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word) -> Word64 -> Word
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
xor Word64
w1 Word64
w2
#endif

-- Now comes the boring instances for tuples.

instance ( Equality a
         , Equality b
         ) => Equality (a , b) where
  eq :: (a, b) -> (a, b) -> Result
eq (a
a1,b
a2) (a
b1,b
b2) = a -> a -> Result
forall a. Equality a => a -> a -> Result
eq a
a1 a
b1 Result -> Result -> Result
forall a. Monoid a => a -> a -> a
`mappend` b -> b -> Result
forall a. Equality a => a -> a -> Result
eq b
a2 b
b2


instance ( Equality a
         , Equality b
         , Equality c
         ) => Equality (a , b, c) where
  eq :: (a, b, c) -> (a, b, c) -> Result
eq (a
a1,b
a2,c
a3) (a
b1,b
b2,c
b3) = a -> a -> Result
forall a. Equality a => a -> a -> Result
eq a
a1 a
b1 Result -> Result -> Result
forall a. Monoid a => a -> a -> a
`mappend`
                             b -> b -> Result
forall a. Equality a => a -> a -> Result
eq b
a2 b
b2 Result -> Result -> Result
forall a. Monoid a => a -> a -> a
`mappend`
                             c -> c -> Result
forall a. Equality a => a -> a -> Result
eq c
a3 c
b3


instance ( Equality a
         , Equality b
         , Equality c
         , Equality d
         ) => Equality (a , b, c, d) where
  eq :: (a, b, c, d) -> (a, b, c, d) -> Result
eq (a
a1,b
a2,c
a3,d
a4) (a
b1,b
b2,c
b3,d
b4) = a -> a -> Result
forall a. Equality a => a -> a -> Result
eq a
a1 a
b1 Result -> Result -> Result
forall a. Monoid a => a -> a -> a
`mappend`
                                   b -> b -> Result
forall a. Equality a => a -> a -> Result
eq b
a2 b
b2 Result -> Result -> Result
forall a. Monoid a => a -> a -> a
`mappend`
                                   c -> c -> Result
forall a. Equality a => a -> a -> Result
eq c
a3 c
b3 Result -> Result -> Result
forall a. Monoid a => a -> a -> a
`mappend`
                                   d -> d -> Result
forall a. Equality a => a -> a -> Result
eq d
a4 d
b4

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


instance ( Equality a
         , Equality b
         , Equality c
         , Equality d
         , Equality e
         , Equality f
         ) => Equality (a , b, c, d, e, f) where
  eq :: (a, b, c, d, e, f) -> (a, b, c, d, e, f) -> Result
eq (a
a1,b
a2,c
a3,d
a4,e
a5,f
a6) (a
b1,b
b2,c
b3,d
b4,e
b5,f
b6) = a -> a -> Result
forall a. Equality a => a -> a -> Result
eq a
a1 a
b1 Result -> Result -> Result
forall a. Monoid a => a -> a -> a
`mappend`
                                               b -> b -> Result
forall a. Equality a => a -> a -> Result
eq b
a2 b
b2 Result -> Result -> Result
forall a. Monoid a => a -> a -> a
`mappend`
                                               c -> c -> Result
forall a. Equality a => a -> a -> Result
eq c
a3 c
b3 Result -> Result -> Result
forall a. Monoid a => a -> a -> a
`mappend`
                                               d -> d -> Result
forall a. Equality a => a -> a -> Result
eq d
a4 d
b4 Result -> Result -> Result
forall a. Monoid a => a -> a -> a
`mappend`
                                               e -> e -> Result
forall a. Equality a => a -> a -> Result
eq e
a5 e
b5 Result -> Result -> Result
forall a. Monoid a => a -> a -> a
`mappend`
                                               f -> f -> Result
forall a. Equality a => a -> a -> Result
eq f
a6 f
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 :: (a, b, c, d, e, f, g) -> (a, b, c, d, e, f, g) -> Result
eq (a
a1,b
a2,c
a3,d
a4,e
a5,f
a6,g
a7) (a
b1,b
b2,c
b3,d
b4,e
b5,f
b6,g
b7) = a -> a -> Result
forall a. Equality a => a -> a -> Result
eq a
a1 a
b1 Result -> Result -> Result
forall a. Monoid a => a -> a -> a
`mappend`
                                                     b -> b -> Result
forall a. Equality a => a -> a -> Result
eq b
a2 b
b2 Result -> Result -> Result
forall a. Monoid a => a -> a -> a
`mappend`
                                                     c -> c -> Result
forall a. Equality a => a -> a -> Result
eq c
a3 c
b3 Result -> Result -> Result
forall a. Monoid a => a -> a -> a
`mappend`
                                                     d -> d -> Result
forall a. Equality a => a -> a -> Result
eq d
a4 d
b4 Result -> Result -> Result
forall a. Monoid a => a -> a -> a
`mappend`
                                                     e -> e -> Result
forall a. Equality a => a -> a -> Result
eq e
a5 e
b5 Result -> Result -> Result
forall a. Monoid a => a -> a -> a
`mappend`
                                                     f -> f -> Result
forall a. Equality a => a -> a -> Result
eq f
a6 f
b6 Result -> Result -> Result
forall a. Monoid a => a -> a -> a
`mappend`
                                                     g -> g -> Result
forall a. Equality a => a -> a -> Result
eq g
a7 g
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 { Result -> Word
unResult :: Word }

instance Semigroup Result where
  <> :: Result -> Result -> Result
(<>) Result
a Result
b = Word -> Result
Result (Result -> Word
unResult Result
a Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Result -> Word
unResult Result
b)

instance Monoid Result where
  mempty :: Result
mempty  = Word -> Result
Result Word
0
  mappend :: Result -> Result -> Result
mappend = Result -> Result -> Result
forall a. Semigroup a => a -> a -> a
(<>)
  {-# INLINE mempty  #-}
  {-# INLINE mappend #-}

-- | Checks whether a given equality comparison is successful.
isSuccessful :: Result -> Bool
{-# INLINE isSuccessful #-}
isSuccessful :: Result -> Bool
isSuccessful = (Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
==Word
0) (Word -> Bool) -> (Result -> Word) -> Result -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result -> Word
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 :: MVector s Result -> Int
basicLength          (MV_Result v)            = MVector s Word -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
GM.basicLength MVector s Word
v
  basicUnsafeSlice :: Int -> Int -> MVector s Result -> MVector s Result
basicUnsafeSlice Int
i Int
n (MV_Result v)            = MVector s Word -> MVector s Result
forall s. MVector s Word -> MVector s Result
MV_Result (MVector s Word -> MVector s Result)
-> MVector s Word -> MVector s Result
forall a b. (a -> b) -> a -> b
$ Int -> Int -> MVector s Word -> MVector s Word
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
GM.basicUnsafeSlice Int
i Int
n MVector s Word
v
  basicOverlaps :: MVector s Result -> MVector s Result -> Bool
basicOverlaps (MV_Result v1) (MV_Result v2)   = MVector s Word -> MVector s Word -> Bool
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> Bool
GM.basicOverlaps MVector s Word
v1 MVector s Word
v2

  basicUnsafeRead :: MVector (PrimState m) Result -> Int -> m Result
basicUnsafeRead  (MV_Result v) Int
i              = Word -> Result
Result (Word -> Result) -> m Word -> m Result
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState m) Word -> Int -> m Word
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m a
GM.basicUnsafeRead MVector (PrimState m) Word
v Int
i
  basicUnsafeWrite :: MVector (PrimState m) Result -> Int -> Result -> m ()
basicUnsafeWrite (MV_Result v) Int
i (Result Word
x)   = MVector (PrimState m) Word -> Int -> Word -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> a -> m ()
GM.basicUnsafeWrite MVector (PrimState m) Word
v Int
i Word
x

  basicClear :: MVector (PrimState m) Result -> m ()
basicClear (MV_Result v)                      = MVector (PrimState m) Word -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
GM.basicClear MVector (PrimState m) Word
v
  basicSet :: MVector (PrimState m) Result -> Result -> m ()
basicSet   (MV_Result v)         (Result Word
x)   = MVector (PrimState m) Word -> Word -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> a -> m ()
GM.basicSet MVector (PrimState m) Word
v Word
x

  basicUnsafeNew :: Int -> m (MVector (PrimState m) Result)
basicUnsafeNew Int
n                              = MVector (PrimState m) Word -> MVector (PrimState m) Result
forall s. MVector s Word -> MVector s Result
MV_Result (MVector (PrimState m) Word -> MVector (PrimState m) Result)
-> m (MVector (PrimState m) Word)
-> m (MVector (PrimState m) Result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m (MVector (PrimState m) Word)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> m (v (PrimState m) a)
GM.basicUnsafeNew Int
n
  basicUnsafeReplicate :: Int -> Result -> m (MVector (PrimState m) Result)
basicUnsafeReplicate Int
n     (Result Word
x)         = MVector (PrimState m) Word -> MVector (PrimState m) Result
forall s. MVector s Word -> MVector s Result
MV_Result (MVector (PrimState m) Word -> MVector (PrimState m) Result)
-> m (MVector (PrimState m) Word)
-> m (MVector (PrimState m) Result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Word -> m (MVector (PrimState m) Word)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> a -> m (v (PrimState m) a)
GM.basicUnsafeReplicate Int
n Word
x
  basicUnsafeCopy :: MVector (PrimState m) Result
-> MVector (PrimState m) Result -> m ()
basicUnsafeCopy (MV_Result v1) (MV_Result v2) = MVector (PrimState m) Word -> MVector (PrimState m) Word -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
GM.basicUnsafeCopy MVector (PrimState m) Word
v1 MVector (PrimState m) Word
v2
  basicUnsafeGrow :: MVector (PrimState m) Result
-> Int -> m (MVector (PrimState m) Result)
basicUnsafeGrow (MV_Result v)   Int
n             = MVector (PrimState m) Word -> MVector (PrimState m) Result
forall s. MVector s Word -> MVector s Result
MV_Result (MVector (PrimState m) Word -> MVector (PrimState m) Result)
-> m (MVector (PrimState m) Word)
-> m (MVector (PrimState m) Result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState m) Word -> Int -> m (MVector (PrimState m) Word)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m (v (PrimState m) a)
GM.basicUnsafeGrow MVector (PrimState m) Word
v Int
n
  basicInitialize :: MVector (PrimState m) Result -> m ()
basicInitialize (MV_Result v)               = MVector (PrimState m) Word -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
GM.basicInitialize MVector (PrimState m) Word
v



instance G.Vector Vector Result where
  {-# INLINE basicUnsafeFreeze #-}
  {-# INLINE basicUnsafeThaw #-}
  {-# INLINE basicLength #-}
  {-# INLINE basicUnsafeSlice #-}
  {-# INLINE basicUnsafeIndexM #-}
  {-# INLINE elemseq #-}
  basicUnsafeFreeze :: Mutable Vector (PrimState m) Result -> m (Vector Result)
basicUnsafeFreeze (MV_Result v)             = Vector Word -> Vector Result
V_Result  (Vector Word -> Vector Result)
-> m (Vector Word) -> m (Vector Result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mutable Vector (PrimState m) Word -> m (Vector Word)
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> m (v a)
G.basicUnsafeFreeze MVector (PrimState m) Word
Mutable Vector (PrimState m) Word
v
  basicUnsafeThaw :: Vector Result -> m (Mutable Vector (PrimState m) Result)
basicUnsafeThaw (V_Result v)                = MVector (PrimState m) Word -> MVector (PrimState m) Result
forall s. MVector s Word -> MVector s Result
MV_Result (MVector (PrimState m) Word -> MVector (PrimState m) Result)
-> m (MVector (PrimState m) Word)
-> m (MVector (PrimState m) Result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector Word -> m (Mutable Vector (PrimState m) Word)
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
v a -> m (Mutable v (PrimState m) a)
G.basicUnsafeThaw Vector Word
v
  basicLength :: Vector Result -> Int
basicLength (V_Result v)                    = Vector Word -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
G.basicLength Vector Word
v
  basicUnsafeSlice :: Int -> Int -> Vector Result -> Vector Result
basicUnsafeSlice Int
i Int
n (V_Result v)           = Vector Word -> Vector Result
V_Result (Vector Word -> Vector Result) -> Vector Word -> Vector Result
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Vector Word -> Vector Word
forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
G.basicUnsafeSlice Int
i Int
n Vector Word
v
  basicUnsafeIndexM :: Vector Result -> Int -> m Result
basicUnsafeIndexM (V_Result v) Int
i            = Word -> Result
Result   (Word -> Result) -> m Word -> m Result
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>  Vector Word -> Int -> m Word
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, Monad m) =>
v a -> Int -> m a
G.basicUnsafeIndexM Vector Word
v Int
i

  basicUnsafeCopy :: Mutable Vector (PrimState m) Result -> Vector Result -> m ()
basicUnsafeCopy (MV_Result mv) (V_Result v) = Mutable Vector (PrimState m) Word -> Vector Word -> m ()
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> v a -> m ()
G.basicUnsafeCopy MVector (PrimState m) Word
Mutable Vector (PrimState m) Word
mv Vector Word
v
  elemseq :: Vector Result -> Result -> b -> b
elemseq Vector Result
_ (Result Word
x)                        = Vector Word -> Word -> b -> b
forall (v :: * -> *) a b. Vector v a => v a -> a -> b -> b
G.elemseq (forall a. Vector a
forall a. HasCallStack => a
undefined :: Vector a) Word
x