{-|

Generic cryptographic block primtives and their implementations. This
module exposes low-level generic code used in the raaz system. Most
likely, one would not need to stoop so low and it might be better to
use a more high level interface.

-}

{-# LANGUAGE TypeFamilies                #-}
{-# LANGUAGE MultiParamTypeClasses       #-}
{-# LANGUAGE GeneralizedNewtypeDeriving  #-}
{-# LANGUAGE FlexibleContexts            #-}
{-# LANGUAGE CPP                         #-}
{-# LANGUAGE ConstraintKinds             #-}
{-# LANGUAGE ExistentialQuantification   #-}

module Raaz.Core.Primitives
       ( -- * Primtives and their implementations.
         Primitive(..), BlockAlgorithm(..), Key, Recommendation(..)
       , BLOCKS, blocksOf
       , allocBufferFor
       ) where

import Data.Monoid
import Prelude

import Raaz.Core.Types

-- | Implementation of block primitives work on buffers. Often for optimal
-- performance, and in some case for safety, we need restrictions on
-- the size and alignment of the buffer pointer. This type class
-- captures such restrictions.
class Describable a => BlockAlgorithm a where

  -- | The alignment expected for the buffer pointer.
  bufferStartAlignment :: a -> Alignment


----------------------- A primitive ------------------------------------


-- | The type class that captures an abstract block cryptographic
-- primitive. Bulk cryptographic primitives like hashes, ciphers etc
-- often acts on blocks of data. The size of the block is captured by
-- the member `blockSize`.
--
-- As a library, raaz believes in providing multiple implementations
-- for a given primitive. The associated type `Implementation`
-- captures implementations of the primitive.
--
-- For use in production code, the library recommends a particular
-- implementation using the `Recommendation` class. By default this is
-- the implementation used when no explicit implementation is
-- specified.
class BlockAlgorithm (Implementation p) => Primitive p where

  -- | The block size.
  blockSize :: p -> BYTES Int

  -- | Associated type that captures an implementation of this
  -- primitive.
  type Implementation p :: *

-- | Primitives that have a recommended implementations.
class Primitive p => Recommendation p where
  -- | The recommended implementation for the primitive.
  recommended :: p -> Implementation p

-- | Allocate a buffer a particular implementation of a primitive prim.
-- algorithm @algo@. It ensures that the memory passed is aligned
-- according to the demands of the implementation.
allocBufferFor :: Primitive prim
               => Implementation prim
               -> BLOCKS prim
               -> (Pointer -> IO b)
               -> IO b
allocBufferFor :: Implementation prim -> BLOCKS prim -> (Pointer -> IO b) -> IO b
allocBufferFor Implementation prim
imp  = Alignment -> BLOCKS prim -> (Pointer -> IO b) -> IO b
forall l b.
LengthUnit l =>
Alignment -> l -> (Pointer -> IO b) -> IO b
allocaAligned (Alignment -> BLOCKS prim -> (Pointer -> IO b) -> IO b)
-> Alignment -> BLOCKS prim -> (Pointer -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ Implementation prim -> Alignment
forall a. BlockAlgorithm a => a -> Alignment
bufferStartAlignment Implementation prim
imp

-- | Some primitives like ciphers have an encryption/decryption key. This
-- type family captures the key associated with a primitive if it has
-- any.
type family  Key prim :: *

------------------- Type safe lengths in units of block ----------------

-- | Type safe message length in units of blocks of the primitive.
-- When dealing with buffer lengths for a primitive, it is often
-- better to use the type safe units `BLOCKS`. Functions in the raaz
-- package that take lengths usually allow any type safe length as
-- long as they can be converted to bytes. This can avoid a lot of
-- tedious and error prone length calculations.
newtype BLOCKS p = BLOCKS {BLOCKS p -> Int
unBLOCKS :: Int}
                 deriving (Int -> BLOCKS p -> ShowS
[BLOCKS p] -> ShowS
BLOCKS p -> String
(Int -> BLOCKS p -> ShowS)
-> (BLOCKS p -> String) -> ([BLOCKS p] -> ShowS) -> Show (BLOCKS p)
forall p. Int -> BLOCKS p -> ShowS
forall p. [BLOCKS p] -> ShowS
forall p. BLOCKS p -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BLOCKS p] -> ShowS
$cshowList :: forall p. [BLOCKS p] -> ShowS
show :: BLOCKS p -> String
$cshow :: forall p. BLOCKS p -> String
showsPrec :: Int -> BLOCKS p -> ShowS
$cshowsPrec :: forall p. Int -> BLOCKS p -> ShowS
Show, BLOCKS p -> BLOCKS p -> Bool
(BLOCKS p -> BLOCKS p -> Bool)
-> (BLOCKS p -> BLOCKS p -> Bool) -> Eq (BLOCKS p)
forall p. BLOCKS p -> BLOCKS p -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BLOCKS p -> BLOCKS p -> Bool
$c/= :: forall p. BLOCKS p -> BLOCKS p -> Bool
== :: BLOCKS p -> BLOCKS p -> Bool
$c== :: forall p. BLOCKS p -> BLOCKS p -> Bool
Eq, Eq (BLOCKS p)
Eq (BLOCKS p)
-> (BLOCKS p -> BLOCKS p -> Ordering)
-> (BLOCKS p -> BLOCKS p -> Bool)
-> (BLOCKS p -> BLOCKS p -> Bool)
-> (BLOCKS p -> BLOCKS p -> Bool)
-> (BLOCKS p -> BLOCKS p -> Bool)
-> (BLOCKS p -> BLOCKS p -> BLOCKS p)
-> (BLOCKS p -> BLOCKS p -> BLOCKS p)
-> Ord (BLOCKS p)
BLOCKS p -> BLOCKS p -> Bool
BLOCKS p -> BLOCKS p -> Ordering
BLOCKS p -> BLOCKS p -> BLOCKS p
forall p. Eq (BLOCKS p)
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall p. BLOCKS p -> BLOCKS p -> Bool
forall p. BLOCKS p -> BLOCKS p -> Ordering
forall p. BLOCKS p -> BLOCKS p -> BLOCKS p
min :: BLOCKS p -> BLOCKS p -> BLOCKS p
$cmin :: forall p. BLOCKS p -> BLOCKS p -> BLOCKS p
max :: BLOCKS p -> BLOCKS p -> BLOCKS p
$cmax :: forall p. BLOCKS p -> BLOCKS p -> BLOCKS p
>= :: BLOCKS p -> BLOCKS p -> Bool
$c>= :: forall p. BLOCKS p -> BLOCKS p -> Bool
> :: BLOCKS p -> BLOCKS p -> Bool
$c> :: forall p. BLOCKS p -> BLOCKS p -> Bool
<= :: BLOCKS p -> BLOCKS p -> Bool
$c<= :: forall p. BLOCKS p -> BLOCKS p -> Bool
< :: BLOCKS p -> BLOCKS p -> Bool
$c< :: forall p. BLOCKS p -> BLOCKS p -> Bool
compare :: BLOCKS p -> BLOCKS p -> Ordering
$ccompare :: forall p. BLOCKS p -> BLOCKS p -> Ordering
$cp1Ord :: forall p. Eq (BLOCKS p)
Ord, Int -> BLOCKS p
BLOCKS p -> Int
BLOCKS p -> [BLOCKS p]
BLOCKS p -> BLOCKS p
BLOCKS p -> BLOCKS p -> [BLOCKS p]
BLOCKS p -> BLOCKS p -> BLOCKS p -> [BLOCKS p]
(BLOCKS p -> BLOCKS p)
-> (BLOCKS p -> BLOCKS p)
-> (Int -> BLOCKS p)
-> (BLOCKS p -> Int)
-> (BLOCKS p -> [BLOCKS p])
-> (BLOCKS p -> BLOCKS p -> [BLOCKS p])
-> (BLOCKS p -> BLOCKS p -> [BLOCKS p])
-> (BLOCKS p -> BLOCKS p -> BLOCKS p -> [BLOCKS p])
-> Enum (BLOCKS p)
forall p. Int -> BLOCKS p
forall p. BLOCKS p -> Int
forall p. BLOCKS p -> [BLOCKS p]
forall p. BLOCKS p -> BLOCKS p
forall p. BLOCKS p -> BLOCKS p -> [BLOCKS p]
forall p. BLOCKS p -> BLOCKS p -> BLOCKS p -> [BLOCKS p]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: BLOCKS p -> BLOCKS p -> BLOCKS p -> [BLOCKS p]
$cenumFromThenTo :: forall p. BLOCKS p -> BLOCKS p -> BLOCKS p -> [BLOCKS p]
enumFromTo :: BLOCKS p -> BLOCKS p -> [BLOCKS p]
$cenumFromTo :: forall p. BLOCKS p -> BLOCKS p -> [BLOCKS p]
enumFromThen :: BLOCKS p -> BLOCKS p -> [BLOCKS p]
$cenumFromThen :: forall p. BLOCKS p -> BLOCKS p -> [BLOCKS p]
enumFrom :: BLOCKS p -> [BLOCKS p]
$cenumFrom :: forall p. BLOCKS p -> [BLOCKS p]
fromEnum :: BLOCKS p -> Int
$cfromEnum :: forall p. BLOCKS p -> Int
toEnum :: Int -> BLOCKS p
$ctoEnum :: forall p. Int -> BLOCKS p
pred :: BLOCKS p -> BLOCKS p
$cpred :: forall p. BLOCKS p -> BLOCKS p
succ :: BLOCKS p -> BLOCKS p
$csucc :: forall p. BLOCKS p -> BLOCKS p
Enum)

#if MIN_VERSION_base(4,11,0)
instance Semigroup (BLOCKS p) where
  <> :: BLOCKS p -> BLOCKS p -> BLOCKS p
(<>) BLOCKS p
x BLOCKS p
y = Int -> BLOCKS p
forall p. Int -> BLOCKS p
BLOCKS (Int -> BLOCKS p) -> Int -> BLOCKS p
forall a b. (a -> b) -> a -> b
$ BLOCKS p -> Int
forall p. BLOCKS p -> Int
unBLOCKS BLOCKS p
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ BLOCKS p -> Int
forall p. BLOCKS p -> Int
unBLOCKS BLOCKS p
y
#endif

instance Monoid (BLOCKS p) where
  mempty :: BLOCKS p
mempty      = Int -> BLOCKS p
forall p. Int -> BLOCKS p
BLOCKS Int
0
  mappend :: BLOCKS p -> BLOCKS p -> BLOCKS p
mappend BLOCKS p
x BLOCKS p
y = Int -> BLOCKS p
forall p. Int -> BLOCKS p
BLOCKS (Int -> BLOCKS p) -> Int -> BLOCKS p
forall a b. (a -> b) -> a -> b
$ BLOCKS p -> Int
forall p. BLOCKS p -> Int
unBLOCKS BLOCKS p
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ BLOCKS p -> Int
forall p. BLOCKS p -> Int
unBLOCKS BLOCKS p
y

instance Primitive p => LengthUnit (BLOCKS p) where
  inBytes :: BLOCKS p -> BYTES Int
inBytes p :: BLOCKS p
p@(BLOCKS Int
x) = BYTES Int
scale BYTES Int -> BYTES Int -> BYTES Int
forall a. Num a => a -> a -> a
* p -> BYTES Int
forall p. Primitive p => p -> BYTES Int
blockSize (BLOCKS p -> p
forall p. BLOCKS p -> p
getPrimitiveType BLOCKS p
p)
    where scale :: BYTES Int
scale = Int -> BYTES Int
forall a. a -> BYTES a
BYTES Int
x
          getPrimitiveType :: BLOCKS p -> p
          getPrimitiveType :: BLOCKS p -> p
getPrimitiveType BLOCKS p
_ = p
forall a. HasCallStack => a
undefined

-- | The expression @n `blocksOf` p@ specifies the message lengths in
-- units of the block length of the primitive @p@. This expression is
-- sometimes required to make the type checker happy.
blocksOf :: Int -> p -> BLOCKS p
blocksOf :: Int -> p -> BLOCKS p
blocksOf Int
n p
_ = Int -> BLOCKS p
forall p. Int -> BLOCKS p
BLOCKS Int
n