summaryrefslogtreecommitdiff
path: root/dht/src/Codec
diff options
context:
space:
mode:
authorJoe Crayne <joe@jerkface.net>2020-01-09 12:10:10 -0500
committerJoe Crayne <joe@jerkface.net>2020-01-09 12:10:10 -0500
commit5e2f6f9f8b78b90f0becb60e735abbd62bac6ca6 (patch)
tree9d7398a42a2925fe4f7e760e7d5ee9ae0a0a75fe /dht/src/Codec
parentb9194d4637ddfc3b9f762d2e4e29a318087e02db (diff)
Moved Codec.AsciiKey256 to tox-crypto.
Diffstat (limited to 'dht/src/Codec')
-rw-r--r--dht/src/Codec/AsciiKey256.hs146
1 files changed, 0 insertions, 146 deletions
diff --git a/dht/src/Codec/AsciiKey256.hs b/dht/src/Codec/AsciiKey256.hs
deleted file mode 100644
index 1738a368..00000000
--- a/dht/src/Codec/AsciiKey256.hs
+++ /dev/null
@@ -1,146 +0,0 @@
1{-# LANGUAGE TupleSections #-}
2module Codec.AsciiKey256 where
3
4import Control.Applicative
5import Control.Monad
6import Control.Monad.Fail as MF
7import Data.Bits
8import qualified Data.ByteArray as BA
9 ;import Data.ByteArray as BA (ByteArrayAccess)
10import qualified Data.ByteString as B
11 ;import Data.ByteString (ByteString)
12import qualified Data.ByteString.Base16 as Base16
13import qualified Data.ByteString.Base32.Z as Base32
14import qualified Data.ByteString.Base64 as Base64
15import qualified Data.ByteString.Char8 as C8
16import Data.Char
17import Data.Int
18import qualified Data.Text as T
19 ;import Data.Text (Text)
20import Data.Word
21import Foreign.Ptr
22import System.IO.Unsafe
23import qualified Text.ParserCombinators.ReadP as RP
24
25stripSuffix :: Text -> Text -> Maybe Text
26stripSuffix suf x = case T.splitAt (T.length x - T.length suf) x of
27 (y,end) | end == suf -> Just y
28 | otherwise -> Nothing
29
30hexdigit :: Char -> Bool
31hexdigit c = ('0' <= c && c <= '9') || ( 'a' <= c && c <= 'f') || ( 'A' <= c && c <= 'F')
32
33b64digit :: Char -> Bool
34b64digit '.' = True
35b64digit '+' = True
36b64digit '-' = True
37b64digit '/' = True
38b64digit c = ('0' <= c && c <= '9') || ( 'a' <= c && c <= 'z') || ( 'A' <= c && c <= 'Z')
39
40-- | Convert to and from a Base64 variant that uses .- instead of +/.
41nmtoken64 :: Bool -> Char -> Char
42nmtoken64 False '.' = '+'
43nmtoken64 False '-' = '/'
44nmtoken64 True '+' = '.'
45nmtoken64 True '/' = '-'
46nmtoken64 _ c = c
47
48
49-- Apply substitutions for mistaken z-base32 digits.
50fixupDigit32 :: Char -> Char
51fixupDigit32 'l' = '1'
52fixupDigit32 '2' = 'z'
53fixupDigit32 'v' = 'u'
54fixupDigit32 c = c
55
56zb32digit :: Char -> Bool
57zb32digit '1' = True
58zb32digit c = or [ '3' <= c && c <= '9'
59 , 'a' <= c && c <= 'k'
60 , 'm' <= c && c <= 'u'
61 , 'w' <= c && c <= 'z'
62 ]
63
64
65-- | Parse 43-digit base64 token into 32-byte bytestring.
66parseToken32 :: String -> Either String ByteString
67parseToken32 str = fmap (BA.drop 1) $ Base64.decode $ C8.pack $ 'A':map (nmtoken64 False) (take 43 str)
68
69-- | Encode 43-digit base64 token from 32-byte bytestring.
70showToken32 :: ByteArrayAccess bin => bin -> String
71showToken32 bs = map (nmtoken64 True) $ C8.unpack $ BA.drop 1 $ Base64.encode $ BA.cons 0 $ BA.convert bs
72
73foreign import ccall "crc4itu" c_crc4itu :: Word8 -- ^ init crc
74 -> Ptr Word8 -- ^ data to checksum
75 -> Int32 -- ^ length of data
76 -> IO Word8 -- crc in low 4 bits
77
78-- | CRC4-ITU. Return crc in lowest 4 bits.
79crc4itu :: ByteArrayAccess ba => Word8 -- ^ Existing CRC value (usually 0x00) before process a new one.
80 -> ba -- ^ Data to checksum.
81 -> Word8
82crc4itu crc0 b = unsafePerformIO $ BA.withByteArray b $ \p ->
83 c_crc4itu crc0 p (fromIntegral $ BA.length b)
84
85-- | Parse 52-digit z-base32 token into 32-byte bytestring.
86parse32Token32 :: String -> Either String ByteString
87parse32Token32 str = do
88 bs <- Base32.decode $ C8.pack $ map (fixupDigit32 . toLower) (take 52 str) ++ "y"
89 case BA.splitAt 32 bs of
90 (key,mac) | crc4itu 0 key == shiftR (BA.index mac 0) 4
91 -> Right key
92 _ -> Left "Failed cyclic redundancy check."
93
94-- | Encode 52-digit z-base32 token from 32-byte bytestring.
95show32Token32 :: ByteArrayAccess bin => bin -> String
96show32Token32 bs = C8.unpack $ B.take 52 $ Base32.encode (b `B.snoc` shiftL crc 4)
97 where
98 b = BA.convert bs
99 crc = crc4itu 0 bs
100
101
102readsPrecKey256 :: (ByteString -> Maybe a) -> [Char] -> [(a, [Char])]
103readsPrecKey256 publicKey str
104 | (bs,_) <- Base16.decode (C8.pack $ take 64 str)
105 , Just pub <- publicKey bs
106 = [ (pub, drop (2 * B.length bs) str) ]
107 | Right bs <- parse32Token32 str
108 , Just pub <- publicKey bs
109 = [ (pub, drop 52 str) ]
110 | Right bs <- parseToken32 str
111 , Just pub <- publicKey bs
112 = [ (pub, drop 43 str) ]
113 | otherwise = []
114
115
116parseKey256 :: (MonadFail m, Alternative m) => String -> m ByteString
117parseKey256 nidstr = do
118 let nidbs = C8.pack nidstr
119 (bs,_) = Base16.decode nidbs
120 enid = case C8.length nidbs of
121 52 -> parse32Token32 nidstr
122 43 -> parseToken32 nidstr
123 _ -> Left "Wrong size of key."
124 idbs <- (guard (B.length bs == 32) >> return bs)
125 <|> either MF.fail return enid
126 return idbs
127
128readP_key256 :: RP.ReadP ByteString
129readP_key256 = do
130 (is64,hexhash) <- foldr1 (RP.+++)
131 [ fmap (16,) (sequence $ replicate 64 (RP.satisfy isHexDigit))
132 , fmap (32,) (sequence $ replicate 52 (RP.satisfy zb32digit))
133 , fmap (64,) (sequence $ replicate 43 (RP.satisfy b64digit))
134 ]
135 let failure = MF.fail "Bad key."
136 case is64 of
137 32 -> case parse32Token32 hexhash of
138 Right bs -> return bs
139 _ -> failure
140 64 -> case parseToken32 hexhash of
141 Right bs -> return bs
142 _ -> failure
143 16 -> case Base16.decode $ C8.pack hexhash of
144 (bs,rem) | B.length bs == 32 && B.null rem -> return bs
145 _ -> failure
146 _ -> failure