diff options
| -rw-r--r-- | src/PubKey.hs | 15 | ||||
| -rw-r--r-- | src/Storage.hs | 11 |
2 files changed, 19 insertions, 7 deletions
diff --git a/src/PubKey.hs b/src/PubKey.hs index d89747a..af4d03b 100644 --- a/src/PubKey.hs +++ b/src/PubKey.hs @@ -2,7 +2,7 @@ module PubKey ( PublicKey, SecretKey, Signature(sigKey), Signed(..), generateKeys, - sign, + sign, signAdd, ) where import Control.Monad @@ -29,7 +29,7 @@ data Signature = Signature data Signed a = Signed { signedData :: Stored a - , signedSignature :: Stored Signature + , signedSignature :: [Stored Signature] } deriving (Show) @@ -59,11 +59,11 @@ instance Storable Signature where instance Storable a => Storable (Signed a) where store' sig = storeRec $ do storeRef "data" $ signedData sig - storeRef "sig" $ signedSignature sig + mapM_ (storeRef "sig") $ signedSignature sig load' = loadRec $ Signed <$> loadRef "data" - <*> loadRef "sig" + <*> loadRefs "sig" generateKeys :: Storage -> IO (SecretKey, Stored PublicKey) @@ -73,8 +73,11 @@ generateKeys st = do return (SecretKey secret public, public) sign :: SecretKey -> Stored a -> IO (Signed a) -sign (SecretKey secret spublic) val = do +sign secret val = signAdd secret $ Signed val [] + +signAdd :: SecretKey -> Signed a -> IO (Signed a) +signAdd (SecretKey secret spublic) (Signed val sigs) = do let PublicKey public = fromStored spublic sig = ED.sign secret public $ storedRef val ssig <- wrappedStore (storedStorage val) $ Signature spublic sig - return $ Signed val ssig + return $ Signed val (ssig : sigs) diff --git a/src/Storage.hs b/src/Storage.hs index b3c2619..a306206 100644 --- a/src/Storage.hs +++ b/src/Storage.hs @@ -24,7 +24,7 @@ module Storage ( loadBlob, loadRec, loadZero, loadInt, loadNum, loadText, loadBinary, loadDate, loadJson, loadRef, - loadMbInt, loadMbNum, loadMbText, loadMbBinary, loadMbDate, loadMbJson, loadMbRef, + loadMbInt, loadMbNum, loadMbText, loadMbBinary, loadMbDate, loadMbJson, loadMbRef, loadRefs, loadZRef, Stored, @@ -607,12 +607,21 @@ loadMbRawRef name = asks (lookup (BC.pack name) . snd) >>= \case Just (RecRef x) -> return (Just x) Just _ -> throwError $ "Expecting type ref of record item '"++name++"'" +loadRawRefs :: String -> LoadRec [Ref] +loadRawRefs name = do + items <- map snd . filter ((BC.pack name ==) . fst) <$> asks snd + forM items $ \case RecRef x -> return x + _ -> throwError $ "Expecting type ref of record item '"++name++"'" + loadRef :: Storable a => String -> LoadRec a loadRef name = load <$> loadRawRef name loadMbRef :: Storable a => String -> LoadRec (Maybe a) loadMbRef name = fmap load <$> loadMbRawRef name +loadRefs :: Storable a => String -> LoadRec [a] +loadRefs name = map load <$> loadRawRefs name + loadZRef :: ZeroStorable a => String -> LoadRec a loadZRef name = loadMbRef name >>= \case Nothing -> do Ref st _ <- asks fst |