From 5e2f6f9f8b78b90f0becb60e735abbd62bac6ca6 Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Thu, 9 Jan 2020 12:10:10 -0500 Subject: Moved Codec.AsciiKey256 to tox-crypto. --- dht/Presence/Presence.hs | 3 +- dht/ToxManager.hs | 1 - dht/cbits/crc4_itu.c | 44 ----------- dht/dht-client.cabal | 3 +- dht/examples/dhtd.hs | 1 - dht/src/Codec/AsciiKey256.hs | 146 ----------------------------------- dht/src/Data/Tox/Msg.hs | 4 +- dht/src/DebugTag.hs | 1 + dht/src/Network/Tox/NodeId.hs | 8 +- tox-crypto/cbits/crc4_itu.c | 44 +++++++++++ tox-crypto/src/Codec/AsciiKey256.hs | 149 ++++++++++++++++++++++++++++++++++++ tox-crypto/src/Crypto/Tox.hs | 11 +++ tox-crypto/tox-crypto.cabal | 5 +- 13 files changed, 216 insertions(+), 204 deletions(-) delete mode 100644 dht/cbits/crc4_itu.c delete mode 100644 dht/src/Codec/AsciiKey256.hs create mode 100644 tox-crypto/cbits/crc4_itu.c create mode 100644 tox-crypto/src/Codec/AsciiKey256.hs diff --git a/dht/Presence/Presence.hs b/dht/Presence/Presence.hs index b8c9f923..866aad78 100644 --- a/dht/Presence/Presence.hs +++ b/dht/Presence/Presence.hs @@ -51,10 +51,9 @@ import Util import qualified Connection ;import Connection (PeerAddress (..), resolvePeer, reverseAddress) import Network.Tox.NodeId (key2id,parseNoSpamId,nospam64,NoSpamId(..),ToxProgress,ToxContact(..)) -import Crypto.Tox (decodeSecret,encodeSecret, generateSecretKey) +import Crypto.Tox (decodeSecret,encodeSecret, generateSecretKey, stripSuffix) import DPut import DebugTag -import Codec.AsciiKey256 {- isPeerKey :: ClientAddress -> Bool diff --git a/dht/ToxManager.hs b/dht/ToxManager.hs index f5a8fd15..4c67e853 100644 --- a/dht/ToxManager.hs +++ b/dht/ToxManager.hs @@ -9,7 +9,6 @@ module ToxManager where import Announcer import Announcer.Tox import ClientState -import Codec.AsciiKey256 import ConfigFiles import Control.Arrow import Control.Concurrent.STM diff --git a/dht/cbits/crc4_itu.c b/dht/cbits/crc4_itu.c deleted file mode 100644 index 8e3b0489..00000000 --- a/dht/cbits/crc4_itu.c +++ /dev/null @@ -1,44 +0,0 @@ -/*----------------------------------------------------------------- -| crc4_itu.c -| -| CRC4-ITU library using lookup table method. -| -*-------------------------------------------------------------------*/ - -#include - -static unsigned char const crc4itu_bbox[256] = { - 0x0, 0x7, 0xe, 0x9, 0x5, 0x2, 0xb, 0xc, 0xa, 0xd, 0x4, 0x3, 0xf, 0x8, 0x1, 0x6, - 0xd, 0xa, 0x3, 0x4, 0x8, 0xf, 0x6, 0x1, 0x7, 0x0, 0x9, 0xe, 0x2, 0x5, 0xc, 0xb, - 0x3, 0x4, 0xd, 0xa, 0x6, 0x1, 0x8, 0xf, 0x9, 0xe, 0x7, 0x0, 0xc, 0xb, 0x2, 0x5, - 0xe, 0x9, 0x0, 0x7, 0xb, 0xc, 0x5, 0x2, 0x4, 0x3, 0xa, 0xd, 0x1, 0x6, 0xf, 0x8, - 0x6, 0x1, 0x8, 0xf, 0x3, 0x4, 0xd, 0xa, 0xc, 0xb, 0x2, 0x5, 0x9, 0xe, 0x7, 0x0, - 0xb, 0xc, 0x5, 0x2, 0xe, 0x9, 0x0, 0x7, 0x1, 0x6, 0xf, 0x8, 0x4, 0x3, 0xa, 0xd, - 0x5, 0x2, 0xb, 0xc, 0x0, 0x7, 0xe, 0x9, 0xf, 0x8, 0x1, 0x6, 0xa, 0xd, 0x4, 0x3, - 0x8, 0xf, 0x6, 0x1, 0xd, 0xa, 0x3, 0x4, 0x2, 0x5, 0xc, 0xb, 0x7, 0x0, 0x9, 0xe, - 0xc, 0xb, 0x2, 0x5, 0x9, 0xe, 0x7, 0x0, 0x6, 0x1, 0x8, 0xf, 0x3, 0x4, 0xd, 0xa, - 0x1, 0x6, 0xf, 0x8, 0x4, 0x3, 0xa, 0xd, 0xb, 0xc, 0x5, 0x2, 0xe, 0x9, 0x0, 0x7, - 0xf, 0x8, 0x1, 0x6, 0xa, 0xd, 0x4, 0x3, 0x5, 0x2, 0xb, 0xc, 0x0, 0x7, 0xe, 0x9, - 0x2, 0x5, 0xc, 0xb, 0x7, 0x0, 0x9, 0xe, 0x8, 0xf, 0x6, 0x1, 0xd, 0xa, 0x3, 0x4, - 0xa, 0xd, 0x4, 0x3, 0xf, 0x8, 0x1, 0x6, 0x0, 0x7, 0xe, 0x9, 0x5, 0x2, 0xb, 0xc, - 0x7, 0x0, 0x9, 0xe, 0x2, 0x5, 0xc, 0xb, 0xd, 0xa, 0x3, 0x4, 0x8, 0xf, 0x6, 0x1, - 0x9, 0xe, 0x7, 0x0, 0xc, 0xb, 0x2, 0x5, 0x3, 0x4, 0xd, 0xa, 0x6, 0x1, 0x8, 0xf, - 0x4, 0x3, 0xa, 0xd, 0x1, 0x6, 0xf, 0x8, 0xe, 0x9, 0x0, 0x7, 0xb, 0xc, 0x5, 0x2 -}; - -/** - * CRC4-ITU function - * - * Parameters: - * crc Existing CRC value (usually 0x00) before process a new one. - * data Pointer to data to be hashed with CRC - * len Size of data - * - * Returns: CRC value in lowest 4 bits. - */ -unsigned char crc4itu(unsigned char crc, unsigned char *data, unsigned int len) { - if (data == NULL) return 0; - crc &= 0xf; - while (len--) crc = crc4itu_bbox[crc ^ *data++]; - return crc; -} diff --git a/dht/dht-client.cabal b/dht/dht-client.cabal index 362f4b36..79a72c05 100644 --- a/dht/dht-client.cabal +++ b/dht/dht-client.cabal @@ -153,7 +153,6 @@ library Network.Tox.AggregateSession Network.Tox.Session DebugTag - Codec.AsciiKey256 Paths_dht_client build-depends: base @@ -252,7 +251,7 @@ library - C-sources: Presence/monitortty.c cbits/crc4_itu.c + C-sources: Presence/monitortty.c -- if flag(aeson) build-depends: aeson, aeson-pretty, unordered-containers, vector diff --git a/dht/examples/dhtd.hs b/dht/examples/dhtd.hs index 3078831d..2f39303c 100644 --- a/dht/examples/dhtd.hs +++ b/dht/examples/dhtd.hs @@ -66,7 +66,6 @@ import System.Posix.Signals import Announcer import Announcer.Tox import ToxManager -import Codec.AsciiKey256 import Crypto.Tox -- (zeros32,SecretKey,PublicKey, generateSecretKey, toPublic, encodeSecret, decodeSecret, userKeys) import qualified Data.Tox.DHT.Multi as Multi import DebugUtil 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 @@ -{-# LANGUAGE TupleSections #-} -module Codec.AsciiKey256 where - -import Control.Applicative -import Control.Monad -import Control.Monad.Fail as MF -import Data.Bits -import qualified Data.ByteArray as BA - ;import Data.ByteArray as BA (ByteArrayAccess) -import qualified Data.ByteString as B - ;import Data.ByteString (ByteString) -import qualified Data.ByteString.Base16 as Base16 -import qualified Data.ByteString.Base32.Z as Base32 -import qualified Data.ByteString.Base64 as Base64 -import qualified Data.ByteString.Char8 as C8 -import Data.Char -import Data.Int -import qualified Data.Text as T - ;import Data.Text (Text) -import Data.Word -import Foreign.Ptr -import System.IO.Unsafe -import qualified Text.ParserCombinators.ReadP as RP - -stripSuffix :: Text -> Text -> Maybe Text -stripSuffix suf x = case T.splitAt (T.length x - T.length suf) x of - (y,end) | end == suf -> Just y - | otherwise -> Nothing - -hexdigit :: Char -> Bool -hexdigit c = ('0' <= c && c <= '9') || ( 'a' <= c && c <= 'f') || ( 'A' <= c && c <= 'F') - -b64digit :: Char -> Bool -b64digit '.' = True -b64digit '+' = True -b64digit '-' = True -b64digit '/' = True -b64digit c = ('0' <= c && c <= '9') || ( 'a' <= c && c <= 'z') || ( 'A' <= c && c <= 'Z') - --- | Convert to and from a Base64 variant that uses .- instead of +/. -nmtoken64 :: Bool -> Char -> Char -nmtoken64 False '.' = '+' -nmtoken64 False '-' = '/' -nmtoken64 True '+' = '.' -nmtoken64 True '/' = '-' -nmtoken64 _ c = c - - --- Apply substitutions for mistaken z-base32 digits. -fixupDigit32 :: Char -> Char -fixupDigit32 'l' = '1' -fixupDigit32 '2' = 'z' -fixupDigit32 'v' = 'u' -fixupDigit32 c = c - -zb32digit :: Char -> Bool -zb32digit '1' = True -zb32digit c = or [ '3' <= c && c <= '9' - , 'a' <= c && c <= 'k' - , 'm' <= c && c <= 'u' - , 'w' <= c && c <= 'z' - ] - - --- | Parse 43-digit base64 token into 32-byte bytestring. -parseToken32 :: String -> Either String ByteString -parseToken32 str = fmap (BA.drop 1) $ Base64.decode $ C8.pack $ 'A':map (nmtoken64 False) (take 43 str) - --- | Encode 43-digit base64 token from 32-byte bytestring. -showToken32 :: ByteArrayAccess bin => bin -> String -showToken32 bs = map (nmtoken64 True) $ C8.unpack $ BA.drop 1 $ Base64.encode $ BA.cons 0 $ BA.convert bs - -foreign import ccall "crc4itu" c_crc4itu :: Word8 -- ^ init crc - -> Ptr Word8 -- ^ data to checksum - -> Int32 -- ^ length of data - -> IO Word8 -- crc in low 4 bits - --- | CRC4-ITU. Return crc in lowest 4 bits. -crc4itu :: ByteArrayAccess ba => Word8 -- ^ Existing CRC value (usually 0x00) before process a new one. - -> ba -- ^ Data to checksum. - -> Word8 -crc4itu crc0 b = unsafePerformIO $ BA.withByteArray b $ \p -> - c_crc4itu crc0 p (fromIntegral $ BA.length b) - --- | Parse 52-digit z-base32 token into 32-byte bytestring. -parse32Token32 :: String -> Either String ByteString -parse32Token32 str = do - bs <- Base32.decode $ C8.pack $ map (fixupDigit32 . toLower) (take 52 str) ++ "y" - case BA.splitAt 32 bs of - (key,mac) | crc4itu 0 key == shiftR (BA.index mac 0) 4 - -> Right key - _ -> Left "Failed cyclic redundancy check." - --- | Encode 52-digit z-base32 token from 32-byte bytestring. -show32Token32 :: ByteArrayAccess bin => bin -> String -show32Token32 bs = C8.unpack $ B.take 52 $ Base32.encode (b `B.snoc` shiftL crc 4) - where - b = BA.convert bs - crc = crc4itu 0 bs - - -readsPrecKey256 :: (ByteString -> Maybe a) -> [Char] -> [(a, [Char])] -readsPrecKey256 publicKey str - | (bs,_) <- Base16.decode (C8.pack $ take 64 str) - , Just pub <- publicKey bs - = [ (pub, drop (2 * B.length bs) str) ] - | Right bs <- parse32Token32 str - , Just pub <- publicKey bs - = [ (pub, drop 52 str) ] - | Right bs <- parseToken32 str - , Just pub <- publicKey bs - = [ (pub, drop 43 str) ] - | otherwise = [] - - -parseKey256 :: (MonadFail m, Alternative m) => String -> m ByteString -parseKey256 nidstr = do - let nidbs = C8.pack nidstr - (bs,_) = Base16.decode nidbs - enid = case C8.length nidbs of - 52 -> parse32Token32 nidstr - 43 -> parseToken32 nidstr - _ -> Left "Wrong size of key." - idbs <- (guard (B.length bs == 32) >> return bs) - <|> either MF.fail return enid - return idbs - -readP_key256 :: RP.ReadP ByteString -readP_key256 = do - (is64,hexhash) <- foldr1 (RP.+++) - [ fmap (16,) (sequence $ replicate 64 (RP.satisfy isHexDigit)) - , fmap (32,) (sequence $ replicate 52 (RP.satisfy zb32digit)) - , fmap (64,) (sequence $ replicate 43 (RP.satisfy b64digit)) - ] - let failure = MF.fail "Bad key." - case is64 of - 32 -> case parse32Token32 hexhash of - Right bs -> return bs - _ -> failure - 64 -> case parseToken32 hexhash of - Right bs -> return bs - _ -> failure - 16 -> case Base16.decode $ C8.pack hexhash of - (bs,rem) | B.length bs == 32 && B.null rem -> return bs - _ -> failure - _ -> failure diff --git a/dht/src/Data/Tox/Msg.hs b/dht/src/Data/Tox/Msg.hs index 4398586f..3188d86f 100644 --- a/dht/src/Data/Tox/Msg.hs +++ b/dht/src/Data/Tox/Msg.hs @@ -259,13 +259,13 @@ instance Serialize ChatID where instance Read ChatID where readsPrec _ s - | Right bs <- parseToken32 s + | Right bs <- parseBase64Key256 s , CryptoPassed ed <- Ed25519.publicKey bs = [ (ChatID ed, Prelude.drop 43 s) ] | otherwise = [] instance Show ChatID where - show (ChatID ed) = showToken32 ed + show (ChatID ed) = showBase64Key256 ed data InviteType = GroupInvite { groupName :: Text } | AcceptedInvite diff --git a/dht/src/DebugTag.hs b/dht/src/DebugTag.hs index 9ac04bb0..efa6415f 100644 --- a/dht/src/DebugTag.hs +++ b/dht/src/DebugTag.hs @@ -12,6 +12,7 @@ data DebugTag | XNetCrypto | XNetCryptoOut | XOnion + | XRelay | XRoutes | XPing | XRefresh diff --git a/dht/src/Network/Tox/NodeId.hs b/dht/src/Network/Tox/NodeId.hs index 667e7d71..3a2a4f07 100644 --- a/dht/src/Network/Tox/NodeId.hs +++ b/dht/src/Network/Tox/NodeId.hs @@ -37,9 +37,8 @@ module Network.Tox.NodeId , verifyChecksum , ToxContact(..) , ToxProgress(..) - , parseToken32 - , showToken32 - , show32Token32 + , showBase64Key256 + , showBase32Key256 , nodeInfoFromJSON , showHexId ) where @@ -97,7 +96,6 @@ import System.Endian import qualified Data.Text as Text ;import Data.Text (Text) import Util (splitJID) -import Codec.AsciiKey256 -- | perform io for hashes that do allocation and ffi. -- unsafeDupablePerformIO is used when possible as the @@ -174,7 +172,7 @@ instance Read NodeId where readsPrec _ str = readsPrecKey256 (fmap key2id . maybeCryptoError . publicKey) str instance Show NodeId where - show nid = show32Token32 $ id2key nid + show nid = showBase32Key256 $ id2key nid instance S.Serialize NodeId where get = key2id <$> getPublicKey diff --git a/tox-crypto/cbits/crc4_itu.c b/tox-crypto/cbits/crc4_itu.c new file mode 100644 index 00000000..8e3b0489 --- /dev/null +++ b/tox-crypto/cbits/crc4_itu.c @@ -0,0 +1,44 @@ +/*----------------------------------------------------------------- +| crc4_itu.c +| +| CRC4-ITU library using lookup table method. +| +*-------------------------------------------------------------------*/ + +#include + +static unsigned char const crc4itu_bbox[256] = { + 0x0, 0x7, 0xe, 0x9, 0x5, 0x2, 0xb, 0xc, 0xa, 0xd, 0x4, 0x3, 0xf, 0x8, 0x1, 0x6, + 0xd, 0xa, 0x3, 0x4, 0x8, 0xf, 0x6, 0x1, 0x7, 0x0, 0x9, 0xe, 0x2, 0x5, 0xc, 0xb, + 0x3, 0x4, 0xd, 0xa, 0x6, 0x1, 0x8, 0xf, 0x9, 0xe, 0x7, 0x0, 0xc, 0xb, 0x2, 0x5, + 0xe, 0x9, 0x0, 0x7, 0xb, 0xc, 0x5, 0x2, 0x4, 0x3, 0xa, 0xd, 0x1, 0x6, 0xf, 0x8, + 0x6, 0x1, 0x8, 0xf, 0x3, 0x4, 0xd, 0xa, 0xc, 0xb, 0x2, 0x5, 0x9, 0xe, 0x7, 0x0, + 0xb, 0xc, 0x5, 0x2, 0xe, 0x9, 0x0, 0x7, 0x1, 0x6, 0xf, 0x8, 0x4, 0x3, 0xa, 0xd, + 0x5, 0x2, 0xb, 0xc, 0x0, 0x7, 0xe, 0x9, 0xf, 0x8, 0x1, 0x6, 0xa, 0xd, 0x4, 0x3, + 0x8, 0xf, 0x6, 0x1, 0xd, 0xa, 0x3, 0x4, 0x2, 0x5, 0xc, 0xb, 0x7, 0x0, 0x9, 0xe, + 0xc, 0xb, 0x2, 0x5, 0x9, 0xe, 0x7, 0x0, 0x6, 0x1, 0x8, 0xf, 0x3, 0x4, 0xd, 0xa, + 0x1, 0x6, 0xf, 0x8, 0x4, 0x3, 0xa, 0xd, 0xb, 0xc, 0x5, 0x2, 0xe, 0x9, 0x0, 0x7, + 0xf, 0x8, 0x1, 0x6, 0xa, 0xd, 0x4, 0x3, 0x5, 0x2, 0xb, 0xc, 0x0, 0x7, 0xe, 0x9, + 0x2, 0x5, 0xc, 0xb, 0x7, 0x0, 0x9, 0xe, 0x8, 0xf, 0x6, 0x1, 0xd, 0xa, 0x3, 0x4, + 0xa, 0xd, 0x4, 0x3, 0xf, 0x8, 0x1, 0x6, 0x0, 0x7, 0xe, 0x9, 0x5, 0x2, 0xb, 0xc, + 0x7, 0x0, 0x9, 0xe, 0x2, 0x5, 0xc, 0xb, 0xd, 0xa, 0x3, 0x4, 0x8, 0xf, 0x6, 0x1, + 0x9, 0xe, 0x7, 0x0, 0xc, 0xb, 0x2, 0x5, 0x3, 0x4, 0xd, 0xa, 0x6, 0x1, 0x8, 0xf, + 0x4, 0x3, 0xa, 0xd, 0x1, 0x6, 0xf, 0x8, 0xe, 0x9, 0x0, 0x7, 0xb, 0xc, 0x5, 0x2 +}; + +/** + * CRC4-ITU function + * + * Parameters: + * crc Existing CRC value (usually 0x00) before process a new one. + * data Pointer to data to be hashed with CRC + * len Size of data + * + * Returns: CRC value in lowest 4 bits. + */ +unsigned char crc4itu(unsigned char crc, unsigned char *data, unsigned int len) { + if (data == NULL) return 0; + crc &= 0xf; + while (len--) crc = crc4itu_bbox[crc ^ *data++]; + return crc; +} diff --git a/tox-crypto/src/Codec/AsciiKey256.hs b/tox-crypto/src/Codec/AsciiKey256.hs new file mode 100644 index 00000000..0212d1d0 --- /dev/null +++ b/tox-crypto/src/Codec/AsciiKey256.hs @@ -0,0 +1,149 @@ +{-# LANGUAGE TupleSections #-} +module Codec.AsciiKey256 where + +import Control.Applicative +import Control.Monad +import Control.Monad.Fail as MF +import Data.Bits +import qualified Data.ByteArray as BA + ;import Data.ByteArray as BA (ByteArrayAccess) +import qualified Data.ByteString as B + ;import Data.ByteString (ByteString) +import qualified Data.ByteString.Base16 as Base16 +import qualified Data.ByteString.Base32.Z as Base32 +import qualified Data.ByteString.Base64 as Base64 +import qualified Data.ByteString.Char8 as C8 +import Data.Char +import Data.Int +import qualified Data.Text as T + ;import Data.Text (Text) +import Data.Word +import Foreign.Ptr +import System.IO.Unsafe +import qualified Text.ParserCombinators.ReadP as RP + +stripSuffix :: Text -> Text -> Maybe Text +stripSuffix suf x = case T.splitAt (T.length x - T.length suf) x of + (y,end) | end == suf -> Just y + | otherwise -> Nothing + +hexdigit :: Char -> Bool +hexdigit c = ('0' <= c && c <= '9') || ( 'a' <= c && c <= 'f') || ( 'A' <= c && c <= 'F') + +b64digit :: Char -> Bool +b64digit '.' = True +b64digit '+' = True +b64digit '-' = True +b64digit '/' = True +b64digit c = ('0' <= c && c <= '9') || ( 'a' <= c && c <= 'z') || ( 'A' <= c && c <= 'Z') + +-- | Convert to and from a Base64 variant that uses .- instead of +/. +nmtoken64 :: Bool -> Char -> Char +nmtoken64 False '.' = '+' +nmtoken64 False '-' = '/' +nmtoken64 True '+' = '.' +nmtoken64 True '/' = '-' +nmtoken64 _ c = c + + +-- Apply substitutions for mistaken z-base32 digits. +fixupDigit32 :: Char -> Char +fixupDigit32 'l' = '1' +fixupDigit32 '2' = 'z' +fixupDigit32 'v' = 'u' +fixupDigit32 c = c + +zb32digit :: Char -> Bool +zb32digit '1' = True +zb32digit c = or [ '3' <= c && c <= '9' + , 'a' <= c && c <= 'k' + , 'm' <= c && c <= 'u' + , 'w' <= c && c <= 'z' + ] + + +-- | Parse 43-digit base64 token into 32-byte bytestring. +parseBase64Key256 :: String -> Either String ByteString +parseBase64Key256 str = fmap (BA.drop 1) $ Base64.decode $ C8.pack $ 'A':map (nmtoken64 False) (take 43 str) + +-- | Encode 43-digit base64 token from 32-byte bytestring. +showBase64Key256 :: ByteArrayAccess bin => bin -> String +showBase64Key256 bs = map (nmtoken64 True) $ C8.unpack $ BA.drop 1 $ Base64.encode $ BA.cons 0 $ BA.convert bs + +foreign import ccall "crc4itu" c_crc4itu :: Word8 -- ^ init crc + -> Ptr Word8 -- ^ data to checksum + -> Int32 -- ^ length of data + -> IO Word8 -- crc in low 4 bits + +-- | CRC4-ITU. Return crc in lowest 4 bits. +crc4itu :: ByteArrayAccess ba => Word8 -- ^ Existing CRC value (usually 0x00) before process a new one. + -> ba -- ^ Data to checksum. + -> Word8 +crc4itu crc0 b = unsafePerformIO $ BA.withByteArray b $ \p -> + c_crc4itu crc0 p (fromIntegral $ BA.length b) + +-- | Parse 52-digit z-base32 token into 32-byte bytestring. +parseBase32Key256 :: String -> Either String ByteString +parseBase32Key256 str = do + bs <- Base32.decode $ C8.pack $ map (fixupDigit32 . toLower) (take 52 str) ++ "y" + case BA.splitAt 32 bs of + (key,mac) | crc4itu 0 key == shiftR (BA.index mac 0) 4 + -> Right key + _ -> Left "Failed cyclic redundancy check." + +-- | Encode 52-digit z-base32 token from 32-byte bytestring. +showBase32Key256 :: ByteArrayAccess bin => bin -> String +showBase32Key256 bs = C8.unpack $ B.take 52 $ Base32.encode (b `B.snoc` shiftL crc 4) + where + b = BA.convert bs + crc = crc4itu 0 bs + +-- | Encode 32-byte bytestring for display. +showKey256 :: ByteArrayAccess bin => bin -> String +showKey256 = showBase32Key256 + +readsPrecKey256 :: (ByteString -> Maybe a) -> [Char] -> [(a, [Char])] +readsPrecKey256 publicKey str + | (bs,_) <- Base16.decode (C8.pack $ take 64 str) + , Just pub <- publicKey bs + = [ (pub, drop (2 * B.length bs) str) ] + | Right bs <- parseBase32Key256 str + , Just pub <- publicKey bs + = [ (pub, drop 52 str) ] + | Right bs <- parseBase64Key256 str + , Just pub <- publicKey bs + = [ (pub, drop 43 str) ] + | otherwise = [] + + +parseKey256 :: (MonadFail m, Alternative m) => String -> m ByteString +parseKey256 nidstr = do + let nidbs = C8.pack nidstr + (bs,_) = Base16.decode nidbs + enid = case C8.length nidbs of + 52 -> parseBase32Key256 nidstr + 43 -> parseBase64Key256 nidstr + _ -> Left "Wrong size of key." + idbs <- (guard (B.length bs == 32) >> return bs) + <|> either MF.fail return enid + return idbs + +readP_key256 :: RP.ReadP ByteString +readP_key256 = do + (is64,hexhash) <- foldr1 (RP.+++) + [ fmap (16,) (sequence $ replicate 64 (RP.satisfy isHexDigit)) + , fmap (32,) (sequence $ replicate 52 (RP.satisfy zb32digit)) + , fmap (64,) (sequence $ replicate 43 (RP.satisfy b64digit)) + ] + let failure = MF.fail "Bad key." + case is64 of + 32 -> case parseBase32Key256 hexhash of + Right bs -> return bs + _ -> failure + 64 -> case parseBase64Key256 hexhash of + Right bs -> return bs + _ -> failure + 16 -> case Base16.decode $ C8.pack hexhash of + (bs,rem) | B.length bs == 32 && B.null rem -> return bs + _ -> failure + _ -> failure diff --git a/tox-crypto/src/Crypto/Tox.hs b/tox-crypto/src/Crypto/Tox.hs index 04b55d94..602ead0a 100644 --- a/tox-crypto/src/Crypto/Tox.hs +++ b/tox-crypto/src/Crypto/Tox.hs @@ -67,6 +67,16 @@ module Crypto.Tox , encodeSecret , decodeSecret , xorsum + , Codec.AsciiKey256.showBase32Key256 + , Codec.AsciiKey256.showBase64Key256 + , Codec.AsciiKey256.showKey256 + , Codec.AsciiKey256.parseBase64Key256 + , Codec.AsciiKey256.parseBase32Key256 + , Codec.AsciiKey256.parseKey256 + , Codec.AsciiKey256.readP_key256 + , Codec.AsciiKey256.readsPrecKey256 + , Codec.AsciiKey256.stripSuffix + , Codec.AsciiKey256.nmtoken64 ) where import Control.Arrow @@ -99,6 +109,7 @@ import Foreign.Marshal.Alloc import Foreign.Ptr import Foreign.Storable import System.Endian +import Codec.AsciiKey256 import Control.Concurrent.STM #ifdef CRYPTONITE_BACKPORT import Crypto.ECC.Class diff --git a/tox-crypto/tox-crypto.cabal b/tox-crypto/tox-crypto.cabal index 678cccd5..370b1a85 100644 --- a/tox-crypto/tox-crypto.cabal +++ b/tox-crypto/tox-crypto.cabal @@ -16,8 +16,9 @@ extra-source-files: CHANGELOG.md cabal-version: >=1.10 library + C-sources: cbits/crc4_itu.c exposed-modules: Crypto.Tox - other-modules: DebugTag + other-modules: DebugTag, Codec.AsciiKey256 other-extensions: CPP , GeneralizedNewtypeDeriving , ScopedTypeVariables @@ -40,8 +41,10 @@ library base , cpu , memory + , base32-bytestring , base64-bytestring , base16-bytestring + , text , cereal , word64-map , contravariant -- cgit v1.2.3