Merge pull request #271 from ocheron/hash-nat-constraints

Hash algorithms with runtime output length

Crypto/ECC.hs

@@ -31,7 +31,6 @@ import qualified Crypto.ECC.Simple.Types as Simple
 import qualified Crypto.ECC.Simple.Prim as Simple
 import           Crypto.Random
 import           Crypto.Error
-import           Crypto.Internal.Proxy
 import           Crypto.Internal.Imports
 import           Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess, ScrubbedBytes)
 import qualified Crypto.Internal.ByteArray as B
@@ -41,6 +40,7 @@ import qualified Crypto.PubKey.Curve448 as X448
 import           Data.ByteArray (convert)
 import           Data.Data (Data())
 import           Data.Kind (Type)
+import           Data.Proxy
 
 -- | An elliptic curve key pair composed of the private part (a scalar), and
 -- the associated point.

Crypto/ECC/Simple/Prim.hs

@@ -17,7 +17,7 @@ module Crypto.ECC.Simple.Prim
     ) where
 
 import Data.Maybe
-import Crypto.Internal.Proxy
+import Data.Proxy
 import Crypto.Number.ModArithmetic
 import Crypto.Number.F2m
 import Crypto.Number.Generate (generateBetween)

Crypto/Internal/Nat.hs

@@ -9,6 +9,7 @@ module Crypto.Internal.Nat
     , type IsAtMost, type IsAtLeast
     , byteLen
     , integralNatVal
+    , type IsDiv8
     , type Div8
     , type Mod8
     ) where
@@ -207,4 +208,6 @@ type family Mod8 (n :: Nat) where
     Mod8 63 = 7
     Mod8 n = Mod8 (n - 64)
 
+-- | ensure the given `bitlen` is divisible by 8
+--
 type IsDivisibleBy8 bitLen = IsDiv8 bitLen bitLen ~ 'True

Crypto/Internal/Proxy.hs

@@ -1,13 +0,0 @@
--- |
--- Module      : Crypto.Internal.Proxy
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : Good
---
-module Crypto.Internal.Proxy
-    ( Proxy(..)
-    ) where
-
--- | A type witness for 'a' as phantom type
-data Proxy a = Proxy

Crypto/Number/Nat.hs

@@ -0,0 +1,63 @@
+-- |
+-- Module      : Crypto.Number.Nat
+-- License     : BSD-style
+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
+-- Stability   : experimental
+-- Portability : Good
+--
+-- Numbers at type level.
+--
+-- This module provides extensions to "GHC.TypeLits" and "GHC.TypeNats" useful
+-- to work with cryptographic algorithms parameterized with a variable bit
+-- length.  Constraints like @'IsDivisibleBy8' n@ ensure that the type-level
+-- parameter is applicable to the algorithm.
+--
+-- Functions are also provided to test whether constraints are satisfied from
+-- values known at runtime.  The following example shows how to discharge
+-- 'IsDivisibleBy8' in a computation @fn@ requiring this constraint:
+--
+-- > withDivisibleBy8 :: Integer
+-- >                  -> (forall proxy n . (KnownNat n, IsDivisibleBy8 n) => proxy n -> a)
+-- >                  -> Maybe a
+-- > withDivisibleBy8 len fn = do
+-- >     SomeNat p <- someNatVal len
+-- >     Refl <- isDivisibleBy8 p
+-- >     pure (fn p)
+--
+-- Function @withDivisibleBy8@ above returns 'Nothing' when the argument @len@
+-- is negative or not divisible by 8.
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeOperators #-}
+module Crypto.Number.Nat
+    ( type IsDivisibleBy8
+    , type IsAtMost, type IsAtLeast
+    , isDivisibleBy8
+    , isAtMost
+    , isAtLeast
+    ) where
+
+import           Data.Type.Equality
+import           GHC.TypeLits
+import           Unsafe.Coerce (unsafeCoerce)
+
+import           Crypto.Internal.Nat
+
+-- | get a runtime proof that the constraint @'IsDivisibleBy8' n@ is satified
+isDivisibleBy8 :: KnownNat n => proxy n -> Maybe (IsDiv8 n n :~: 'True)
+isDivisibleBy8 n
+    | mod (natVal n) 8 == 0 = Just (unsafeCoerce Refl)
+    | otherwise             = Nothing
+
+-- | get a runtime proof that the constraint @'IsAtMost' value bound@ is
+-- satified
+isAtMost :: (KnownNat value, KnownNat bound)
+         => proxy value -> proxy' bound -> Maybe ((value <=? bound) :~: 'True)
+isAtMost x y
+    | natVal x <= natVal y  = Just (unsafeCoerce Refl)
+    | otherwise             = Nothing
+
+-- | get a runtime proof that the constraint @'IsAtLeast' value bound@ is
+-- satified
+isAtLeast :: (KnownNat value, KnownNat bound)
+          => proxy value -> proxy' bound -> Maybe ((bound <=? value) :~: 'True)
+isAtLeast = flip isAtMost

Crypto/Random/Entropy/Backend.hs

@@ -14,8 +14,8 @@ module Crypto.Random.Entropy.Backend
     ) where
 
 import Foreign.Ptr
+import Data.Proxy
 import Data.Word (Word8)
-import Crypto.Internal.Proxy
 import Crypto.Random.Entropy.Source
 #ifdef SUPPORT_RDRAND
 import Crypto.Random.Entropy.RDRand

cryptonite.cabal

@@ -130,6 +130,7 @@ Library
                      Crypto.Number.F2m
                      Crypto.Number.Generate
                      Crypto.Number.ModArithmetic
+                     Crypto.Number.Nat
                      Crypto.Number.Prime
                      Crypto.Number.Serialize
                      Crypto.Number.Serialize.Internal
@@ -220,7 +221,6 @@ Library
                      Crypto.PubKey.ElGamal
                      Crypto.ECC.Simple.Types
                      Crypto.ECC.Simple.Prim
-                     Crypto.Internal.Proxy
                      Crypto.Internal.ByteArray
                      Crypto.Internal.Compat
                      Crypto.Internal.CompatPrim