From dc67ee394205802d30d888387dffa7f588099217 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sun, 5 May 2019 13:37:01 +0200
Subject: Signed identities using ED25519

---
 src/PubKey.hs | 80 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 80 insertions(+)
 create mode 100644 src/PubKey.hs

(limited to 'src/PubKey.hs')

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
-- 
cgit v1.2.3