aboutsummaryrefslogtreecommitdiff
path: root/src/Ssb/Identity.hs
diff options
context:
space:
mode:
authorHaskell Guy <haskell.guy@localhost>2020-05-26 13:07:50 +0200
committerHaskell Guy <haskell.guy@localhost>2020-05-26 13:37:29 +0200
commit41cde99ec6189dbecca6803a5aa4f6f18142e8ba (patch)
tree7a0ceab0d516b8c3b7b49313100ae50c97e875c3 /src/Ssb/Identity.hs
downloadssb-haskell-41cde99ec6189dbecca6803a5aa4f6f18142e8ba.tar.xz
initial commit
Diffstat (limited to 'src/Ssb/Identity.hs')
-rw-r--r--src/Ssb/Identity.hs82
1 files changed, 82 insertions, 0 deletions
diff --git a/src/Ssb/Identity.hs b/src/Ssb/Identity.hs
new file mode 100644
index 0000000..e3fa4dc
--- /dev/null
+++ b/src/Ssb/Identity.hs
@@ -0,0 +1,82 @@
+module Ssb.Identity where
+
+import Protolude hiding ( Identity )
+import Control.Monad.Fail
+import Data.Aeson hiding ( encode )
+import qualified Data.ByteString.Base64 as Base64
+import qualified Crypto.Saltine.Core.Sign as Nacl
+import qualified Crypto.Saltine.Class as Nacl
+
+import Data.Serialize ( Serialize )
+import Data.Either.Combinators ( mapLeft )
+import qualified Data.Text as T
+
+newtype PrivateKey = PrivateKey ByteString
+ deriving (Eq,Generic,Ord,Show)
+
+extractPrivateKey :: PrivateKey -> ByteString
+extractPrivateKey (PrivateKey a) = a
+
+instance Serialize PrivateKey
+
+formatPrivateKey :: PrivateKey -> Text
+formatPrivateKey (PrivateKey buf) = "@" <> pubKey <> ".ed25519"
+ where pubKey = toS $ Base64.encode buf
+
+parsePrivateKey :: Text -> Either Text PrivateKey
+parsePrivateKey arg = decode $ T.dropEnd constLen $ T.drop 1 arg
+ where
+ constLen = T.length ".ed25519"
+ decode = fmap PrivateKey . mapLeft toS . Base64.decode . toS
+
+instance FromJSON PrivateKey where
+ parseJSON = withText "PrivateKey" $ \v -> case parsePrivateKey v of
+ Left err -> fail $ toS err
+ Right a -> return a
+
+instance ToJSON PrivateKey where
+ toJSON arg = String $ formatPrivateKey arg
+
+newtype PublicKey = PublicKey ByteString
+ deriving (Eq,Generic,Ord,Show)
+
+extractPublicKey :: PublicKey -> ByteString
+extractPublicKey (PublicKey a) = a
+
+instance Serialize PublicKey
+
+formatPublicKey :: PublicKey -> Text
+formatPublicKey (PublicKey buf) = "@" <> pubKey <> ".ed25519"
+ where pubKey = toS $ Base64.encode buf
+
+parsePublicKey :: Text -> Either Text PublicKey
+parsePublicKey arg = decode $ T.dropEnd constLen $ T.drop 1 arg
+ where
+ constLen = T.length ".ed25519"
+ decode = fmap PublicKey . mapLeft toS . Base64.decode . toS
+
+instance FromJSON PublicKey where
+ parseJSON = withText "PublicKey" $ \v -> case parsePublicKey v of
+ Left err -> fail $ toS err
+ Right a -> return a
+
+instance ToJSON PublicKey where
+ toJSON arg = String $ formatPublicKey arg
+
+-- | Identity represents a user or agent on the scuttlebutt network. Each of
+-- these entities own their own append-only message feed.
+data Identity = Identity
+ { privateKey :: Maybe PrivateKey
+ , publicKey :: PublicKey
+ } deriving (Eq,Generic,Show)
+
+instance FromJSON Identity
+
+instance ToJSON Identity
+
+newIdentity :: IO Identity
+newIdentity = do
+ (secret, public) <- Nacl.newKeypair
+ return Identity { privateKey = Just $ PrivateKey $ Nacl.encode secret
+ , publicKey = PublicKey $ Nacl.encode public
+ }