Replace storedStorage usage with MonadHead

2 files changed, 10 insertions, 3 deletions

diff --git a/src/Storage/Internal.hs b/src/Storage/Internal.hs
index 402d924..b68d0f7 100644
--- a/src/Storage/Internal.hs
+++ b/src/Storage/Internal.hs
@@ -175,6 +175,9 @@ instance Eq (Stored' c a) where
 instance Ord (Stored' c a) where
     compare (Stored r1 _) (Stored r2 _) = compare (refDigest r1) (refDigest r2)
 
+storedStorage :: Stored' c a -> Storage' c
+storedStorage (Stored (Ref st _) _) = st
+
 
 type Complete = Identity
 type Partial = Either RefDigest
diff --git a/src/Storage/Key.hs b/src/Storage/Key.hs
index 28fc989..7d36da3 100644
--- a/src/Storage/Key.hs
+++ b/src/Storage/Key.hs
@@ -1,10 +1,11 @@
 module Storage.Key (
     KeyPair(..),
-    storeKey, loadKey,
+    storeKey, loadKey, loadKeyMb,
 ) where
 
 import Control.Concurrent.MVar
 import Control.Monad
+import Control.Monad.Except
 
 import Data.ByteArray
 import qualified Data.ByteString.Char8 as BC
@@ -34,8 +35,11 @@ storeKey key = do
          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 => Stored pub -> IO (Maybe sec)
-loadKey spub = do
+loadKey :: (KeyPair sec pub, MonadIO m, MonadError String m) => Stored pub -> m sec
+loadKey = maybe (throwError "secret key not found") return <=< loadKeyMb
+
+loadKeyMb :: (KeyPair sec pub, MonadIO m) => Stored pub -> m (Maybe sec)
+loadKeyMb spub = liftIO $ do
     case stBacking $ storedStorage spub of
          StorageDir { dirPath = dir } -> tryIOError (BC.readFile (keyFilePath dir spub)) >>= \case
              Right kdata -> return $ keyFromData (convert kdata) spub