From 8f500ba16efbb0c1d27de38de33c8957ec0fe7f7 Mon Sep 17 00:00:00 2001 From: Nils Schweinsberg Date: Sun, 3 Oct 2010 22:57:31 +0200 Subject: [PATCH] Removing Crypto dependency Moving required modules into our own src directory --- CryptoReadMe.tex | 374 +++++++++++++++++++++++++++++++++ happstack-auth.cabal | 12 +- src/Codec/Utils.hs | 147 +++++++++++++ src/Data/Digest/SHA2.hs | 303 ++++++++++++++++++++++++++ src/Data/Digest/SHA512.hs | 26 +++ src/Happstack/Auth/Internal.hs | 4 +- 6 files changed, 862 insertions(+), 4 deletions(-) create mode 100644 CryptoReadMe.tex create mode 100644 src/Codec/Utils.hs create mode 100644 src/Data/Digest/SHA2.hs create mode 100644 src/Data/Digest/SHA512.hs diff --git a/CryptoReadMe.tex b/CryptoReadMe.tex new file mode 100644 index 0000000..2a34aaa --- /dev/null +++ b/CryptoReadMe.tex @@ -0,0 +1,374 @@ +\documentclass{article} + +\usepackage{listings} +\usepackage{a4} +\usepackage{courier} +\usepackage{hyperref} +\usepackage{html} + + +\lstdefinelanguage{ASN1} { + morekeywords={}, + sensitive=false, + morecomment=[s]{(--}{--)} + } + +\lstdefinelanguage{shell} { + sensitive=true + } + +\setlength{\parskip}{\medskipamount} +\setlength{\parindent}{0pt} + +\title{Haskell Cryptographic Library 4.2.0} +\author{Dominic Steinitz} + +\begin{document} + +\maketitle + +The +\htmladdnormallinkfoot +{Haskell Cryptographic Library 4.2.0} +{http://www.haskell.org/crypto} +collects together existing Haskell cryptographic +functions into one cabalized package, together with HUnit tests, +QuickCheck property tests and examples. It is a significant +change from previous versions and now only contains cryptographic +functions; the functions for dealing with ASN.1, X.509 certificates +and PKCS\#8 will be provided by an entirely separate library reducing +the number of dependencies. + +This release contains: +\begin{itemize} +\item DES +\item Blowfish +\item AES +\item TEA +\item Cipher Block Chaining (CBC) +\item PKCS\#5 and nulls padding +\item SHA-1 +\item MD5 +\item RSA +\end{itemize} + +Haddock documentation for the library is available +\htmladdnormallinkfoot +{here} +{http://www.haskell.org/crypto/doc/html} +. + +\section{System Requirements} + +\begin{itemize} +\item +The code has been tested on GHC 6.6 and Hugs Version September 2006. +It does not currently work with YHC because of the lack of {\tt Data.Word} +and {\tt Data.Bits}. +\item +It {\em no longer} requires the use of +{\tt NewBinary.Binary}. +\end{itemize} + +\section{Installation Instructions} + +Get the sources: + +\lstset{language=shell,basicstyle=\ttfamily\small} +\begin{lstlisting}[frame=single] +darcs get --tag "4.2.0" http://code.haskell.org/crypto +\end{lstlisting} + +Build and install ready for testing: + +\begin{lstlisting}[frame=single] +ghc -o Setup Setup.hs -package Cabal +./Setup configure --prefix=/my/chosen/dir +./Setup build +./Setup install --user +\end{lstlisting} + +Run the tests. + +\begin{lstlisting}[frame=single] +cd /my/chosen/dir/bin +./RSATest +./SymmetricTest +./QuickTest +\end{lstlisting} + +You can now run the examples to confirm further that everything +is working satisfactorily. +When you are happy, build and install them in +their final destination: + +\begin{lstlisting}[frame=single] +./Setup unregister --user +./Setup clean +./Setup configure +./Setup build +./Setup install +\end{lstlisting} + +\section{To Do} + +In no particular order: + +\begin{itemize} +\item +Incorporate other symmetric key algorithms already coded in Haskell. +\item +Performance analysis as Blowfish ought to run more quickly than DES. +\item +Other modes / padding schemes. +\item +Extend typechecking to ensure that only the appropriate key sizes are used +for a given algorithm. +\item +Improve performance, for example, for SHA1. This +\htmladdnormallinkfoot +{code} +{http://www.abridgegame.org/repos/darcs-unstable} +runs an order of magnitude faster but, with respect to the authors, doesn't +feel that functional. +\item +Get rid of the GPL code. +\end{itemize} + +\section{Contact} + +All questions, comments, bug reports, flames, requests for +updates / changes and suggestions should be directed to Dominic Steinitz and +logged +\htmladdnormallinkfoot +{here} +{http://hackage.haskell.org/trac/crypto} +. +\section{Licensing} + +The modules in the library come from different authors and have been +released under different licences. + +\subsection{Contributors} + +\subsubsection{Codec.Binary} +\begin{tabular}{|p{6cm}|p{3cm}|p{3cm}|p{1cm}|} +\hline\hline +Codec.Binary.BubbleBabble & John Meacham & +Copyright \copyright\ 2008, All rights reserved & BSD \\ +\hline\hline +\end{tabular} + +\subsubsection{Codec.Text} +\begin{tabular}{|p{6cm}|p{3cm}|p{3cm}|p{1cm}|} +\hline\hline +Codec.Text.Raw & Dominic Steinitz & +Copyright \copyright\ 2006, All rights reserved & BSD \\ +\hline\hline +\end{tabular} + +\subsubsection{Codec.Encryption} +\begin{tabular}{|p{6cm}|p{3cm}|p{3cm}|p{1cm}|} +\hline\hline +Codec.Encryption.AES & Lukasz Anforowicz & +Copyright \copyright\ 2005, All rights reserved & BSD \\ +\hline +Codec.Encryption.AESAux & Dominic Steinitz & +Copyright \copyright\ 2005, All rights reserved & BSD \\ +\hline +Codec.Encryption.Blowfish & Doug Hoyte & +Copyright \copyright\ 2005, All rights reserved & BSD \\ +\hline +Codec.Encryption.BlowfishAux & Dominic Steinitz & +Copyright \copyright\ 2005, All rights reserved & BSD \\ +\hline +Codec.Encryption.TEA & John Meacham & +Copyright \copyright\ 2008, All rights reserved & BSD \\ +\hline +Codec.Encryption.DES & Ian Lynagh & +Copyright \copyright\ 2005, All rights reserved & BSD \\ +\hline +Codec.Encryption.DESAux & Dominic Steinitz & +Copyright \copyright\ 2005, All rights reserved & BSD \\ +\hline +Codec.Encryption.Modes & Dominic Steinitz & +Copyright \copyright\ 2005, All rights reserved & BSD \\ +\hline +Codec.Encryption.Padding & Dominic Steinitz & +Copyright \copyright\ 2005, All rights reserved & BSD \\ +\hline +Codec.Encryption.RSA & David Sankel & +Copyright \copyright\ 2005, All rights reserved & GPL \\ +\hline +Codec.Encryption.RSA.EMEOAEP & David Sankel & +Copyright \copyright\ 2005, All rights reserved & GPL \\ +\hline +Codec.Encryption.RSA.MGF & Dominic Steinitz & +Copyright \copyright\ 2005, All rights reserved & BSD \\ +\hline +Codec.Encryption.RSA.NumberTheory & David Sankel & +Copyright \copyright\ 2005, All rights reserved & GPL \\ +\hline\hline +\end{tabular} + +\subsubsection{Codec} +\begin{tabular}{|p{6cm}|p{3cm}|p{3cm}|p{1cm}|} +\hline\hline +Codec.Utils & Dominic Steinitz & +Copyright \copyright\ 2005, All rights reserved & BSD \\ +\hline\hline +\end{tabular} + +\subsubsection{Data.Digest} +\begin{tabular}{|p{6cm}|p{3cm}|p{3cm}|p{1cm}|} +\hline\hline +Data.Digest.MD5 & Dominic Steinitz & +Copyright \copyright\ 2005, All rights reserved & BSD \\ +\hline +Data.Digest.MD5Aux & Ian Lynagh & +Copyright \copyright\ 2005, All rights reserved & BSD \\ +\hline +Data.Digest.SHA1 & Dominic Steinitz & +Copyright \copyright\ 2005, All rights reserved & BSD \\ +\hline\hline +\end{tabular} + +\subsubsection{Data} +\begin{tabular}{|p{6cm}|p{3cm}|p{3cm}|p{1cm}|} +\hline\hline +Data.LargeWord +& Dominic Steinitz & +Copyright \copyright\ 2005, All rights reserved & BSD \\ +\hline\hline +\end{tabular} + +\subsubsection{Tests and Examples} +\begin{tabular}{|p{6cm}|p{3cm}|p{3cm}|p{1cm}|} +\hline\hline +RSATest +& Dominic Steinitz & +Copyright \copyright\ 2005, All rights reserved & BSD \\ +\hline +QuickTest +& Dominic Steinitz & +Copyright \copyright\ 2005, All rights reserved & BSD \\ +\hline +SymmetricTest +& Dominic Steinitz & +Copyright \copyright\ 2005, All rights reserved & BSD \\ +\hline\hline +\end{tabular} + +\subsection{The BSD License} + +This license is based on +\htmladdnormallinkfoot +{The BSD License} +{http://www.opensource.org/licenses/bsd-license.php}. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +\begin{itemize} +\item +Redistributions of source code must retain the above copyright notice, +this list of conditions and the following disclaimer. +\item +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. +\item +The names of its contributors may not be used to endorse or promote +products derived from this software without specific prior written permission. +\end{itemize} + +\begin{sc} +This software is provided by the copyright holders and 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 copyright onwers 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. +\end{sc} + +\subsection{The GNU General Public License (GPL)} + +This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. + +This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. + +You can find a copy of +the GNU General Public License +\htmladdnormallinkfoot +{here} +{http://www.opensource.org/licenses/gpl-license.php} +; +if not, write to the Free Software Foundation, Inc., 59 Temple Place, +Suite 330, Boston, MA 02111-1307 USA + +\section{Disclaimer} +Cryptography is a notoriously easy area in which to make mistakes, +not necessarily with the algorithms but with how they are implemented +(for example not protecting keys, using weak keys and so on). +For a readable account of some of the pitfalls, see +\htmladdnormallinkfoot +{Ross Anderson} +{http://www.cl.cam.ac.uk/users/rja14/} +'s book. + +\begin{sc} +This software is provided by the copyright holders and 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 copyright onwers 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. +\end{sc} + +\section{Acknowledgements} + +\begin{itemize} +\item +Doug Hoyte (HardCore SoftWare) +\item +Anatoly Zaretsky +\item +\htmladdnormallinkfoot + {Ian Lynagh} + {http://web.comlab.ox.ac.uk/oucl/work/ian.lynagh} +\item +\htmladdnormallinkfoot + {David Sankel} + {http://www.electronconsulting.com/whois.html} +\item +\htmladdnormallinkfoot +{Ross Paterson} +{http://www.soi.city.ac.uk/~ross} +\item +Lukasz Anforowicz +\item +\htmladdnormallinkfoot +{Warrick Gray} +{http://homepages.paradise.net.nz/warrickg/haskell/http/} +\item +\htmladdnormallinkfoot +{Russell O'Connor} +{http://r6.ca} +\item +Spencer Janssen +\end{itemize} + +This document was last updated on 7th December 2008. +\copyright\ 2006--2008 Dominic Steinitz. + +\end{document} diff --git a/happstack-auth.cabal b/happstack-auth.cabal index 67544a3..cd5b29b 100644 --- a/happstack-auth.cabal +++ b/happstack-auth.cabal @@ -1,5 +1,5 @@ Name: happstack-auth -Version: 0.2 +Version: 0.2.1 License: BSD3 License-File: LICENSE Author: Nils Schweinsberg @@ -14,6 +14,10 @@ Homepage: http://n-sch.de/happstack-auth Build-Type: Simple Cabal-Version: >= 1.8 +Source-Repository head + type: git + location: http://github.com/mcmaniac/happstack-auth + Library HS-Source-Dirs: src @@ -31,7 +35,6 @@ Library happstack-server == 0.5.*, happstack-ixset == 0.5.*, happstack-data == 0.5.*, - Crypto == 4.*, convertible == 1.* Exposed-Modules: @@ -40,6 +43,11 @@ Library Happstack.Auth.Internal.Data Other-Modules: + + Codec.Utils + Data.Digest.SHA2 + Data.Digest.SHA512 + Happstack.Auth.Internal.Data.AuthState Happstack.Auth.Internal.Data.SaltedHash Happstack.Auth.Internal.Data.SessionData diff --git a/src/Codec/Utils.hs b/src/Codec/Utils.hs new file mode 100644 index 0000000..bb928d0 --- /dev/null +++ b/src/Codec/Utils.hs @@ -0,0 +1,147 @@ +{-# OPTIONS -fno-warn-type-defaults -fno-warn-name-shadowing + -fno-warn-missing-signatures #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Codec.Utils +-- Copyright : (c) Dominic Steinitz 2003 +-- License : BSD-style (see the file CryptoReadMe.tex) +-- +-- Maintainer : dominic.steinitz@blueyonder.co.uk +-- Stability : experimental +-- Portability : portable +-- +-- Utilities for coding and decoding. +-- +----------------------------------------------------------------------------- + +module Codec.Utils ( + -- * Types and Constants + Octet, + -- msb, + -- * Octet Conversion Functions + -- fromTwosComp, toTwosComp, + -- toOctets, + -- fromOctets, + -- listFromOctets, + listToOctets, + -- i2osp + ) where + +import Data.Word +import Data.Bits + +-- powersOf n = 1 : (map (*n) (powersOf n)) + +toBase x = + map fromIntegral . + reverse . + map (flip mod x) . + takeWhile (/=0) . + iterate (flip div x) + +-- | Take a number a convert it to base n as a list of octets. + +toOctets :: (Integral a, Integral b) => a -> b -> [Octet] +toOctets n x = (toBase n . fromIntegral) x + +-- | This is used to (approximately) get back to a starting word list. +-- For example, if you have a list of 3 Word8 and try to convert them to +-- a Word32, the Word32 will get null-padded, and without correction, you +-- will get 4 Word8s when converting back. This corrects it. +-- Unfortunately, it also means you will have errors if trying to convert +-- Word8 lists with nulls on the end. +trimNulls :: [Word8] -> [Word8] +trimNulls = reverse . (dropWhile (== 0)) . reverse + +-- | Converts a list of numbers into a list of octets. +-- The resultant list has nulls trimmed from the end to make this the dual +-- of listFromOctets (except when the original octet list ended with nulls; +-- see 'trimNulls'). +listToOctets :: (Bits a, Integral a) => [a] -> [Octet] +listToOctets x = trimNulls $ concat paddedOctets where + paddedOctets :: [[Octet]] + paddedOctets = map (padTo bytes) rawOctets + rawOctets :: [[Octet]] + rawOctets = map (reverse . toOctets 256) x + padTo :: Int -> [Octet] -> [Octet] + padTo x y = take x $ y ++ repeat 0 + bytes :: Int + bytes = bitSize (head x) `div` 8 + +-- | The basic type for encoding and decoding. + +type Octet = Word8 + +{- + +-- | The most significant bit of an 'Octet'. + +msb :: Int +msb = bitSize (undefined::Octet) - 1 + +-- | Take a list of octets (a number expressed in base n) and convert it +-- to a number. + +fromOctets :: (Integral a, Integral b) => a -> [Octet] -> b +fromOctets n x = + fromIntegral $ + sum $ + zipWith (*) (powersOf n) (reverse (map fromIntegral x)) + +-- | See 'listToOctets'. +listFromOctets :: (Integral a, Bits a) => [Octet] -> [a] +listFromOctets [] = [] +listFromOctets x = result where + result = first : rest + first = fromOctets 256 first' + first' = reverse $ take bytes x + rest = listFromOctets $ drop bytes x + bytes = bitSize first `div` 8 + +-- | Take the length of the required number of octets and convert the +-- number to base 256 padding it out to the required length. If the +-- required length is less than the number of octets of the converted +-- number then return the converted number. NB this is different from +-- the standard +-- but mimics how replicate behaves. + +i2osp :: Integral a => Int -> a -> [Octet] +i2osp l y = + pad ++ z + where + pad = replicate (l - unPaddedLen) (0x00::Octet) + z = toOctets 256 y + unPaddedLen = length z + +-- | Convert from twos complement. + +fromTwosComp :: Integral a => [Octet] -> a +fromTwosComp x = conv x + where conv [] = 0 + conv w@(x:xs) = if (testBit x msb) + then neg w + else pos w + neg w@(x:xs) = let z=(clearBit x msb):xs in + fromIntegral((fromOctets 256 z)- + (128*(256^((length w)-1)))) + pos w = fromIntegral(fromOctets 256 w) + +toTwosComp :: Integral a => a -> [Octet] +toTwosComp x + | x < 0 = reverse . plusOne . reverse . (map complement) $ u + | x == 0 = [0x00] + | otherwise = u + where z@(y:ys) = toBase 256 (abs x) + u = if testBit y msb + then 0x00:z + else z + +plusOne :: [Octet] -> [Octet] +plusOne [] = [1] +plusOne (x:xs) = + if x == 0xff + then 0x00:(plusOne xs) + else (x+1):xs + +-} diff --git a/src/Data/Digest/SHA2.hs b/src/Data/Digest/SHA2.hs new file mode 100644 index 0000000..7a348c0 --- /dev/null +++ b/src/Data/Digest/SHA2.hs @@ -0,0 +1,303 @@ +{-# OPTIONS_GHC -funbox-strict-fields -fno-warn-incomplete-patterns + -fno-warn-missing-signatures -fno-warn-name-shadowing #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Digest.SHA2 +-- Copyright : (c) Russell O'Connor 2006 +-- License : BSD-style (see the file CryptoReadMe.tex) +-- +-- Implements SHA-256, SHA-384, SHA-512, and SHA-224 as defined in FIPS 180-2 +-- . +-- +----------------------------------------------------------------------------- + +module Data.Digest.SHA2 + ( sha512 + , toOctets + -- , sha256, sha256Ascii, Hash256 + -- , sha512Ascii, Hash512 + -- , sha384, sha384Ascii, Hash384 + -- , sha224, sha224Ascii, Hash224 + ) where + +import Data.Word +import Data.Bits +import Data.List +import Numeric +-- import Test.HUnit + +ch x y z = (x .&. y) `xor` (complement x .&. z) +maj x y z = (x .&. y) `xor` (x .&. z) `xor` (y .&. z) + +class (Bits w) => ShaData w where + bigSigma0 :: w -> w + bigSigma1 :: w -> w + smallSigma0 :: w -> w + smallSigma1 :: w -> w + ks :: [w] + +instance ShaData Word32 where + bigSigma0 x = rotateR x 2 `xor` rotateR x 13 `xor` rotateR x 22 + bigSigma1 x = rotateR x 6 `xor` rotateR x 11 `xor` rotateR x 25 + smallSigma0 x = rotateR x 7 `xor` rotateR x 18 `xor` shiftR x 3 + smallSigma1 x = rotateR x 17 `xor` rotateR x 19 `xor` shiftR x 10 + ks = + [0x428a2f98, 0x71374491, 0xb5c0fbcf, 0xe9b5dba5, 0x3956c25b, 0x59f111f1, 0x923f82a4, 0xab1c5ed5 + ,0xd807aa98, 0x12835b01, 0x243185be, 0x550c7dc3, 0x72be5d74, 0x80deb1fe, 0x9bdc06a7, 0xc19bf174 + ,0xe49b69c1, 0xefbe4786, 0x0fc19dc6, 0x240ca1cc, 0x2de92c6f, 0x4a7484aa, 0x5cb0a9dc, 0x76f988da + ,0x983e5152, 0xa831c66d, 0xb00327c8, 0xbf597fc7, 0xc6e00bf3, 0xd5a79147, 0x06ca6351, 0x14292967 + ,0x27b70a85, 0x2e1b2138, 0x4d2c6dfc, 0x53380d13, 0x650a7354, 0x766a0abb, 0x81c2c92e, 0x92722c85 + ,0xa2bfe8a1, 0xa81a664b, 0xc24b8b70, 0xc76c51a3, 0xd192e819, 0xd6990624, 0xf40e3585, 0x106aa070 + ,0x19a4c116, 0x1e376c08, 0x2748774c, 0x34b0bcb5, 0x391c0cb3, 0x4ed8aa4a, 0x5b9cca4f, 0x682e6ff3 + ,0x748f82ee, 0x78a5636f, 0x84c87814, 0x8cc70208, 0x90befffa, 0xa4506ceb, 0xbef9a3f7, 0xc67178f2] + +instance ShaData Word64 where + bigSigma0 x = rotateR x 28 `xor` rotateR x 34 `xor` rotateR x 39 + bigSigma1 x = rotateR x 14 `xor` rotateR x 18 `xor` rotateR x 41 + smallSigma0 x = rotateR x 1 `xor` rotateR x 8 `xor` shiftR x 7 + smallSigma1 x = rotateR x 19 `xor` rotateR x 61 `xor` shiftR x 6 + ks = + [0x428a2f98d728ae22, 0x7137449123ef65cd, 0xb5c0fbcfec4d3b2f, 0xe9b5dba58189dbbc + ,0x3956c25bf348b538, 0x59f111f1b605d019, 0x923f82a4af194f9b, 0xab1c5ed5da6d8118 + ,0xd807aa98a3030242, 0x12835b0145706fbe, 0x243185be4ee4b28c, 0x550c7dc3d5ffb4e2 + ,0x72be5d74f27b896f, 0x80deb1fe3b1696b1, 0x9bdc06a725c71235, 0xc19bf174cf692694 + ,0xe49b69c19ef14ad2, 0xefbe4786384f25e3, 0x0fc19dc68b8cd5b5, 0x240ca1cc77ac9c65 + ,0x2de92c6f592b0275, 0x4a7484aa6ea6e483, 0x5cb0a9dcbd41fbd4, 0x76f988da831153b5 + ,0x983e5152ee66dfab, 0xa831c66d2db43210, 0xb00327c898fb213f, 0xbf597fc7beef0ee4 + ,0xc6e00bf33da88fc2, 0xd5a79147930aa725, 0x06ca6351e003826f, 0x142929670a0e6e70 + ,0x27b70a8546d22ffc, 0x2e1b21385c26c926, 0x4d2c6dfc5ac42aed, 0x53380d139d95b3df + ,0x650a73548baf63de, 0x766a0abb3c77b2a8, 0x81c2c92e47edaee6, 0x92722c851482353b + ,0xa2bfe8a14cf10364, 0xa81a664bbc423001, 0xc24b8b70d0f89791, 0xc76c51a30654be30 + ,0xd192e819d6ef5218, 0xd69906245565a910, 0xf40e35855771202a, 0x106aa07032bbd1b8 + ,0x19a4c116b8d2d0c8, 0x1e376c085141ab53, 0x2748774cdf8eeb99, 0x34b0bcb5e19b48a8 + ,0x391c0cb3c5c95a63, 0x4ed8aa4ae3418acb, 0x5b9cca4f7763e373, 0x682e6ff3d6b2b8a3 + ,0x748f82ee5defb2fc, 0x78a5636f43172f60, 0x84c87814a1f0ab72, 0x8cc702081a6439ec + ,0x90befffa23631e28, 0xa4506cebde82bde9, 0xbef9a3f7b2c67915, 0xc67178f2e372532b + ,0xca273eceea26619c, 0xd186b8c721c0c207, 0xeada7dd6cde0eb1e, 0xf57d4f7fee6ed178 + ,0x06f067aa72176fba, 0x0a637dc5a2c898a6, 0x113f9804bef90dae, 0x1b710b35131c471b + ,0x28db77f523047d84, 0x32caab7b40c72493, 0x3c9ebe0a15c9bebc, 0x431d67c49c100d4c + ,0x4cc5d4becb3e42b6, 0x597f299cfc657e2a, 0x5fcb6fab3ad6faec, 0x6c44198c4a475817] + +blockSize = 16 + +----------------------------------------------------------------------------- +-- | 'padding' currently requires that the bitSize of @a@ divide the bitSize +-- of @w@ +----------------------------------------------------------------------------- +padding :: (ShaData w, Bits a, Integral a) => [a] -> [[w]] +padding x = unfoldr block $ paddingHelper x 0 (0::Int) (0::Integer) + where + block [] = Nothing + block x = Just $ splitAt blockSize x + paddingHelper x o on n | on == (bitSize o) = o:paddingHelper x 0 0 n + paddingHelper (x:xs) o on n | on < (bitSize o) = + paddingHelper xs ((shiftL o bs) .|. (fromIntegral x)) (on+bs) $! (n+fromIntegral bs) + where + bs = bitSize x + paddingHelper [] o on n = (shiftL (shiftL o 1 .|. 1) (bso-on-1)): + (zeros ((-(fromIntegral n-on+3*bso)) `mod` (blockSize*bso))) + [fromIntegral (shiftR n bso), fromIntegral n] + where + bso = bitSize o + zeros 0 = id + zeros n | 0 < n = let z=0 in (z:) . (zeros (n-bitSize z)) + +data Hash8 w = Hash8 !w !w !w !w !w !w !w !w deriving (Eq, Ord) + +-- type Hash256 = Hash8 Word32 +type Hash512 = Hash8 Word64 + +data Hash384 = Hash384 !Word64 !Word64 !Word64 !Word64 !Word64 !Word64 deriving (Eq, Ord) +data Hash224 = Hash224 !Word32 !Word32 !Word32 !Word32 !Word32 !Word32 !Word32 deriving (Eq, Ord) + +instance (Integral a) => Show (Hash8 a) where + showsPrec _ (Hash8 a b c d e f g h) = + (showHex a) . (' ':) . + (showHex b) . (' ':) . + (showHex c) . (' ':) . + (showHex d) . (' ':) . + (showHex e) . (' ':) . + (showHex f) . (' ':) . + (showHex g) . (' ':) . + (showHex h) + +instance Show Hash384 where + showsPrec _ (Hash384 a b c d e f) = + (showHex a) . (' ':) . + (showHex b) . (' ':) . + (showHex c) . (' ':) . + (showHex d) . (' ':) . + (showHex e) . (' ':) . + (showHex f) + +instance Show Hash224 where + showsPrec _ (Hash224 a b c d e f g) = + (showHex a) . (' ':) . + (showHex b) . (' ':) . + (showHex c) . (' ':) . + (showHex d) . (' ':) . + (showHex e) . (' ':) . + (showHex f) . (' ':) . + (showHex g) + +class (Eq h, Ord h, Show h) => Hash h where + toOctets :: h -> [Word8] + +bitsToOctets x = helper (bitSize x) x [] + where + helper s x r | s <= 0 = r + | otherwise = helper (s-bs) (shiftR x bs) ((fromIntegral x):r) + where + bs = bitSize (head r) + +instance (Integral h, Bits h) => Hash (Hash8 h) where + toOctets (Hash8 x0 x1 x2 x3 x4 x5 x6 x7) = bitsToOctets =<< [x0, x1, x2, x3, x4, x5, x6, x7] + +instance Hash Hash384 where + toOctets (Hash384 x0 x1 x2 x3 x4 x5) = bitsToOctets =<< [x0, x1, x2, x3, x4, x5] + +instance Hash Hash224 where + toOctets (Hash224 x0 x1 x2 x3 x4 x5 x6) = bitsToOctets =<< [x0, x1, x2, x3, x4, x5, x6] + +shaStep :: (ShaData w) => Hash8 w -> [w] -> Hash8 w +shaStep h m = (foldl' (flip id) h (zipWith mkStep3 ks ws)) `plus` h + where + ws = m++zipWith4 smallSigma (drop (blockSize-2) ws) (drop (blockSize-7) ws) + (drop (blockSize-15) ws) (drop (blockSize-16) ws) + where + smallSigma a b c d = smallSigma1 a + b + smallSigma0 c + d + mkStep3 k w (Hash8 a b c d e f g h) = Hash8 (t1+t2) a b c (d+t1) e f g + where + t1 = h + bigSigma1 e + ch e f g + k + w + t2 = bigSigma0 a + maj a b c + (Hash8 x0 x1 x2 x3 x4 x5 x6 x7) `plus` (Hash8 y0 y1 y2 y3 y4 y5 y6 y7) = + Hash8 (x0+y0) (x1+y1) (x2+y2) (x3+y3) (x4+y4) (x5+y5) (x6+y6) (x7+y7) + +----------------------------------------------------------------------------- +-- | Due to the limitations of 'padding', 'sha' currently requires that the +-- bitSize of @a@ divide the bitSize of @w@ +----------------------------------------------------------------------------- + +sha :: (ShaData w, Bits a, Integral a) => Hash8 w -> [a] -> Hash8 w +sha h0 x = foldl' shaStep h0 $ padding x + +{- + +stringToOctets :: String -> [Word8] +stringToOctets = map (fromIntegral . fromEnum) + +----------------------------------------------------------------------------- +-- | 'sha256' currently requires that the bitSize of @a@ divide 32 +----------------------------------------------------------------------------- +sha256 :: (Bits a, Integral a) => [a] -> Hash256 +sha256 = sha $ + Hash8 0x6a09e667 0xbb67ae85 0x3c6ef372 0xa54ff53a 0x510e527f 0x9b05688c 0x1f83d9ab 0x5be0cd19 + +----------------------------------------------------------------------------- +-- | 'sha384' currently requires that the bitSize of @a@ divide 64 +----------------------------------------------------------------------------- +sha384 :: (Bits a, Integral a) => [a] -> Hash384 +sha384 x = Hash384 x0 x1 x2 x3 x4 x5 + where + Hash8 x0 x1 x2 x3 x4 x5 x6 x7 = flip sha x $ + Hash8 0xcbbb9d5dc1059ed8 0x629a292a367cd507 0x9159015a3070dd17 0x152fecd8f70e5939 + 0x67332667ffc00b31 0x8eb44a8768581511 0xdb0c2e0d64f98fa7 0x47b5481dbefa4fa4 + +-} + +----------------------------------------------------------------------------- +-- | 'sha384' currently requires that the bitSize of @a@ divide 64 +----------------------------------------------------------------------------- +sha512 :: (Bits a, Integral a) => [a] -> Hash512 +sha512 = sha $ + Hash8 0x6a09e667f3bcc908 0xbb67ae8584caa73b 0x3c6ef372fe94f82b 0xa54ff53a5f1d36f1 + 0x510e527fade682d1 0x9b05688c2b3e6c1f 0x1f83d9abfb41bd6b 0x5be0cd19137e2179 + +{- + +----------------------------------------------------------------------------- +-- | 'sha224' currently requires that the bitSize of @a@ divide 32 +----------------------------------------------------------------------------- +sha224 :: (Bits a, Integral a) => [a] -> Hash224 +sha224 x = Hash224 x0 x1 x2 x3 x4 x5 x6 + where + Hash8 x0 x1 x2 x3 x4 x5 x6 x7 = flip sha x $ + Hash8 0xc1059ed8 0x367cd507 0x3070dd17 0xf70e5939 0xffc00b31 0x68581511 0x64f98fa7 0xbefa4fa4 + +----------------------------------------------------------------------------- +-- ** Hashing Strings +-- | @shaXXXAscii@ assumes that all characters of the strings are +-- ISO-latin-1 characters. ie. each characters fits in one octet. +----------------------------------------------------------------------------- +sha256Ascii :: String -> Hash256 +sha256Ascii = sha256 . stringToOctets + +sha384Ascii :: String -> Hash384 +sha384Ascii = sha384 . stringToOctets + +sha512Ascii :: String -> Hash512 +sha512Ascii = sha512 . stringToOctets + +sha224Ascii :: String -> Hash224 +sha224Ascii = sha224 . stringToOctets + +-} + +----------------------------------------------------------------------------- +-- ** Test cases +-- | Below are test cases from the FIPS 180-2 document +----------------------------------------------------------------------------- + +-- Should this go into it's own module? + +{- + +test_sha256 = "SHA-256" ~: test + [sha256Ascii "abc" ~?= + Hash8 0xba7816bf 0x8f01cfea 0x414140de 0x5dae2223 0xb00361a3 0x96177a9c 0xb410ff61 0xf20015ad + ,sha256Ascii "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" ~?= + Hash8 0x248d6a61 0xd20638b8 0xe5c02693 0x0c3e6039 0xa33ce459 0x64ff2167 0xf6ecedd4 0x19db06c1 + ,sha256Ascii (replicate 1000000 'a') ~?= + Hash8 0xcdc76e5c 0x9914fb92 0x81a1c7e2 0x84d73e67 0xf1809a48 0xa497200e 0x046d39cc 0xc7112cd0] + +test_sha512 = "SHA-512" ~: test + [sha512Ascii "abc" ~?= + Hash8 0xddaf35a193617aba 0xcc417349ae204131 0x12e6fa4e89a97ea2 0x0a9eeee64b55d39a + 0x2192992a274fc1a8 0x36ba3c23a3feebbd 0x454d4423643ce80e 0x2a9ac94fa54ca49f + ,sha512Ascii ("abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmn"++ + "hijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu") ~?= + Hash8 0x8e959b75dae313da 0x8cf4f72814fc143f 0x8f7779c6eb9f7fa1 0x7299aeadb6889018 + 0x501d289e4900f7e4 0x331b99dec4b5433a 0xc7d329eeb6dd2654 0x5e96e55b874be909 + ,sha512Ascii (replicate 1000000 'a') ~?= + Hash8 0xe718483d0ce76964 0x4e2e42c7bc15b463 0x8e1f98b13b204428 0x5632a803afa973eb + 0xde0ff244877ea60a 0x4cb0432ce577c31b 0xeb009c5c2c49aa2e 0x4eadb217ad8cc09b] + +test_sha384 = "SHA-384" ~: test + [sha384Ascii "abc" ~?= + Hash384 0xcb00753f45a35e8b 0xb5a03d699ac65007 0x272c32ab0eded163 0x1a8b605a43ff5bed + 0x8086072ba1e7cc23 0x58baeca134c825a7 + ,sha384Ascii ("abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmn"++ + "hijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu") ~?= + Hash384 0x09330c33f71147e8 0x3d192fc782cd1b47 0x53111b173b3b05d2 0x2fa08086e3b0f712 + 0xfcc7c71a557e2db9 0x66c3e9fa91746039 + ,sha384Ascii (replicate 1000000 'a') ~?= + Hash384 0x9d0e1809716474cb 0x086e834e310a4a1c 0xed149e9c00f24852 0x7972cec5704c2a5b + 0x07b8b3dc38ecc4eb 0xae97ddd87f3d8985] + +test_sha224 = "SHA-224" ~: test + [sha224Ascii "abc" ~?= + Hash224 0x23097d22 0x3405d822 0x8642a477 0xbda255b3 0x2aadbce4 0xbda0b3f7 0xe36c9da7 + ,sha224Ascii "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" ~?= + Hash224 0x75388b16 0x512776cc 0x5dba5da1 0xfd890150 0xb0c6455c 0xb4f58b19 0x52522525 + ,sha224Ascii (replicate 1000000 'a') ~?= + Hash224 0x20794655 0x980c91d8 0xbbb4c1ea 0x97618a4b 0xf03f4258 0x1948b2ee 0x4ee7ad67] + +test_sha2 = "SHA-2" ~: test + [test_sha256, test_sha512, test_sha384, test_sha224] + +-- Test with: +-- ghc -no-recomp -O --make Data/Digest/SHA2.hs -main-is Data.Digest.SHA2.moduleTest -o moduleTest && ./moduleTest && rm moduleTest +moduleTest = runTestTT test_sha2 + +-} diff --git a/src/Data/Digest/SHA512.hs b/src/Data/Digest/SHA512.hs new file mode 100644 index 0000000..837b78d --- /dev/null +++ b/src/Data/Digest/SHA512.hs @@ -0,0 +1,26 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Data.Digest.SHA512 +-- Copyright : (c) Russell O'Connor 2006 +-- License : BSD-style (see the file CryptoReadMe.tex) +-- +-- Takes the SHA2 module supplied and wraps it so it +-- takes [Octet] and returns [Octet] where the length of the result +-- is always 64. +-- and . +-- +----------------------------------------------------------------------------- + +module Data.Digest.SHA512 ( + -- * Function Types + hash) where + +import Data.Digest.SHA2 as SHA2 +import Codec.Utils + +-- | Take [Octet] and return [Octet] according to the standard. +-- The length of the result is always 64 octets or 512 bits as required +-- by the standard. + +hash :: [Octet] -> [Octet] +hash = SHA2.toOctets . SHA2.sha512 diff --git a/src/Happstack/Auth/Internal.hs b/src/Happstack/Auth/Internal.hs index fd50317..787d78d 100644 --- a/src/Happstack/Auth/Internal.hs +++ b/src/Happstack/Auth/Internal.hs @@ -53,9 +53,9 @@ import System.Random import qualified Data.Map as M -import Codec.Utils +import Codec.Utils (Octet, listToOctets) import Data.ByteString.Internal -import Data.Digest.SHA512 +import Data.Digest.SHA512 (hash) import Happstack.Data.IxSet hiding (null) import Happstack.State import Happstack.State.ClockTime