raaz-0.0.2: The raaz cryptographic library.

Safe HaskellNone

Raaz.Core.Types

Contents

Description

This module exposes some core types used through out the Raaz library. One of the major goals of the raaz cryptographic library use the type safety of Haskell to catch some common bugs at compile time. As of now we address three kinds of errors

Synopsis

Timing safe equality checking.

We need a consistent way to build timing safe equality comparisons. The type class Equality plays the role of Eq for us. The comparison result is of type Result and not Bool so as to avoid timing attacks due to short-circuting of the AND-operation.

The Result type is an opaque type to avoid the user from compromising the equality comparisons by pattern matching on it. To combine the results of two comparisons one can use the monoid instance of Result, i.e. if r1 and r2 are the results of two comparisons then r1 mappend r2 essentially takes the AND of these results but this and is not short-circuited and is timing independent.

Instance for basic word types are provided by the library and users are expected to build the Equality instances of compound types by combine the results of comparisons using the monoid instance of Result. We also give timing safe equality comparisons for Vector types using the eqVector and oftenCorrectEqVector functions. Once an instance for Equality is defined for a cryptographically sensitive data type, we define the Eq for it indirectly using the Equality instance and the operation ===.

class Equality a whereSource

In a cryptographic setting, naive equality checking is dangerous. This class is the timing safe way of doing equality checking. The recommended method of defining equality checking for cryptographically sensitive data is as follows.

  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

Methods

eq :: a -> a -> ResultSource

Instances

Equality Word 
Equality Word8 
Equality Word16 
Equality Word32 
Equality Word64 
Equality SHA1 
Equality SHA224 
Equality SHA256 
Equality SHA384 
Equality SHA512 
Equality a => Equality (BITS a) 
Equality a => Equality (BYTES a) 
Equality w => Equality (BE w) 
Equality w => Equality (LE w) 
(Equality a, Equality b) => Equality (a, b) 
(Unbox a, Equality a) => Equality (Tuple dim a) 
(Equality a, Equality b, Equality c) => Equality (a, b, c) 
(Equality a, Equality b, Equality c, Equality d) => Equality (a, b, c, d) 
(Equality a, Equality b, Equality c, Equality d, Equality e) => Equality (a, b, c, d, e) 
(Equality a, Equality b, Equality c, Equality d, Equality e, Equality f) => Equality (a, b, c, d, e, f) 
(Equality a, Equality b, Equality c, Equality d, Equality e, Equality f, Equality g) => Equality (a, b, c, d, e, f, g) 

(===) :: Equality a => a -> a -> BoolSource

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.

The result of comparion.

data Result Source

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.

Comparing vectors.

oftenCorrectEqVector :: (Vector v a, Equality a, Vector v Result) => v a -> v a -> BoolSource

Timing independent equality checks for vector of values. Do not use this to check the equality of two general vectors in a timing independent manner (use eqVector instead) because:

  1. They do not work for vectors of unequal lengths,
  2. They do not work for empty vectors.

The use case is for defining equality of data types which have fixed size vector quantities in it. Like for example

 import Data.Vector.Unboxed
 newtype Sha1 = Sha1 (Vector (BE Word32))

 instance Eq Sha1 where
    (==) (Sha1 g) (Sha1 h) = oftenCorrectEqVector g h

eqVector :: (Vector v a, Equality a, Vector v Result) => v a -> v a -> BoolSource

Timing independent equality checks for vectors. If you know that the vectors are not empty and of equal length, you may use the slightly faster oftenCorrectEqVector

Endianess aware types.

Cryptographic primitives often consider their input as an array of words of a particular endianness. Endianness is only relevant when the data is being read or written to. It makes sense therefore to keep track of the endianness in the type and perform necessary transformations depending on the endianness of the machine. Such types are captured by the type class EndianStore. They support the load and store combinators that automatically compensates for the endianness of the machine.

This libraray exposes endian aware variants of Word32 and Word64 here and expect other cryptographic types to use such endian explicit types in their definition.

class Storable w => EndianStore w whereSource

This class is the starting point of an endian agnostic interface to basic cryptographic data types. Endianness only matters when we first load the data from the buffer or when we finally write the data out. Any multi-byte type that are meant to be serialised should define and instance of this class. The load and store should takes care of the appropriate endian conversion.

Methods

storeSource

Arguments

:: Pointer

the location.

-> w

value to store

-> IO () 

Store the given value at the locating pointed by the pointer

load :: Pointer -> IO wSource

Load the value from the location pointed by the pointer.

Endian explicit word types.

data LE w Source

Little endian version of the word type w

Instances

Typeable1 LE 
Unbox w => Vector Vector (LE w) 
Unbox w => MVector MVector (LE w) 
Bounded w => Bounded (LE w) 
Enum w => Enum (LE w) 
Eq w => Eq (LE w) 
Integral w => Integral (LE w) 
Num w => Num (LE w) 
Ord w => Ord (LE w) 
Read w => Read (LE w) 
Real w => Real (LE w) 
Show w => Show (LE w) 
Storable w => Storable (LE w) 
Bits w => Bits (LE w) 
NFData w => NFData (LE w) 
Unbox w => Unbox (LE w) 
Equality w => Equality (LE w) 
EndianStore (LE Word32) 
EndianStore (LE Word64) 
Encodable (LE Word32) 
Encodable (LE Word64) 
Random w => Random (LE w) 

data BE w Source

Big endian version of the word type w

Instances

Typeable1 BE 
Unbox w => Vector Vector (BE w) 
Unbox w => MVector MVector (BE w) 
Bounded w => Bounded (BE w) 
Enum w => Enum (BE w) 
Eq w => Eq (BE w) 
Integral w => Integral (BE w) 
Num w => Num (BE w) 
Ord w => Ord (BE w) 
Read w => Read (BE w) 
Real w => Real (BE w) 
Show w => Show (BE w) 
Storable w => Storable (BE w) 
Bits w => Bits (BE w) 
NFData w => NFData (BE w) 
Unbox w => Unbox (BE w) 
Equality w => Equality (BE w) 
EndianStore (BE Word32) 
EndianStore (BE Word64) 
Encodable (BE Word32) 
Encodable (BE Word64) 
Random w => Random (BE w) 

littleEndian :: w -> LE wSource

Convert to the little endian variant.

bigEndian :: w -> BE wSource

Convert to the big endian variants.

Helper functions for endian aware storing and loading.

storeAtSource

Arguments

:: (EndianStore w, LengthUnit offset) 
=> Pointer

the pointer

-> offset

the absolute offset in type safe length units.

-> w

value to store

-> IO () 

Store the given value at an offset from the crypto pointer. The offset is given in type safe units.

storeAtIndexSource

Arguments

:: EndianStore w 
=> Pointer

the pointer to the first element of the array

-> Int

the index of the array

-> w

the value to store

-> IO () 

Store the given value as the n-th element of the array pointed by the crypto pointer.

loadFromSource

Arguments

:: (EndianStore w, LengthUnit offset) 
=> Pointer

the pointer

-> offset

the offset

-> IO w 

Load from a given offset. The offset is given in type safe units.

loadFromIndexSource

Arguments

:: EndianStore w 
=> Pointer

the pointer to the first element of the array

-> Int

the index of the array

-> IO w 

Load the n-th value of an array pointed by the crypto pointer.

The pointer type and Length offsets.

We have the generic pointer type Pointer and distinguish between different length units at the type level. This helps in to avoid a lot of length conversion errors.

The pointer type.

type Pointer = Ptr AlignSource

The pointer type used by all cryptographic library.

Type safe length units.

class (Num u, Enum u) => LengthUnit u whereSource

In cryptographic settings, we need to measure pointer offsets and buffer sizes in different units. To avoid errors due to unit conversions, we distinguish between different length units at the type level. This type class capturing such types, i.e. types that stand of length units.

Methods

inBytes :: u -> BYTES IntSource

Express the length units in bytes.

newtype BYTES a Source

Type safe lengths/offsets in units of bytes.

Constructors

BYTES a 

Instances

IsString Write 
Encodable Write 
Enum a => Enum (BYTES a) 
Eq a => Eq (BYTES a) 
Integral a => Integral (BYTES a) 
Num a => Num (BYTES a) 
Ord a => Ord (BYTES a) 
Real a => Real (BYTES a) 
Show a => Show (BYTES a) 
Storable a => Storable (BYTES a) 
Equality a => Equality (BYTES a) 
LengthUnit (BYTES Int) 
Encodable a => Encodable (BYTES a) 

newtype BITS a Source

Type safe lengths/offsets in units of bits.

Constructors

BITS a 

Instances

Enum a => Enum (BITS a) 
Eq a => Eq (BITS a) 
Integral a => Integral (BITS a) 
Num a => Num (BITS a) 
Ord a => Ord (BITS a) 
Real a => Real (BITS a) 
Show a => Show (BITS a) 
Storable a => Storable (BITS a) 
Equality a => Equality (BITS a) 
Encodable a => Encodable (BITS a) 

data Align Source

A type whose only purpose in this universe is to provide alignment safe pointers.

Instances

IsString Write 
Storable Align 
Encodable Write 
LengthUnit u => LAction (Sum u) Pointer

The most interesting monoidal action for us.

inBits :: LengthUnit u => u -> BITS Word64Source

Express the length units in bits.

Some length arithmetic

bitsQuotRem :: LengthUnit u => BITS Word64 -> (u, BITS Word64)Source

Function similar to bytesQuotRem but works with bits instead.

bytesQuotRem :: LengthUnit u => BYTES Int -> (u, BYTES Int)Source

A length unit u is usually a multiple of bytes. The function bytesQuotRem is like quotRem: the value byteQuotRem bytes is a tuple (x,r), where x is bytes expressed in the unit u with r being the reminder.

bitsQuot :: LengthUnit u => BITS Word64 -> uSource

Function similar to bitsQuotRem but returns only the quotient.

bytesQuot :: LengthUnit u => BYTES Int -> uSource

Function similar to bytesQuotRem but returns only the quotient.

atLeast :: (LengthUnit src, LengthUnit dest) => src -> destSource

Express length unit src in terms of length unit dest rounding upwards.

atMost :: (LengthUnit src, LengthUnit dest) => src -> destSource

Express length unit src in terms of length unit dest rounding downwards.

Helper function that uses generalised length units.

allocaBufferSource

Arguments

:: LengthUnit l 
=> l

buffer length

-> (Pointer -> IO b)

the action to run

-> IO b 

The expression allocaBuffer l action allocates a local buffer of length l and passes it on to the IO action action. No explicit freeing of the memory is required as the memory is allocated locally and freed once the action finishes. It is better to use this function than allocaBytes as it does type safe scaling. This function also ensure that the allocated buffer is word aligned.

allocaSecure :: LengthUnit l => l -> (Pointer -> IO a) -> IO aSource

This function allocates a chunk of secure memory of a given size and runs the action. The memory (1) exists for the duration of the action (2) will not be swapped during that time and (3) will be wiped clean and deallocated when the action terminates either directly or indirectly via errors. While this is mostly secure, there can be strange situations in multi-threaded application where the memory is not wiped out. For example if you run a crypto-sensitive action inside a child thread and the main thread gets exists, then the child thread is killed (due to the demonic nature of haskell threads) immediately and might not give it chance to wipe the memory clean. This is a problem inherent to how the bracket combinator works inside a child thread.

TODO: File this insecurity in the wiki.

mallocBufferSource

Arguments

:: LengthUnit l 
=> l

buffer length

-> IO Pointer 

Creates a memory of given size. It is better to use over mallocBytes as it uses typesafe length.

hFillBuf :: LengthUnit bufSize => Handle -> Pointer -> bufSize -> IO (BYTES Int)Source

A version of hGetBuf which works for any type safe length units.

byteSize :: Storable a => a -> BYTES IntSource

Similar to sizeOf but returns the length in type safe units.

memsetSource

Arguments

:: LengthUnit l 
=> Pointer

Target

-> Word8

Value byte to set

-> l

Number of bytes to set

-> IO () 

Sets the given number of Bytes to the specified value.

memmoveSource

Arguments

:: LengthUnit l 
=> Pointer

Dest

-> Pointer

Src

-> l

Number of Bytes to copy

-> IO () 

Move between pointers.

memcpySource

Arguments

:: LengthUnit l 
=> Pointer

Dest

-> Pointer

Src

-> l

Number of Bytes to copy

-> IO () 

Copy between pointers.

Tuples with length encoded in their types.

Length encoded tuples

data Tuple dim a Source

Tuples that encode their length in their types. For tuples, we call the length its dimension

Instances

(Unbox a, Equality a) => Eq (Tuple dim a)

Equality checking is timing safe.

(Show a, Unbox a) => Show (Tuple dim a) 
(Unbox a, Storable a, SingI Nat dim) => Storable (Tuple dim a) 
(Unbox a, Equality a) => Equality (Tuple dim a) 
(Unbox a, EndianStore a, SingI Nat dim) => EndianStore (Tuple dim a) 

dimension :: (Unbox a, SingI dim) => Tuple dim a -> IntSource

Function that returns the dimension of the tuple. The dimension is calculated without inspecting the tuple and hence the term dimension (undefined :: Tuple 5 Int) will evaluate to 5.

initial :: (Unbox a, SingI dim0, SingI dim1) => Tuple dim1 a -> Tuple dim0 aSource

Computes the initial fragment of a tuple. No length needs to be given as it is infered from the types.

Unsafe operations

unsafeFromList :: (Unbox a, SingI dim) => [a] -> Tuple dim aSource

Construct a tuple out of the list. This function is unsafe and will result in run time error if the list is not of the correct dimension.

class Describable d whereSource

This class captures all types that have some sort of description attached to it.

Methods

name :: d -> StringSource

Short name that describes the object.

description :: d -> StringSource

Longer description

Instances

Describable (SomeHashI h) 
Describable (SomeCipherI cipher) 
Describable (HashI h m) 
Describable (CipherI cipher encMem decMem)