diff --git a/Crypto/Cipher/AES/Primitive.hs b/Crypto/Cipher/AES/Primitive.hs index 5e26174..3536b6d 100644 --- a/Crypto/Cipher/AES/Primitive.hs +++ b/Crypto/Cipher/AES/Primitive.hs @@ -11,37 +11,37 @@ -- module Crypto.Cipher.AES.Primitive ( - -- * block cipher data types + -- * Block cipher data types AES -- * Authenticated encryption block cipher types , AESGCM , AESOCB - -- * creation + -- * Creation , initAES - -- * misc + -- * Miscellanea , genCTR , genCounter - -- * encryption + -- * Encryption , encryptECB , encryptCBC , encryptCTR , encryptXTS - -- * decryption + -- * Decryption , decryptECB , decryptCBC , decryptCTR , decryptXTS - -- * incremental GCM + -- * Incremental GCM , gcmMode , gcmInit - -- * incremental OCB + -- * Incremental OCB , ocbMode , ocbInit ) where diff --git a/Crypto/Cipher/Camellia/Primitive.hs b/Crypto/Cipher/Camellia/Primitive.hs index 5a28a12..8d683d0 100644 --- a/Crypto/Cipher/Camellia/Primitive.hs +++ b/Crypto/Cipher/Camellia/Primitive.hs @@ -6,8 +6,8 @@ -- Stability : experimental -- Portability : Good -- --- this only cover Camellia 128 bits for now, API will change once --- 192 and 256 mode are implemented too +-- This only cover Camellia 128 bits for now. The API will change once +-- 192 and 256 mode are implemented too. {-# LANGUAGE MagicHash #-} module Crypto.Cipher.Camellia.Primitive ( Camellia diff --git a/Crypto/Cipher/ChaCha.hs b/Crypto/Cipher/ChaCha.hs index 5e85b7b..cd5c511 100644 --- a/Crypto/Cipher/ChaCha.hs +++ b/Crypto/Cipher/ChaCha.hs @@ -12,7 +12,7 @@ module Crypto.Cipher.ChaCha , combine , generate , State - -- * simple interface for DRG purpose + -- * Simple interface for DRG purpose , initializeSimple , generateSimple , StateSimple diff --git a/Crypto/Cipher/Types.hs b/Crypto/Cipher/Types.hs index 3a0cde0..8ab88c0 100644 --- a/Crypto/Cipher/Types.hs +++ b/Crypto/Cipher/Types.hs @@ -5,7 +5,7 @@ -- Stability : Stable -- Portability : Excellent -- --- symmetric cipher basic types +-- Symmetric cipher basic types -- {-# LANGUAGE DeriveDataTypeable #-} module Crypto.Cipher.Types diff --git a/Crypto/Cipher/Types/Base.hs b/Crypto/Cipher/Types/Base.hs index ef1a4a6..e2c1652 100644 --- a/Crypto/Cipher/Types/Base.hs +++ b/Crypto/Cipher/Types/Base.hs @@ -5,7 +5,7 @@ -- Stability : Stable -- Portability : Excellent -- --- symmetric cipher basic types +-- Symmetric cipher basic types -- {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} diff --git a/Crypto/Cipher/Types/Block.hs b/Crypto/Cipher/Types/Block.hs index ff3fedd..290b67b 100644 --- a/Crypto/Cipher/Types/Block.hs +++ b/Crypto/Cipher/Types/Block.hs @@ -5,7 +5,7 @@ -- Stability : Stable -- Portability : Excellent -- --- block cipher basic types +-- Block cipher basic types -- {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ExistentialQuantification #-} @@ -16,7 +16,7 @@ module Crypto.Cipher.Types.Block -- * BlockCipher BlockCipher(..) , BlockCipher128(..) - -- * initialization vector (IV) + -- * Initialization vector (IV) , IV(..) , makeIV , nullIV diff --git a/Crypto/Cipher/Types/Stream.hs b/Crypto/Cipher/Types/Stream.hs index 9d77846..caa9e2d 100644 --- a/Crypto/Cipher/Types/Stream.hs +++ b/Crypto/Cipher/Types/Stream.hs @@ -5,7 +5,7 @@ -- Stability : Stable -- Portability : Excellent -- --- stream cipher basic types +-- Stream cipher basic types -- module Crypto.Cipher.Types.Stream ( StreamCipher(..) diff --git a/Crypto/Cipher/Types/Utils.hs b/Crypto/Cipher/Types/Utils.hs index 4ac6b56..1185404 100644 --- a/Crypto/Cipher/Types/Utils.hs +++ b/Crypto/Cipher/Types/Utils.hs @@ -5,7 +5,7 @@ -- Stability : Stable -- Portability : Excellent -- --- basic utility for cipher related stuff +-- Basic utility for cipher related stuff -- module Crypto.Cipher.Types.Utils where diff --git a/Crypto/ConstructHash/MiyaguchiPreneel.hs b/Crypto/ConstructHash/MiyaguchiPreneel.hs index fe3df1c..636af08 100644 --- a/Crypto/ConstructHash/MiyaguchiPreneel.hs +++ b/Crypto/ConstructHash/MiyaguchiPreneel.hs @@ -5,7 +5,7 @@ -- Stability : experimental -- Portability : unknown -- --- provide the hash function construction method from block cipher +-- Provide the hash function construction method from block cipher -- -- {-# LANGUAGE GeneralizedNewtypeDeriving #-} diff --git a/Crypto/Data/AFIS.hs b/Crypto/Data/AFIS.hs index 87b90be..bcf95cf 100644 --- a/Crypto/Data/AFIS.hs +++ b/Crypto/Data/AFIS.hs @@ -5,7 +5,7 @@ -- Stability : experimental -- Portability : unknown -- --- haskell implementation of the Anti-forensic information splitter +-- Haskell implementation of the Anti-forensic information splitter -- available in LUKS. -- -- The algorithm bloats an arbitrary secret with many bits that are necessary for diff --git a/Crypto/ECC/Simple/Types.hs b/Crypto/ECC/Simple/Types.hs index c97daa2..653f4c2 100644 --- a/Crypto/ECC/Simple/Types.hs +++ b/Crypto/ECC/Simple/Types.hs @@ -6,7 +6,7 @@ -- Stability : Experimental -- Portability : Excellent -- --- references: +-- References: -- -- {-# OPTIONS_GHC -fno-warn-missing-signatures #-} @@ -20,7 +20,7 @@ module Crypto.ECC.Simple.Types , curveSizeBits , curveSizeBytes , CurveParameters(..) - -- * specific curves definition + -- * Specific curves definition , SEC_p112r1(..) , SEC_p112r2(..) , SEC_p128r1(..) diff --git a/Crypto/Hash.hs b/Crypto/Hash.hs index cd08a6a..3eed034 100644 --- a/Crypto/Hash.hs +++ b/Crypto/Hash.hs @@ -25,10 +25,10 @@ module Crypto.Hash , Digest -- * Functions , digestFromByteString - -- * hash methods parametrized by algorithm + -- * Hash methods parametrized by algorithm , hashInitWith , hashWith - -- * hash methods + -- * Hash methods , hashInit , hashUpdates , hashUpdate diff --git a/Crypto/Hash/Algorithms.hs b/Crypto/Hash/Algorithms.hs index fdf52f4..ade287f 100644 --- a/Crypto/Hash/Algorithms.hs +++ b/Crypto/Hash/Algorithms.hs @@ -10,7 +10,7 @@ -- module Crypto.Hash.Algorithms ( HashAlgorithm - -- * hash algorithms + -- * Hash algorithms , Blake2s_160(..) , Blake2s_224(..) , Blake2s_256(..) diff --git a/Crypto/Hash/Blake2.hs b/Crypto/Hash/Blake2.hs index 74a3d14..e2c6c09 100644 --- a/Crypto/Hash/Blake2.hs +++ b/Crypto/Hash/Blake2.hs @@ -5,7 +5,7 @@ -- Stability : experimental -- Portability : unknown -- --- module containing the binding functions to work with the +-- Module containing the binding functions to work with the -- Blake2 -- -- Implementation based from [RFC7693](https://tools.ietf.org/html/rfc7693) @@ -51,7 +51,7 @@ import Crypto.Internal.Nat -- -- It is espacially known to target 32bits architectures. -- --- known supported digest sizes: +-- Known supported digest sizes: -- -- * Blake2s 160 -- * Blake2s 224 diff --git a/Crypto/Hash/Blake2b.hs b/Crypto/Hash/Blake2b.hs index b20fdc4..419d6a4 100644 --- a/Crypto/Hash/Blake2b.hs +++ b/Crypto/Hash/Blake2b.hs @@ -5,7 +5,7 @@ -- Stability : experimental -- Portability : unknown -- --- module containing the binding functions to work with the +-- Module containing the binding functions to work with the -- Blake2b cryptographic hash. -- {-# LANGUAGE ForeignFunctionInterface #-} diff --git a/Crypto/Hash/Blake2bp.hs b/Crypto/Hash/Blake2bp.hs index 7a555d9..154ca6e 100644 --- a/Crypto/Hash/Blake2bp.hs +++ b/Crypto/Hash/Blake2bp.hs @@ -5,7 +5,7 @@ -- Stability : experimental -- Portability : unknown -- --- module containing the binding functions to work with the +-- Module containing the binding functions to work with the -- Blake2bp cryptographic hash. -- {-# LANGUAGE ForeignFunctionInterface #-} diff --git a/Crypto/Hash/Blake2s.hs b/Crypto/Hash/Blake2s.hs index 3f1e62b..d74730f 100644 --- a/Crypto/Hash/Blake2s.hs +++ b/Crypto/Hash/Blake2s.hs @@ -5,7 +5,7 @@ -- Stability : experimental -- Portability : unknown -- --- module containing the binding functions to work with the +-- Module containing the binding functions to work with the -- Blake2s cryptographic hash. -- {-# LANGUAGE ForeignFunctionInterface #-} diff --git a/Crypto/Hash/Blake2sp.hs b/Crypto/Hash/Blake2sp.hs index 2aaa041..c517594 100644 --- a/Crypto/Hash/Blake2sp.hs +++ b/Crypto/Hash/Blake2sp.hs @@ -5,7 +5,7 @@ -- Stability : experimental -- Portability : unknown -- --- module containing the binding functions to work with the +-- Module containing the binding functions to work with the -- Blake2sp cryptographic hash. -- {-# LANGUAGE ForeignFunctionInterface #-} diff --git a/Crypto/Hash/Keccak.hs b/Crypto/Hash/Keccak.hs index c7bab21..234e3cf 100644 --- a/Crypto/Hash/Keccak.hs +++ b/Crypto/Hash/Keccak.hs @@ -5,7 +5,7 @@ -- Stability : experimental -- Portability : unknown -- --- module containing the binding functions to work with the +-- Module containing the binding functions to work with the -- Keccak cryptographic hash. -- {-# LANGUAGE ForeignFunctionInterface #-} diff --git a/Crypto/Hash/MD2.hs b/Crypto/Hash/MD2.hs index fe83fd4..f1919ce 100644 --- a/Crypto/Hash/MD2.hs +++ b/Crypto/Hash/MD2.hs @@ -5,7 +5,7 @@ -- Stability : experimental -- Portability : unknown -- --- module containing the binding functions to work with the +-- Module containing the binding functions to work with the -- MD2 cryptographic hash. -- {-# LANGUAGE ForeignFunctionInterface #-} diff --git a/Crypto/Hash/MD4.hs b/Crypto/Hash/MD4.hs index b0f09b4..543dd3b 100644 --- a/Crypto/Hash/MD4.hs +++ b/Crypto/Hash/MD4.hs @@ -5,7 +5,7 @@ -- Stability : experimental -- Portability : unknown -- --- module containing the binding functions to work with the +-- Module containing the binding functions to work with the -- MD4 cryptographic hash. -- {-# LANGUAGE ForeignFunctionInterface #-} diff --git a/Crypto/Hash/MD5.hs b/Crypto/Hash/MD5.hs index 143b5bb..dc94a91 100644 --- a/Crypto/Hash/MD5.hs +++ b/Crypto/Hash/MD5.hs @@ -5,7 +5,7 @@ -- Stability : experimental -- Portability : unknown -- --- module containing the binding functions to work with the +-- Module containing the binding functions to work with the -- MD5 cryptographic hash. -- {-# LANGUAGE ForeignFunctionInterface #-} diff --git a/Crypto/Hash/RIPEMD160.hs b/Crypto/Hash/RIPEMD160.hs index 96c0ec6..13334a3 100644 --- a/Crypto/Hash/RIPEMD160.hs +++ b/Crypto/Hash/RIPEMD160.hs @@ -5,7 +5,7 @@ -- Stability : experimental -- Portability : unknown -- --- module containing the binding functions to work with the +-- Module containing the binding functions to work with the -- RIPEMD160 cryptographic hash. -- {-# LANGUAGE ForeignFunctionInterface #-} diff --git a/Crypto/Hash/SHA1.hs b/Crypto/Hash/SHA1.hs index e0e1de5..8d1ed84 100644 --- a/Crypto/Hash/SHA1.hs +++ b/Crypto/Hash/SHA1.hs @@ -5,7 +5,7 @@ -- Stability : experimental -- Portability : unknown -- --- module containing the binding functions to work with the +-- Module containing the binding functions to work with the -- SHA1 cryptographic hash. -- {-# LANGUAGE ForeignFunctionInterface #-} diff --git a/Crypto/Hash/SHA224.hs b/Crypto/Hash/SHA224.hs index a19ebba..9801a33 100644 --- a/Crypto/Hash/SHA224.hs +++ b/Crypto/Hash/SHA224.hs @@ -5,7 +5,7 @@ -- Stability : experimental -- Portability : unknown -- --- module containing the binding functions to work with the +-- Module containing the binding functions to work with the -- SHA224 cryptographic hash. -- {-# LANGUAGE ForeignFunctionInterface #-} diff --git a/Crypto/Hash/SHA256.hs b/Crypto/Hash/SHA256.hs index 1b6ea92..d9102f9 100644 --- a/Crypto/Hash/SHA256.hs +++ b/Crypto/Hash/SHA256.hs @@ -5,7 +5,7 @@ -- Stability : experimental -- Portability : unknown -- --- module containing the binding functions to work with the +-- Module containing the binding functions to work with the -- SHA256 cryptographic hash. -- {-# LANGUAGE ForeignFunctionInterface #-} diff --git a/Crypto/Hash/SHA3.hs b/Crypto/Hash/SHA3.hs index a067d04..9dada07 100644 --- a/Crypto/Hash/SHA3.hs +++ b/Crypto/Hash/SHA3.hs @@ -5,7 +5,7 @@ -- Stability : experimental -- Portability : unknown -- --- module containing the binding functions to work with the +-- Module containing the binding functions to work with the -- SHA3 cryptographic hash. -- {-# LANGUAGE ForeignFunctionInterface #-} diff --git a/Crypto/Hash/SHA384.hs b/Crypto/Hash/SHA384.hs index b5194f4..4bcc5fc 100644 --- a/Crypto/Hash/SHA384.hs +++ b/Crypto/Hash/SHA384.hs @@ -5,7 +5,7 @@ -- Stability : experimental -- Portability : unknown -- --- module containing the binding functions to work with the +-- Module containing the binding functions to work with the -- SHA384 cryptographic hash. -- {-# LANGUAGE ForeignFunctionInterface #-} diff --git a/Crypto/Hash/SHA512.hs b/Crypto/Hash/SHA512.hs index 71583b6..14b82f2 100644 --- a/Crypto/Hash/SHA512.hs +++ b/Crypto/Hash/SHA512.hs @@ -5,7 +5,7 @@ -- Stability : experimental -- Portability : unknown -- --- module containing the binding functions to work with the +-- Module containing the binding functions to work with the -- SHA512 cryptographic hash. -- {-# LANGUAGE ForeignFunctionInterface #-} diff --git a/Crypto/Hash/SHA512t.hs b/Crypto/Hash/SHA512t.hs index 850adf0..be88d3a 100644 --- a/Crypto/Hash/SHA512t.hs +++ b/Crypto/Hash/SHA512t.hs @@ -5,7 +5,7 @@ -- Stability : experimental -- Portability : unknown -- --- module containing the binding functions to work with the +-- Module containing the binding functions to work with the -- SHA512t cryptographic hash. -- {-# LANGUAGE ForeignFunctionInterface #-} diff --git a/Crypto/Hash/SHAKE.hs b/Crypto/Hash/SHAKE.hs index c26d6ac..aa9d692 100644 --- a/Crypto/Hash/SHAKE.hs +++ b/Crypto/Hash/SHAKE.hs @@ -5,7 +5,7 @@ -- Stability : experimental -- Portability : unknown -- --- module containing the binding functions to work with the +-- Module containing the binding functions to work with the -- SHA3 extendable output functions (SHAKE). -- {-# LANGUAGE ForeignFunctionInterface #-} diff --git a/Crypto/Hash/Skein256.hs b/Crypto/Hash/Skein256.hs index 8d61a98..9871d47 100644 --- a/Crypto/Hash/Skein256.hs +++ b/Crypto/Hash/Skein256.hs @@ -5,7 +5,7 @@ -- Stability : experimental -- Portability : unknown -- --- module containing the binding functions to work with the +-- Module containing the binding functions to work with the -- Skein256 cryptographic hash. -- {-# LANGUAGE ForeignFunctionInterface #-} diff --git a/Crypto/Hash/Skein512.hs b/Crypto/Hash/Skein512.hs index d97365f..75d2407 100644 --- a/Crypto/Hash/Skein512.hs +++ b/Crypto/Hash/Skein512.hs @@ -5,7 +5,7 @@ -- Stability : experimental -- Portability : unknown -- --- module containing the binding functions to work with the +-- Module containing the binding functions to work with the -- Skein512 cryptographic hash. -- {-# LANGUAGE ForeignFunctionInterface #-} diff --git a/Crypto/Hash/Tiger.hs b/Crypto/Hash/Tiger.hs index 4822f81..de74a75 100644 --- a/Crypto/Hash/Tiger.hs +++ b/Crypto/Hash/Tiger.hs @@ -5,7 +5,7 @@ -- Stability : experimental -- Portability : unknown -- --- module containing the binding functions to work with the +-- Module containing the binding functions to work with the -- Tiger cryptographic hash. -- {-# LANGUAGE ForeignFunctionInterface #-} diff --git a/Crypto/Hash/Whirlpool.hs b/Crypto/Hash/Whirlpool.hs index 32f99a6..3780565 100644 --- a/Crypto/Hash/Whirlpool.hs +++ b/Crypto/Hash/Whirlpool.hs @@ -5,7 +5,7 @@ -- Stability : experimental -- Portability : unknown -- --- module containing the binding functions to work with the +-- Module containing the binding functions to work with the -- Whirlpool cryptographic hash. -- {-# LANGUAGE ForeignFunctionInterface #-} diff --git a/Crypto/Internal/Compat.hs b/Crypto/Internal/Compat.hs index a3712a7..30615d9 100644 --- a/Crypto/Internal/Compat.hs +++ b/Crypto/Internal/Compat.hs @@ -5,8 +5,8 @@ -- Stability : stable -- Portability : Good -- --- This module try to keep all the difference between versions of base --- or other needed packages, so that modules don't need to use CPP +-- This module tries to keep all the difference between versions of base +-- or other needed packages, so that modules don't need to use CPP. -- {-# LANGUAGE CPP #-} module Crypto.Internal.Compat @@ -19,10 +19,10 @@ import System.IO.Unsafe import Data.Word import Data.Bits --- | perform io for hashes that do allocation and ffi. --- unsafeDupablePerformIO is used when possible as the +-- | Perform io for hashes that do allocation and FFI. +-- 'unsafeDupablePerformIO' is used when possible as the -- computation is pure and the output is directly linked --- to the input. we also do not modify anything after it has +-- to the input. We also do not modify anything after it has -- been returned to the user. unsafeDoIO :: IO a -> a #if __GLASGOW_HASKELL__ > 704 diff --git a/Crypto/Internal/CompatPrim.hs b/Crypto/Internal/CompatPrim.hs index 68c951f..abfc79d 100644 --- a/Crypto/Internal/CompatPrim.hs +++ b/Crypto/Internal/CompatPrim.hs @@ -5,11 +5,11 @@ -- Stability : stable -- Portability : Compat -- --- This module try to keep all the difference between versions of ghc primitive +-- This module tries to keep all the difference between versions of ghc primitive -- or other needed packages, so that modules don't need to use CPP. -- -- Note that MagicHash and CPP conflicts in places, making it "more interesting" --- to write compat code for primitives +-- to write compat code for primitives. -- {-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} @@ -28,9 +28,9 @@ import GHC.Prim import Data.Memory.Endian (getSystemEndianness, Endianness(..)) #endif --- | byteswap Word# to or from Big Endian +-- | Byteswap Word# to or from Big Endian -- --- on a big endian machine, this function is a nop. +-- On a big endian machine, this function is a nop. be32Prim :: Word# -> Word# #ifdef ARCH_IS_LITTLE_ENDIAN be32Prim = byteswap32Prim @@ -40,9 +40,9 @@ be32Prim = id be32Prim w = if getSystemEndianness == LittleEndian then byteswap32Prim w else w #endif --- | byteswap Word# to or from Little Endian +-- | Byteswap Word# to or from Little Endian -- --- on a little endian machine, this function is a nop. +-- On a little endian machine, this function is a nop. le32Prim :: Word# -> Word# #ifdef ARCH_IS_LITTLE_ENDIAN le32Prim w = w @@ -66,7 +66,7 @@ byteswap32Prim w = in or# a (or# b (or# c d)) #endif --- | combine 4 word8 [a,b,c,d] to a word32 representing [a,b,c,d] +-- | Combine 4 word8 [a,b,c,d] to a word32 representing [a,b,c,d] convert4To32 :: Word# -> Word# -> Word# -> Word# -> Word# convert4To32 a b c d = or# (or# c1 c2) (or# c3 c4) diff --git a/Crypto/Internal/WordArray.hs b/Crypto/Internal/WordArray.hs index 93481e0..0f3c0f6 100644 --- a/Crypto/Internal/WordArray.hs +++ b/Crypto/Internal/WordArray.hs @@ -8,7 +8,7 @@ -- Small and self contained array representation -- with limited safety for internal use. -- --- the array produced should never be exposed to the user directly +-- The array produced should never be exposed to the user directly. -- {-# LANGUAGE BangPatterns #-} {-# LANGUAGE MagicHash #-} diff --git a/Crypto/MAC/CMAC.hs b/Crypto/MAC/CMAC.hs index 010153b..cfb8a49 100644 --- a/Crypto/MAC/CMAC.hs +++ b/Crypto/MAC/CMAC.hs @@ -5,7 +5,7 @@ -- Stability : experimental -- Portability : unknown -- --- provide the CMAC (Cipher based Message Authentification Code) base algorithm. +-- Provide the CMAC (Cipher based Message Authentification Code) base algorithm. -- -- -- diff --git a/Crypto/MAC/HMAC.hs b/Crypto/MAC/HMAC.hs index e4f5716..77582e3 100644 --- a/Crypto/MAC/HMAC.hs +++ b/Crypto/MAC/HMAC.hs @@ -5,7 +5,7 @@ -- Stability : experimental -- Portability : unknown -- --- provide the HMAC (Hash based Message Authentification Code) base algorithm. +-- Provide the HMAC (Hash based Message Authentification Code) base algorithm. -- -- {-# LANGUAGE BangPatterns #-} @@ -13,7 +13,7 @@ module Crypto.MAC.HMAC ( hmac , HMAC(..) - -- * incremental + -- * Incremental , Context(..) , initialize , update diff --git a/Crypto/Math/Polynomial.hs b/Crypto/Math/Polynomial.hs index 133dca3..84e67e9 100644 --- a/Crypto/Math/Polynomial.hs +++ b/Crypto/Math/Polynomial.hs @@ -8,7 +8,7 @@ module Crypto.Math.Polynomial ( Monomial(..) - -- * polynomial operations + -- * Polynomial operations , Polynomial , toList , fromList diff --git a/Crypto/Number/Basic.hs b/Crypto/Number/Basic.hs index 75de3ed..52b6e4e 100644 --- a/Crypto/Number/Basic.hs +++ b/Crypto/Number/Basic.hs @@ -17,8 +17,8 @@ module Crypto.Number.Basic import Crypto.Number.Compat --- | sqrti returns two integer (l,b) so that l <= sqrt i <= b --- the implementation is quite naive, use an approximation for the first number +-- | @sqrti@ returns two integers @(l,b)@ so that @l <= sqrt i <= b@. +-- The implementation is quite naive, use an approximation for the first number -- and use a dichotomy algorithm to compute the bound relatively efficiently. sqrti :: Integer -> (Integer, Integer) sqrti i @@ -49,7 +49,7 @@ sqrti i else iter (lb+d) ub sq a = a * a --- | get the extended GCD of two integer using integer divMod +-- | Get the extended GCD of two integer using integer divMod -- -- gcde 'a' 'b' find (x,y,gcd(a,b)) where ax + by = d -- @@ -63,7 +63,7 @@ gcde a b = onGmpUnsupported (gmpGcde a b) $ let (q, r) = a' `divMod` b' in f t (r, sa - (q * sb), ta - (q * tb)) --- | check if a list of integer are all even +-- | Check if a list of integer are all even areEven :: [Integer] -> Bool areEven = and . map even diff --git a/Crypto/Number/ModArithmetic.hs b/Crypto/Number/ModArithmetic.hs index ed18805..398c17c 100644 --- a/Crypto/Number/ModArithmetic.hs +++ b/Crypto/Number/ModArithmetic.hs @@ -9,10 +9,10 @@ module Crypto.Number.ModArithmetic ( - -- * exponentiation + -- * Exponentiation expSafe , expFast - -- * inverse computing + -- * Inverse computing , inverse , inverseCoprimes ) where @@ -64,7 +64,7 @@ expFast :: Integer -- ^ base -> Integer -- ^ result expFast b e m = gmpPowModInteger b e m `onGmpUnsupported` exponentiation b e m --- | exponentiation computes modular exponentiation as b^e mod m +-- | @exponentiation@ computes modular exponentiation as /b^e mod m/ -- using repetitive squaring. exponentiation :: Integer -> Integer -> Integer -> Integer exponentiation b e m @@ -75,7 +75,7 @@ exponentiation b e m in (p^(2::Integer)) `mod` m | otherwise = (b * exponentiation b (e-1) m) `mod` m --- | inverse computes the modular inverse as in g^(-1) mod m +-- | @inverse@ computes the modular inverse as in /g^(-1) mod m/. inverse :: Integer -> Integer -> Maybe Integer inverse g m = gmpInverse g m `onGmpUnsupported` v where @@ -84,12 +84,12 @@ inverse g m = gmpInverse g m `onGmpUnsupported` v | otherwise = Just (x `mod` m) (x,_,d) = gcde g m --- | Compute the modular inverse of 2 coprime numbers. +-- | Compute the modular inverse of two coprime numbers. -- This is equivalent to inverse except that the result -- is known to exists. -- --- if the numbers are not defined as coprime, this function --- will raise a CoprimesAssertionError. +-- If the numbers are not defined as coprime, this function +-- will raise a 'CoprimesAssertionError'. inverseCoprimes :: Integer -> Integer -> Integer inverseCoprimes g m = case inverse g m of diff --git a/Crypto/Number/Prime.hs b/Crypto/Number/Prime.hs index 10e0be0..19faaa9 100644 --- a/Crypto/Number/Prime.hs +++ b/Crypto/Number/Prime.hs @@ -31,10 +31,10 @@ import Crypto.Error import Data.Bits --- | returns if the number is probably prime. --- first a list of small primes are implicitely tested for divisibility, +-- | Returns if the number is probably prime. +-- First a list of small primes are implicitely tested for divisibility, -- then a fermat primality test is used with arbitrary numbers and --- then the Miller Rabin algorithm is used with an accuracy of 30 recursions +-- then the Miller Rabin algorithm is used with an accuracy of 30 recursions. isProbablyPrime :: Integer -> Bool isProbablyPrime !n | any (\p -> p `divides` n) (filter (< n) firstPrimes) = False @@ -42,14 +42,14 @@ isProbablyPrime !n | primalityTestFermat 50 (n `div` 2) n = primalityTestMillerRabin 30 n | otherwise = False --- | generate a prime number of the required bitsize (i.e. in the range --- [2^(b-1)+2^(b-2), 2^b)). +-- | Generate a prime number of the required bitsize (i.e. in the range +-- [2^(b-1)+2^(b-2), 2^b)). -- --- May throw a CryptoError_PrimeSizeInvalid if the requested size is less --- than 5 bits, as the smallest prime meeting these conditions is 29. --- This function requires that the two highest bits are set, so that when --- multiplied with another prime to create a key, it is guaranteed to be of --- the proper size. +-- May throw a 'CryptoError_PrimeSizeInvalid' if the requested size is less +-- than 5 bits, as the smallest prime meeting these conditions is 29. +-- This function requires that the two highest bits are set, so that when +-- multiplied with another prime to create a key, it is guaranteed to be of +-- the proper size. generatePrime :: MonadRandom m => Int -> m Integer generatePrime bits = do if bits < 5 then @@ -61,13 +61,13 @@ generatePrime bits = do return $ prime else generatePrime bits --- | generate a prime number of the form 2p+1 where p is also prime. +-- | Generate a prime number of the form 2p+1 where p is also prime. -- it is also knowed as a Sophie Germaine prime or safe prime. -- -- The number of safe prime is significantly smaller to the number of prime, -- as such it shouldn't be used if this number is supposed to be kept safe. -- --- May throw a CryptoError_PrimeSizeInvalid if the requested size is less than +-- May throw a 'CryptoError_PrimeSizeInvalid' if the requested size is less than -- 6 bits, as the smallest safe prime with the two highest bits set is 59. generateSafePrime :: MonadRandom m => Int -> m Integer generateSafePrime bits = do @@ -81,7 +81,7 @@ generateSafePrime bits = do return $ val else generateSafePrime bits --- | find a prime from a starting point where the property hold. +-- | Find a prime from a starting point where the property hold. findPrimeFromWith :: (Integer -> Bool) -> Integer -> Integer findPrimeFromWith prop !n | even n = findPrimeFromWith prop (n+1) @@ -93,7 +93,7 @@ findPrimeFromWith prop !n then n else findPrimeFromWith prop (n+2) --- | find a prime from a starting point with no specific property. +-- | Find a prime from a starting point with no specific property. findPrimeFrom :: Integer -> Integer findPrimeFrom n = case gmpNextPrime n of @@ -185,7 +185,7 @@ primalityTestNaive n isCoprime :: Integer -> Integer -> Bool isCoprime m n = case gcde m n of (_,_,d) -> d == 1 --- | list of the first primes till 2903.. +-- | List of the first primes till 2903. firstPrimes :: [Integer] firstPrimes = [ 2 , 3 , 5 , 7 , 11 , 13 , 17 , 19 , 23 , 29 diff --git a/Crypto/Number/Serialize.hs b/Crypto/Number/Serialize.hs index a37b9d5..9855c5b 100644 --- a/Crypto/Number/Serialize.hs +++ b/Crypto/Number/Serialize.hs @@ -5,7 +5,7 @@ -- Stability : experimental -- Portability : Good -- --- fast serialization primitives for integer +-- Fast serialization primitives for integer {-# LANGUAGE BangPatterns #-} module Crypto.Number.Serialize ( i2osp @@ -19,21 +19,21 @@ import Crypto.Internal.Compat (unsafeDoIO) import qualified Crypto.Internal.ByteArray as B import qualified Crypto.Number.Serialize.Internal as Internal --- | os2ip converts a byte string into a positive integer +-- | @os2ip@ converts a byte string into a positive integer. os2ip :: B.ByteArrayAccess ba => ba -> Integer os2ip bs = unsafeDoIO $ B.withByteArray bs (\p -> Internal.os2ip p (B.length bs)) --- | i2osp converts a positive integer into a byte string +-- | @i2osp@ converts a positive integer into a byte string. -- --- first byte is MSB (most significant byte), last byte is the LSB (least significant byte) +-- The first byte is MSB (most significant byte); the last byte is the LSB (least significant byte) i2osp :: B.ByteArray ba => Integer -> ba i2osp 0 = B.allocAndFreeze 1 (\p -> Internal.i2osp 0 p 1 >> return ()) i2osp m = B.allocAndFreeze sz (\p -> Internal.i2osp m p sz >> return ()) where !sz = numBytes m --- | just like i2osp, but take an extra parameter for size. --- if the number is too big to fit in @len@ bytes, 'Nothing' is returned +-- | Just like 'i2osp', but takes an extra parameter for size. +-- If the number is too big to fit in @len@ bytes, 'Nothing' is returned -- otherwise the number is padded with 0 to fit the @len@ required. i2ospOf :: B.ByteArray ba => Int -> Integer -> Maybe ba i2ospOf len m @@ -44,10 +44,10 @@ i2ospOf len m where !sz = numBytes m --- | just like i2ospOf except that it doesn't expect a failure: i.e. --- an integer larger than the number of output bytes requested +-- | Just like 'i2ospOf' except that it doesn't expect a failure: i.e. +-- an integer larger than the number of output bytes requested. -- --- for example if you just took a modulo of the number that represent +-- For example if you just took a modulo of the number that represent -- the size (example the RSA modulo n). i2ospOf_ :: B.ByteArray ba => Int -> Integer -> ba i2ospOf_ len = maybe (error "i2ospOf_: integer is larger than expected") id . i2ospOf len diff --git a/Crypto/Number/Serialize/Internal.hs b/Crypto/Number/Serialize/Internal.hs index 2b56bfd..2f86380 100644 --- a/Crypto/Number/Serialize/Internal.hs +++ b/Crypto/Number/Serialize/Internal.hs @@ -5,7 +5,7 @@ -- Stability : experimental -- Portability : Good -- --- fast serialization primitives for integer using raw pointers +-- Fast serialization primitives for integer using raw pointers {-# LANGUAGE BangPatterns #-} module Crypto.Number.Serialize.Internal ( i2osp @@ -21,12 +21,12 @@ import Data.Word (Word8) import Foreign.Ptr import Foreign.Storable --- | fill a pointer with the big endian binary representation of an integer +-- | Fill a pointer with the big endian binary representation of an integer -- --- if the room available @ptrSz is less than the number of bytes needed, +-- If the room available @ptrSz is less than the number of bytes needed, -- 0 is returned. Likewise if a parameter is invalid, 0 is returned. -- --- returns the number of bytes written +-- Returns the number of bytes written i2osp :: Integer -> Ptr Word8 -> Int -> IO Int i2osp m ptr ptrSz | ptrSz <= 0 = return 0 @@ -61,7 +61,7 @@ fillPtr p sz m = gmpExportInteger m p `onGmpUnsupported` export (sz-1) m pokeByteOff p ofs (fromIntegral b :: Word8) export (ofs-1) i' --- | transform a big endian binary integer representation pointed by a pointer and a size +-- | Transform a big endian binary integer representation pointed by a pointer and a size -- into an integer os2ip :: Ptr Word8 -> Int -> IO Integer os2ip ptr ptrSz diff --git a/Crypto/PubKey/Curve25519.hs b/Crypto/PubKey/Curve25519.hs index e3416c8..720ff9a 100644 --- a/Crypto/PubKey/Curve25519.hs +++ b/Crypto/PubKey/Curve25519.hs @@ -18,7 +18,7 @@ module Crypto.PubKey.Curve25519 , dhSecret , publicKey , secretKey - -- * methods + -- * Methods , dh , toPublic , generateSecretKey diff --git a/Crypto/PubKey/Curve448.hs b/Crypto/PubKey/Curve448.hs index 95feaf3..bc83fb9 100644 --- a/Crypto/PubKey/Curve448.hs +++ b/Crypto/PubKey/Curve448.hs @@ -21,7 +21,7 @@ module Crypto.PubKey.Curve448 , dhSecret , publicKey , secretKey - -- * methods + -- * Methods , dh , toPublic , generateSecretKey diff --git a/Crypto/PubKey/DSA.hs b/Crypto/PubKey/DSA.hs index 1587c46..1b91598 100644 --- a/Crypto/PubKey/DSA.hs +++ b/Crypto/PubKey/DSA.hs @@ -14,13 +14,13 @@ module Crypto.PubKey.DSA , PrivateKey(..) , PublicNumber , PrivateNumber - -- * generation + -- * Generation , generatePrivate , calculatePublic - -- * signature primitive + -- * Signature primitive , sign , signWith - -- * verification primitive + -- * Verification primitive , verify -- * Key pair , KeyPair(..) diff --git a/Crypto/PubKey/ECC/P256.hs b/Crypto/PubKey/ECC/P256.hs index 1409c91..f1d8c32 100644 --- a/Crypto/PubKey/ECC/P256.hs +++ b/Crypto/PubKey/ECC/P256.hs @@ -14,7 +14,7 @@ module Crypto.PubKey.ECC.P256 ( Scalar , Point - -- * point arithmetic + -- * Point arithmetic , pointBase , pointAdd , pointMul @@ -27,7 +27,7 @@ module Crypto.PubKey.ECC.P256 , pointToBinary , pointFromBinary , unsafePointFromBinary - -- * scalar arithmetic + -- * Scalar arithmetic , scalarGenerate , scalarZero , scalarIsZero diff --git a/Crypto/PubKey/ECC/Types.hs b/Crypto/PubKey/ECC/Types.hs index 8f6a070..4f34f2e 100644 --- a/Crypto/PubKey/ECC/Types.hs +++ b/Crypto/PubKey/ECC/Types.hs @@ -6,7 +6,7 @@ -- Stability : Experimental -- Portability : Excellent -- --- references: +-- References: -- -- module Crypto.PubKey.ECC.Types @@ -21,7 +21,7 @@ module Crypto.PubKey.ECC.Types , ecc_fx , ecc_p , CurveCommon(..) - -- * recommended curves definition + -- * Recommended curves definition , CurveName(..) , getCurveByName ) where diff --git a/Crypto/PubKey/Ed25519.hs b/Crypto/PubKey/Ed25519.hs index 9656e56..42b604c 100644 --- a/Crypto/PubKey/Ed25519.hs +++ b/Crypto/PubKey/Ed25519.hs @@ -21,7 +21,7 @@ module Crypto.PubKey.Ed25519 , signature , publicKey , secretKey - -- * methods + -- * Methods , toPublic , sign , verify diff --git a/Crypto/PubKey/Ed448.hs b/Crypto/PubKey/Ed448.hs index 726f61b..d2d6b6d 100644 --- a/Crypto/PubKey/Ed448.hs +++ b/Crypto/PubKey/Ed448.hs @@ -25,7 +25,7 @@ module Crypto.PubKey.Ed448 , signature , publicKey , secretKey - -- * methods + -- * Methods , toPublic , sign , verify diff --git a/Crypto/PubKey/ElGamal.hs b/Crypto/PubKey/ElGamal.hs index ea2133b..33c6a0f 100644 --- a/Crypto/PubKey/ElGamal.hs +++ b/Crypto/PubKey/ElGamal.hs @@ -19,17 +19,17 @@ module Crypto.PubKey.ElGamal , EphemeralKey(..) , SharedKey , Signature - -- * generation + -- * Generation , generatePrivate , generatePublic - -- * encryption and decryption with no scheme + -- * Encryption and decryption with no scheme , encryptWith , encrypt , decrypt - -- * signature primitives + -- * Signature primitives , signWith , sign - -- * verification primitives + -- * Verification primitives , verify ) where diff --git a/Crypto/PubKey/RSA.hs b/Crypto/PubKey/RSA.hs index 3464d11..eea7070 100644 --- a/Crypto/PubKey/RSA.hs +++ b/Crypto/PubKey/RSA.hs @@ -10,7 +10,7 @@ module Crypto.PubKey.RSA , PublicKey(..) , PrivateKey(..) , Blinder(..) - -- * generation function + -- * Generation function , generateWith , generate , generateBlinder diff --git a/Crypto/PubKey/RSA/PKCS15.hs b/Crypto/PubKey/RSA/PKCS15.hs index a6c7286..d3b9311 100644 --- a/Crypto/PubKey/RSA/PKCS15.hs +++ b/Crypto/PubKey/RSA/PKCS15.hs @@ -7,19 +7,19 @@ -- module Crypto.PubKey.RSA.PKCS15 ( - -- * padding and unpadding + -- * Padding and unpadding pad , padSignature , unpad - -- * private key operations + -- * Private key operations , decrypt , decryptSafer , sign , signSafer - -- * public key operations + -- * Public key operations , encrypt , verify - -- * hash ASN1 description + -- * Hash ASN1 description , HashAlgorithmASN1 ) where diff --git a/Crypto/PubKey/RSA/Prim.hs b/Crypto/PubKey/RSA/Prim.hs index 7691765..1f437f5 100644 --- a/Crypto/PubKey/RSA/Prim.hs +++ b/Crypto/PubKey/RSA/Prim.hs @@ -7,9 +7,9 @@ -- module Crypto.PubKey.RSA.Prim ( - -- * decrypt primitive + -- * Decrypt primitive dp - -- * encrypt primitive + -- * Encrypt primitive , ep ) where diff --git a/Crypto/Random/Entropy/RDRand.hs b/Crypto/Random/Entropy/RDRand.hs index d3d3866..275aac2 100644 --- a/Crypto/Random/Entropy/RDRand.hs +++ b/Crypto/Random/Entropy/RDRand.hs @@ -21,7 +21,7 @@ foreign import ccall unsafe "cryptonite_cpu_has_rdrand" foreign import ccall unsafe "cryptonite_get_rand_bytes" c_get_rand_bytes :: Ptr Word8 -> CInt -> IO CInt --- | fake handle to Intel RDRand entropy cpu instruction +-- | Fake handle to Intel RDRand entropy CPU instruction data RDRand = RDRand instance EntropySource RDRand where diff --git a/Crypto/Random/Entropy/Source.hs b/Crypto/Random/Entropy/Source.hs index 49d7f61..cb76ab8 100644 --- a/Crypto/Random/Entropy/Source.hs +++ b/Crypto/Random/Entropy/Source.hs @@ -13,10 +13,10 @@ import Data.Word (Word8) -- | A handle to an entropy maker, either a system capability -- or a hardware generator. class EntropySource a where - -- | try to open an handle for this source + -- | Try to open an handle for this source entropyOpen :: IO (Maybe a) - -- | try to gather a number of entropy bytes into a buffer. - -- return the number of actual bytes gathered + -- | Try to gather a number of entropy bytes into a buffer. + -- Return the number of actual bytes gathered entropyGather :: a -> Ptr Word8 -> Int -> IO Int -- | Close an open handle entropyClose :: a -> IO () diff --git a/Crypto/Random/Entropy/Unix.hs b/Crypto/Random/Entropy/Unix.hs index e08fe78..9a7400c 100644 --- a/Crypto/Random/Entropy/Unix.hs +++ b/Crypto/Random/Entropy/Unix.hs @@ -22,10 +22,10 @@ import System.IO type H = Handle type DeviceName = String --- | Entropy device /dev/random on unix system +-- | Entropy device @/dev/random@ on unix system newtype DevRandom = DevRandom DeviceName --- | Entropy device /dev/urandom on unix system +-- | Entropy device @/dev/urandom@ on unix system newtype DevURandom = DevURandom DeviceName instance EntropySource DevRandom where diff --git a/Crypto/Random/Entropy/Unsafe.hs b/Crypto/Random/Entropy/Unsafe.hs index 5770dc0..672e9c2 100644 --- a/Crypto/Random/Entropy/Unsafe.hs +++ b/Crypto/Random/Entropy/Unsafe.hs @@ -16,8 +16,8 @@ import Crypto.Random.Entropy.Backend -- | Refill the entropy in a buffer -- --- call each entropy backend in turn until the buffer has --- been replenish. +-- Call each entropy backend in turn until the buffer has +-- been replenished. -- -- If the buffer cannot be refill after 3 loopings, this will raise -- an User Error exception diff --git a/Crypto/Random/Entropy/Windows.hs b/Crypto/Random/Entropy/Windows.hs index 806a0d3..1fbad39 100644 --- a/Crypto/Random/Entropy/Windows.hs +++ b/Crypto/Random/Entropy/Windows.hs @@ -5,7 +5,7 @@ -- Stability : experimental -- Portability : Good -- --- code originally from the entropy package and thus is: +-- Code originally from the entropy package and thus is: -- Copyright (c) Thomas DuBuisson. -- {-# LANGUAGE ForeignFunctionInterface #-} @@ -26,7 +26,7 @@ import System.Win32.Types (getLastError) import Crypto.Random.Entropy.Source --- | handle to windows crypto API for random generation +-- | Handle to Windows crypto API for random generation data WinCryptoAPI = WinCryptoAPI instance EntropySource WinCryptoAPI where diff --git a/Crypto/Random/Probabilistic.hs b/Crypto/Random/Probabilistic.hs index 9dfc733..176427f 100644 --- a/Crypto/Random/Probabilistic.hs +++ b/Crypto/Random/Probabilistic.hs @@ -20,7 +20,7 @@ import Crypto.Random -- This is useful for probabilistic algorithm like Miller Rabin -- probably prime algorithm, given appropriate choice of the heuristic -- --- Generally, it's advise not to use this function. +-- Generally, it's advised not to use this function. probabilistic :: MonadPseudoRandom ChaChaDRG a -> a probabilistic f = fst $ withDRG drg f where {-# NOINLINE drg #-}