    {-|

    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 imp :: 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
    (<>) x :: BLOCKS p
    x y :: 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 0
      mappend :: BLOCKS p -> BLOCKS p -> BLOCKS p
    mappend x :: BLOCKS p
    x y :: 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 x :: 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 _ = 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 n :: Int
    n _ = Int -> BLOCKS p
    forall p. Int -> BLOCKS p
    BLOCKS Int
    n