1 files changed, 52 insertions, 0 deletions
diff --git a/src/Erebos/Storage/Key.hs b/src/Erebos/Storage/Key.hs
new file mode 100644
index 0000000..b615f16
--- /dev/null
+++ b/src/Erebos/Storage/Key.hs
@@ -0,0 +1,52 @@
+module Erebos.Storage.Key (
+    KeyPair(..),
+    storeKey, loadKey, loadKeyMb,
+    moveKeys,
+) where
+
+import Control.Monad
+import Control.Monad.Except
+import Control.Monad.IO.Class
+
+import Data.ByteArray
+import Data.Typeable
+
+import Erebos.Storable
+import Erebos.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
+
+
+storeKey :: KeyPair sec pub => sec -> IO ()
+storeKey key = do
+    let spub = keyGetPublic key
+    case storedStorage spub of
+        Storage {..} -> backendStoreKey stBackend (refDigest $ storedRef spub) (keyGetData key)
+
+loadKey :: (KeyPair sec pub, MonadIO m, MonadError e m, FromErebosError e) => Stored pub -> m sec
+loadKey pub = maybe (throwOtherError $ "secret key not found for " <> show (storedRef pub)) return =<< loadKeyMb pub
+
+loadKeyMb :: forall sec pub m. (KeyPair sec pub, MonadIO m) => Stored pub -> m (Maybe sec)
+loadKeyMb spub = liftIO $ run $ storedStorage spub
+  where
+    run :: Storage' c -> IO (Maybe sec)
+    run Storage {..} = backendLoadKey stBackend (refDigest $ storedRef spub) >>= \case
+        Just bytes -> return $ keyFromData bytes spub
+        Nothing
+            | Just (parent :: Storage) <- cast (backendParent stBackend) -> run parent
+            | Just (parent :: PartialStorage) <- cast (backendParent stBackend) -> run parent
+            | otherwise -> return Nothing
+
+moveKeys :: MonadIO m => Storage -> Storage -> m ()
+moveKeys Storage { stBackend = from } Storage { stBackend = to } = liftIO $ do
+    keys <- backendListKeys from
+    forM_ keys $ \key -> do
+        backendLoadKey from key >>= \case
+            Just sec -> do
+                backendStoreKey to key sec
+                backendRemoveKey from key
+            Nothing -> return ()