module Ssb.Types.Link (
Link(..),
parseLink,
formatLink,
FeedLink(..),
MessageLink(..),
BlobLink(..),
IsLink(..),
) where
import Ssb.Types.Key
import Ssb.Types.Hash
import Data.Monoid
import Data.Text.Encoding (encodeUtf8, decodeUtf8)
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson
import qualified Data.Text as T
import qualified Crypto.Sign.Ed25519 as Ed
data Link = Link
{ linkSigil :: Char
, linkTo :: T.Text
, linkTag :: T.Text
} deriving (Eq, Ord)
instance Show Link where
show = T.unpack . formatLink
instance Aeson.FromJSON Link where
parseJSON = Aeson.withText "Link" $ either fail pure . parseLink
instance Aeson.ToJSON Link where
toJSON = Aeson.String . formatLink
parseLink :: T.Text -> Either String Link
parseLink t
| T.null t = Left "empty link"
| otherwise =
let (sigil, rest) = T.splitAt 1 t
(linkto, linktag) = T.breakOnEnd "." rest
in if T.null linktag
then Left "missing linkTag"
else if T.null linkto
then Left "empty link"
else Right $ Link
{ linkSigil = T.head sigil
, linkTo = T.init linkto
, linkTag = linktag
}
formatLink :: Link -> T.Text
formatLink l = T.singleton (linkSigil l) <> linkTo l <> "." <> linkTag l
class IsLink t where
fromLink :: Link -> Either String t
toLink :: t -> Link
toJSONLink :: t -> Aeson.Value
toJSONLink = Aeson.toJSON . toLink
fromJSONLink :: Aeson.Value -> Aeson.Parser t
fromJSONLink o = do
l <- Aeson.parseJSON o
either fail pure (fromLink l)
newtype FeedLink = FeedLink { unFeedLink :: PublicKey }
deriving (Show, Eq, Ord)
instance IsLink FeedLink where
fromLink l
| linkSigil l == '@' && linkTag l == "ed25519" =
maybe (Left "ed25519 key parse failed")
(Right . FeedLink)
(parseEd25519PublicKey $ encodeUtf8 $ linkTo l)
| otherwise = Left "wrong sigil for feed link"
toLink fl = Link '@' linkto "ed25519"
where
linkto = decodeUtf8 $ Ed.unPublicKey $ ed25519Key $ unFeedLink fl
instance Aeson.ToJSON FeedLink where
toJSON = toJSONLink
instance Aeson.FromJSON FeedLink where
parseJSON = fromJSONLink
newtype MessageLink = MessageLink { unMessageLink :: Hash }
deriving (Show, Eq, Ord)
instance IsLink MessageLink where
fromLink l
| linkSigil l == '%' && linkTag l == "sha256" =
maybe (Left "sha256 hash parse failed")
(Right . MessageLink)
(parseSha256 $ encodeUtf8 $ linkTo l)
| otherwise = Left "wrong sigil for message link"
toLink fl = Link '%' linkto "sha256"
where
linkto = decodeUtf8 $ formatHash $ unMessageLink fl
instance Aeson.ToJSON MessageLink where
toJSON = toJSONLink
instance Aeson.FromJSON MessageLink where
parseJSON = fromJSONLink
newtype BlobLink = BlobLink { unBlobLink :: Hash }
deriving (Show, Eq, Ord)
instance IsLink BlobLink where
fromLink l
| linkSigil l == '&' && linkTag l == "sha256" =
maybe (Left "sha256 hash parse failed")
(Right . BlobLink)
(parseSha256 $ encodeUtf8 $ linkTo l)
| otherwise = Left "wrong sigil for blob link"
toLink fl = Link '&' linkto "sha256"
where
linkto = decodeUtf8 $ formatHash $ unBlobLink fl
instance Aeson.ToJSON BlobLink where
toJSON = toJSONLink
instance Aeson.FromJSON BlobLink where
parseJSON = fromJSONLink