Use Semigroup API
This commit is contained in:
parent
b01f610aa2
commit
2e0a60f7f7
@ -14,7 +14,6 @@ module Crypto.Internal.Builder
|
|||||||
( Builder
|
( Builder
|
||||||
, buildAndFreeze
|
, buildAndFreeze
|
||||||
, builderLength
|
, builderLength
|
||||||
, (<+>)
|
|
||||||
, byte
|
, byte
|
||||||
, bytes
|
, bytes
|
||||||
, zero
|
, zero
|
||||||
@ -23,16 +22,17 @@ module Crypto.Internal.Builder
|
|||||||
import Data.ByteArray (ByteArray, ByteArrayAccess)
|
import Data.ByteArray (ByteArray, ByteArrayAccess)
|
||||||
import qualified Data.ByteArray as B
|
import qualified Data.ByteArray as B
|
||||||
import Data.Memory.PtrMethods (memSet)
|
import Data.Memory.PtrMethods (memSet)
|
||||||
import Data.Word (Word8)
|
|
||||||
|
|
||||||
import Foreign.Ptr (Ptr, plusPtr)
|
import Foreign.Ptr (Ptr, plusPtr)
|
||||||
import Foreign.Storable (poke)
|
import Foreign.Storable (poke)
|
||||||
|
|
||||||
|
import Crypto.Internal.Imports
|
||||||
|
|
||||||
data Builder = Builder !Int (Ptr Word8 -> IO ()) -- size and initializer
|
data Builder = Builder !Int (Ptr Word8 -> IO ()) -- size and initializer
|
||||||
|
|
||||||
(<+>) :: Builder -> Builder -> Builder
|
instance Semigroup Builder where
|
||||||
(Builder s1 f1) <+> (Builder s2 f2) = Builder (s1 + s2) f
|
(Builder s1 f1) <> (Builder s2 f2) = Builder (s1 + s2) f
|
||||||
where f p = f1 p >> f2 (p `plusPtr` s1)
|
where f p = f1 p >> f2 (p `plusPtr` s1)
|
||||||
|
|
||||||
builderLength :: Builder -> Int
|
builderLength :: Builder -> Int
|
||||||
builderLength (Builder s _) = s
|
builderLength (Builder s _) = s
|
||||||
|
|||||||
@ -5,11 +5,15 @@
|
|||||||
-- Stability : experimental
|
-- Stability : experimental
|
||||||
-- Portability : unknown
|
-- Portability : unknown
|
||||||
--
|
--
|
||||||
|
{-# LANGUAGE CPP #-}
|
||||||
module Crypto.Internal.Imports
|
module Crypto.Internal.Imports
|
||||||
( module X
|
( module X
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.Word as X
|
import Data.Word as X
|
||||||
|
#if !(MIN_VERSION_base(4,11,0))
|
||||||
|
import Data.Semigroup as X (Semigroup(..))
|
||||||
|
#endif
|
||||||
import Control.Applicative as X
|
import Control.Applicative as X
|
||||||
import Control.Monad as X (forM, forM_, void)
|
import Control.Monad as X (forM, forM_, void)
|
||||||
import Control.Arrow as X (first, second)
|
import Control.Arrow as X (first, second)
|
||||||
|
|||||||
@ -28,6 +28,7 @@ import Crypto.Hash.SHAKE (HashSHAKE(..))
|
|||||||
import Crypto.Hash.Types (HashAlgorithm(..), Digest(..))
|
import Crypto.Hash.Types (HashAlgorithm(..), Digest(..))
|
||||||
import qualified Crypto.Hash.Types as H
|
import qualified Crypto.Hash.Types as H
|
||||||
import Crypto.Internal.Builder
|
import Crypto.Internal.Builder
|
||||||
|
import Crypto.Internal.Imports
|
||||||
import Foreign.Ptr (Ptr)
|
import Foreign.Ptr (Ptr)
|
||||||
import Data.Bits (shiftR)
|
import Data.Bits (shiftR)
|
||||||
import Data.ByteArray (ByteArrayAccess)
|
import Data.ByteArray (ByteArrayAccess)
|
||||||
@ -45,7 +46,7 @@ cshakeInit n s p = H.Context $ B.allocAndFreeze c $ \(ptr :: Ptr (H.Context a))
|
|||||||
where
|
where
|
||||||
c = hashInternalContextSize (undefined :: a)
|
c = hashInternalContextSize (undefined :: a)
|
||||||
w = hashBlockSize (undefined :: a)
|
w = hashBlockSize (undefined :: a)
|
||||||
x = encodeString n <+> encodeString s
|
x = encodeString n <> encodeString s
|
||||||
b = buildAndFreeze (bytepad x w) :: B.Bytes
|
b = buildAndFreeze (bytepad x w) :: B.Bytes
|
||||||
|
|
||||||
cshakeUpdate :: (HashSHAKE a, ByteArrayAccess ba)
|
cshakeUpdate :: (HashSHAKE a, ByteArrayAccess ba)
|
||||||
@ -75,7 +76,7 @@ cshakeFinalize !c s =
|
|||||||
-- The Eq instance is constant time. No Show instance is provided, to avoid
|
-- The Eq instance is constant time. No Show instance is provided, to avoid
|
||||||
-- printing by mistake.
|
-- printing by mistake.
|
||||||
newtype KMAC a = KMAC { kmacGetDigest :: Digest a }
|
newtype KMAC a = KMAC { kmacGetDigest :: Digest a }
|
||||||
deriving ByteArrayAccess
|
deriving (ByteArrayAccess,NFData)
|
||||||
|
|
||||||
instance Eq (KMAC a) where
|
instance Eq (KMAC a) where
|
||||||
(KMAC b1) == (KMAC b2) = B.constEq b1 b2
|
(KMAC b1) == (KMAC b2) = B.constEq b1 b2
|
||||||
@ -118,26 +119,26 @@ finalize (Context ctx) = KMAC $ cshakeFinalize ctx suffix
|
|||||||
-- Utilities
|
-- Utilities
|
||||||
|
|
||||||
bytepad :: Builder -> Int -> Builder
|
bytepad :: Builder -> Int -> Builder
|
||||||
bytepad x w = prefix <+> x <+> zero padLen
|
bytepad x w = prefix <> x <> zero padLen
|
||||||
where
|
where
|
||||||
prefix = leftEncode w
|
prefix = leftEncode w
|
||||||
padLen = (w - builderLength prefix - builderLength x) `mod` w
|
padLen = (w - builderLength prefix - builderLength x) `mod` w
|
||||||
|
|
||||||
encodeString :: ByteArrayAccess bin => bin -> Builder
|
encodeString :: ByteArrayAccess bin => bin -> Builder
|
||||||
encodeString s = leftEncode (8 * B.length s) <+> bytes s
|
encodeString s = leftEncode (8 * B.length s) <> bytes s
|
||||||
|
|
||||||
leftEncode :: Int -> Builder
|
leftEncode :: Int -> Builder
|
||||||
leftEncode x = byte len <+> digits
|
leftEncode x = byte len <> digits
|
||||||
where
|
where
|
||||||
digits = i2osp x
|
digits = i2osp x
|
||||||
len = fromIntegral (builderLength digits)
|
len = fromIntegral (builderLength digits)
|
||||||
|
|
||||||
rightEncode :: Int -> Builder
|
rightEncode :: Int -> Builder
|
||||||
rightEncode x = digits <+> byte len
|
rightEncode x = digits <> byte len
|
||||||
where
|
where
|
||||||
digits = i2osp x
|
digits = i2osp x
|
||||||
len = fromIntegral (builderLength digits)
|
len = fromIntegral (builderLength digits)
|
||||||
|
|
||||||
i2osp :: Int -> Builder
|
i2osp :: Int -> Builder
|
||||||
i2osp i | i >= 256 = i2osp (shiftR i 8) <+> byte (fromIntegral i)
|
i2osp i | i >= 256 = i2osp (shiftR i 8) <> byte (fromIntegral i)
|
||||||
| otherwise = byte (fromIntegral i)
|
| otherwise = byte (fromIntegral i)
|
||||||
|
|||||||
@ -296,7 +296,7 @@ getK :: forall proxy curve hash ctx msg .
|
|||||||
=> proxy curve -> Bool -> ctx -> PublicKey curve hash -> Bytes -> msg -> Scalar curve
|
=> proxy curve -> Bool -> ctx -> PublicKey curve hash -> Bytes -> msg -> Scalar curve
|
||||||
getK prx ph ctx (PublicKey pub) bsR msg =
|
getK prx ph ctx (PublicKey pub) bsR msg =
|
||||||
let alg = undefined :: hash
|
let alg = undefined :: hash
|
||||||
digK = hashWithDom prx alg ph ctx (bytes bsR <+> bytes pub) msg
|
digK = hashWithDom prx alg ph ctx (bytes bsR <> bytes pub) msg
|
||||||
in decodeScalarNoErr prx digK
|
in decodeScalarNoErr prx digK
|
||||||
|
|
||||||
encodeSignature :: EllipticCurveEdDSA curve
|
encodeSignature :: EllipticCurveEdDSA curve
|
||||||
@ -304,7 +304,7 @@ encodeSignature :: EllipticCurveEdDSA curve
|
|||||||
-> (Bytes, Point curve, Scalar curve)
|
-> (Bytes, Point curve, Scalar curve)
|
||||||
-> Signature curve hash
|
-> Signature curve hash
|
||||||
encodeSignature prx (bsR, _, sS) = Signature $ buildAndFreeze $
|
encodeSignature prx (bsR, _, sS) = Signature $ buildAndFreeze $
|
||||||
bytes bsR <+> bytes bsS <+> zero len0
|
bytes bsR <> bytes bsS <> zero len0
|
||||||
where
|
where
|
||||||
bsS = encodeScalarLE prx sS :: Bytes
|
bsS = encodeScalarLE prx sS :: Bytes
|
||||||
len0 = signatureSize prx - B.length bsR - B.length bsS
|
len0 = signatureSize prx - B.length bsR - B.length bsS
|
||||||
@ -339,10 +339,10 @@ instance EllipticCurveEdDSA Curve_Edwards25519 where
|
|||||||
|
|
||||||
hashWithDom _ alg ph ctx bss
|
hashWithDom _ alg ph ctx bss
|
||||||
| not ph && B.null ctx = digestDomMsg alg bss
|
| not ph && B.null ctx = digestDomMsg alg bss
|
||||||
| otherwise = digestDomMsg alg (dom <+> bss)
|
| otherwise = digestDomMsg alg (dom <> bss)
|
||||||
where dom = bytes ("SigEd25519 no Ed25519 collisions" :: ByteString) <+>
|
where dom = bytes ("SigEd25519 no Ed25519 collisions" :: ByteString) <>
|
||||||
byte (if ph then 1 else 0) <+>
|
byte (if ph then 1 else 0) <>
|
||||||
byte (fromIntegral $ B.length ctx) <+>
|
byte (fromIntegral $ B.length ctx) <>
|
||||||
bytes ctx
|
bytes ctx
|
||||||
|
|
||||||
pointPublic _ = PublicKey . Edwards25519.pointEncode
|
pointPublic _ = PublicKey . Edwards25519.pointEncode
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user