From 0fb19186ddd80ae71d694071ed56d192e5bb942c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Mon, 6 May 2019 21:58:39 +0200 Subject: Distinct device and owner identities --- src/Identity.hs | 18 +++++++++++++++--- src/Main.hs | 7 ++++++- 2 files changed, 21 insertions(+), 4 deletions(-) diff --git a/src/Identity.hs b/src/Identity.hs index 65fec8a..07356d8 100644 --- a/src/Identity.hs +++ b/src/Identity.hs @@ -1,5 +1,6 @@ module Identity ( Identity, IdentityData(..), + emptyIdentity, ) where import Data.Text (Text) @@ -10,19 +11,30 @@ import Storage type Identity = Signed IdentityData data IdentityData = Identity - { idName :: Text + { idName :: Maybe Text , idPrev :: Maybe (Stored Identity) + , idOwner :: Maybe (Stored Identity) , idKeyIdentity :: Stored PublicKey } deriving (Show) +emptyIdentity :: Stored PublicKey -> IdentityData +emptyIdentity key = Identity + { idName = Nothing + , idPrev = Nothing + , idOwner = Nothing + , idKeyIdentity = key + } + instance Storable IdentityData where store' idt = storeRec $ do - storeText "name" $ idName idt + storeMbText "name" $ idName idt storeMbRef "prev" $ idPrev idt + storeMbRef "owner" $ idOwner idt storeRef "key-id" $ idKeyIdentity idt load' = loadRec $ Identity - <$> loadText "name" + <$> loadMbText "name" <*> loadMbRef "prev" + <*> loadMbRef "owner" <*> loadRef "key-id" diff --git a/src/Main.hs b/src/Main.hs index 9f6cade..40540fe 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -24,9 +24,14 @@ main = do putStr "Name: " hFlush stdout name <- T.getLine + (secret, public) <- generateKeys st + (devSecret, devPublic) <- generateKeys st + + owner <- wrappedStore st =<< sign secret =<< wrappedStore st (emptyIdentity public) { idName = Just name } + base <- signAdd devSecret =<< sign secret =<< + wrappedStore st (emptyIdentity devPublic) { idOwner = Just owner } - base <- sign secret =<< wrappedStore st (Identity name Nothing public) Right h <- replaceHead base (Left (st, "identity")) return h let sidentity = wrappedLoad (headRef idhead) :: Stored Identity -- cgit v1.2.3