1 files changed, 58 insertions, 0 deletions

diff --git a/lib/KeyDB.hs b/lib/KeyDB.hs
new file mode 100644
index 0000000..f5a4357
--- /dev/null
+++ b/lib/KeyDB.hs
@@ -0,0 +1,58 @@
+module KeyDB
+    {-
+    ( TrustMap
+    , SigAndTrust
+    , SubKey(..)
+    , KeyData(..)
+    , KeyDB
+    , emptyKeyDB
+    , keyData
+    , transmute
+    ) -} where
+
+import Control.Monad
+import Data.Functor
+import qualified Data.Map.Strict as Map
+import Data.OpenPGP
+
+import FunctorToMaybe
+import KeyRing.Types
+
+type TrustMap = Map.Map FilePath Packet
+type SigAndTrust = ( MappedPacket
+                   , TrustMap     ) -- trust packets
+data SubKey = SubKey MappedPacket [SigAndTrust] deriving Show
+
+-- | This is a GPG Identity which includes a master key and all its UIDs and
+-- subkeys and associated signatures.
+data KeyData = KeyData
+    { keyMappedPacket :: MappedPacket                               -- main key
+    , keySigAndTrusts :: [SigAndTrust]                              -- sigs on main key
+    , keyUids         :: (Map.Map String ([SigAndTrust],OriginMap)) -- uids
+    , keySubKeys      :: (Map.Map KeyKey SubKey)                    -- subkeys
+    } deriving Show
+
+
+data KeyDB = KeyDB
+    { byKeyKey :: Map.Map KeyKey KeyData
+    } deriving Show
+
+emptyKeyDB :: KeyDB
+emptyKeyDB = KeyDB { byKeyKey = Map.empty }
+
+keyData :: KeyDB -> [KeyData]
+keyData db = Map.elems (byKeyKey db)
+
+
+transmute :: (Monad m, Monad kiki, Traversable kiki) =>
+       ((KeyData, [info]) -> opcode -> m (kiki (KeyData, [info]))) -- ^ interpreter
+       -> (KeyData -> [opcode])                                    -- ^ instructions
+       -> KeyDB                                                    -- ^ initial state
+       -> m (kiki (KeyDB, [info]))
+transmute perform update db = do
+    let performAll kd = foldM (\kkd op -> join <$> mapM (`perform` op) kkd)
+                              (pure (kd,[]))
+                              (update kd)
+    r <- sequenceA <$> mapM performAll (byKeyKey db)
+    return $ r <&> \bkk -> ( db { byKeyKey = fst <$> bkk }
+                           , concatMap snd $ Map.elems bkk )