summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--erebos.cabal1
-rw-r--r--src/Identity.hs12
-rw-r--r--src/Main.hs5
-rw-r--r--src/Network.hs21
-rw-r--r--src/PubKey.hs80
-rw-r--r--src/Storage.hs4
6 files changed, 113 insertions, 10 deletions
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
generated by cgit v1.2.3 (git 2.25.1) at 2025-10-31 02:29:36 +0000