summaryrefslogtreecommitdiff
path: root/DNSKey.hs
blob: 03767cfc05ab4fe1241e72bd3abcbc2ab0a18a67 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
module DNSKey where

import           Data.Binary
import           Data.Binary.Get
import           Data.Binary.Put
import           Data.Bits
import qualified Data.ByteString      as B
import           Data.Int

-- RSA n e
--  n = modulus
--  e = exponent
data RSA = RSA Integer Integer
 deriving (Eq,Show)

getRSA :: Int64 -> Get RSA
getRSA len = do
    elen <- do
        tog <- get
        case tog :: Word8 of
            0 -> get :: Get Word16
            _ -> return $ fromIntegral tog
    ebs <- getByteString (fromIntegral elen)
    nlen <- fmap (fromIntegral . ((-) len)) bytesRead
    nbs <- getByteString nlen
    let e = snd $ B.foldl' (\(c,a) w8 -> (c-1, a + 256^c * fromIntegral w8)) (elen-1,0) ebs
        n = snd $ B.foldl' (\(c,a) w8 -> (c-1, a + 256^c * fromIntegral w8)) (nlen-1,0) nbs
    return $ RSA n e

putRSA :: RSA -> PutM ()
putRSA (RSA n e) = do
    if elen > 255 || elen==0
        then do
            put (0 :: Word8)
            put (fromIntegral elen :: Word16)
        else do
            put (fromIntegral elen :: Word8)
    putByteString ebs
    putByteString nbs
 where
    elen = B.length ebs
    ebs = i2bs_unsized e
    nbs = i2bs_unsized n

-- |@i2bs_unsized i@ converts @i@ to a 'ByteString' of sufficient bytes to express the integer.
-- The integer must be non-negative and a zero will be encoded in one byte.
--
-- Thanks: Thomas DuBuisson (crypto-api)
i2bs_unsized :: Integer -> B.ByteString
i2bs_unsized 0 = B.singleton 0
i2bs_unsized i = B.reverse $ B.unfoldr (\i' -> if i' <= 0 then Nothing else Just (fromIntegral i', (i' `shiftR` 8))) i
{-# INLINE i2bs_unsized #-}

{-
main = do
    bs <- L.getContents
    let rsa = runGet (getRSA (fromIntegral $ L.length bs)) bs
        bs' = runPut (putRSA rsa)
        rsa' = runGet (getRSA (fromIntegral $ L.length bs)) bs'
    print rsa
    print rsa'
-}