Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Initial attempt at a unified crypto api

Ignore-this: d64ea7baa48f74cfd349358ee2c5efc4

darcs-hash:20100615001526-cef97-4fcf4b8b69660a5de0ca5640e39d69983a8be5e3.gz
  • Loading branch information...
commit 435b097e0c9ab6fbd401a675903e2f6f5dfb5920 0 parents
@TomMD authored
84 Data/Crypto/Classes.hs
@@ -0,0 +1,84 @@
+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
+module Data.Crypto.Classes
+ ( Hash(..)
+ , Cipher(..)
+ , for
+ , (.::.)
+ , hashFunc
+ ) where
+
+import Data.Binary
+import Data.Serialize
+import qualified Data.ByteString.Lazy as L
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Internal as I
+import Data.List (foldl')
+import Data.Tagged
+import Data.Crypto.Types
+
+{-
+class (Binary d, Serialize d)
+ => Hash ctx d | d -> ctx, ctx -> d where
+ outputLength :: Tagged d BitLength
+ blockLength :: Tagged d BitLength
+ hash :: ByteString -> d
+ initialCtx :: ctx
+ updateCtx :: ctx -> ByteString -> ctx
+ finalize :: ctx -> d
+ strength :: Tagged d Int
+-}
+
+class (Binary d, Serialize d)
+ => Hash ctx d | d -> ctx, ctx -> d where
+ outputLength :: Tagged d BitLength
+ blockLength :: Tagged d BitLength
+ initialCtx :: ctx
+ updateCtx :: ctx -> B.ByteString -> ctx
+ finalize :: ctx -> B.ByteString -> d
+ strength :: Tagged d Int
+ needAlignment :: Tagged d Int
+ hash :: L.ByteString -> d
+ hash msg = res
+ where
+ res = finalize ctx end
+ ctx = foldl' updateCtx initialCtx blks
+ (blks,end) = makeBlocks msg blockLen (needAlignment .::. res)
+ blockLen = (blockLength .::. res) `div` 8
+ hash' :: B.ByteString -> d
+ hash' msg = res
+ where
+ res = finalize (foldl' updateCtx initialCtx blks) end
+ (blks, end) = makeBlocks (L.fromChunks [msg]) (blockLength .::. res `div` 8) (needAlignment .::. res)
+ hashFunc :: Hash c d => d -> (L.ByteString -> d)
+ hashFunc d = f
+ where
+ f = hash
+ a = f undefined `asTypeOf` d
+
+{-# INLINE makeBlocks #-}
+makeBlocks :: L.ByteString -> ByteLength -> Int -> ([B.ByteString], B.ByteString)
+makeBlocks msg len ali = go msg
+ where
+ go lps =
+ if B.length blk' == len
+ then let (rest,end) = go lps in (blk':rest, end)
+ else ([],blk)
+ where
+ blk = if isAligned blk' then blk' else B.copy blk'
+ blk' = B.concat $ L.toChunks top
+ (top,rest) = L.splitAt (fromIntegral len) lps
+ isAligned (I.PS _ off _) = off `rem` ali == 0
+
+for :: Tagged a b -> a -> b
+for t _ = unTagged t
+
+(.::.) :: Tagged a b -> a -> b
+(.::.) = for
+
+
+class Cipher k where
+ blockSize :: Tagged k BitLength
+ encrypt :: k -> B.ByteString -> B.ByteString
+ decrypt :: k -> B.ByteString -> B.ByteString
+ buildKey :: B.ByteString -> Maybe k
+ keyLength :: k -> BitLength -- ^ keyLength may inspect its argument to return the length
23 Data/Crypto/HMAC.hs
@@ -0,0 +1,23 @@
+module Data.Crypto.HMAC where
+
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as L
+import Data.Crypto.Classes
+import Data.Serialize (encode)
+import qualified Data.Binary as Bin
+import Data.Bits (xor)
+
+hmac :: (Hash c d) => B.ByteString -> L.ByteString -> d
+hmac k msg = res
+ where
+ res = f . L.append ko . Bin.encode . f . L.append ki $ msg
+ f = hash
+ keylen = B.length k
+ blen = blockLength .::. res
+ k' = case compare keylen blen of
+ GT -> encode . f . fc $ k
+ EQ -> k
+ LT -> B.append k (B.replicate (blen - keylen) 0x00)
+ ko = fc $ B.map (`xor` 0x5c) k'
+ ki = fc $ B.map (`xor` 0x36) k'
+ fc = L.fromChunks . \s -> [s]
8 Data/Crypto/Types.hs
@@ -0,0 +1,8 @@
+module Data.Crypto.Types where
+
+import Data.ByteString as B
+import Data.ByteString.Lazy as L
+
+type BitLength = Int
+type ByteLength = Int
+type CipherText = L.ByteString
30 LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) Thomas DuBuisson
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+
+3. Neither the name of the author nor the names of his contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
25 crypto.cabal
@@ -0,0 +1,25 @@
+name: crypto
+version: 0.0.0.1
+license: BSD3
+license-file: LICENSE
+author: Thomas DuBuisson <thomas.dubuisson@gmail.com>
+maintainer: Thomas DuBuisson
+description: A generic interface for cryptographic operations.
+ Maintainers of hash and cipher implementations are
+ encouraged to add instances for the classes defined
+ in Data.Crypto.Classes. Crypto users are similarly
+ encoraged to use the interfaces defined in the Classes
+ module.
+synopsis: A generic interface for cryptographic operations
+category: Data, Cryptography
+stability: stable
+build-type: Simple
+cabal-version: >= 1.6
+tested-with: GHC == 6.12.1
+extra-source-files:
+
+Library
+ Build-Depends: base == 4.*, bytestring >= 0.9 && < 0.10, binary >= 0.4.0, cereal >= 0.2, tagged
+ ghc-options: -O2 -funfolding-use-threshold66 -funfolding-creation-threshold66 -fexcess-precision -funbox-strict-fields
+ hs-source-dirs:
+ exposed-modules: Data.Crypto.Classes, Data.Crypto.Types, Data.Crypto.HMAC

0 comments on commit 435b097

Please sign in to comment.
Something went wrong with that request. Please try again.