Implemented the wrapper that picks AESNI or portable software impleme…

…ntation at runtime by checking CPU id.

CHANGELOG

@@ -202,3 +202,13 @@ Ok... I tried rebuilding the library by hand to get a .so
     gcc -shared -dynamic  -o lib/x64/libintel_aes64.so obj/x64/*.o
 
 
+
+
+[2011.02.02] {Annoying link problems}
+
+In commit 4bf79dfe55.. I reverted some recent refactorings to fix the weird link problem.
+
+     Linking dist/build/benchmark-intel-aes-rng/benchmark-intel-aes-rng ...
+     /home/newton/Dropbox/working_copies/intel-aes/dist/build/libHSintel-aes-0.1.1.a(GladmanAES.o): In function `s3iP_info':
+     (.text+0x34c3): undefined reference to `__stginit_intelzmaeszm0zi1zi1_CodecziCryptoziConvertRNG_'
+     collect2: ld returned 1 exit status

Codec/Crypto/ConvertRNG.hs

@@ -138,7 +138,7 @@ instance BlockCipher x => CryptoRandomGen (BCtoCRG x) where
 					 Just x  -> Right (BCtoCRG x 0)
   genSeedLength = Tagged 128
 
-  -- If this is called for less than blockSize data 
+  -- If this is called for less than blockSize data there's some waste but it should work.
   genBytes req (BCtoCRG (bcgen :: k) counter) = 
       -- What's the most efficient way to do this?
       unsafePerformIO $ do  -- Potentially heavyweight... not allowing dupable.
@@ -162,8 +162,8 @@ instance BlockCipher x => CryptoRandomGen (BCtoCRG x) where
 	if req==total then return$ Right (cipher, newgen)
 	              else return$ Right (B.take req cipher, newgen)
 
---  reseed bs gen = newGen bs
-reseed bs (BCtoCRG k _) = newGen (xorExtendBS (encode k) bs)
+  reseed bs (BCtoCRG k _) = newGen (xorExtendBS (encode k) bs)
+
 xorExtendBS a b = B.append (B.pack$ B.zipWith Data.Bits.xor a b) rem
       where
       al = B.length a

Codec/Crypto/GladmanAES.hsc

@@ -2,7 +2,9 @@
 -- Svein Ove Aas (University of Tromsø), though it is heavily modified
 -- and any bugs should be blamed on me, Thomas M. DuBuisson.
 {-# LANGUAGE FlexibleInstances, EmptyDataDecls, FlexibleContexts, 
-    ForeignFunctionInterface, ViewPatterns #-}
+    ForeignFunctionInterface, ViewPatterns,
+    ScopedTypeVariables
+    #-}
 {-# CFILES cbits/gladman/aescrypt.c cbits/gladman/aeskey.c cbits/gladman/aestab.c cbits/gladman/aes_modes.c #-}
 module Codec.Crypto.GladmanAES
 	( AES
@@ -22,6 +24,14 @@ import Foreign
 import Control.Applicative
 import Control.Monad
 
+-- import Crypto.Random (CryptoRandomGen(newGen))
+-- The following line will cause a link problem currently [2011.02.02]:
+     -- Linking dist/build/benchmark-intel-aes-rng/benchmark-intel-aes-rng ...
+     -- /home/newton/Dropbox/working_copies/intel-aes/dist/build/libHSintel-aes-0.1.1.a(GladmanAES.o): In function `s3ho_info':
+     -- (.text+0x34c3): undefined reference to `__stginit_intelzmaeszm0zi1zi1_CodecziCryptoziConvertRNG_'
+     -- collect2: ld returned 1 exit status
+-- import qualified Codec.Crypto.ConvertRNG as CR
+
 #include "gladman/aesopt.h"
 #include "gladman/aes.h"
 #include "gladman/aestab.h"
@@ -37,6 +47,26 @@ data AES n = AES
 		, decCtx :: DecryptCtxP
 		, aesKeyRaw :: B.ByteString }
 
+
+-- Because of the above link problem I can't move these:
+{-
+mkAESGen :: Int -> CR.CRGtoRG (CR.BCtoCRG (AES N128))
+mkAESGen int = CR.convertCRG gen
+ where
+  Right (gen :: CR.BCtoCRG (AES N128)) = newGen (B.append halfseed halfseed )
+  halfseed = encode word64
+  word64 = fromIntegral int :: Word64
+
+mkAESGen0 :: Int -> CR.CRGtoRG0 (CR.BCtoCRG (AES N128))
+mkAESGen0 int = CR.CRGtoRG0 gen
+ where
+  Right (gen :: CR.BCtoCRG (AES N128)) = newGen (B.append halfseed halfseed )
+  halfseed = encode word64
+  word64 = fromIntegral int :: Word64
+ -}
+
+--------------------------------------------------------------------------------
+
 -- | Create an encryption/decryption context for incremental
 -- encryption/decryption
 --

Codec/Crypto/IntelAES.hs

@@ -10,53 +10,101 @@
 
   -}
 {-# OPTIONS_GHC -fwarn-unused-imports #-}
-{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE ForeignFunctionInterface, CPP, ScopedTypeVariables  #-}
 
 module Codec.Crypto.IntelAES
     (
       mkAESGen
      -- Plus, instances exported of course.
+    , testIntelAES
     )
 where 
 
 import qualified Codec.Crypto.IntelAES.AESNI      as NI
--- import qualified Codec.Crypto.IntelAES.GladmanAES as GL
+import qualified Codec.Crypto.GladmanAES as GA
+import GHC.IO (unsafeDupablePerformIO)
+import Data.Tagged
+import Data.Word
+import Data.Serialize
+import qualified Data.ByteString as B
+import Crypto.Random (CryptoRandomGen(..), GenError(..), splitGen, genBytes)
+import Crypto.Types
+import Codec.Crypto.ConvertRNG 
+import Debug.Trace
+
+newtype CompoundCRG = 
+  CompoundCRG 
+   (Either (BCtoCRG (NI.IntelAES NI.N128))
+	   (BCtoCRG (GA.AES GA.N128)))
+
+type CompoundAESRNG = CRGtoRG CompoundCRG
+
+mkAESGen :: Int -> CompoundAESRNG
+mkAESGen int = convertCRG gen
+ where
+  Right (gen :: CompoundCRG) = newGen (B.append halfseed halfseed )
+  halfseed = encode word64
+  word64 = fromIntegral int :: Word64
+
+
+-- foreign import ccall unsafe "iaesni.h" check_for_aes_instructions :: IO Bool
+foreign import ccall unsafe "iaesni.h" check_for_aes_instructions :: Bool
+
+
+{-# INLINE mapRight #-}
+mapRight fn x@(Left _) = x
+mapRight fn (Right x)  = Right$ fn x
+
+{-# INLINE mapSnd #-}
+mapSnd fn (x,y) = (x,fn y)
+
+
+instance CryptoRandomGen CompoundCRG where 
+
+--  newGen :: B.ByteString -> Either GenError CompoundCRG
+  newGen = 
+--     if unsafeDupablePerformIO check_for_aes_instructions
+     trace ("Checked for AES instructions: "++ show check_for_aes_instructions)$
+     if check_for_aes_instructions
+     -- Ick, boilerplate:
+     then \bytes -> case newGen bytes of Left err  -> Left err
+					 Right gen -> Right$ CompoundCRG$ Left gen
+     else \bytes -> case newGen bytes of Left err  -> Left err
+					 Right gen -> Right$ CompoundCRG$ Right gen
+
+  genSeedLength = Tagged 128
+
+
+  -- ByteLength -> CompoundCRG -> Either GenError (B.ByteString, CompoundCRG)
+  genBytes req (CompoundCRG (Left gen)) = 
+#if 0
+    mapRight (mapSnd (CompoundCRG . Left) ) $ genBytes req gen
+#else
+    case genBytes req gen of 
+      Left  err  -> Left err
+      Right (bytes,gen') -> Right (bytes, CompoundCRG (Left gen'))
+#endif
+
+-- <boilerplate> OUCH
+  genBytes req (CompoundCRG (Right gen)) = 
+    case genBytes req gen of 
+      Left  err  -> Left err
+      Right (bytes,gen') -> Right (bytes, CompoundCRG (Right gen'))
+  reseed bs (CompoundCRG (Left gen)) = 
+    case reseed bs gen of 
+      Left  err  -> Left err
+      Right gen' -> Right (CompoundCRG (Left gen'))
+  reseed bs (CompoundCRG (Right gen)) = 
+    case reseed bs gen of 
+      Left  err  -> Left err
+      Right gen' -> Right (CompoundCRG (Right gen'))
+-- </boilerplate>
+
+
+
+testIntelAES = do 
+  putStrLn$ "Running crude tests."
+--  b <- check_for_aes_instructions
+  let b = check_for_aes_instructions
+  putStrLn$ "Machine supports AESNI: "++ show b
 
--- import System.Random 
--- import System.IO.Unsafe (unsafePerformIO)
--- import GHC.IO (unsafeDupablePerformIO)
-
--- import Data.List
--- import Data.Word
--- import Data.Tagged
--- import Data.Serialize
-
--- import qualified Data.Bits
--- import qualified Data.ByteString as B
--- import qualified Data.ByteString.Char8 as BC
--- import qualified Data.ByteString.Internal as BI
-
--- import Crypto.Random.DRBG ()
--- import Crypto.Modes
-
--- import Crypto.Random (CryptoRandomGen(..), GenError(..), splitGen, genBytes)
--- import Crypto.Classes (BlockCipher(..), blockSizeBytes)
--- import Crypto.Types
-
--- import Control.Monad
--- import Foreign.Ptr
--- import qualified Foreign.ForeignPtr as FP
--- import Foreign.Storable
-
-
--- type CompoundAESRNG = (LiftCRG (BCtoCRG (IntelAES N128)))
---     Either (LiftCRG (BCtoCRG (IntelAES N128)))
---	    ()
-
---mkAESGen :: Int -> CompoundAESRNG
---mkAESGen = undecidable
-
-mkAESGen = NI.mkAESGen
-
--- int check_for_aes_instructions()
-foreign import ccall unsafe "iaesni.h" check_for_aes_instructions :: IO Bool

Codec/Crypto/IntelAES/AESNI.hs

@@ -16,7 +16,7 @@
 
 module Codec.Crypto.IntelAES.AESNI
     (
-      testIntelAES
+      testAESNI
     , mkAESGen, SimpleAESRNG
 
     -- Inefficient version for testing:
@@ -199,7 +199,7 @@ unpack_ptr ptr len = loop len []
 		  loop (i-1) (x:acc)
 
 -- This is not a meaningful test yet... one option would be to reproduce the tests in aessample.c
-testIntelAES = do 
+testAESNI = do 
 
   let bytes = 256
   plaintext  <- calloc bytes 1