From dc67ee394205802d30d888387dffa7f588099217 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Sun, 5 May 2019 13:37:01 +0200 Subject: Signed identities using ED25519 --- erebos.cabal | 1 + src/Identity.hs | 12 ++++++--- src/Main.hs | 5 +++- src/Network.hs | 21 ++++++++++----- src/PubKey.hs | 80 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ src/Storage.hs | 4 +++ 6 files changed, 113 insertions(+), 10 deletions(-) create mode 100644 src/PubKey.hs diff --git a/erebos.cabal b/erebos.cabal index fad6b90..8d7e62f 100644 --- a/erebos.cabal +++ b/erebos.cabal @@ -20,6 +20,7 @@ executable erebos main-is: Main.hs other-modules: Identity, Network, + PubKey, Storage default-extensions: FlexibleContexts, diff --git a/src/Identity.hs b/src/Identity.hs index 76d0c97..65fec8a 100644 --- a/src/Identity.hs +++ b/src/Identity.hs @@ -1,22 +1,28 @@ module Identity ( - Identity(..), + Identity, IdentityData(..), ) where import Data.Text (Text) +import PubKey import Storage -data Identity = Identity +type Identity = Signed IdentityData + +data IdentityData = Identity { idName :: Text , idPrev :: Maybe (Stored Identity) + , idKeyIdentity :: Stored PublicKey } deriving (Show) -instance Storable Identity where +instance Storable IdentityData where store' idt = storeRec $ do storeText "name" $ idName idt storeMbRef "prev" $ idPrev idt + storeRef "key-id" $ idKeyIdentity idt load' = loadRec $ Identity <$> loadText "name" <*> loadMbRef "prev" + <*> loadRef "key-id" diff --git a/src/Main.hs b/src/Main.hs index 017d70d..9f6cade 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -12,6 +12,7 @@ import System.IO.Error import Identity import Network +import PubKey import Storage @@ -23,7 +24,9 @@ main = do putStr "Name: " hFlush stdout name <- T.getLine - let base = Identity name Nothing + (secret, public) <- generateKeys st + + base <- sign secret =<< wrappedStore st (Identity name Nothing public) Right h <- replaceHead base (Left (st, "identity")) return h let sidentity = wrappedLoad (headRef idhead) :: Stored Identity diff --git a/src/Network.hs b/src/Network.hs index 6609667..44f27e7 100644 --- a/src/Network.hs +++ b/src/Network.hs @@ -17,6 +17,7 @@ import Network.Socket import Network.Socket.ByteString (recvFrom, sendTo) import Identity +import PubKey import Storage @@ -108,30 +109,38 @@ peerDiscovery bhost sidentity = do void $ sendTo sock (BL.toStrict $ BL.concat [ serializeObject $ transportToObject $ IdentityRequest ref (storedRef sidentity) , lazyLoadBytes $ storedRef sidentity + , lazyLoadBytes $ storedRef $ signedData $ fromStored sidentity + , lazyLoadBytes $ storedRef $ idKeyIdentity $ fromStored $ signedData $ fromStored sidentity + , lazyLoadBytes $ storedRef $ signedSignature $ fromStored sidentity ]) peer packet _ _ peer (IdentityRequest ref from) [] = do putStrLn $ "Got identity request: for " ++ show ref ++ " by " ++ show from ++ " from " ++ show peer ++ " without content" - packet chan sock peer (IdentityRequest ref from) objs@(obj:_) = do + packet chan sock peer (IdentityRequest ref from) (obj:objs) = do putStrLn $ "Got identity request: for " ++ show ref ++ " by " ++ show from ++ " from " ++ show peer - print objs + print (obj:objs) from' <- store (storedStorage sidentity) obj if from == from' - then do writeChan chan $ Peer (wrappedLoad from) (DatagramAddress peer) + then do forM_ objs $ store $ storedStorage sidentity + writeChan chan $ Peer (wrappedLoad from) (DatagramAddress peer) void $ sendTo sock (BL.toStrict $ BL.concat [ serializeObject $ transportToObject $ IdentityResponse (storedRef sidentity) , lazyLoadBytes $ storedRef sidentity + , lazyLoadBytes $ storedRef $ signedData $ fromStored sidentity + , lazyLoadBytes $ storedRef $ idKeyIdentity $ fromStored $ signedData $ fromStored sidentity + , lazyLoadBytes $ storedRef $ signedSignature $ fromStored sidentity ]) peer else putStrLn $ "Mismatched content" packet _ _ peer (IdentityResponse ref) [] = do putStrLn $ "Got identity response: by " ++ show ref ++ " from " ++ show peer ++ " without content" - packet chan _ peer (IdentityResponse ref) objs@(obj:_) = do + packet chan _ peer (IdentityResponse ref) (obj:objs) = do putStrLn $ "Got identity response: by " ++ show ref ++ " from " ++ show peer - print objs + print (obj:objs) ref' <- store (storedStorage sidentity) obj if ref == ref' - then writeChan chan $ Peer (wrappedLoad ref) (DatagramAddress peer) + then do forM_ objs $ store $ storedStorage sidentity + writeChan chan $ Peer (wrappedLoad ref) (DatagramAddress peer) else putStrLn $ "Mismatched content" diff --git a/src/PubKey.hs b/src/PubKey.hs new file mode 100644 index 0000000..d89747a --- /dev/null +++ b/src/PubKey.hs @@ -0,0 +1,80 @@ +module PubKey ( + PublicKey, SecretKey, + Signature(sigKey), Signed(..), + generateKeys, + sign, +) where + +import Control.Monad +import Control.Monad.Except + +import Crypto.Error +import qualified Crypto.PubKey.Ed25519 as ED + +import Data.ByteString (ByteString) +import qualified Data.Text as T + +import Storage + +data PublicKey = PublicKey ED.PublicKey + deriving (Show) + +data SecretKey = SecretKey ED.SecretKey (Stored PublicKey) + +data Signature = Signature + { sigKey :: Stored PublicKey + , sigSignature :: ED.Signature + } + deriving (Show) + +data Signed a = Signed + { signedData :: Stored a + , signedSignature :: Stored Signature + } + deriving (Show) + +instance Storable PublicKey where + store' (PublicKey pk) = storeRec $ do + storeText "type" $ T.pack "ed25519" + storeBinary "pubkey" pk + + load' = loadRec $ do + ktype <- loadText "type" + guard $ ktype == "ed25519" + maybe (throwError "Public key decoding failed") (return . PublicKey) . + maybeCryptoError . (ED.publicKey :: ByteString -> CryptoFailable ED.PublicKey) =<< + loadBinary "pubkey" + +instance Storable Signature where + store' sig = storeRec $ do + storeRef "key" $ sigKey sig + storeBinary "sig" $ sigSignature sig + + load' = loadRec $ Signature + <$> loadRef "key" + <*> loadSignature "sig" + where loadSignature = maybe (throwError "Signature decoding failed") return . + maybeCryptoError . (ED.signature :: ByteString -> CryptoFailable ED.Signature) <=< loadBinary + +instance Storable a => Storable (Signed a) where + store' sig = storeRec $ do + storeRef "data" $ signedData sig + storeRef "sig" $ signedSignature sig + + load' = loadRec $ Signed + <$> loadRef "data" + <*> loadRef "sig" + + +generateKeys :: Storage -> IO (SecretKey, Stored PublicKey) +generateKeys st = do + secret <- ED.generateSecretKey + public <- wrappedStore st $ PublicKey $ ED.toPublic secret + return (SecretKey secret public, public) + +sign :: SecretKey -> Stored a -> IO (Signed a) +sign (SecretKey secret spublic) val = do + let PublicKey public = fromStored spublic + sig = ED.sign secret public $ storedRef val + ssig <- wrappedStore (storedStorage val) $ Signature spublic sig + return $ Signed val ssig diff --git a/src/Storage.hs b/src/Storage.hs index f9d302e..c31230e 100644 --- a/src/Storage.hs +++ b/src/Storage.hs @@ -107,6 +107,10 @@ data Ref = Ref Storage (Digest Blake2b_256) instance Show Ref where show ref@(Ref (Storage path) _) = path ++ ":" ++ BC.unpack (showRef ref) +instance BA.ByteArrayAccess Ref where + length (Ref _ dgst) = BA.length dgst + withByteArray (Ref _ dgst) = BA.withByteArray dgst + zeroRef :: Storage -> Ref zeroRef s = Ref s h where h = case digestFromByteString $ B.replicate (BA.length h) 0 of -- cgit v1.2.3