Use extended identity data for name

9 files changed, 46 insertions, 31 deletions

diff --git a/src/Attach.hs b/src/Attach.hs
index 48d18d8..436f786 100644
--- a/src/Attach.hs
+++ b/src/Attach.hs
@@ -42,13 +42,13 @@ instance PairingResult AttachIdentity where
 
     pairingVerifyResult (AttachIdentity sdata keys) = do
         curid <- lsIdentity . fromStored <$> svcGetLocal
-        secret <- loadKey $ iddKeyIdentity $ fromStored $ signedData $ fromStored curid
+        secret <- loadKey $ eiddKeyIdentity $ fromSigned curid
         sdata' <- mstore =<< signAdd secret (fromStored sdata)
         return $ do
-            guard $ iddKeyIdentity (fromStored $ signedData $ fromStored sdata) ==
-                iddKeyIdentity (fromStored $ signedData $ fromStored curid)
+            guard $ iddKeyIdentity (fromSigned sdata) ==
+                eiddKeyIdentity (fromSigned curid)
             identity <- validateIdentity sdata'
-            guard $ iddPrev (fromStored $ signedData $ fromStored $ idData identity) == [curid]
+            guard $ iddPrev (fromSigned $ idData identity) == [eiddStoredBase curid]
             return (identity, keys)
 
     pairingFinalizeRequest (identity, keys) = updateLocalHead_ $ \slocal -> do
@@ -57,9 +57,10 @@ instance PairingResult AttachIdentity where
         pkeys <- mapM (copyStored st) [ idKeyIdentity owner, idKeyMessage owner ]
         liftIO $ mapM_ storeKey $ catMaybes [ keyFromData sec pub | sec <- keys, pub <- pkeys ]
 
+        identity' <- mergeIdentity $ updateIdentity [ lsIdentity $ fromStored slocal ] identity
         shared <- makeSharedStateUpdate st (Just owner) (lsShared $ fromStored slocal)
         mstore (fromStored slocal)
-            { lsIdentity = idData identity
+            { lsIdentity = idExtData identity'
             , lsShared = [ shared ]
             }
 
diff --git a/src/Contact.hs b/src/Contact.hs
index 2d1e2a9..a232b8c 100644
--- a/src/Contact.hs
+++ b/src/Contact.hs
@@ -39,7 +39,7 @@ data Contact = Contact
 
 data ContactData = ContactData
     { cdPrev :: [Stored ContactData]
-    , cdIdentity :: [Stored (Signed IdentityData)]
+    , cdIdentity :: [Stored (Signed ExtendedIdentityData)]
     , cdName :: Maybe Text
     }
 
@@ -59,7 +59,7 @@ instance Mergeable Contact where
 
     mergeSorted cdata = Contact
         { contactData = cdata
-        , contactIdentity_ = validateIdentityF $ concat $ findProperty ((\case [] -> Nothing; xs -> Just xs) . cdIdentity) cdata
+        , contactIdentity_ = validateExtendedIdentityF $ concat $ findProperty ((\case [] -> Nothing; xs -> Just xs) . cdIdentity) cdata
         , contactCustomName_ = findPropertyFirst cdName cdata
         }
 
@@ -169,7 +169,7 @@ finalizeContact identity = updateLocalHead_ $ updateSharedState_ $ \contacts ->
     st <- getStorage
     cdata <- wrappedStore st ContactData
         { cdPrev = []
-        , cdIdentity = idDataF $ finalOwner identity
+        , cdIdentity = idExtDataF $ finalOwner identity
         , cdName = Nothing
         }
     storeSetAdd st (mergeSorted @Contact [cdata]) contacts
diff --git a/src/Identity.hs b/src/Identity.hs
index e9216fb..7c49c9f 100644
--- a/src/Identity.hs
+++ b/src/Identity.hs
@@ -220,19 +220,32 @@ createIdentity st name owner = do
     (secret, public) <- generateKeys st
     (_secretMsg, publicMsg) <- generateKeys st
 
-    let signOwner idd
+    let signOwner :: Signed a -> ReaderT Storage IO (Signed a)
+        signOwner idd
             | Just o <- owner = do
                 Just ownerSecret <- loadKeyMb (iddKeyIdentity $ fromSigned $ idData o)
                 signAdd ownerSecret idd
             | otherwise = return idd
 
     Just identity <- flip runReaderT st $ do
-        return . validateIdentity =<< mstore =<< signOwner =<< sign secret =<<
+        baseData <- mstore =<< signOwner =<< sign secret =<<
             mstore (emptyIdentityData public)
-                { iddName = name
-                , iddOwner = idData <$> owner
+                { iddOwner = idData <$> owner
                 , iddKeyMessage = Just publicMsg
                 }
+        let extOwner = do
+                odata <- idExtData <$> owner
+                guard $ isExtension odata
+                return odata
+
+        validateExtendedIdentityF . I.Identity <$>
+            if isJust name || isJust extOwner
+               then mstore =<< signOwner =<< sign secret =<<
+                       mstore . ExtendedIdentityData =<< return (emptyIdentityExtension baseData)
+                       { ideName = name
+                       , ideOwner = extOwner
+                       }
+               else return $ baseToExtended baseData
     return identity
 
 validateIdentity :: Stored (Signed IdentityData) -> Maybe UnifiedIdentity
diff --git a/src/Message.hs b/src/Message.hs
index ac67f07..334cd1e 100644
--- a/src/Message.hs
+++ b/src/Message.hs
@@ -43,7 +43,7 @@ data DirectMessage = DirectMessage
 
 instance Storable DirectMessage where
     store' msg = storeRec $ do
-        mapM_ (storeRef "from") $ idDataF $ msgFrom msg
+        mapM_ (storeRef "from") $ idExtDataF $ msgFrom msg
         mapM_ (storeRef "PREV") $ msgPrev msg
         storeDate "time" $ msgTime msg
         storeText "text" $ msgText msg
diff --git a/src/Network.hs b/src/Network.hs
index 1d28d68..58e9816 100644
--- a/src/Network.hs
+++ b/src/Network.hs
@@ -223,7 +223,7 @@ startServer opt serverOrigHead logd' serverServices = do
 
             let announceUpdate identity = do
                     st <- derivePartialStorage serverStorage
-                    let selfRef = partialRef st $ storedRef $ idData identity
+                    let selfRef = partialRef st $ storedRef $ idExtData identity
                         updateRefs = map refDigest $ selfRef : map (partialRef st . storedRef) (idUpdates identity)
                         ackedBy = concat [[ Acknowledged r, Rejected r, DataRequest r ] | r <- updateRefs ]
                         hitems = map AnnounceUpdate updateRefs
@@ -585,7 +585,7 @@ finalizedChannel peer@Peer {..} ch self = do
 
     -- Identity update
     writeTQueue (serverIOActions peerServer_) $ liftIO $ atomically $ do
-        let selfRef = refDigest $ storedRef $ idData $ self
+        let selfRef = refDigest $ storedRef $ idExtData $ self
             updateRefs = selfRef : map (refDigest . storedRef) (idUpdates self)
             ackedBy = concat [[ Acknowledged r, Rejected r, DataRequest r ] | r <- updateRefs ]
         sendToPeerS peer ackedBy $ flip TransportPacket [] $ TransportHeader $ map AnnounceUpdate updateRefs
diff --git a/src/Pairing.hs b/src/Pairing.hs
index 8567168..0b31625 100644
--- a/src/Pairing.hs
+++ b/src/Pairing.hs
@@ -116,7 +116,7 @@ instance PairingResult a => Service (PairingService a) where
         (NoPairing, PairingRequest pdata sdata confirm) -> do
             self <- maybe (throwError "failed to validate received identity") return $ validateIdentity sdata
             self' <- maybe (throwError "failed to validate own identity") return .
-                validateIdentity . lsIdentity . fromStored =<< svcGetLocal
+                validateExtendedIdentity . lsIdentity . fromStored =<< svcGetLocal
             when (not $ self `sameIdentity` self') $ do
                 throwError "pairing request to different identity"
 
diff --git a/src/Service.hs b/src/Service.hs
index 580c17d..f15662e 100644
--- a/src/Service.hs
+++ b/src/Service.hs
@@ -172,7 +172,7 @@ svcSetLocal x = modify $ \st -> st { svcLocal = x }
 
 svcSelf :: ServiceHandler s UnifiedIdentity
 svcSelf = maybe (throwError "failed to validate own identity") return .
-        validateIdentity . lsIdentity . fromStored =<< svcGetLocal
+        validateExtendedIdentity . lsIdentity . fromStored =<< svcGetLocal
 
 svcPrint :: String -> ServiceHandler s ()
 svcPrint str = afterCommit . ($ str) =<< asks svcPrintOp
diff --git a/src/State.hs b/src/State.hs
index 207030c..e1ddcea 100644
--- a/src/State.hs
+++ b/src/State.hs
@@ -38,7 +38,7 @@ import Storage
 import Storage.Merge
 
 data LocalState = LocalState
-    { lsIdentity :: Stored (Signed IdentityData)
+    { lsIdentity :: Stored (Signed ExtendedIdentityData)
     , lsShared :: [Stored SharedState]
     }
 
@@ -117,17 +117,17 @@ loadLocalStateHead st = loadHeads st >>= \case
         shared <- wrappedStore st $ SharedState
             { ssPrev = []
             , ssType = Just $ sharedTypeID @(Maybe ComposedIdentity) Proxy
-            , ssValue = [storedRef $ idData $ fromMaybe identity owner]
+            , ssValue = [storedRef $ idExtData $ fromMaybe identity owner]
             }
         storeHead st $ LocalState
-            { lsIdentity = idData identity
+            { lsIdentity = idExtData identity
             , lsShared = [shared]
             }
 
 localIdentity :: LocalState -> UnifiedIdentity
 localIdentity ls = maybe (error "failed to verify local identity")
     (updateOwners $ maybe [] idExtDataF $ lookupSharedValue $ lsShared ls)
-    (validateIdentity $ lsIdentity ls)
+    (validateExtendedIdentity $ lsIdentity ls)
 
 headLocalIdentity :: Head LocalState -> UnifiedIdentity
 headLocalIdentity = localIdentity . headObject
diff --git a/src/Test.hs b/src/Test.hs
index 3f59239..ab9a78c 100644
--- a/src/Test.hs
+++ b/src/Test.hs
@@ -321,7 +321,7 @@ cmdCreateIdentity = do
             _ -> return []
 
         storeHead st $ LocalState
-            { lsIdentity = idData identity
+            { lsIdentity = idExtData identity
             , lsShared = shared
             }
 
@@ -427,14 +427,14 @@ cmdUpdateLocalIdentity :: Command
 cmdUpdateLocalIdentity = do
     [name] <- asks tiParams
     updateLocalHead_ $ \ls -> do
-        Just identity <- return $ validateIdentity $ lsIdentity $ fromStored ls
+        Just identity <- return $ validateExtendedIdentity $ lsIdentity $ fromStored ls
         let public = idKeyIdentity identity
 
         secret <- loadKey public
-        nidata <- maybe (error "created invalid identity") (return . idData) . validateIdentity =<<
-            mstore =<< sign secret =<< mstore (emptyIdentityData public)
-            { iddPrev = toList $ idDataF identity
-            , iddName = Just name
+        nidata <- maybe (error "created invalid identity") (return . idExtData) . validateExtendedIdentity =<<
+            mstore =<< sign secret =<< mstore . ExtendedIdentityData =<< return (emptyIdentityExtension $ idData identity)
+            { idePrev = toList $ idExtDataF identity
+            , ideName = Just name
             }
         mstore (fromStored ls) { lsIdentity = nidata }
 
@@ -446,10 +446,11 @@ cmdUpdateSharedIdentity = do
         Just identity -> do
             let public = idKeyIdentity identity
             secret <- loadKey public
-            maybe (error "created invalid identity") (return . Just . toComposedIdentity) . validateIdentity =<<
-                mstore =<< sign secret =<< mstore (emptyIdentityData public)
-                { iddPrev = toList $ idDataF identity
-                , iddName = Just name
+            uidentity <- mergeIdentity identity
+            maybe (error "created invalid identity") (return . Just . toComposedIdentity) . validateExtendedIdentity =<<
+                mstore =<< sign secret =<< mstore . ExtendedIdentityData =<< return (emptyIdentityExtension $ idData uidentity)
+                { idePrev = toList $ idExtDataF identity
+                , ideName = Just name
                 }
 
 cmdAttachTo :: Command