Identity extension data

5 files changed, 219 insertions, 63 deletions

diff --git a/src/Identity.hs b/src/Identity.hs
index 8bee231..e9216fb 100644
--- a/src/Identity.hs
+++ b/src/Identity.hs
@@ -1,12 +1,18 @@
 {-# LANGUAGE UndecidableInstances #-}
 
 module Identity (
-    Identity, ComposedIdentity, UnifiedIdentity, IdentityData(..),
-    idData, idDataF, idName, idOwner, idUpdates, idKeyIdentity, idKeyMessage,
+    Identity, ComposedIdentity, UnifiedIdentity,
+    IdentityData(..), ExtendedIdentityData(..), IdentityExtension(..),
+    idData, idDataF, idExtData, idExtDataF,
+    idName, idOwner, idUpdates, idKeyIdentity, idKeyMessage,
+    eiddBase, eiddStoredBase,
+    eiddName, eiddOwner, eiddKeyIdentity, eiddKeyMessage,
 
     emptyIdentityData,
+    emptyIdentityExtension,
     createIdentity,
     validateIdentity, validateIdentityF, validateIdentityFE,
+    validateExtendedIdentity, validateExtendedIdentityF, validateExtendedIdentityFE,
     loadIdentity, loadUnifiedIdentity,
 
     mergeIdentity, toUnifiedIdentity, toComposedIdentity,
@@ -38,22 +44,32 @@ import qualified Data.Text as T
 import PubKey
 import Storage
 import Storage.Merge
+import Util
 
-data Identity m = Identity
-    { idData_ :: m (Stored (Signed IdentityData))
+data Identity m = IdentityKind m => Identity
+    { idData_ :: m (Stored (Signed ExtendedIdentityData))
     , idName_ :: Maybe Text
     , idOwner_ :: Maybe ComposedIdentity
-    , idUpdates_ :: [Stored (Signed IdentityData)]
+    , idUpdates_ :: [Stored (Signed ExtendedIdentityData)]
     , idKeyIdentity_ :: Stored PublicKey
     , idKeyMessage_ :: Stored PublicKey
     }
 
-deriving instance Show (m (Stored (Signed IdentityData))) => Show (Identity m)
+deriving instance Show (m (Stored (Signed ExtendedIdentityData))) => Show (Identity m)
+
+class (Functor f, Foldable f) => IdentityKind f where
+    ikFilterAncestors :: Storable a => f (Stored a) -> f (Stored a)
+
+instance IdentityKind I.Identity where
+    ikFilterAncestors = id
+
+instance IdentityKind [] where
+    ikFilterAncestors = filterAncestors
 
 type ComposedIdentity = Identity []
 type UnifiedIdentity = Identity I.Identity
 
-instance Eq (m (Stored (Signed IdentityData))) => Eq (Identity m) where
+instance Eq (m (Stored (Signed ExtendedIdentityData))) => Eq (Identity m) where
     (==) = (==) `on` (idData_ &&& idUpdates_)
 
 data IdentityData = IdentityData
@@ -65,6 +81,21 @@ data IdentityData = IdentityData
     }
     deriving (Show)
 
+data IdentityExtension = IdentityExtension
+    { idePrev :: [Stored (Signed ExtendedIdentityData)]
+    , ideBase :: Stored (Signed IdentityData)
+    , ideName :: Maybe Text
+    , ideOwner :: Maybe (Stored (Signed ExtendedIdentityData))
+    }
+    deriving (Show)
+
+data ExtendedIdentityData = BaseIdentityData IdentityData
+                          | ExtendedIdentityData IdentityExtension
+    deriving (Show)
+
+baseToExtended :: Stored (Signed IdentityData) -> Stored (Signed ExtendedIdentityData)
+baseToExtended = unsafeMapStored (unsafeMapSigned BaseIdentityData)
+
 instance Storable IdentityData where
     store' idt = storeRec $ do
         mapM_ (storeRef "SPREV") $ iddPrev idt
@@ -80,16 +111,44 @@ instance Storable IdentityData where
         <*> loadRef "key-id"
         <*> loadMbRef "key-msg"
 
+instance Storable IdentityExtension where
+    store' IdentityExtension {..} = storeRec $ do
+        mapM_ (storeRef "SPREV") idePrev
+        storeRef "SBASE" ideBase
+        storeMbText "name" ideName
+        storeMbRef "owner" ideOwner
+
+    load' = loadRec $ IdentityExtension
+        <$> loadRefs "SPREV"
+        <*> loadRef "SBASE"
+        <*> loadMbText "name"
+        <*> loadMbRef "owner"
+
+instance Storable ExtendedIdentityData where
+    store' (BaseIdentityData idata) = store' idata
+    store' (ExtendedIdentityData idata) = store' idata
+
+    load' = msum
+        [ BaseIdentityData <$> load'
+        , ExtendedIdentityData <$> load'
+        ]
+
 instance Mergeable (Maybe ComposedIdentity) where
-    type Component (Maybe ComposedIdentity) = Signed IdentityData
-    mergeSorted = validateIdentityF
-    toComponents = maybe [] idDataF
+    type Component (Maybe ComposedIdentity) = Signed ExtendedIdentityData
+    mergeSorted = validateExtendedIdentityF
+    toComponents = maybe [] idExtDataF
 
 idData :: UnifiedIdentity -> Stored (Signed IdentityData)
 idData = I.runIdentity . idDataF
 
 idDataF :: Identity m -> m (Stored (Signed IdentityData))
-idDataF = idData_
+idDataF idt@Identity {} = ikFilterAncestors . fmap eiddStoredBase . idData_ $ idt
+
+idExtData :: UnifiedIdentity -> Stored (Signed ExtendedIdentityData)
+idExtData = I.runIdentity . idExtDataF
+
+idExtDataF :: Identity m -> m (Stored (Signed ExtendedIdentityData))
+idExtDataF = idData_
 
 idName :: Identity m -> Maybe Text
 idName = idName_
@@ -97,7 +156,7 @@ idName = idName_
 idOwner :: Identity m -> Maybe ComposedIdentity
 idOwner = idOwner_
 
-idUpdates :: Identity m -> [Stored (Signed IdentityData)]
+idUpdates :: Identity m -> [Stored (Signed ExtendedIdentityData)]
 idUpdates = idUpdates_
 
 idKeyIdentity :: Identity m -> Stored PublicKey
@@ -106,6 +165,33 @@ idKeyIdentity = idKeyIdentity_
 idKeyMessage :: Identity m -> Stored PublicKey
 idKeyMessage = idKeyMessage_
 
+eiddPrev :: ExtendedIdentityData -> [Stored (Signed ExtendedIdentityData)]
+eiddPrev (BaseIdentityData idata) = baseToExtended <$> iddPrev idata
+eiddPrev (ExtendedIdentityData IdentityExtension {..}) = baseToExtended ideBase : idePrev
+
+eiddBase :: ExtendedIdentityData -> IdentityData
+eiddBase (BaseIdentityData idata) = idata
+eiddBase (ExtendedIdentityData IdentityExtension {..}) = fromSigned ideBase
+
+eiddStoredBase :: Stored (Signed ExtendedIdentityData) -> Stored (Signed IdentityData)
+eiddStoredBase ext = case fromSigned ext of
+                          (BaseIdentityData idata) -> unsafeMapStored (unsafeMapSigned (const idata)) ext
+                          (ExtendedIdentityData IdentityExtension {..}) -> ideBase
+
+eiddName :: ExtendedIdentityData -> Maybe Text
+eiddName (BaseIdentityData idata) = iddName idata
+eiddName (ExtendedIdentityData IdentityExtension {..}) = ideName
+
+eiddOwner :: ExtendedIdentityData -> Maybe (Stored (Signed ExtendedIdentityData))
+eiddOwner (BaseIdentityData idata) = baseToExtended <$> iddOwner idata
+eiddOwner (ExtendedIdentityData IdentityExtension {..}) = ideOwner
+
+eiddKeyIdentity :: ExtendedIdentityData -> Stored PublicKey
+eiddKeyIdentity = iddKeyIdentity . eiddBase
+
+eiddKeyMessage :: ExtendedIdentityData -> Maybe (Stored PublicKey)
+eiddKeyMessage = iddKeyMessage . eiddBase
+
 
 emptyIdentityData :: Stored PublicKey -> IdentityData
 emptyIdentityData key = IdentityData
@@ -116,6 +202,19 @@ emptyIdentityData key = IdentityData
     , iddKeyMessage = Nothing
     }
 
+emptyIdentityExtension :: Stored (Signed IdentityData) -> IdentityExtension
+emptyIdentityExtension base = IdentityExtension
+    { idePrev = []
+    , ideBase = base
+    , ideName = Nothing
+    , ideOwner = Nothing
+    }
+
+isExtension :: Stored (Signed ExtendedIdentityData) -> Bool
+isExtension x = case fromSigned x of BaseIdentityData {} -> False
+                                     _ -> True
+
+
 createIdentity :: Storage -> Maybe Text -> Maybe UnifiedIdentity -> IO UnifiedIdentity
 createIdentity st name owner = do
     (secret, public) <- generateKeys st
@@ -123,7 +222,7 @@ createIdentity st name owner = do
 
     let signOwner idd
             | Just o <- owner = do
-                Just ownerSecret <- loadKeyMb (iddKeyIdentity $ fromStored $ signedData $ fromStored $ idData o)
+                Just ownerSecret <- loadKeyMb (iddKeyIdentity $ fromSigned $ idData o)
                 signAdd ownerSecret idd
             | otherwise = return idd
 
@@ -139,62 +238,71 @@ createIdentity st name owner = do
 validateIdentity :: Stored (Signed IdentityData) -> Maybe UnifiedIdentity
 validateIdentity = validateIdentityF . I.Identity
 
-validateIdentityF :: Foldable m => m (Stored (Signed IdentityData)) -> Maybe (Identity m)
+validateIdentityF :: IdentityKind m => m (Stored (Signed IdentityData)) -> Maybe (Identity m)
 validateIdentityF = either (const Nothing) Just . runExcept . validateIdentityFE
 
-validateIdentityFE :: Foldable m => m (Stored (Signed IdentityData)) -> Except String (Identity m)
-validateIdentityFE mdata = do
-    let idata = filterAncestors $ toList mdata
+validateIdentityFE :: IdentityKind m => m (Stored (Signed IdentityData)) -> Except String (Identity m)
+validateIdentityFE = validateExtendedIdentityFE . fmap baseToExtended
+
+validateExtendedIdentity :: Stored (Signed ExtendedIdentityData) -> Maybe UnifiedIdentity
+validateExtendedIdentity = validateExtendedIdentityF . I.Identity
+
+validateExtendedIdentityF :: IdentityKind m => m (Stored (Signed ExtendedIdentityData)) -> Maybe (Identity m)
+validateExtendedIdentityF = either (const Nothing) Just . runExcept . validateExtendedIdentityFE
+
+validateExtendedIdentityFE :: IdentityKind m => m (Stored (Signed ExtendedIdentityData)) -> Except String (Identity m)
+validateExtendedIdentityFE mdata = do
+    let idata = ikFilterAncestors mdata
     when (null idata) $ throwError "null data"
-    mapM_ verifySignatures $ gatherPrevious S.empty idata
+    mapM_ verifySignatures $ gatherPrevious S.empty $ toList idata
     Identity
-        <$> pure mdata
-        <*> pure (lookupProperty iddName idata)
-        <*> case lookupProperty iddOwner idata of
+        <$> pure idata
+        <*> pure (lookupProperty eiddName idata)
+        <*> case lookupProperty eiddOwner idata of
                  Nothing    -> return Nothing
-                 Just owner -> return <$> validateIdentityFE [owner]
+                 Just owner -> return <$> validateExtendedIdentityFE [owner]
         <*> pure []
-        <*> pure (iddKeyIdentity $ fromStored $ signedData $ fromStored $ minimum idata)
-        <*> case lookupProperty iddKeyMessage idata of
+        <*> pure (eiddKeyIdentity $ fromSigned $ minimum idata)
+        <*> case lookupProperty eiddKeyMessage idata of
                  Nothing -> throwError "no message key"
                  Just mk -> return mk
 
 loadIdentity :: String -> LoadRec ComposedIdentity
-loadIdentity name = maybe (throwError "identity validation failed") return . validateIdentityF =<< loadRefs name
+loadIdentity name = maybe (throwError "identity validation failed") return . validateExtendedIdentityF =<< loadRefs name
 
 loadUnifiedIdentity :: String -> LoadRec UnifiedIdentity
-loadUnifiedIdentity name = maybe (throwError "identity validation failed") return . validateIdentity =<< loadRef name
+loadUnifiedIdentity name = maybe (throwError "identity validation failed") return . validateExtendedIdentity =<< loadRef name
 
 
-gatherPrevious :: Set (Stored (Signed IdentityData)) -> [Stored (Signed IdentityData)] -> Set (Stored (Signed IdentityData))
+gatherPrevious :: Set (Stored (Signed ExtendedIdentityData)) -> [Stored (Signed ExtendedIdentityData)] -> Set (Stored (Signed ExtendedIdentityData))
 gatherPrevious res (n:ns) | n `S.member` res = gatherPrevious res ns
-                          | otherwise        = gatherPrevious (S.insert n res) $ (iddPrev $ fromStored $ signedData $ fromStored n) ++ ns
+                          | otherwise        = gatherPrevious (S.insert n res) $ (eiddPrev $ fromSigned n) ++ ns
 gatherPrevious res [] = res
 
-verifySignatures :: Stored (Signed IdentityData) -> Except String ()
+verifySignatures :: Stored (Signed ExtendedIdentityData) -> Except String ()
 verifySignatures sidd = do
-    let idd = fromStored $ signedData $ fromStored sidd
+    let idd = fromSigned sidd
         required = concat
-            [ [ iddKeyIdentity idd ]
-            , map (iddKeyIdentity . fromStored . signedData . fromStored) $ iddPrev idd
-            , map (iddKeyIdentity . fromStored . signedData . fromStored) $ toList $ iddOwner idd
+            [ [ eiddKeyIdentity idd ]
+            , map (eiddKeyIdentity . fromSigned) $ eiddPrev idd
+            , map (eiddKeyIdentity . fromSigned) $ toList $ eiddOwner idd
             ]
     unless (all (fromStored sidd `isSignedBy`) required) $ do
         throwError "signature verification failed"
 
-lookupProperty :: forall a. (IdentityData -> Maybe a) -> [Stored (Signed IdentityData)] -> Maybe a
+lookupProperty :: forall a m. Foldable m => (ExtendedIdentityData -> Maybe a) -> m (Stored (Signed ExtendedIdentityData)) -> Maybe a
 lookupProperty sel topHeads = findResult filteredLayers
-    where findPropHeads :: Stored (Signed IdentityData) -> [(Stored (Signed IdentityData), a)]
-          findPropHeads sobj | Just x <- sel $ fromStored $ signedData $ fromStored sobj = [(sobj, x)]
-                             | otherwise = findPropHeads =<< (iddPrev $ fromStored $ signedData $ fromStored sobj)
+    where findPropHeads :: Stored (Signed ExtendedIdentityData) -> [(Stored (Signed ExtendedIdentityData), a)]
+          findPropHeads sobj | Just x <- sel $ fromSigned sobj = [(sobj, x)]
+                             | otherwise = findPropHeads =<< (eiddPrev $ fromSigned sobj)
 
-          propHeads :: [(Stored (Signed IdentityData), a)]
-          propHeads = findPropHeads =<< topHeads
+          propHeads :: [(Stored (Signed ExtendedIdentityData), a)]
+          propHeads = findPropHeads =<< toList topHeads
 
-          historyLayers :: [Set (Stored (Signed IdentityData))]
+          historyLayers :: [Set (Stored (Signed ExtendedIdentityData))]
           historyLayers = generations $ map fst propHeads
 
-          filteredLayers :: [[(Stored (Signed IdentityData), a)]]
+          filteredLayers :: [[(Stored (Signed ExtendedIdentityData), a)]]
           filteredLayers = scanl (\cur obsolete -> filter ((`S.notMember` obsolete) . fst) cur) propHeads historyLayers
 
           findResult ([(_, x)] : _) = Just x
@@ -203,10 +311,10 @@ lookupProperty sel topHeads = findResult filteredLayers
           findResult [xs] = Just $ snd $ minimumBy (comparing fst) xs
           findResult (_:rest) = findResult rest
 
-mergeIdentity :: (Foldable f, MonadStorage m, MonadError String m, MonadIO m) => Identity f -> m UnifiedIdentity
+mergeIdentity :: (MonadStorage m, MonadError String m, MonadIO m) => Identity f -> m UnifiedIdentity
 mergeIdentity idt | Just idt' <- toUnifiedIdentity idt = return idt'
-mergeIdentity idt = do
-    (owner, ownerData) <- case idOwner_ idt of
+mergeIdentity idt@Identity {..} = do
+    (owner, ownerData) <- case idOwner_ of
         Nothing -> return (Nothing, Nothing)
         Just cowner | Just owner <- toUnifiedIdentity cowner -> return (Just owner, Nothing)
                     | otherwise -> do owner <- mergeIdentity cowner
@@ -214,40 +322,51 @@ mergeIdentity idt = do
 
     let public = idKeyIdentity idt
     secret <- loadKey public
-    sdata <- mstore =<< sign secret =<< mstore (emptyIdentityData public)
-        { iddPrev = toList $ idDataF idt, iddOwner = ownerData }
-    return $ idt { idData_ = I.Identity sdata, idOwner_ = toComposedIdentity <$> owner }
 
-toUnifiedIdentity :: Foldable m => Identity m -> Maybe UnifiedIdentity
-toUnifiedIdentity idt
-    | [sdata] <- toList $ idDataF idt = Just idt { idData_ = I.Identity sdata }
-    | otherwise = Nothing
+    unifiedBaseData <-
+        case toList $ idDataF idt of
+            [idata] -> return idata
+            idatas -> mstore =<< sign secret =<< mstore (emptyIdentityData public)
+                { iddPrev = idatas, iddOwner = ownerData }
+
+    case filter isExtension $ toList $ idExtDataF idt of
+        [] -> return Identity { idData_ = I.Identity (baseToExtended unifiedBaseData), idOwner_ = toComposedIdentity <$> owner, .. }
+        extdata -> do
+            unifiedExtendedData <- mstore =<< sign secret =<<
+                (mstore . ExtendedIdentityData) (emptyIdentityExtension unifiedBaseData)
+                    { idePrev = extdata }
+            return Identity { idData_ = I.Identity unifiedExtendedData, idOwner_ = toComposedIdentity <$> owner, .. }
 
-toComposedIdentity :: Foldable m => Identity m -> ComposedIdentity
-toComposedIdentity idt = idt { idData_ = toList $ idDataF idt
-                             , idOwner_ = toComposedIdentity <$> idOwner_ idt
-                             }
 
+toUnifiedIdentity :: Identity m -> Maybe UnifiedIdentity
+toUnifiedIdentity Identity {..}
+    | [sdata] <- toList idData_ = Just Identity { idData_ = I.Identity sdata, .. }
+    | otherwise = Nothing
+
+toComposedIdentity :: Identity m -> ComposedIdentity
+toComposedIdentity Identity {..} = Identity { idData_ = toList idData_
+                                            , idOwner_ = toComposedIdentity <$> idOwner_
+                                            , ..
+                                            }
 
-updateIdentity :: Foldable m => [Stored (Signed IdentityData)] -> Identity m -> ComposedIdentity
+updateIdentity :: [Stored (Signed ExtendedIdentityData)] -> Identity m -> ComposedIdentity
 updateIdentity [] orig = toComposedIdentity orig
-updateIdentity updates orig =
-    case validateIdentityF $ filterAncestors (ourUpdates ++ idata) of
-         -- need to filter ancestors here as validateIdentityF currently stores the whole list in idData_
+updateIdentity updates orig@Identity {} =
+    case validateExtendedIdentityF $ ourUpdates ++ idata of
          Just updated -> updated
              { idOwner_ = updateIdentity ownerUpdates <$> idOwner_ updated
              , idUpdates_ = ownerUpdates
              }
          Nothing -> toComposedIdentity orig
     where idata = toList $ idData_ orig
-          ilen = length idata
+          idataRoots = foldl' mergeUniq [] $ map storedRoots idata
           (ourUpdates, ownerUpdates) = partitionEithers $ flip map (filterAncestors $ updates ++ idUpdates_ orig) $
               -- if an update is related to anything in idData_, use it here, otherwise push to owners
-              \u -> if length (filterAncestors (u : idata)) < ilen + 1
+              \u -> if storedRoots u `intersectsSorted` idataRoots
                        then Left u
                        else Right u
 
-updateOwners :: [Stored (Signed IdentityData)] -> Identity m -> Identity m
+updateOwners :: [Stored (Signed ExtendedIdentityData)] -> Identity m -> Identity m
 updateOwners updates orig@Identity { idOwner_ = Just owner, idUpdates_ = cupdates } =
     orig { idOwner_ = Just $ updateIdentity updates owner, idUpdates_ = filterAncestors (updates ++ cupdates) }
 updateOwners _ orig@Identity { idOwner_ = Nothing } = orig
diff --git a/src/PubKey.hs b/src/PubKey.hs
index f69d739..5f235eb 100644
--- a/src/PubKey.hs
+++ b/src/PubKey.hs
@@ -3,6 +3,8 @@ module PubKey (
     KeyPair(generateKeys), loadKey, loadKeyMb,
     Signature(sigKey), Signed, signedData, signedSignature,
     sign, signAdd, isSignedBy,
+    fromSigned,
+    unsafeMapSigned,
 
     PublicKexKey, SecretKexKey,
     dhSecret,
@@ -110,6 +112,13 @@ signAdd (SecretKey secret spublic) (Signed val sigs) = do
 isSignedBy :: Signed a -> Stored PublicKey -> Bool
 isSignedBy sig key = key `elem` map (sigKey . fromStored) (signedSignature sig)
 
+fromSigned :: Stored (Signed a) -> a
+fromSigned = fromStored . signedData . fromStored
+
+-- |Passed function needs to preserve the object representation to be safe
+unsafeMapSigned :: (a -> b) -> Signed a -> Signed b
+unsafeMapSigned f signed = signed { signedData_ = unsafeMapStored f (signedData_ signed) }
+
 
 data PublicKexKey = PublicKexKey CX.PublicKey
     deriving (Show)
diff --git a/src/State.hs b/src/State.hs
index b575ffa..207030c 100644
--- a/src/State.hs
+++ b/src/State.hs
@@ -126,7 +126,7 @@ loadLocalStateHead st = loadHeads st >>= \case
 
 localIdentity :: LocalState -> UnifiedIdentity
 localIdentity ls = maybe (error "failed to verify local identity")
-    (updateOwners $ maybe [] idDataF $ lookupSharedValue $ lsShared ls)
+    (updateOwners $ maybe [] idExtDataF $ lookupSharedValue $ lsShared ls)
     (validateIdentity $ lsIdentity ls)
 
 headLocalIdentity :: Head LocalState -> UnifiedIdentity
diff --git a/src/Storage.hs b/src/Storage.hs
index 69e8ab6..7edae8b 100644
--- a/src/Storage.hs
+++ b/src/Storage.hs
@@ -46,6 +46,7 @@ module Storage (
     fromStored, storedRef,
     wrappedStore, wrappedLoad,
     copyStored,
+    unsafeMapStored,
 
     StoreInfo(..), makeStoreInfo,
 
@@ -891,6 +892,10 @@ copyStored :: forall c c' m a. (StorageCompleteness c, StorageCompleteness c', M
     Storage' c' -> Stored' c a -> m (LoadResult c (Stored' c' a))
 copyStored st (Stored ref' x) = liftIO $ returnLoadResult . fmap (flip Stored x) <$> copyRef' st ref'
 
+-- |Passed function needs to preserve the object representation to be safe
+unsafeMapStored :: (a -> b) -> Stored a -> Stored b
+unsafeMapStored f (Stored ref x) = Stored ref (f x)
+
 
 data StoreInfo = StoreInfo
     { infoDate :: ZonedTime
diff --git a/src/Util.hs b/src/Util.hs
index fe802e2..c69adee 100644
--- a/src/Util.hs
+++ b/src/Util.hs
@@ -12,3 +12,26 @@ mergeBy cmp (x : xs) (y : ys) = case cmp x y of
                                      GT -> y : mergeBy cmp (x : xs) ys
 mergeBy _ xs [] = xs
 mergeBy _ [] ys = ys
+
+mergeUniqBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
+mergeUniqBy cmp (x : xs) (y : ys) = case cmp x y of
+                                         LT -> x : mergeBy cmp xs (y : ys)
+                                         EQ -> x : mergeBy cmp xs ys
+                                         GT -> y : mergeBy cmp (x : xs) ys
+mergeUniqBy _ xs [] = xs
+mergeUniqBy _ [] ys = ys
+
+mergeUniq :: Ord a => [a] -> [a] -> [a]
+mergeUniq = mergeUniqBy compare
+
+diffSorted :: Ord a => [a] -> [a] -> [a]
+diffSorted (x:xs) (y:ys) | x < y     = x : diffSorted xs (y:ys)
+                         | x > y     = diffSorted (x:xs) ys
+                         | otherwise = diffSorted xs (y:ys)
+diffSorted xs _ = xs
+
+intersectsSorted :: Ord a => [a] -> [a] -> Bool
+intersectsSorted (x:xs) (y:ys) | x < y     = intersectsSorted xs (y:ys)
+                               | x > y     = intersectsSorted (x:xs) ys
+                               | otherwise = True
+intersectsSorted _ _ = False