~haskell-guy/ssb-haskell

ref: 41cde99ec6189dbecca6803a5aa4f6f18142e8ba ssb-haskell/src/Ssb/Identity.hs -rw-r--r-- 2.6 KiB
41cde99e — Haskell Guy initial commit 10 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
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
                  }