Key storage interface

5 files changed, 112 insertions, 57 deletions

diff --git a/erebos.cabal b/erebos.cabal
index 17948b2..a51e61a 100644
--- a/erebos.cabal
+++ b/erebos.cabal
@@ -21,10 +21,13 @@ executable erebos
   other-modules:       Identity,
                        Network,
                        PubKey,
-                       Storage
+                       Storage,
+                       Storage.Internal
+                       Storage.Key
 
   default-extensions:  FlexibleContexts,
                        FlexibleInstances,
+                       FunctionalDependencies,
                        LambdaCase,
                        TupleSections
 
diff --git a/src/PubKey.hs b/src/PubKey.hs
index 787ada3..0022343 100644
--- a/src/PubKey.hs
+++ b/src/PubKey.hs
@@ -1,7 +1,7 @@
 module PubKey (
     PublicKey, SecretKey,
+    KeyPair(generateKeys), loadKey,
     Signature(sigKey), Signed, signedData, signedSignature,
-    generateKeys,
     sign, signAdd,
 ) where
 
@@ -11,10 +11,12 @@ import Control.Monad.Except
 import Crypto.Error
 import qualified Crypto.PubKey.Ed25519 as ED
 
+import Data.ByteArray
 import Data.ByteString (ByteString)
 import qualified Data.Text as T
 
 import Storage
+import Storage.Key
 
 data PublicKey = PublicKey ED.PublicKey
     deriving (Show)
@@ -39,6 +41,17 @@ signedData = signedData_
 signedSignature :: Signed a -> [Stored Signature]
 signedSignature = signedSignature_
 
+instance KeyPair SecretKey PublicKey where
+    keyGetPublic (SecretKey _ pub) = pub
+    keyGetData (SecretKey sec _) = convert sec
+    keyFromData kdata spub = SecretKey <$> maybeCryptoError (ED.secretKey kdata) <*> pure spub
+    generateKeys st = do
+        secret <- ED.generateSecretKey
+        public <- wrappedStore st $ PublicKey $ ED.toPublic secret
+        let pair = SecretKey secret public
+        storeKey pair
+        return (pair, public)
+
 instance Storable PublicKey where
     store' (PublicKey pk) = storeRec $ do
         storeText "type" $ T.pack "ed25519"
@@ -76,13 +89,6 @@ instance Storable a => Storable (Signed a) where
                 throwError "signature verification failed"
         return $ Signed sdata sigs
 
-
-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 secret val = signAdd secret $ Signed val []
 
diff --git a/src/Storage.hs b/src/Storage.hs
index 25c7a75..caf9d30 100644
--- a/src/Storage.hs
+++ b/src/Storage.hs
@@ -51,7 +51,6 @@ import qualified Codec.MIME.Type as MIME
 import qualified Codec.MIME.Parse as MIME
 
 import Control.Arrow
-import Control.Exception
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.Reader
@@ -86,16 +85,10 @@ import Data.Time.Format
 import Data.Time.LocalTime
 
 import System.Directory
-import System.FilePath
-import System.IO
 import System.IO.Unsafe
-import System.Posix.Files
-import System.Posix.IO
-import System.Posix.Types
 
+import Storage.Internal
 
-data Storage = Storage FilePath
-    deriving (Eq, Ord)
 
 openStorage :: FilePath -> IO Storage
 openStorage path = do
@@ -325,46 +318,6 @@ replaceHead obj prev = do
           showRefL ref = showRef ref `B.append` BC.singleton '\n'
 
 
-openFdParents :: FilePath -> OpenMode -> Maybe FileMode -> OpenFileFlags -> IO Fd
-openFdParents path omode fmode flags = do
-    createDirectoryIfMissing True (takeDirectory path)
-    openFd path omode fmode flags
-
-writeFileOnce :: FilePath -> BL.ByteString -> IO ()
-writeFileOnce file content = bracket
-    (fdToHandle =<< openFdParents locked WriteOnly (Just $ unionFileModes ownerReadMode ownerWriteMode) (defaultFileFlags { exclusive = True }))
-    hClose $ \h -> do
-        fileExist file >>= \case
-            True  -> removeLink locked
-            False -> do BL.hPut h content
-                        rename locked file
-    where locked = file ++ ".lock"
-
-writeFileChecked :: FilePath -> Maybe ByteString -> ByteString -> IO (Either (Maybe ByteString) ())
-writeFileChecked file prev content = bracket
-    (fdToHandle =<< openFdParents locked WriteOnly (Just $ unionFileModes ownerReadMode ownerWriteMode) (defaultFileFlags { exclusive = True }))
-    hClose $ \h -> do
-        (prev,) <$> fileExist file >>= \case
-            (Nothing, True) -> do
-                current <- B.readFile file
-                removeLink locked
-                return $ Left $ Just current
-            (Nothing, False) -> do B.hPut h content
-                                   rename locked file
-                                   return $ Right ()
-            (Just expected, True) -> do
-                current <- B.readFile file
-                if current == expected then do B.hPut h content
-                                               rename locked file
-                                               return $ return ()
-                                       else do removeLink locked
-                                               return $ Left $ Just current
-            (Just _, False) -> do
-                removeLink locked
-                return $ Left Nothing
-    where locked = file ++ ".lock"
-
-
 class Storable a where
     store' :: a -> Store
     load' :: Load a
diff --git a/src/Storage/Internal.hs b/src/Storage/Internal.hs
new file mode 100644
index 0000000..6a86dea
--- /dev/null
+++ b/src/Storage/Internal.hs
@@ -0,0 +1,57 @@
+module Storage.Internal where
+
+import Control.Exception
+
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as BL
+
+import System.Directory
+import System.FilePath
+import System.IO
+import System.Posix.Files
+import System.Posix.IO
+import System.Posix.Types
+
+data Storage = Storage FilePath
+    deriving (Eq, Ord)
+
+
+openFdParents :: FilePath -> OpenMode -> Maybe FileMode -> OpenFileFlags -> IO Fd
+openFdParents path omode fmode flags = do
+    createDirectoryIfMissing True (takeDirectory path)
+    openFd path omode fmode flags
+
+writeFileOnce :: FilePath -> BL.ByteString -> IO ()
+writeFileOnce file content = bracket
+    (fdToHandle =<< openFdParents locked WriteOnly (Just $ unionFileModes ownerReadMode ownerWriteMode) (defaultFileFlags { exclusive = True }))
+    hClose $ \h -> do
+        fileExist file >>= \case
+            True  -> removeLink locked
+            False -> do BL.hPut h content
+                        rename locked file
+    where locked = file ++ ".lock"
+
+writeFileChecked :: FilePath -> Maybe ByteString -> ByteString -> IO (Either (Maybe ByteString) ())
+writeFileChecked file prev content = bracket
+    (fdToHandle =<< openFdParents locked WriteOnly (Just $ unionFileModes ownerReadMode ownerWriteMode) (defaultFileFlags { exclusive = True }))
+    hClose $ \h -> do
+        (prev,) <$> fileExist file >>= \case
+            (Nothing, True) -> do
+                current <- B.readFile file
+                removeLink locked
+                return $ Left $ Just current
+            (Nothing, False) -> do B.hPut h content
+                                   rename locked file
+                                   return $ Right ()
+            (Just expected, True) -> do
+                current <- B.readFile file
+                if current == expected then do B.hPut h content
+                                               rename locked file
+                                               return $ return ()
+                                       else do removeLink locked
+                                               return $ Left $ Just current
+            (Just _, False) -> do
+                removeLink locked
+                return $ Left Nothing
+    where locked = file ++ ".lock"
diff --git a/src/Storage/Key.hs b/src/Storage/Key.hs
new file mode 100644
index 0000000..3ed4a66
--- /dev/null
+++ b/src/Storage/Key.hs
@@ -0,0 +1,36 @@
+module Storage.Key (
+    KeyPair(..),
+    storeKey, loadKey,
+) where
+
+import Data.ByteArray
+import qualified Data.ByteString.Char8 as BC
+import qualified Data.ByteString.Lazy as BL
+
+import System.FilePath
+import System.IO.Error
+
+import Storage
+import Storage.Internal
+
+class Storable pub => KeyPair sec pub | sec -> pub, pub -> sec where
+    generateKeys :: Storage -> IO (sec, Stored pub)
+    keyGetPublic :: sec -> Stored pub
+    keyGetData :: sec -> ScrubbedBytes
+    keyFromData :: ScrubbedBytes -> Stored pub -> Maybe sec
+
+
+keyStorage :: Storage -> FilePath
+keyStorage (Storage base) = base </> "keys"
+
+keyFilePath :: KeyPair sec pub => Stored pub -> FilePath
+keyFilePath pkey = keyStorage (storedStorage pkey) </> (BC.unpack $ showRef $ storedRef pkey)
+
+storeKey :: KeyPair sec pub => sec -> IO ()
+storeKey key = writeFileOnce (keyFilePath $ keyGetPublic key) (BL.fromStrict $ convert $ keyGetData key)
+
+loadKey :: KeyPair sec pub => Stored pub -> IO (Maybe sec)
+loadKey spub = do
+    tryIOError (BC.readFile (keyFilePath spub)) >>= \case
+        Right kdata -> return $ keyFromData (convert kdata) spub
+        Left _ -> return Nothing