diff --git a/Network/CommSec.hs b/Network/CommSec.hs --- a/Network/CommSec.hs +++ b/Network/CommSec.hs @@ -20,7 +20,7 @@ import Crypto.Classes (buildKey) import Crypto.Cipher.AES128.Internal (encryptCTR) -import Crypto.Cipher.AES128 (AESKey) +import Crypto.Cipher.AES128 (AESKey128, ctr, zeroIV) import Network.CommSec.Package import Network.CommSec.Types import Network.Socket ( Socket, SocketType(..), SockAddr, AddrInfo(..) @@ -161,19 +161,10 @@ -- Use counter mode to expand input entropy that is at least 16 bytes long expandSecret :: B.ByteString -> Int -> B.ByteString expandSecret entropy sz = - let k = buildKey entropy + let k = buildKey entropy :: Maybe AESKey128 in case k of Nothing -> error "Build key failed" - Just key -> - let iv = B.replicate 16 0 - in enc key iv input - where - input = B.replicate sz 0 - enc :: AESKey -> B.ByteString -> B.ByteString -> B.ByteString - enc k i pt = B.unsafeCreate sz $ \ctPtr -> - B.useAsCString pt $ \ptPtr -> - B.useAsCString i $ \iv -> - encryptCTR k (castPtr iv) nullPtr (castPtr ctPtr) (castPtr ptPtr) sz + Just key -> fst $ ctr key zeroIV (B.replicate sz 0) -- |Expands the provided 128 (or more) bit secret into two -- keys to create a connection. diff --git a/Network/CommSec/Package.hs b/Network/CommSec/Package.hs --- a/Network/CommSec/Package.hs +++ b/Network/CommSec/Package.hs @@ -37,7 +37,7 @@ import Prelude hiding (seq) import qualified Crypto.Cipher.AES128.Internal as AES -import Crypto.Cipher.AES128.Internal (GCM) +import Crypto.Cipher.AES128.Internal (GCMpc, AESKey128) import Crypto.Cipher.AES128 () import qualified Data.ByteString.Internal as B import qualified Data.ByteString as B @@ -68,28 +68,34 @@ -- -- [CNT (used for both the IV and seq) | CT of Payload | ICV] +-- | A tuple of key and precomputed data for use by GCM +data GCMdata = GCMdata { gcmkey :: AESKey128 + , gcmpc :: GCMpc + } + + -- | A context useful for sending data. data OutContext = Out { aesCtr :: {-# UNPACK #-} !Word64 , saltOut :: {-# UNPACK #-} !Word32 - , outKey :: GCM + , outKey :: GCMdata } -- | A context useful for receiving data. data InContext - = In { bitWindow :: {-# UNPACK #-} !BitWindow + = In { bitWindow :: {-# UNPACK #-} !BitWindow , saltIn :: {-# UNPACK #-} !Word32 - , inKey :: GCM + , inKey :: GCMdata } | InStrict { seqVal :: {-# UNPACK #-} !Word64 , saltIn :: {-# UNPACK #-} !Word32 - , inKey :: GCM + , inKey :: GCMdata } | InSequential { seqVal :: {-# UNPACK #-} !Word64 , saltIn :: {-# UNPACK #-} !Word32 - , inKey :: GCM + , inKey :: GCMdata } @@ -119,13 +125,19 @@ StrictOrdering -> InStrict {..} Sequential -> InSequential {..} -buildGCM :: B.ByteString -> GCM -buildGCM key = unsafePerformIO $ do - B.unsafeUseAsCString key $ \bPtr -> AES.generateGCM (castPtr bPtr) +buildGCM :: B.ByteString -> GCMdata +buildGCM key + | B.length key >= 16 = unsafePerformIO $ + B.unsafeUseAsCString key $ \bPtr -> do + kStruct <- AES.generateKey128 (castPtr bPtr) + case kStruct of + Just t -> GCMdata t `fmap` AES.precomputeGCMdata t + Nothing -> throw BuildKeyFailure + | otherwise = throw BuildKeyFailure -- Encrypts multiple-of-block-sized input, returing a bytestring of the -- [ctr, ct, tag]. -encryptGCM :: GCM +encryptGCM :: GCMdata -> Word64 -- ^ AES GCM Counter (IV) -> Word32 -- ^ Salt -> ByteString -- ^ Plaintext @@ -138,14 +150,14 @@ -- Encrypts multiple-of-block-sized input, filling a pointer with the -- result of [ctr, ct, tag]. -encryptGCMPtr :: GCM +encryptGCMPtr :: GCMdata -> Word64 -- ^ AES GCM Counter (IV) -> Word32 -- ^ Salt -> Ptr Word8 -- ^ Plaintext buffer -> Int -- ^ Plaintext length -> Ptr Word8 -- ^ ciphertext buffer (at least encBytes large) -> IO () -encryptGCMPtr key ctr salt ptPtr ptLen ctPtr = do +encryptGCMPtr (GCMdata {..}) ctr salt ptPtr ptLen ctPtr = do let ivLen = sizeOf ctr + sizeOf salt tagLen = gTagLen allocaBytes ivLen $ \ptrIV -> do @@ -155,10 +167,10 @@ pokeBE ctPtr ctr let tagPtr = ctPtr' `plusPtr` ptLen ctPtr' = ctPtr `plusPtr` sizeOf ctr - AES.encryptGCM key ptrIV ivLen (castPtr ptPtr) ptLen nullPtr 0 (castPtr ctPtr') tagPtr + AES.encryptGCM gcmkey gcmpc ptrIV (fromIntegral ivLen) nullPtr 0 (castPtr ptPtr) (fromIntegral ptLen) (castPtr ctPtr') tagPtr -- | GCM decrypt and verify ICV. -decryptGCMPtr :: GCM +decryptGCMPtr :: GCMdata -> Word64 -- ^ AES GCM Counter (IV) -> Word32 -- ^ Salt -> Ptr Word8 -- ^ Ciphertext @@ -167,7 +179,7 @@ -> Int -- ^ Tag length -> Ptr Word8 -- ^ Plaintext result ptr (at least 'decBytes' large) -> IO (Either CommSecError ()) -decryptGCMPtr key ctr salt ctPtr ctLen tagPtr tagLen ptPtr +decryptGCMPtr (GCMdata {..}) ctr salt ctPtr ctLen tagPtr tagLen ptPtr | tagLen /= gTagLen = return $ Left InvalidICV | otherwise = do let ivLen = sizeOf ctr + sizeOf salt @@ -176,7 +188,7 @@ -- Build the IV pokeBE32 ptrIV salt pokeBE (ptrIV `plusPtr` sizeOf salt) ctr - AES.decryptGCM key ptrIV ivLen (castPtr ctPtr) paddedLen nullPtr 0 (castPtr ptPtr) ctagPtr + AES.decryptGCM gcmkey gcmpc ptrIV (fromIntegral ivLen) nullPtr 0 (castPtr ctPtr) (fromIntegral paddedLen) (castPtr ptPtr) ctagPtr w1 <- peekBE ctagPtr w2 <- peekBE (ctagPtr `plusPtr` sizeOf w1) y1 <- peekBE (castPtr tagPtr) @@ -187,13 +199,13 @@ -- Decrypts multiple-of-block-sized input, returing a bytestring of the -- [ctr, ct, tag]. -decryptGCM :: GCM +decryptGCM :: GCMdata -> Word64 -- ^ AES GCM Counter (IV) -> Word32 -- ^ Salt -> ByteString -- ^ Ciphertext -> ByteString -- ^ Tag -> Either CommSecError ByteString -- Plaintext (or an exception due to bad tag) -decryptGCM key ctr salt ct tag +decryptGCM (GCMdata {..}) ctr salt ct tag | B.length tag < gTagLen = Left InvalidICV | otherwise = unsafePerformIO $ do let ivLen = sizeOf ctr + sizeOf salt @@ -206,7 +218,7 @@ B.unsafeUseAsCString tag $ \tagPtr -> do B.unsafeUseAsCString ct $ \ptrCT -> do pt <- B.create paddedLen $ \ptrPT -> do - AES.decryptGCM key ptrIV ivLen (castPtr ptrCT) (B.length ct) nullPtr 0 (castPtr ptrPT) ctagPtr + AES.decryptGCM gcmkey gcmpc ptrIV (fromIntegral ivLen) nullPtr 0 (castPtr ptrCT) (fromIntegral $ B.length ct) (castPtr ptrPT) ctagPtr w1 <- peekBE ctagPtr w2 <- peekBE (ctagPtr `plusPtr` sizeOf w1) y1 <- peekBE (castPtr tagPtr) diff --git a/Network/CommSec/Types.hs b/Network/CommSec/Types.hs --- a/Network/CommSec/Types.hs +++ b/Network/CommSec/Types.hs @@ -9,10 +9,11 @@ -- |Errors that can be returned by the decoding/receicing operations. data CommSecError - = OldContext -- The context is too old (sequence number rollover) - | DuplicateSeq -- The sequence number we previously seen (possible replay attack) - | InvalidICV -- The integrity check value is invalid - | BadPadding -- The padding was invalid (corrupt sender?) + = OldContext -- The context is too old (sequence number rollover) + | DuplicateSeq -- The sequence number we previously seen (possible replay attack) + | InvalidICV -- The integrity check value is invalid + | BadPadding -- The padding was invalid (corrupt sender?) + | BuildKeyFailure -- The entropy was insufficent to build a key (bytestring too short) deriving (Eq,Ord,Show,Enum,Data,Typeable) -- |Policy for misordered packets. Notice StrictOrdering does not mean diff --git a/commsec.cabal b/commsec.cabal --- a/commsec.cabal +++ b/commsec.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: commsec -version: 0.3.3 +version: 0.3.4 synopsis: Provide communications security using symmetric ephemeral keys description: This package provides confidentiallity, integrity and replay detection. Users must @@ -24,7 +24,7 @@ exposed-modules: Network.CommSec, Network.CommSec.Package, Network.CommSec.BitWindow, Network.CommSec.Types -- other-modules: Network.CommSec.BitWindow, Network.CommSec.Types build-depends: base >4.5 && < 5, - cipher-aes128 >= 0.5, + cipher-aes128 >= 0.6.1, bytestring, crypto-api >= 0.12, network >= 2.4.1