diff options
| -rw-r--r-- | src/Identity.hs | 18 | ||||
| -rw-r--r-- | 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 |