From 88a7bb50033baab3c2d0eed7e4be868e8966300a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Fri, 17 Nov 2023 20:28:44 +0100
Subject: Split to library and executable parts

---
 src/Storage/Key.hs | 84 ------------------------------------------------------
 1 file changed, 84 deletions(-)
 delete mode 100644 src/Storage/Key.hs

(limited to 'src/Storage/Key.hs')

diff --git a/src/Storage/Key.hs b/src/Storage/Key.hs
deleted file mode 100644
index 7730f9f..0000000
--- a/src/Storage/Key.hs
+++ /dev/null
@@ -1,84 +0,0 @@
-module Storage.Key (
-    KeyPair(..),
-    storeKey, loadKey, loadKeyMb,
-    moveKeys,
-) where
-
-import Control.Concurrent.MVar
-import Control.Monad
-import Control.Monad.Except
-
-import Data.ByteArray
-import qualified Data.ByteString.Char8 as BC
-import qualified Data.ByteString.Lazy as BL
-import qualified Data.Map as M
-
-import System.Directory
-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
-
-
-keyFilePath :: KeyPair sec pub => FilePath -> Stored pub -> FilePath
-keyFilePath sdir pkey = sdir </> "keys" </> (BC.unpack $ showRef $ storedRef pkey)
-
-storeKey :: KeyPair sec pub => sec -> IO ()
-storeKey key = do
-    let spub = keyGetPublic key
-    case stBacking $ storedStorage spub of
-         StorageDir { dirPath = dir } -> writeFileOnce (keyFilePath dir spub) (BL.fromStrict $ convert $ keyGetData key)
-         StorageMemory { memKeys = kstore } -> modifyMVar_ kstore $ return . M.insert (refDigest $ storedRef spub) (keyGetData key)
-
-loadKey :: (KeyPair sec pub, MonadIO m, MonadError String m) => Stored pub -> m sec
-loadKey pub = maybe (throwError $ "secret key not found for " <> show (storedRef pub)) return =<< loadKeyMb pub
-
-loadKeyMb :: (KeyPair sec pub, MonadIO m) => Stored pub -> m (Maybe sec)
-loadKeyMb spub = liftIO $ run $ storedStorage spub
-  where
-    run st = tryOneLevel (stBacking st) >>= \case
-        key@Just {} -> return key
-        Nothing | Just parent <- stParent st -> run parent
-                | otherwise -> return Nothing
-    tryOneLevel = \case
-        StorageDir { dirPath = dir } -> tryIOError (BC.readFile (keyFilePath dir spub)) >>= \case
-            Right kdata -> return $ keyFromData (convert kdata) spub
-            Left _ -> return Nothing
-        StorageMemory { memKeys = kstore } -> (flip keyFromData spub <=< M.lookup (refDigest $ storedRef spub)) <$> readMVar kstore
-
-moveKeys :: MonadIO m => Storage -> Storage -> m ()
-moveKeys from to = liftIO $ do
-    case (stBacking from, stBacking to) of
-        (StorageDir { dirPath = fromPath }, StorageDir { dirPath = toPath }) -> do
-            files <- listDirectory (fromPath </> "keys")
-            forM_ files $ \file -> do
-                renameFile (fromPath </> "keys" </> file) (toPath </> "keys" </> file)
-
-        (StorageDir { dirPath = fromPath }, StorageMemory { memKeys = toKeys }) -> do
-            let move m file
-                    | Just dgst <- readRefDigest (BC.pack file) = do
-                        let path = fromPath </> "keys" </> file
-                        key <- convert <$> BC.readFile path
-                        removeFile path
-                        return $ M.insert dgst key m
-                    | otherwise = return m
-            files <- listDirectory (fromPath </> "keys")
-            modifyMVar_ toKeys $ \keys -> foldM move keys files
-
-        (StorageMemory { memKeys = fromKeys }, StorageDir { dirPath = toPath }) -> do
-            modifyMVar_ fromKeys $ \keys -> do
-                forM_ (M.assocs keys) $ \(dgst, key) ->
-                    writeFileOnce (toPath </> "keys" </> (BC.unpack $ showRefDigest dgst)) (BL.fromStrict $ convert key)
-                return M.empty
-
-        (StorageMemory { memKeys = fromKeys }, StorageMemory { memKeys = toKeys }) -> do
-            modifyMVar_ fromKeys $ \fkeys -> do
-                modifyMVar_ toKeys $ return . M.union fkeys
-                return M.empty
-- 
cgit v1.2.3