diff options
author | Joe Crayne <joe@jerkface.net> | 2018-11-25 22:26:24 -0500 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2018-12-16 14:08:26 -0500 |
commit | 1177dc760f2d12c551859054323580b93f2d38d9 (patch) | |
tree | 2dcd7d5fb26f0af4594ebd484f2d3aa33bd1badc | |
parent | dfcab14e4d593f6a51db3fa5cf61f0358dc0f280 (diff) |
ChatID is a type alias for an Ed25519 signature key.
-rw-r--r-- | src/Data/Tox/Msg.hs | 27 | ||||
-rw-r--r-- | src/Network/Tox/NodeId.hs | 14 |
2 files changed, 37 insertions, 4 deletions
diff --git a/src/Data/Tox/Msg.hs b/src/Data/Tox/Msg.hs index d42b092b..e8c26a56 100644 --- a/src/Data/Tox/Msg.hs +++ b/src/Data/Tox/Msg.hs | |||
@@ -10,6 +10,9 @@ | |||
10 | {-# LANGUAGE TypeFamilies #-} | 10 | {-# LANGUAGE TypeFamilies #-} |
11 | module Data.Tox.Msg where | 11 | module Data.Tox.Msg where |
12 | 12 | ||
13 | import Crypto.Error | ||
14 | import qualified Crypto.PubKey.Ed25519 as Ed25519 | ||
15 | import Data.ByteArray as BA | ||
13 | import Data.ByteString as B | 16 | import Data.ByteString as B |
14 | import Data.Dependent.Sum | 17 | import Data.Dependent.Sum |
15 | import Data.Functor.Contravariant | 18 | import Data.Functor.Contravariant |
@@ -234,8 +237,28 @@ lossyness m = case msgbyte m of | |||
234 | | otherwise -> Lossless | 237 | | otherwise -> Lossless |
235 | 238 | ||
236 | 239 | ||
237 | newtype ChatID = ChatID Nonce32 | 240 | newtype ChatID = ChatID Ed25519.PublicKey |
238 | deriving (Eq,Show,Serialize,Sized) | 241 | deriving Eq |
242 | |||
243 | instance Sized ChatID where size = ConstSize 32 | ||
244 | |||
245 | instance Serialize ChatID where | ||
246 | get = do | ||
247 | bs <- getBytes 32 | ||
248 | case Ed25519.publicKey bs of | ||
249 | CryptoPassed ed -> return $ ChatID ed | ||
250 | CryptoFailed e -> fail (show e) | ||
251 | put (ChatID ed) = putByteString $ BA.convert ed | ||
252 | |||
253 | instance Read ChatID where | ||
254 | readsPrec _ s | ||
255 | | Right bs <- parseToken32 s | ||
256 | , CryptoPassed ed <- Ed25519.publicKey bs | ||
257 | = [ (ChatID ed, Prelude.drop 43 s) ] | ||
258 | | otherwise = [] | ||
259 | |||
260 | instance Show ChatID where | ||
261 | show (ChatID ed) = showToken32 ed | ||
239 | 262 | ||
240 | data InviteType = GroupInvite { groupName :: Text } | 263 | data InviteType = GroupInvite { groupName :: Text } |
241 | | AccptedInvite | 264 | | AccptedInvite |
diff --git a/src/Network/Tox/NodeId.hs b/src/Network/Tox/NodeId.hs index 97faa942..56ddf03c 100644 --- a/src/Network/Tox/NodeId.hs +++ b/src/Network/Tox/NodeId.hs | |||
@@ -37,6 +37,8 @@ module Network.Tox.NodeId | |||
37 | , verifyChecksum | 37 | , verifyChecksum |
38 | , ToxContact(..) | 38 | , ToxContact(..) |
39 | , ToxProgress(..) | 39 | , ToxProgress(..) |
40 | , parseToken32 | ||
41 | , showToken32 | ||
40 | ) where | 42 | ) where |
41 | 43 | ||
42 | import Control.Applicative | 44 | import Control.Applicative |
@@ -166,18 +168,26 @@ nmtoken64 True '+' = '.' | |||
166 | nmtoken64 True '/' = '-' | 168 | nmtoken64 True '/' = '-' |
167 | nmtoken64 _ c = c | 169 | nmtoken64 _ c = c |
168 | 170 | ||
171 | -- | Parse 43-digit base64 token into 32-byte bytestring. | ||
172 | parseToken32 :: String -> Either String ByteString | ||
173 | parseToken32 str = fmap (BA.drop 1) $ Base64.decode $ C8.pack $ 'A':map (nmtoken64 False) (take 43 str) | ||
174 | |||
175 | -- | Encode 32-byte bytestring as 43-digit base64 token. | ||
176 | showToken32 :: ByteArrayAccess bin => bin -> String | ||
177 | showToken32 bs = map (nmtoken64 True) $ C8.unpack $ BA.drop 1 $ Base64.encode $ BA.cons 0 $ BA.convert bs | ||
178 | |||
169 | instance Read NodeId where | 179 | instance Read NodeId where |
170 | readsPrec _ str | 180 | readsPrec _ str |
171 | | (bs,_) <- Base16.decode (C8.pack $ take 64 str) | 181 | | (bs,_) <- Base16.decode (C8.pack $ take 64 str) |
172 | , CryptoPassed pub <- publicKey bs -- B.length bs == 32 | 182 | , CryptoPassed pub <- publicKey bs -- B.length bs == 32 |
173 | = [ (key2id pub, drop (2 * B.length bs) str) ] | 183 | = [ (key2id pub, drop (2 * B.length bs) str) ] |
174 | | Right bs <- fmap (BA.drop 1) $ Base64.decode $ C8.pack $ 'A':map (nmtoken64 False) (take 43 str) | 184 | | Right bs <- parseToken32 str |
175 | , CryptoPassed pub <- publicKey bs -- B.length bs == 32 | 185 | , CryptoPassed pub <- publicKey bs -- B.length bs == 32 |
176 | = [ (key2id pub, drop 43 str) ] | 186 | = [ (key2id pub, drop 43 str) ] |
177 | | otherwise = [] | 187 | | otherwise = [] |
178 | 188 | ||
179 | instance Show NodeId where | 189 | instance Show NodeId where |
180 | show nid = map (nmtoken64 True) $ C8.unpack $ BA.drop 1 $ Base64.encode $ BA.cons 0 $ BA.convert $ id2key nid | 190 | show nid = showToken32 $ id2key nid |
181 | 191 | ||
182 | instance S.Serialize NodeId where | 192 | instance S.Serialize NodeId where |
183 | get = key2id <$> getPublicKey | 193 | get = key2id <$> getPublicKey |