    {-# LANGUAGE CPP #-}
    module Hackage.Security.Key (
        -- * Key types
        Ed25519
        -- * Types abstracting over key types
      , Key(..)
      , PublicKey(..)
      , PrivateKey(..)
        -- * Key types in isolation
      , KeyType(..)
        -- * Hiding key types
      , somePublicKey
      , somePublicKeyType
      , someKeyId
        -- * Operations on keys
      , publicKey
      , privateKey
      , createKey
      , createKey'
        -- * Key IDs
      , KeyId(..)
      , HasKeyId(..)
        -- * Signing
      , sign
      , verify
      ) where

    import Prelude
    import Control.Monad
    import Data.Functor.Identity
    import Text.JSON.Canonical
    import qualified Crypto.Hash.SHA256   as SHA256
    import qualified Crypto.Sign.Ed25519  as Ed25519
    import qualified Data.ByteString      as BS
    import qualified Data.ByteString.Char8 as BS.C8
    import qualified Data.ByteString.Base16 as Base16
    import qualified Data.ByteString.Lazy as BS.L

    import Hackage.Security.Util.JSON
    import Hackage.Security.Util.Some
    import Hackage.Security.Util.TypedEmbedded
    import qualified Hackage.Security.Util.Base64 as B64

    {-------------------------------------------------------------------------------
      Generalization over key types
    -------------------------------------------------------------------------------}

    data Ed25519

    data Key a where
        KeyEd25519 :: Ed25519.PublicKey -> Ed25519.SecretKey -> Key Ed25519

    data PublicKey a where
        PublicKeyEd25519 :: Ed25519.PublicKey -> PublicKey Ed25519

    data PrivateKey a where
        PrivateKeyEd25519 :: Ed25519.SecretKey -> PrivateKey Ed25519

    deriving instance Show (Key        typ)
    deriving instance Show (PublicKey  typ)
    deriving instance Show (PrivateKey typ)

    deriving instance Eq (Key        typ)
    deriving instance Eq (PublicKey  typ)
    deriving instance Eq (PrivateKey typ)

    instance SomeShow Key        where someShow :: forall a. DictShow (Key a)
    someShow = DictShow (Key a)
    forall a. Show a => DictShow a
    DictShow
    instance SomeShow PublicKey  where someShow :: forall a. DictShow (PublicKey a)
    someShow = DictShow (PublicKey a)
    forall a. Show a => DictShow a
    DictShow
    instance SomeShow PrivateKey where someShow :: forall a. DictShow (PrivateKey a)
    someShow = DictShow (PrivateKey a)
    forall a. Show a => DictShow a
    DictShow

    instance SomeEq Key        where someEq :: forall a. DictEq (Key a)
    someEq = DictEq (Key a)
    forall a. Eq a => DictEq a
    DictEq
    instance SomeEq PublicKey  where someEq :: forall a. DictEq (PublicKey a)
    someEq = DictEq (PublicKey a)
    forall a. Eq a => DictEq a
    DictEq
    instance SomeEq PrivateKey where someEq :: forall a. DictEq (PrivateKey a)
    someEq = DictEq (PrivateKey a)
    forall a. Eq a => DictEq a
    DictEq

    publicKey :: Key a -> PublicKey a
    publicKey :: forall a. Key a -> PublicKey a
    publicKey (KeyEd25519 PublicKey
    pub SecretKey
    _pri) = PublicKey -> PublicKey Ed25519
    PublicKeyEd25519 PublicKey
    pub

    privateKey :: Key a -> PrivateKey a
    privateKey :: forall a. Key a -> PrivateKey a
    privateKey (KeyEd25519 PublicKey
    _pub SecretKey
    pri) = SecretKey -> PrivateKey Ed25519
    PrivateKeyEd25519 SecretKey
    pri

    {-------------------------------------------------------------------------------
      Sometimes it's useful to talk about the type of a key independent of the key
    -------------------------------------------------------------------------------}

    data KeyType typ where
      KeyTypeEd25519 :: KeyType Ed25519

    deriving instance Show (KeyType typ)
    deriving instance Eq   (KeyType typ)

    instance SomeShow KeyType where someShow :: forall a. DictShow (KeyType a)
    someShow = DictShow (KeyType a)
    forall a. Show a => DictShow a
    DictShow
    instance SomeEq   KeyType where someEq :: forall a. DictEq (KeyType a)
    someEq   = DictEq (KeyType a)
    forall a. Eq a => DictEq a
    DictEq

    instance Unify KeyType where
      unify :: forall typ typ'.
    KeyType typ -> KeyType typ' -> Maybe (typ :=: typ')
    unify KeyType typ
    KeyTypeEd25519 KeyType typ'
    KeyTypeEd25519 = (typ :=: typ') -> Maybe (typ :=: typ')
    forall a. a -> Maybe a
    Just typ :=: typ
    typ :=: typ'
    forall a. a :=: a
    Refl

    type instance TypeOf Key        = KeyType
    type instance TypeOf PublicKey  = KeyType
    type instance TypeOf PrivateKey = KeyType

    instance Typed Key where
      typeOf :: forall typ. Key typ -> TypeOf Key typ
    typeOf (KeyEd25519 PublicKey
    _ SecretKey
    _) = TypeOf Key typ
    KeyType Ed25519
    KeyTypeEd25519

    instance Typed PublicKey where
      typeOf :: forall typ. PublicKey typ -> TypeOf PublicKey typ
    typeOf (PublicKeyEd25519 PublicKey
    _) = TypeOf PublicKey typ
    KeyType Ed25519
    KeyTypeEd25519

    instance Typed PrivateKey where
      typeOf :: forall typ. PrivateKey typ -> TypeOf PrivateKey typ
    typeOf (PrivateKeyEd25519 SecretKey
    _) = TypeOf PrivateKey typ
    KeyType Ed25519
    KeyTypeEd25519

    {-------------------------------------------------------------------------------
      We don't always know the key type
    -------------------------------------------------------------------------------}

    somePublicKey :: Some Key -> Some PublicKey
    somePublicKey :: Some Key -> Some PublicKey
    somePublicKey (Some Key a
    key) = PublicKey a -> Some PublicKey
    forall (f :: * -> *) a. f a -> Some f
    Some (Key a -> PublicKey a
    forall a. Key a -> PublicKey a
    publicKey Key a
    key)

    somePublicKeyType :: Some PublicKey -> Some KeyType
    somePublicKeyType :: Some PublicKey -> Some KeyType
    somePublicKeyType (Some PublicKey a
    pub) = KeyType a -> Some KeyType
    forall (f :: * -> *) a. f a -> Some f
    Some (PublicKey a -> TypeOf PublicKey a
    forall typ. PublicKey typ -> TypeOf PublicKey typ
    forall (f :: * -> *) typ. Typed f => f typ -> TypeOf f typ
    typeOf PublicKey a
    pub)

    someKeyId :: HasKeyId key => Some key -> KeyId
    someKeyId :: forall (key :: * -> *). HasKeyId key => Some key -> KeyId
    someKeyId (Some key a
    a) = key a -> KeyId
    forall typ. key typ -> KeyId
    forall (key :: * -> *) typ. HasKeyId key => key typ -> KeyId
    keyId key a
    a

    {-------------------------------------------------------------------------------
      Creating keys
    -------------------------------------------------------------------------------}

    createKey :: KeyType key -> IO (Key key)
    createKey :: forall key. KeyType key -> IO (Key key)
    createKey KeyType key
    KeyTypeEd25519 = (PublicKey -> SecretKey -> Key key)
    -> (PublicKey, SecretKey) -> Key key
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry PublicKey -> SecretKey -> Key key
    PublicKey -> SecretKey -> Key Ed25519
    KeyEd25519 ((PublicKey, SecretKey) -> Key key)
    -> IO (PublicKey, SecretKey) -> IO (Key key)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO (PublicKey, SecretKey)
    Ed25519.createKeypair

    createKey' :: KeyType key -> IO (Some Key)
    createKey' :: forall key. KeyType key -> IO (Some Key)
    createKey' = (Key key -> Some Key) -> IO (Key key) -> IO (Some Key)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Key key -> Some Key
    forall (f :: * -> *) a. f a -> Some f
    Some (IO (Key key) -> IO (Some Key))
    -> (KeyType key -> IO (Key key)) -> KeyType key -> IO (Some Key)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . KeyType key -> IO (Key key)
    forall key. KeyType key -> IO (Key key)
    createKey

    {-------------------------------------------------------------------------------
      Key IDs
    -------------------------------------------------------------------------------}

    -- | The key ID of a key, by definition, is the hexdigest of the SHA-256 hash of
    -- the canonical JSON form of the key where the private object key is excluded.
    --
    -- NOTE: The FromJSON and ToJSON instances for KeyId are intentionally omitted.
    -- Use writeKeyAsId instead.
    newtype KeyId = KeyId { KeyId -> String
    keyIdString :: String }
      deriving (Int -> KeyId -> ShowS
    [KeyId] -> ShowS
    KeyId -> String
    (Int -> KeyId -> ShowS)
    -> (KeyId -> String) -> ([KeyId] -> ShowS) -> Show KeyId
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> KeyId -> ShowS
    showsPrec :: Int -> KeyId -> ShowS
    $cshow :: KeyId -> String
    show :: KeyId -> String
    $cshowList :: [KeyId] -> ShowS
    showList :: [KeyId] -> ShowS
    Show, KeyId -> KeyId -> Bool
    (KeyId -> KeyId -> Bool) -> (KeyId -> KeyId -> Bool) -> Eq KeyId
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: KeyId -> KeyId -> Bool
    == :: KeyId -> KeyId -> Bool
    $c/= :: KeyId -> KeyId -> Bool
    /= :: KeyId -> KeyId -> Bool
    Eq, Eq KeyId
    Eq KeyId =>
    (KeyId -> KeyId -> Ordering)
    -> (KeyId -> KeyId -> Bool)
    -> (KeyId -> KeyId -> Bool)
    -> (KeyId -> KeyId -> Bool)
    -> (KeyId -> KeyId -> Bool)
    -> (KeyId -> KeyId -> KeyId)
    -> (KeyId -> KeyId -> KeyId)
    -> Ord KeyId
    KeyId -> KeyId -> Bool
    KeyId -> KeyId -> Ordering
    KeyId -> KeyId -> KeyId
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: KeyId -> KeyId -> Ordering
    compare :: KeyId -> KeyId -> Ordering
    $c< :: KeyId -> KeyId -> Bool
    < :: KeyId -> KeyId -> Bool
    $c<= :: KeyId -> KeyId -> Bool
    <= :: KeyId -> KeyId -> Bool
    $c> :: KeyId -> KeyId -> Bool
    > :: KeyId -> KeyId -> Bool
    $c>= :: KeyId -> KeyId -> Bool
    >= :: KeyId -> KeyId -> Bool
    $cmax :: KeyId -> KeyId -> KeyId
    max :: KeyId -> KeyId -> KeyId
    $cmin :: KeyId -> KeyId -> KeyId
    min :: KeyId -> KeyId -> KeyId
    Ord)

    instance Monad m => ToObjectKey m KeyId where
      toObjectKey :: KeyId -> m String
    toObjectKey = String -> m String
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> m String) -> (KeyId -> String) -> KeyId -> m String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . KeyId -> String
    keyIdString

    instance Monad m => FromObjectKey m KeyId where
      fromObjectKey :: String -> m (Maybe KeyId)
    fromObjectKey = Maybe KeyId -> m (Maybe KeyId)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe KeyId -> m (Maybe KeyId))
    -> (String -> Maybe KeyId) -> String -> m (Maybe KeyId)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . KeyId -> Maybe KeyId
    forall a. a -> Maybe a
    Just (KeyId -> Maybe KeyId)
    -> (String -> KeyId) -> String -> Maybe KeyId
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> KeyId
    KeyId

    -- | Compute the key ID of a key
    class HasKeyId key where
      keyId :: key typ -> KeyId

    instance HasKeyId PublicKey where
      keyId :: forall typ. PublicKey typ -> KeyId
    keyId = String -> KeyId
    KeyId
            (String -> KeyId)
    -> (PublicKey typ -> String) -> PublicKey typ -> KeyId
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> String
    BS.C8.unpack
            (ByteString -> String)
    -> (PublicKey typ -> ByteString) -> PublicKey typ -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    Base16.encode
            (ByteString -> ByteString)
    -> (PublicKey typ -> ByteString) -> PublicKey typ -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    SHA256.hashlazy
            (ByteString -> ByteString)
    -> (PublicKey typ -> ByteString) -> PublicKey typ -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . JSValue -> ByteString
    renderCanonicalJSON
            (JSValue -> ByteString)
    -> (PublicKey typ -> JSValue) -> PublicKey typ -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Identity JSValue -> JSValue
    forall a. Identity a -> a
    runIdentity
            (Identity JSValue -> JSValue)
    -> (PublicKey typ -> Identity JSValue) -> PublicKey typ -> JSValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PublicKey typ -> Identity JSValue
    forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
    toJSON

    instance HasKeyId Key where
      keyId :: forall typ. Key typ -> KeyId
    keyId = PublicKey typ -> KeyId
    forall typ. PublicKey typ -> KeyId
    forall (key :: * -> *) typ. HasKeyId key => key typ -> KeyId
    keyId (PublicKey typ -> KeyId)
    -> (Key typ -> PublicKey typ) -> Key typ -> KeyId
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Key typ -> PublicKey typ
    forall a. Key a -> PublicKey a
    publicKey

    {-------------------------------------------------------------------------------
      Signing
    -------------------------------------------------------------------------------}

    -- | Sign a bytestring and return the signature
    --
    -- TODO: It is unfortunate that we have to convert to a strict bytestring for
    -- ed25519
    sign :: PrivateKey typ -> BS.L.ByteString -> BS.ByteString
    sign :: forall typ. PrivateKey typ -> ByteString -> ByteString
    sign (PrivateKeyEd25519 SecretKey
    pri) =
        Signature -> ByteString
    Ed25519.unSignature (Signature -> ByteString)
    -> (ByteString -> Signature) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SecretKey -> ByteString -> Signature
    dsign SecretKey
    pri (ByteString -> Signature)
    -> (ByteString -> ByteString) -> ByteString -> Signature
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [ByteString] -> ByteString
    BS.concat ([ByteString] -> ByteString)
    -> (ByteString -> [ByteString]) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> [ByteString]
    BS.L.toChunks
      where
    #if MIN_VERSION_ed25519(0,0,4)
        dsign :: SecretKey -> ByteString -> Signature
    dsign = SecretKey -> ByteString -> Signature
    Ed25519.dsign
    #else
        dsign = Ed25519.sign'
    #endif

    verify :: PublicKey typ -> BS.L.ByteString -> BS.ByteString -> Bool
    verify :: forall typ. PublicKey typ -> ByteString -> ByteString -> Bool
    verify (PublicKeyEd25519 PublicKey
    pub) ByteString
    inp ByteString
    sig =
        PublicKey -> ByteString -> Signature -> Bool
    dverify PublicKey
    pub ([ByteString] -> ByteString
    BS.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString -> [ByteString]
    BS.L.toChunks ByteString
    inp) (ByteString -> Signature
    Ed25519.Signature ByteString
    sig)
      where
    #if MIN_VERSION_ed25519(0,0,4)
        dverify :: PublicKey -> ByteString -> Signature -> Bool
    dverify = PublicKey -> ByteString -> Signature -> Bool
    Ed25519.dverify
    #else
        dverify = Ed25519.verify'
    #endif

    {-------------------------------------------------------------------------------
      JSON encoding and decoding
    -------------------------------------------------------------------------------}

    instance Monad m => ToJSON m (Key typ) where
      toJSON :: Key typ -> m JSValue
    toJSON Key typ
    key = case Key typ
    key of
          KeyEd25519 PublicKey
    pub SecretKey
    pri ->
            String -> ByteString -> ByteString -> m JSValue
    enc String
    "ed25519" (PublicKey -> ByteString
    Ed25519.unPublicKey PublicKey
    pub) (SecretKey -> ByteString
    Ed25519.unSecretKey SecretKey
    pri)
        where
          enc :: String -> BS.ByteString -> BS.ByteString -> m JSValue
          enc :: String -> ByteString -> ByteString -> m JSValue
    enc String
    tag ByteString
    pub ByteString
    pri = [(String, m JSValue)] -> m JSValue
    forall (m :: * -> *). Monad m => [(String, m JSValue)] -> m JSValue
    mkObject [
                (String
    "keytype", JSValue -> m JSValue
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JSValue -> m JSValue) -> JSValue -> m JSValue
    forall a b. (a -> b) -> a -> b
    $ String -> JSValue
    JSString String
    tag)
              , (String
    "keyval", [(String, m JSValue)] -> m JSValue
    forall (m :: * -> *). Monad m => [(String, m JSValue)] -> m JSValue
    mkObject [
                    (String
    "public",  Base64 -> m JSValue
    forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
    toJSON (ByteString -> Base64
    B64.fromByteString ByteString
    pub))
                  , (String
    "private", Base64 -> m JSValue
    forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
    toJSON (ByteString -> Base64
    B64.fromByteString ByteString
    pri))
                  ])
              ]

    instance ReportSchemaErrors m => FromJSON m (Some Key) where
      fromJSON :: JSValue -> m (Some Key)
    fromJSON JSValue
    enc = do
          (tag, pub, pri) <- JSValue -> m (String, ByteString, ByteString)
    dec JSValue
    enc
          case tag of
            String
    "ed25519" -> Some Key -> m (Some Key)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Some Key -> m (Some Key))
    -> (Key Ed25519 -> Some Key) -> Key Ed25519 -> m (Some Key)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Key Ed25519 -> Some Key
    forall (f :: * -> *) a. f a -> Some f
    Some (Key Ed25519 -> m (Some Key)) -> Key Ed25519 -> m (Some Key)
    forall a b. (a -> b) -> a -> b
    $
              PublicKey -> SecretKey -> Key Ed25519
    KeyEd25519 (ByteString -> PublicKey
    Ed25519.PublicKey ByteString
    pub) (ByteString -> SecretKey
    Ed25519.SecretKey ByteString
    pri)
            String
    _otherwise ->
              String -> Maybe String -> m (Some Key)
    forall a. String -> Maybe String -> m a
    forall (m :: * -> *) a.
    ReportSchemaErrors m =>
    String -> Maybe String -> m a
    expected String
    "valid key type" (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    tag)
        where
          dec :: JSValue -> m (String, BS.ByteString, BS.ByteString)
          dec :: JSValue -> m (String, ByteString, ByteString)
    dec JSValue
    obj = do
            tag <- JSValue -> String -> m String
    forall (m :: * -> *) a.
    (ReportSchemaErrors m, FromJSON m a) =>
    JSValue -> String -> m a
    fromJSField JSValue
    obj String
    "keytype"
            val <- fromJSField obj "keyval"
            pub <- fromJSField val "public"
            pri <- fromJSField val "private"
            return (tag, B64.toByteString pub, B64.toByteString pri)

    instance Monad m => ToJSON m (PublicKey typ) where
      toJSON :: PublicKey typ -> m JSValue
    toJSON PublicKey typ
    key = case PublicKey typ
    key of
          PublicKeyEd25519 PublicKey
    pub ->
            String -> ByteString -> m JSValue
    enc String
    "ed25519" (PublicKey -> ByteString
    Ed25519.unPublicKey PublicKey
    pub)
        where
          enc :: String -> BS.ByteString -> m JSValue
          enc :: String -> ByteString -> m JSValue
    enc String
    tag ByteString
    pub = [(String, m JSValue)] -> m JSValue
    forall (m :: * -> *). Monad m => [(String, m JSValue)] -> m JSValue
    mkObject [
                (String
    "keytype", JSValue -> m JSValue
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JSValue -> m JSValue) -> JSValue -> m JSValue
    forall a b. (a -> b) -> a -> b
    $ String -> JSValue
    JSString String
    tag)
              , (String
    "keyval", [(String, m JSValue)] -> m JSValue
    forall (m :: * -> *). Monad m => [(String, m JSValue)] -> m JSValue
    mkObject [
                    (String
    "public", Base64 -> m JSValue
    forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
    toJSON (ByteString -> Base64
    B64.fromByteString ByteString
    pub))
                  ])
              ]

    instance Monad m => ToJSON m (Some Key)        where toJSON :: Some Key -> m JSValue
    toJSON (Some Key a
    a) = Key a -> m JSValue
    forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
    toJSON Key a
    a
    instance Monad m => ToJSON m (Some PublicKey)  where toJSON :: Some PublicKey -> m JSValue
    toJSON (Some PublicKey a
    a) = PublicKey a -> m JSValue
    forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
    toJSON PublicKey a
    a
    instance Monad m => ToJSON m (Some KeyType)    where toJSON :: Some KeyType -> m JSValue
    toJSON (Some KeyType a
    a) = KeyType a -> m JSValue
    forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
    toJSON KeyType a
    a

    instance ReportSchemaErrors m => FromJSON m (Some PublicKey) where
      fromJSON :: JSValue -> m (Some PublicKey)
    fromJSON JSValue
    enc = do
          (tag, pub) <- JSValue -> m (String, ByteString)
    dec JSValue
    enc
          case tag of
            String
    "ed25519" -> Some PublicKey -> m (Some PublicKey)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Some PublicKey -> m (Some PublicKey))
    -> (PublicKey Ed25519 -> Some PublicKey)
    -> PublicKey Ed25519
    -> m (Some PublicKey)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PublicKey Ed25519 -> Some PublicKey
    forall (f :: * -> *) a. f a -> Some f
    Some (PublicKey Ed25519 -> m (Some PublicKey))
    -> PublicKey Ed25519 -> m (Some PublicKey)
    forall a b. (a -> b) -> a -> b
    $
              PublicKey -> PublicKey Ed25519
    PublicKeyEd25519 (ByteString -> PublicKey
    Ed25519.PublicKey ByteString
    pub)
            String
    _otherwise ->
              String -> Maybe String -> m (Some PublicKey)
    forall a. String -> Maybe String -> m a
    forall (m :: * -> *) a.
    ReportSchemaErrors m =>
    String -> Maybe String -> m a
    expected String
    "valid key type" (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    tag)
        where
          dec :: JSValue -> m (String, BS.ByteString)
          dec :: JSValue -> m (String, ByteString)
    dec JSValue
    obj = do
            tag <- JSValue -> String -> m String
    forall (m :: * -> *) a.
    (ReportSchemaErrors m, FromJSON m a) =>
    JSValue -> String -> m a
    fromJSField JSValue
    obj String
    "keytype"
            val <- fromJSField obj "keyval"
            pub <- fromJSField val "public"
            return (tag, B64.toByteString pub)

    instance Monad m => ToJSON m (KeyType typ) where
      toJSON :: KeyType typ -> m JSValue
    toJSON KeyType typ
    KeyTypeEd25519 = JSValue -> m JSValue
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JSValue -> m JSValue) -> JSValue -> m JSValue
    forall a b. (a -> b) -> a -> b
    $ String -> JSValue
    JSString String
    "ed25519"

    instance ReportSchemaErrors m => FromJSON m (Some KeyType) where
      fromJSON :: JSValue -> m (Some KeyType)
    fromJSON JSValue
    enc = do
        tag <- JSValue -> m String
    forall (m :: * -> *) a. FromJSON m a => JSValue -> m a
    fromJSON JSValue
    enc
        case tag of
          String
    "ed25519"  -> Some KeyType -> m (Some KeyType)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Some KeyType -> m (Some KeyType))
    -> (KeyType Ed25519 -> Some KeyType)
    -> KeyType Ed25519
    -> m (Some KeyType)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . KeyType Ed25519 -> Some KeyType
    forall (f :: * -> *) a. f a -> Some f
    Some (KeyType Ed25519 -> m (Some KeyType))
    -> KeyType Ed25519 -> m (Some KeyType)
    forall a b. (a -> b) -> a -> b
    $ KeyType Ed25519
    KeyTypeEd25519
          String
    _otherwise -> String -> Maybe String -> m (Some KeyType)
    forall a. String -> Maybe String -> m a
    forall (m :: * -> *) a.
    ReportSchemaErrors m =>
    String -> Maybe String -> m a
    expected String
    "valid key type" (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    tag)