Commit 95c12e57 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Remove the bundled deps as they're totally out of date

parent 5fb9cd39
Copyright (c) 2002, Warrick Gray
Copyright (c) 2002-2005, Ian Lynagh
Copyright (c) 2003-2006, Bjorn Bringert
Copyright (c) 2004, Andre Furtado
Copyright (c) 2004, Ganesh Sittampalam
Copyright (c) 2004-2005, Dominic Steinitz
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* 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.
* The names of contributors may not be used to endorse or promote
products derived from this software without specific prior
written permission.
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
OWNER 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.
HADDOCK = haddock
TODAY = $(shell date +%Y%m%d)
DIST_NAME = http-$(TODAY)
HADDOCK_FILES = Network/HTTP.hs Network/Browser.hs
.PHONY: all configure build install dist haddock clean
default all: configure build
configure:
./Setup.lhs configure
build:
./Setup.lhs build
install:
./Setup.lhs install
dist:
darcs dist --dist-name=$(DIST_NAME)
haddock: $(HADDOCK_FILES)
mkdir -p haddock
$(HADDOCK) -o haddock -h $^
clean:
-./Setup.lhs clean
-rm -rf haddock
-rm -rf dist
$(MAKE) -C test clean
setup: Setup.lhs
ghc --make -package Cabal -o setup Setup.lhs
-----------------------------------------------------------------------------
-- |
-- Module : Codec.Binary.Base64
-- Copyright : (c) Dominic Steinitz 2005, Warrick Gray 2002
-- License : BSD-style (see the file ReadMe.tex)
--
-- Maintainer : dominic.steinitz@blueyonder.co.uk
-- Stability : experimental
-- Portability : portable
--
-- Base64 encoding and decoding functions provided by Warwick Gray.
-- See <http://homepages.paradise.net.nz/warrickg/haskell/http/#base64>
-- and <http://www.faqs.org/rfcs/rfc2045.html>.
--
-----------------------------------------------------------------------------
module Network.HTTP.Base64 (
encode,
decode,
chop72
) where
{------------------------------------------------------------------------
This is what RFC2045 had to say:
6.8. Base64 Content-Transfer-Encoding
The Base64 Content-Transfer-Encoding is designed to represent
arbitrary sequences of octets in a form that need not be humanly
readable. The encoding and decoding algorithms are simple, but the
encoded data are consistently only about 33 percent larger than the
unencoded data. This encoding is virtually identical to the one used
in Privacy Enhanced Mail (PEM) applications, as defined in RFC 1421.
A 65-character subset of US-ASCII is used, enabling 6 bits to be
represented per printable character. (The extra 65th character, "=",
is used to signify a special processing function.)
NOTE: This subset has the important property that it is represented
identically in all versions of ISO 646, including US-ASCII, and all
characters in the subset are also represented identically in all
versions of EBCDIC. Other popular encodings, such as the encoding
used by the uuencode utility, Macintosh binhex 4.0 [RFC-1741], and
the base85 encoding specified as part of Level 2 PostScript, do not
share these properties, and thus do not fulfill the portability
requirements a binary transport encoding for mail must meet.
The encoding process represents 24-bit groups of input bits as output
strings of 4 encoded characters. Proceeding from left to right, a
24-bit input group is formed by concatenating 3 8bit input groups.
These 24 bits are then treated as 4 concatenated 6-bit groups, each
of which is translated into a single digit in the base64 alphabet.
When encoding a bit stream via the base64 encoding, the bit stream
must be presumed to be ordered with the most-significant-bit first.
That is, the first bit in the stream will be the high-order bit in
the first 8bit byte, and the eighth bit will be the low-order bit in
the first 8bit byte, and so on.
Each 6-bit group is used as an index into an array of 64 printable
characters. The character referenced by the index is placed in the
output string. These characters, identified in Table 1, below, are
selected so as to be universally representable, and the set excludes
characters with particular significance to SMTP (e.g., ".", CR, LF)
and to the multipart boundary delimiters defined in RFC 2046 (e.g.,
"-").
Table 1: The Base64 Alphabet
Value Encoding Value Encoding Value Encoding Value Encoding
0 A 17 R 34 i 51 z
1 B 18 S 35 j 52 0
2 C 19 T 36 k 53 1
3 D 20 U 37 l 54 2
4 E 21 V 38 m 55 3
5 F 22 W 39 n 56 4
6 G 23 X 40 o 57 5
7 H 24 Y 41 p 58 6
8 I 25 Z 42 q 59 7
9 J 26 a 43 r 60 8
10 K 27 b 44 s 61 9
11 L 28 c 45 t 62 +
12 M 29 d 46 u 63 /
13 N 30 e 47 v
14 O 31 f 48 w (pad) =
15 P 32 g 49 x
16 Q 33 h 50 y
The encoded output stream must be represented in lines of no more
than 76 characters each. All line breaks or other characters not
found in Table 1 must be ignored by decoding software. In base64
data, characters other than those in Table 1, line breaks, and other
white space probably indicate a transmission error, about which a
warning message or even a message rejection might be appropriate
under some circumstances.
Special processing is performed if fewer than 24 bits are available
at the end of the data being encoded. A full encoding quantum is
always completed at the end of a body. When fewer than 24 input bits
are available in an input group, zero bits are added (on the right)
to form an integral number of 6-bit groups. Padding at the end of
the data is performed using the "=" character. Since all base64
input is an integral number of octets, only the following cases can
arise: (1) the final quantum of encoding input is an integral
multiple of 24 bits; here, the final unit of encoded output will be
an integral multiple of 4 characters with no "=" padding, (2) the
final quantum of encoding input is exactly 8 bits; here, the final
unit of encoded output will be two characters followed by two "="
padding characters, or (3) the final quantum of encoding input is
exactly 16 bits; here, the final unit of encoded output will be three
characters followed by one "=" padding character.
Because it is used only for padding at the end of the data, the
occurrence of any "=" characters may be taken as evidence that the
end of the data has been reached (without truncation in transit). No
such assurance is possible, however, when the number of octets
transmitted was a multiple of three and no "=" characters are
present.
Any characters outside of the base64 alphabet are to be ignored in
base64-encoded data.
Care must be taken to use the proper octets for line breaks if base64
encoding is applied directly to text material that has not been
converted to canonical form. In particular, text line breaks must be
converted into CRLF sequences prior to base64 encoding. The
important thing to note is that this may be done directly by the
encoder rather than in a prior canonicalization step in some
implementations.
NOTE: There is no need to worry about quoting potential boundary
delimiters within base64-encoded bodies within multipart entities
because no hyphen characters are used in the base64 encoding.
----------------------------------------------------------------------------}
{-
The following properties should hold:
decode . encode = id
decode . chop72 . encode = id
I.E. Both "encode" and "chop72 . encode" are valid methods of encoding input,
the second variation corresponds better with the RFC above, but outside of
MIME applications might be undesireable.
But: The Haskell98 Char type is at least 16bits (and often 32), these implementations assume only
8 significant bits, which is more than enough for US-ASCII.
-}
import Data.Array
import Data.Bits
import Data.Int
import Data.Char (chr,ord)
import Data.Word (Word8)
type Octet = Word8
encodeArray :: Array Int Char
encodeArray = array (0,64)
[ (0,'A'), (1,'B'), (2,'C'), (3,'D'), (4,'E'), (5,'F')
, (6,'G'), (7,'H'), (8,'I'), (9,'J'), (10,'K'), (11,'L')
, (12,'M'), (13,'N'), (14,'O'), (15,'P'), (16,'Q'), (17,'R')
, (18,'S'), (19,'T'), (20,'U'), (21,'V'), (22,'W'), (23,'X')
, (24,'Y'), (25,'Z'), (26,'a'), (27,'b'), (28,'c'), (29,'d')
, (30,'e'), (31,'f'), (32,'g'), (33,'h'), (34,'i'), (35,'j')
, (36,'k'), (37,'l'), (38,'m'), (39,'n'), (40,'o'), (41,'p')
, (42,'q'), (43,'r'), (44,'s'), (45,'t'), (46,'u'), (47,'v')
, (48,'w'), (49,'x'), (50,'y'), (51,'z'), (52,'0'), (53,'1')
, (54,'2'), (55,'3'), (56,'4'), (57,'5'), (58,'6'), (59,'7')
, (60,'8'), (61,'9'), (62,'+'), (63,'/') ]
-- Convert between 4 base64 (6bits ea) integers and 1 ordinary integer (32 bits)
-- clearly the upmost/leftmost 8 bits of the answer are 0.
-- Hack Alert: In the last entry of the answer, the upper 8 bits encode
-- the integer number of 6bit groups encoded in that integer, ie 1, 2, 3.
-- 0 represents a 4 :(
int4_char3 :: [Int] -> [Char]
int4_char3 (a:b:c:d:t) =
let n = (a `shiftL` 18 .|. b `shiftL` 12 .|. c `shiftL` 6 .|. d)
in (chr (n `shiftR` 16 .&. 0xff))
: (chr (n `shiftR` 8 .&. 0xff))
: (chr (n .&. 0xff)) : int4_char3 t
int4_char3 [a,b,c] =
let n = (a `shiftL` 18 .|. b `shiftL` 12 .|. c `shiftL` 6)
in [ (chr (n `shiftR` 16 .&. 0xff))
, (chr (n `shiftR` 8 .&. 0xff)) ]
int4_char3 [a,b] =
let n = (a `shiftL` 18 .|. b `shiftL` 12)
in [ (chr (n `shiftR` 16 .&. 0xff)) ]
int4_char3 [] = []
-- Convert triplets of characters to
-- 4 base64 integers. The last entries
-- in the list may not produce 4 integers,
-- a trailing 2 character group gives 3 integers,
-- while a trailing single character gives 2 integers.
char3_int4 :: [Char] -> [Int]
char3_int4 (a:b:c:t)
= let n = (ord a `shiftL` 16 .|. ord b `shiftL` 8 .|. ord c)
in (n `shiftR` 18 .&. 0x3f) : (n `shiftR` 12 .&. 0x3f) : (n `shiftR` 6 .&. 0x3f) : (n .&. 0x3f) : char3_int4 t
char3_int4 [a,b]
= let n = (ord a `shiftL` 16 .|. ord b `shiftL` 8)
in [ (n `shiftR` 18 .&. 0x3f)
, (n `shiftR` 12 .&. 0x3f)
, (n `shiftR` 6 .&. 0x3f) ]
char3_int4 [a]
= let n = (ord a `shiftL` 16)
in [(n `shiftR` 18 .&. 0x3f),(n `shiftR` 12 .&. 0x3f)]
char3_int4 [] = []
-- Retrieve base64 char, given an array index integer in the range [0..63]
enc1 :: Int -> Char
enc1 ch = encodeArray!ch
-- | Cut up a string into 72 char lines, each line terminated by CRLF.
chop72 :: String -> String
chop72 str = let (bgn,end) = splitAt 70 str
in if null end then bgn else "\r\n" ++ chop72 end
-- Pads a base64 code to a multiple of 4 characters, using the special
-- '=' character.
quadruplets (a:b:c:d:t) = a:b:c:d:quadruplets t
quadruplets [a,b,c] = [a,b,c,'='] -- 16bit tail unit
quadruplets [a,b] = [a,b,'=','='] -- 8bit tail unit
quadruplets [] = [] -- 24bit tail unit
enc :: [Int] -> [Char]
enc = quadruplets . map enc1
dcd [] = []
dcd (h:t)
| h <= 'Z' && h >= 'A' = ord h - ord 'A' : dcd t
| h >= '0' && h <= '9' = ord h - ord '0' + 52 : dcd t
| h >= 'a' && h <= 'z' = ord h - ord 'a' + 26 : dcd t
| h == '+' = 62 : dcd t
| h == '/' = 63 : dcd t
| h == '=' = [] -- terminate data stream
| otherwise = dcd t
-- Principal encoding and decoding functions.
encode :: [Octet] -> String
encode = enc . char3_int4 . (map (chr .fromIntegral))
{-
prop_base64 os =
os == (f . g . h) os
where types = (os :: [Word8])
f = map (fromIntegral. ord)
g = decode . encode
h = map (chr . fromIntegral)
-}
decode :: String -> [Octet]
decode = (map (fromIntegral . ord)) . int4_char3 . dcd
\ No newline at end of file
-----------------------------------------------------------------------------
-- |
-- Module : Data.Digest.MD5
-- Copyright : (c) Dominic Steinitz 2004
-- License : BSD-style (see the file ReadMe.tex)
--
-- Maintainer : dominic.steinitz@blueyonder.co.uk
-- Stability : experimental
-- Portability : portable
--
-- Takes the MD5 module supplied by Ian Lynagh and wraps it so it
-- takes [Octet] and returns [Octet] where the length of the result
-- is always 16.
-- See <http://web.comlab.ox.ac.uk/oucl/work/ian.lynagh/>
-- and <http://www.ietf.org/rfc/rfc1321.txt>.
--
-----------------------------------------------------------------------------
module Network.HTTP.MD5 (
-- * Function Types
hash) where
import Data.Char(chr)
import Data.List(unfoldr)
import Numeric(readHex)
import Network.HTTP.MD5Aux
import Data.Word (Word8)
type Octet = Word8
-- | Take [Octet] and return [Octet] according to the standard.
-- The length of the result is always 16 octets or 128 bits as required
-- by the standard.
hash :: [Octet] -> [Octet]
hash xs =
unfoldr f $ md5s $ Str $ map (chr . fromIntegral) xs
where f :: String -> Maybe (Octet,String)
f [] =
Nothing
f (x:y:zs) =
Just (fromIntegral a,zs)
where [(a,_)] = readHex (x:y:[])
module Network.HTTP.MD5Aux
(md5, md5s, md5i,
MD5(..), ABCD(..),
Zord64, Str(..), BoolList(..), WordList(..)) where
import Data.Char
import Data.Bits
import Data.Word
{-
Nasty kludge to create a type Zord64 which is really a Word64 but works
how we want in hugs ands nhc98 too...
Also need a rotate left function that actually works.
#ifdef __GLASGOW_HASKELL__
#define rotL rotateL
#include "Zord64_EASY.hs"
#else
> import Zord64_HARD
> rotL :: Word32 -> Rotation -> Word32
> rotL a s = shiftL a s .|. shiftL a (s-32)
#endif
-}
rotL x = rotateL x
type Zord64 = Word64
-- ===================== TYPES AND CLASS DEFINTIONS ========================
type XYZ = (Word32, Word32, Word32)
type Rotation = Int
newtype ABCD = ABCD (Word32, Word32, Word32, Word32) deriving (Eq, Show)
newtype Str = Str String
newtype BoolList = BoolList [Bool]
newtype WordList = WordList ([Word32], Zord64)
-- Anything we want to work out the MD5 of must be an instance of class MD5
class MD5 a where
get_next :: a -> ([Word32], Int, a) -- get the next blocks worth
-- \ \ \------ the rest of the input
-- \ \--------- the number of bits returned
-- \--------------- the bits returned in 32bit words
len_pad :: Zord64 -> a -> a -- append the padding and length
finished :: a -> Bool -- Have we run out of input yet?
-- Mainly exists because it's fairly easy to do MD5s on input where the
-- length is not a multiple of 8
instance MD5 BoolList where
get_next (BoolList s) = (bools_to_word32s ys, length ys, BoolList zs)
where (ys, zs) = splitAt 512 s
len_pad l (BoolList bs)
= BoolList (bs ++ [True]
++ replicate (fromIntegral $ (447 - l) .&. 511) False
++ [l .&. (shiftL 1 x) > 0 | x <- (mangle [0..63])]
)
where mangle [] = []
mangle xs = reverse ys ++ mangle zs
where (ys, zs) = splitAt 8 xs
finished (BoolList s) = s == []
-- The string instance is fairly straightforward
instance MD5 Str where
get_next (Str s) = (string_to_word32s ys, 8 * length ys, Str zs)
where (ys, zs) = splitAt 64 s
len_pad c64 (Str s) = Str (s ++ padding ++ l)
where padding = '\128':replicate (fromIntegral zeros) '\000'
zeros = shiftR ((440 - c64) .&. 511) 3
l = length_to_chars 8 c64
finished (Str s) = s == ""
-- YA instance that is believed will be useful
instance MD5 WordList where
get_next (WordList (ws, l)) = (xs, fromIntegral taken, WordList (ys, l - taken))
where (xs, ys) = splitAt 16 ws
taken = if l > 511 then 512 else l .&. 511
len_pad c64 (WordList (ws, l)) = WordList (beginning ++ nextish ++ blanks ++ size, newlen)
where beginning = if length ws > 0 then start ++ lastone' else []
start = init ws
lastone = last ws
offset = c64 .&. 31
lastone' = [if offset > 0 then lastone + theone else lastone]
theone = shiftL (shiftR 128 (fromIntegral $ offset .&. 7))
(fromIntegral $ offset .&. (31 - 7))
nextish = if offset == 0 then [128] else []
c64' = c64 + (32 - offset)
num_blanks = (fromIntegral $ shiftR ((448 - c64') .&. 511) 5)
blanks = replicate num_blanks 0
lowsize = fromIntegral $ c64 .&. (shiftL 1 32 - 1)
topsize = fromIntegral $ shiftR c64 32
size = [lowsize, topsize]
newlen = l .&. (complement 511)
+ if c64 .&. 511 >= 448 then 1024 else 512
finished (WordList (_, z)) = z == 0
instance Num ABCD where
ABCD (a1, b1, c1, d1) + ABCD (a2, b2, c2, d2) = ABCD (a1 + a2, b1 + b2, c1 + c2, d1 + d2)
-- ===================== EXPORTED FUNCTIONS ========================
-- The simplest function, gives you the MD5 of a string as 4-tuple of
-- 32bit words.
md5 :: (MD5 a) => a -> ABCD
md5 m = md5_main False 0 magic_numbers m
-- Returns a hex number ala the md5sum program
md5s :: (MD5 a) => a -> String
md5s = abcd_to_string . md5
-- Returns an integer equivalent to the above hex number
md5i :: (MD5 a) => a -> Integer
md5i = abcd_to_integer . md5
-- ===================== THE CORE ALGORITHM ========================
-- Decides what to do. The first argument indicates if padding has been
-- added. The second is the length mod 2^64 so far. Then we have the
-- starting state, the rest of the string and the final state.
md5_main :: (MD5 a) =>
Bool -- Have we added padding yet?
-> Zord64 -- The length so far mod 2^64
-> ABCD -- The initial state
-> a -- The non-processed portion of the message
-> ABCD -- The resulting state
md5_main padded ilen abcd m
= if finished m && padded
then abcd
else md5_main padded' (ilen + 512) (abcd + abcd') m''
where (m16, l, m') = get_next m
len' = ilen + fromIntegral l
((m16', _, m''), padded') = if not padded && l < 512
then (get_next $ len_pad len' m, True)
else ((m16, l, m'), padded)
abcd' = md5_do_block abcd m16'
-- md5_do_block processes a 512 bit block by calling md5_round 4 times to
-- apply each round with the correct constants and permutations of the
-- block
md5_do_block :: ABCD -- Initial state
-> [Word32] -- The block to be processed - 16 32bit words
-> ABCD -- Resulting state
md5_do_block abcd0 w = abcd4
where (r1, r2, r3, r4) = rounds
{-
map (\x -> w !! x) [1,6,11,0,5,10,15,4,9,14,3,8,13,2,7,12]
-- [(5 * x + 1) `mod` 16 | x <- [0..15]]
map (\x -> w !! x) [5,8,11,14,1,4,7,10,13,0,3,6,9,12,15,2]
-- [(3 * x + 5) `mod` 16 | x <- [0..15]]
map (\x -> w !! x) [0,7,14,5,12,3,10,1,8,15,6,13,4,11,2,9]
-- [(7 * x) `mod` 16 | x <- [0..15]]
-}
perm5 [c0,c1,c2,c3,c4,c5,c6,c7,c8,c9,c10,c11,c12,c13,c14,c15]
= [c1,c6,c11,c0,c5,