1-- |
2-- Module      : Crypto.Hash.Blake2
3-- License     : BSD-style
4-- Maintainer  : Nicolas Di Prima <nicolas@primetype.co.uk>
5-- Stability   : experimental
6-- Portability : unknown
7--
8-- Module containing the binding functions to work with the
9-- Blake2
10--
11-- Implementation based from [RFC7693](https://tools.ietf.org/html/rfc7693)
12--
13-- Please consider the following when chosing a hash:
14--
15--      Algorithm     | Target | Collision | Digest Size |
16--         Identifier |  Arch  |  Security |   in bytes  |
17--     ---------------+--------+-----------+-------------+
18--      id-blake2b160 | 64-bit |   2**80   |         20  |
19--      id-blake2b256 | 64-bit |   2**128  |         32  |
20--      id-blake2b384 | 64-bit |   2**192  |         48  |
21--      id-blake2b512 | 64-bit |   2**256  |         64  |
22--     ---------------+--------+-----------+-------------+
23--      id-blake2s128 | 32-bit |   2**64   |         16  |
24--      id-blake2s160 | 32-bit |   2**80   |         20  |
25--      id-blake2s224 | 32-bit |   2**112  |         28  |
26--      id-blake2s256 | 32-bit |   2**128  |         32  |
27--     ---------------+--------+-----------+-------------+
28--
29{-# LANGUAGE ForeignFunctionInterface #-}
30{-# LANGUAGE DeriveDataTypeable #-}
31{-# LANGUAGE ScopedTypeVariables #-}
32{-# LANGUAGE KindSignatures #-}
33{-# LANGUAGE DataKinds #-}
34{-# LANGUAGE TypeFamilies #-}
35module Crypto.Hash.Blake2
36    ( Blake2s(..)
37    , Blake2sp(..)
38    , Blake2b(..)
39    , Blake2bp(..)
40    ) where
41
42import           Crypto.Hash.Types
43import           Foreign.Ptr (Ptr)
44import           Data.Data
45import           Data.Word (Word8, Word32)
46import           GHC.TypeLits (Nat, KnownNat)
47import           Crypto.Internal.Nat
48
49-- | Fast and secure alternative to SHA1 and HMAC-SHA1
50--
51-- It is espacially known to target 32bits architectures.
52--
53-- Known supported digest sizes:
54--
55-- * Blake2s 160
56-- * Blake2s 224
57-- * Blake2s 256
58--
59data Blake2s (bitlen :: Nat) = Blake2s
60    deriving (Show,Data)
61
62instance (IsDivisibleBy8 bitlen, KnownNat bitlen, IsAtLeast bitlen 8, IsAtMost bitlen 256)
63      => HashAlgorithm (Blake2s bitlen)
64      where
65    type HashBlockSize           (Blake2s bitlen) = 64
66    type HashDigestSize          (Blake2s bitlen) = Div8 bitlen
67    type HashInternalContextSize (Blake2s bitlen) = 136
68    hashBlockSize  _          = 64
69    hashDigestSize _          = byteLen (Proxy :: Proxy bitlen)
70    hashInternalContextSize _ = 136
71    hashInternalInit p        = c_blake2s_init p (integralNatVal (Proxy :: Proxy bitlen))
72    hashInternalUpdate        = c_blake2s_update
73    hashInternalFinalize p    = c_blake2s_finalize p (integralNatVal (Proxy :: Proxy bitlen))
74
75foreign import ccall unsafe "cryptonite_blake2s_init"
76    c_blake2s_init :: Ptr (Context a) -> Word32 -> IO ()
77foreign import ccall "cryptonite_blake2s_update"
78    c_blake2s_update :: Ptr (Context a) -> Ptr Word8 -> Word32 -> IO ()
79foreign import ccall unsafe "cryptonite_blake2s_finalize"
80    c_blake2s_finalize :: Ptr (Context a) -> Word32 -> Ptr (Digest a) -> IO ()
81
82-- | Fast cryptographic hash.
83--
84-- It is especially known to target 64bits architectures.
85--
86-- Known supported digest sizes:
87--
88-- * Blake2b 160
89-- * Blake2b 224
90-- * Blake2b 256
91-- * Blake2b 384
92-- * Blake2b 512
93--
94data Blake2b (bitlen :: Nat) = Blake2b
95    deriving (Show,Data)
96
97instance (IsDivisibleBy8 bitlen, KnownNat bitlen, IsAtLeast bitlen 8, IsAtMost bitlen 512)
98      => HashAlgorithm (Blake2b bitlen)
99      where
100    type HashBlockSize           (Blake2b bitlen) = 128
101    type HashDigestSize          (Blake2b bitlen) = Div8 bitlen
102    type HashInternalContextSize (Blake2b bitlen) = 248
103    hashBlockSize  _          = 128
104    hashDigestSize _          = byteLen (Proxy :: Proxy bitlen)
105    hashInternalContextSize _ = 248
106    hashInternalInit p        = c_blake2b_init p (integralNatVal (Proxy :: Proxy bitlen))
107    hashInternalUpdate        = c_blake2b_update
108    hashInternalFinalize p    = c_blake2b_finalize p (integralNatVal (Proxy :: Proxy bitlen))
109
110foreign import ccall unsafe "cryptonite_blake2b_init"
111    c_blake2b_init :: Ptr (Context a) -> Word32 -> IO ()
112foreign import ccall "cryptonite_blake2b_update"
113    c_blake2b_update :: Ptr (Context a) -> Ptr Word8 -> Word32 -> IO ()
114foreign import ccall unsafe "cryptonite_blake2b_finalize"
115    c_blake2b_finalize :: Ptr (Context a) -> Word32 -> Ptr (Digest a) -> IO ()
116
117data Blake2sp (bitlen :: Nat) = Blake2sp
118    deriving (Show,Data)
119
120instance (IsDivisibleBy8 bitlen, KnownNat bitlen, IsAtLeast bitlen 8, IsAtMost bitlen 256)
121      => HashAlgorithm (Blake2sp bitlen)
122      where
123    type HashBlockSize           (Blake2sp bitlen) = 64
124    type HashDigestSize          (Blake2sp bitlen) = Div8 bitlen
125    type HashInternalContextSize (Blake2sp bitlen) = 2185
126    hashBlockSize  _          = 64
127    hashDigestSize _          = byteLen (Proxy :: Proxy bitlen)
128    hashInternalContextSize _ = 2185
129    hashInternalInit p        = c_blake2sp_init p (integralNatVal (Proxy :: Proxy bitlen))
130    hashInternalUpdate        = c_blake2sp_update
131    hashInternalFinalize p    = c_blake2sp_finalize p (integralNatVal (Proxy :: Proxy bitlen))
132
133foreign import ccall unsafe "cryptonite_blake2sp_init"
134    c_blake2sp_init :: Ptr (Context a) -> Word32 -> IO ()
135foreign import ccall "cryptonite_blake2sp_update"
136    c_blake2sp_update :: Ptr (Context a) -> Ptr Word8 -> Word32 -> IO ()
137foreign import ccall unsafe "cryptonite_blake2sp_finalize"
138    c_blake2sp_finalize :: Ptr (Context a) -> Word32 -> Ptr (Digest a) -> IO ()
139
140data Blake2bp (bitlen :: Nat) = Blake2bp
141    deriving (Show,Data)
142
143instance (IsDivisibleBy8 bitlen, KnownNat bitlen, IsAtLeast bitlen 8, IsAtMost bitlen 512)
144      => HashAlgorithm (Blake2bp bitlen)
145      where
146    type HashBlockSize           (Blake2bp bitlen) = 128
147    type HashDigestSize          (Blake2bp bitlen) = Div8 bitlen
148    type HashInternalContextSize (Blake2bp bitlen) = 2325
149    hashBlockSize  _          = 128
150    hashDigestSize _          = byteLen (Proxy :: Proxy bitlen)
151    hashInternalContextSize _ = 2325
152    hashInternalInit p        = c_blake2bp_init p (integralNatVal (Proxy :: Proxy bitlen))
153    hashInternalUpdate        = c_blake2bp_update
154    hashInternalFinalize p    = c_blake2bp_finalize p (integralNatVal (Proxy :: Proxy bitlen))
155
156
157foreign import ccall unsafe "cryptonite_blake2bp_init"
158    c_blake2bp_init :: Ptr (Context a) -> Word32 -> IO ()
159foreign import ccall "cryptonite_blake2bp_update"
160    c_blake2bp_update :: Ptr (Context a) -> Ptr Word8 -> Word32 -> IO ()
161foreign import ccall unsafe "cryptonite_blake2bp_finalize"
162    c_blake2bp_finalize :: Ptr (Context a) -> Word32 -> Ptr (Digest a) -> IO ()
163