diff options
author | Joe Crayne <joe@jerkface.net> | 2020-01-09 12:10:10 -0500 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2020-01-09 12:10:10 -0500 |
commit | 5e2f6f9f8b78b90f0becb60e735abbd62bac6ca6 (patch) | |
tree | 9d7398a42a2925fe4f7e760e7d5ee9ae0a0a75fe /dht/src/Codec | |
parent | b9194d4637ddfc3b9f762d2e4e29a318087e02db (diff) |
Moved Codec.AsciiKey256 to tox-crypto.
Diffstat (limited to 'dht/src/Codec')
-rw-r--r-- | dht/src/Codec/AsciiKey256.hs | 146 |
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 #-} | ||
2 | module Codec.AsciiKey256 where | ||
3 | |||
4 | import Control.Applicative | ||
5 | import Control.Monad | ||
6 | import Control.Monad.Fail as MF | ||
7 | import Data.Bits | ||
8 | import qualified Data.ByteArray as BA | ||
9 | ;import Data.ByteArray as BA (ByteArrayAccess) | ||
10 | import qualified Data.ByteString as B | ||
11 | ;import Data.ByteString (ByteString) | ||
12 | import qualified Data.ByteString.Base16 as Base16 | ||
13 | import qualified Data.ByteString.Base32.Z as Base32 | ||
14 | import qualified Data.ByteString.Base64 as Base64 | ||
15 | import qualified Data.ByteString.Char8 as C8 | ||
16 | import Data.Char | ||
17 | import Data.Int | ||
18 | import qualified Data.Text as T | ||
19 | ;import Data.Text (Text) | ||
20 | import Data.Word | ||
21 | import Foreign.Ptr | ||
22 | import System.IO.Unsafe | ||
23 | import qualified Text.ParserCombinators.ReadP as RP | ||
24 | |||
25 | stripSuffix :: Text -> Text -> Maybe Text | ||
26 | stripSuffix suf x = case T.splitAt (T.length x - T.length suf) x of | ||
27 | (y,end) | end == suf -> Just y | ||
28 | | otherwise -> Nothing | ||
29 | |||
30 | hexdigit :: Char -> Bool | ||
31 | hexdigit c = ('0' <= c && c <= '9') || ( 'a' <= c && c <= 'f') || ( 'A' <= c && c <= 'F') | ||
32 | |||
33 | b64digit :: Char -> Bool | ||
34 | b64digit '.' = True | ||
35 | b64digit '+' = True | ||
36 | b64digit '-' = True | ||
37 | b64digit '/' = True | ||
38 | b64digit 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 +/. | ||
41 | nmtoken64 :: Bool -> Char -> Char | ||
42 | nmtoken64 False '.' = '+' | ||
43 | nmtoken64 False '-' = '/' | ||
44 | nmtoken64 True '+' = '.' | ||
45 | nmtoken64 True '/' = '-' | ||
46 | nmtoken64 _ c = c | ||
47 | |||
48 | |||
49 | -- Apply substitutions for mistaken z-base32 digits. | ||
50 | fixupDigit32 :: Char -> Char | ||
51 | fixupDigit32 'l' = '1' | ||
52 | fixupDigit32 '2' = 'z' | ||
53 | fixupDigit32 'v' = 'u' | ||
54 | fixupDigit32 c = c | ||
55 | |||
56 | zb32digit :: Char -> Bool | ||
57 | zb32digit '1' = True | ||
58 | zb32digit 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. | ||
66 | parseToken32 :: String -> Either String ByteString | ||
67 | parseToken32 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. | ||
70 | showToken32 :: ByteArrayAccess bin => bin -> String | ||
71 | showToken32 bs = map (nmtoken64 True) $ C8.unpack $ BA.drop 1 $ Base64.encode $ BA.cons 0 $ BA.convert bs | ||
72 | |||
73 | foreign 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. | ||
79 | crc4itu :: ByteArrayAccess ba => Word8 -- ^ Existing CRC value (usually 0x00) before process a new one. | ||
80 | -> ba -- ^ Data to checksum. | ||
81 | -> Word8 | ||
82 | crc4itu 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. | ||
86 | parse32Token32 :: String -> Either String ByteString | ||
87 | parse32Token32 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. | ||
95 | show32Token32 :: ByteArrayAccess bin => bin -> String | ||
96 | show32Token32 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 | |||
102 | readsPrecKey256 :: (ByteString -> Maybe a) -> [Char] -> [(a, [Char])] | ||
103 | readsPrecKey256 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 | |||
116 | parseKey256 :: (MonadFail m, Alternative m) => String -> m ByteString | ||
117 | parseKey256 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 | |||
128 | readP_key256 :: RP.ReadP ByteString | ||
129 | readP_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 | ||