{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

-- | Ed448 digital signatures.
module Cardano.Crypto.DSIGN.Ed448
  ( Ed448DSIGN
  , SigDSIGN (..)
  , SignKeyDSIGN (..)
  , VerKeyDSIGN (..)
  )
where

import Control.DeepSeq (NFData)
import Data.ByteArray as BA (ByteArrayAccess, convert)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks, InspectHeap(..))

import Cardano.Binary (FromCBOR (..), ToCBOR (..))

import Crypto.Error (CryptoFailable (..))
import Crypto.PubKey.Ed448 as Ed448

import Cardano.Crypto.DSIGN.Class
import Cardano.Crypto.Seed
import Cardano.Crypto.Util (SignableRepresentation(..))


data Ed448DSIGN

instance DSIGNAlgorithm Ed448DSIGN where
    type SeedSizeDSIGN Ed448DSIGN = 57
    -- | Goldilocks points are 448 bits long
    type SizeVerKeyDSIGN  Ed448DSIGN = 57
    type SizeSignKeyDSIGN Ed448DSIGN = 57
    type SizeSigDSIGN     Ed448DSIGN = 114

    --
    -- Key and signature types
    --

    newtype VerKeyDSIGN Ed448DSIGN = VerKeyEd448DSIGN PublicKey
        deriving (Int -> VerKeyDSIGN Ed448DSIGN -> ShowS
[VerKeyDSIGN Ed448DSIGN] -> ShowS
VerKeyDSIGN Ed448DSIGN -> String
(Int -> VerKeyDSIGN Ed448DSIGN -> ShowS)
-> (VerKeyDSIGN Ed448DSIGN -> String)
-> ([VerKeyDSIGN Ed448DSIGN] -> ShowS)
-> Show (VerKeyDSIGN Ed448DSIGN)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VerKeyDSIGN Ed448DSIGN] -> ShowS
$cshowList :: [VerKeyDSIGN Ed448DSIGN] -> ShowS
show :: VerKeyDSIGN Ed448DSIGN -> String
$cshow :: VerKeyDSIGN Ed448DSIGN -> String
showsPrec :: Int -> VerKeyDSIGN Ed448DSIGN -> ShowS
$cshowsPrec :: Int -> VerKeyDSIGN Ed448DSIGN -> ShowS
Show, VerKeyDSIGN Ed448DSIGN -> VerKeyDSIGN Ed448DSIGN -> Bool
(VerKeyDSIGN Ed448DSIGN -> VerKeyDSIGN Ed448DSIGN -> Bool)
-> (VerKeyDSIGN Ed448DSIGN -> VerKeyDSIGN Ed448DSIGN -> Bool)
-> Eq (VerKeyDSIGN Ed448DSIGN)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VerKeyDSIGN Ed448DSIGN -> VerKeyDSIGN Ed448DSIGN -> Bool
$c/= :: VerKeyDSIGN Ed448DSIGN -> VerKeyDSIGN Ed448DSIGN -> Bool
== :: VerKeyDSIGN Ed448DSIGN -> VerKeyDSIGN Ed448DSIGN -> Bool
$c== :: VerKeyDSIGN Ed448DSIGN -> VerKeyDSIGN Ed448DSIGN -> Bool
Eq, (forall x.
 VerKeyDSIGN Ed448DSIGN -> Rep (VerKeyDSIGN Ed448DSIGN) x)
-> (forall x.
    Rep (VerKeyDSIGN Ed448DSIGN) x -> VerKeyDSIGN Ed448DSIGN)
-> Generic (VerKeyDSIGN Ed448DSIGN)
forall x. Rep (VerKeyDSIGN Ed448DSIGN) x -> VerKeyDSIGN Ed448DSIGN
forall x. VerKeyDSIGN Ed448DSIGN -> Rep (VerKeyDSIGN Ed448DSIGN) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (VerKeyDSIGN Ed448DSIGN) x -> VerKeyDSIGN Ed448DSIGN
$cfrom :: forall x. VerKeyDSIGN Ed448DSIGN -> Rep (VerKeyDSIGN Ed448DSIGN) x
Generic, VerKeyDSIGN Ed448DSIGN -> Int
VerKeyDSIGN Ed448DSIGN -> Ptr p -> IO ()
VerKeyDSIGN Ed448DSIGN -> (Ptr p -> IO a) -> IO a
(VerKeyDSIGN Ed448DSIGN -> Int)
-> (forall p a. VerKeyDSIGN Ed448DSIGN -> (Ptr p -> IO a) -> IO a)
-> (forall p. VerKeyDSIGN Ed448DSIGN -> Ptr p -> IO ())
-> ByteArrayAccess (VerKeyDSIGN Ed448DSIGN)
forall p. VerKeyDSIGN Ed448DSIGN -> Ptr p -> IO ()
forall ba.
(ba -> Int)
-> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
-> (forall p. ba -> Ptr p -> IO ())
-> ByteArrayAccess ba
forall p a. VerKeyDSIGN Ed448DSIGN -> (Ptr p -> IO a) -> IO a
copyByteArrayToPtr :: VerKeyDSIGN Ed448DSIGN -> Ptr p -> IO ()
$ccopyByteArrayToPtr :: forall p. VerKeyDSIGN Ed448DSIGN -> Ptr p -> IO ()
withByteArray :: VerKeyDSIGN Ed448DSIGN -> (Ptr p -> IO a) -> IO a
$cwithByteArray :: forall p a. VerKeyDSIGN Ed448DSIGN -> (Ptr p -> IO a) -> IO a
length :: VerKeyDSIGN Ed448DSIGN -> Int
$clength :: VerKeyDSIGN Ed448DSIGN -> Int
ByteArrayAccess)
        deriving newtype VerKeyDSIGN Ed448DSIGN -> ()
(VerKeyDSIGN Ed448DSIGN -> ()) -> NFData (VerKeyDSIGN Ed448DSIGN)
forall a. (a -> ()) -> NFData a
rnf :: VerKeyDSIGN Ed448DSIGN -> ()
$crnf :: VerKeyDSIGN Ed448DSIGN -> ()
NFData
        deriving Context -> VerKeyDSIGN Ed448DSIGN -> IO (Maybe ThunkInfo)
Proxy (VerKeyDSIGN Ed448DSIGN) -> String
(Context -> VerKeyDSIGN Ed448DSIGN -> IO (Maybe ThunkInfo))
-> (Context -> VerKeyDSIGN Ed448DSIGN -> IO (Maybe ThunkInfo))
-> (Proxy (VerKeyDSIGN Ed448DSIGN) -> String)
-> NoThunks (VerKeyDSIGN Ed448DSIGN)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (VerKeyDSIGN Ed448DSIGN) -> String
$cshowTypeOf :: Proxy (VerKeyDSIGN Ed448DSIGN) -> String
wNoThunks :: Context -> VerKeyDSIGN Ed448DSIGN -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> VerKeyDSIGN Ed448DSIGN -> IO (Maybe ThunkInfo)
noThunks :: Context -> VerKeyDSIGN Ed448DSIGN -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> VerKeyDSIGN Ed448DSIGN -> IO (Maybe ThunkInfo)
NoThunks via InspectHeap PublicKey

    newtype SignKeyDSIGN Ed448DSIGN = SignKeyEd448DSIGN SecretKey
        deriving (Int -> SignKeyDSIGN Ed448DSIGN -> ShowS
[SignKeyDSIGN Ed448DSIGN] -> ShowS
SignKeyDSIGN Ed448DSIGN -> String
(Int -> SignKeyDSIGN Ed448DSIGN -> ShowS)
-> (SignKeyDSIGN Ed448DSIGN -> String)
-> ([SignKeyDSIGN Ed448DSIGN] -> ShowS)
-> Show (SignKeyDSIGN Ed448DSIGN)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignKeyDSIGN Ed448DSIGN] -> ShowS
$cshowList :: [SignKeyDSIGN Ed448DSIGN] -> ShowS
show :: SignKeyDSIGN Ed448DSIGN -> String
$cshow :: SignKeyDSIGN Ed448DSIGN -> String
showsPrec :: Int -> SignKeyDSIGN Ed448DSIGN -> ShowS
$cshowsPrec :: Int -> SignKeyDSIGN Ed448DSIGN -> ShowS
Show, SignKeyDSIGN Ed448DSIGN -> SignKeyDSIGN Ed448DSIGN -> Bool
(SignKeyDSIGN Ed448DSIGN -> SignKeyDSIGN Ed448DSIGN -> Bool)
-> (SignKeyDSIGN Ed448DSIGN -> SignKeyDSIGN Ed448DSIGN -> Bool)
-> Eq (SignKeyDSIGN Ed448DSIGN)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignKeyDSIGN Ed448DSIGN -> SignKeyDSIGN Ed448DSIGN -> Bool
$c/= :: SignKeyDSIGN Ed448DSIGN -> SignKeyDSIGN Ed448DSIGN -> Bool
== :: SignKeyDSIGN Ed448DSIGN -> SignKeyDSIGN Ed448DSIGN -> Bool
$c== :: SignKeyDSIGN Ed448DSIGN -> SignKeyDSIGN Ed448DSIGN -> Bool
Eq, (forall x.
 SignKeyDSIGN Ed448DSIGN -> Rep (SignKeyDSIGN Ed448DSIGN) x)
-> (forall x.
    Rep (SignKeyDSIGN Ed448DSIGN) x -> SignKeyDSIGN Ed448DSIGN)
-> Generic (SignKeyDSIGN Ed448DSIGN)
forall x.
Rep (SignKeyDSIGN Ed448DSIGN) x -> SignKeyDSIGN Ed448DSIGN
forall x.
SignKeyDSIGN Ed448DSIGN -> Rep (SignKeyDSIGN Ed448DSIGN) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep (SignKeyDSIGN Ed448DSIGN) x -> SignKeyDSIGN Ed448DSIGN
$cfrom :: forall x.
SignKeyDSIGN Ed448DSIGN -> Rep (SignKeyDSIGN Ed448DSIGN) x
Generic, SignKeyDSIGN Ed448DSIGN -> Int
SignKeyDSIGN Ed448DSIGN -> Ptr p -> IO ()
SignKeyDSIGN Ed448DSIGN -> (Ptr p -> IO a) -> IO a
(SignKeyDSIGN Ed448DSIGN -> Int)
-> (forall p a. SignKeyDSIGN Ed448DSIGN -> (Ptr p -> IO a) -> IO a)
-> (forall p. SignKeyDSIGN Ed448DSIGN -> Ptr p -> IO ())
-> ByteArrayAccess (SignKeyDSIGN Ed448DSIGN)
forall p. SignKeyDSIGN Ed448DSIGN -> Ptr p -> IO ()
forall ba.
(ba -> Int)
-> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
-> (forall p. ba -> Ptr p -> IO ())
-> ByteArrayAccess ba
forall p a. SignKeyDSIGN Ed448DSIGN -> (Ptr p -> IO a) -> IO a
copyByteArrayToPtr :: SignKeyDSIGN Ed448DSIGN -> Ptr p -> IO ()
$ccopyByteArrayToPtr :: forall p. SignKeyDSIGN Ed448DSIGN -> Ptr p -> IO ()
withByteArray :: SignKeyDSIGN Ed448DSIGN -> (Ptr p -> IO a) -> IO a
$cwithByteArray :: forall p a. SignKeyDSIGN Ed448DSIGN -> (Ptr p -> IO a) -> IO a
length :: SignKeyDSIGN Ed448DSIGN -> Int
$clength :: SignKeyDSIGN Ed448DSIGN -> Int
ByteArrayAccess)
        deriving newtype SignKeyDSIGN Ed448DSIGN -> ()
(SignKeyDSIGN Ed448DSIGN -> ()) -> NFData (SignKeyDSIGN Ed448DSIGN)
forall a. (a -> ()) -> NFData a
rnf :: SignKeyDSIGN Ed448DSIGN -> ()
$crnf :: SignKeyDSIGN Ed448DSIGN -> ()
NFData
        deriving Context -> SignKeyDSIGN Ed448DSIGN -> IO (Maybe ThunkInfo)
Proxy (SignKeyDSIGN Ed448DSIGN) -> String
(Context -> SignKeyDSIGN Ed448DSIGN -> IO (Maybe ThunkInfo))
-> (Context -> SignKeyDSIGN Ed448DSIGN -> IO (Maybe ThunkInfo))
-> (Proxy (SignKeyDSIGN Ed448DSIGN) -> String)
-> NoThunks (SignKeyDSIGN Ed448DSIGN)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (SignKeyDSIGN Ed448DSIGN) -> String
$cshowTypeOf :: Proxy (SignKeyDSIGN Ed448DSIGN) -> String
wNoThunks :: Context -> SignKeyDSIGN Ed448DSIGN -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> SignKeyDSIGN Ed448DSIGN -> IO (Maybe ThunkInfo)
noThunks :: Context -> SignKeyDSIGN Ed448DSIGN -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> SignKeyDSIGN Ed448DSIGN -> IO (Maybe ThunkInfo)
NoThunks via InspectHeap SecretKey

    newtype SigDSIGN Ed448DSIGN = SigEd448DSIGN Signature
        deriving (Int -> SigDSIGN Ed448DSIGN -> ShowS
[SigDSIGN Ed448DSIGN] -> ShowS
SigDSIGN Ed448DSIGN -> String
(Int -> SigDSIGN Ed448DSIGN -> ShowS)
-> (SigDSIGN Ed448DSIGN -> String)
-> ([SigDSIGN Ed448DSIGN] -> ShowS)
-> Show (SigDSIGN Ed448DSIGN)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SigDSIGN Ed448DSIGN] -> ShowS
$cshowList :: [SigDSIGN Ed448DSIGN] -> ShowS
show :: SigDSIGN Ed448DSIGN -> String
$cshow :: SigDSIGN Ed448DSIGN -> String
showsPrec :: Int -> SigDSIGN Ed448DSIGN -> ShowS
$cshowsPrec :: Int -> SigDSIGN Ed448DSIGN -> ShowS
Show, SigDSIGN Ed448DSIGN -> SigDSIGN Ed448DSIGN -> Bool
(SigDSIGN Ed448DSIGN -> SigDSIGN Ed448DSIGN -> Bool)
-> (SigDSIGN Ed448DSIGN -> SigDSIGN Ed448DSIGN -> Bool)
-> Eq (SigDSIGN Ed448DSIGN)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SigDSIGN Ed448DSIGN -> SigDSIGN Ed448DSIGN -> Bool
$c/= :: SigDSIGN Ed448DSIGN -> SigDSIGN Ed448DSIGN -> Bool
== :: SigDSIGN Ed448DSIGN -> SigDSIGN Ed448DSIGN -> Bool
$c== :: SigDSIGN Ed448DSIGN -> SigDSIGN Ed448DSIGN -> Bool
Eq, (forall x. SigDSIGN Ed448DSIGN -> Rep (SigDSIGN Ed448DSIGN) x)
-> (forall x. Rep (SigDSIGN Ed448DSIGN) x -> SigDSIGN Ed448DSIGN)
-> Generic (SigDSIGN Ed448DSIGN)
forall x. Rep (SigDSIGN Ed448DSIGN) x -> SigDSIGN Ed448DSIGN
forall x. SigDSIGN Ed448DSIGN -> Rep (SigDSIGN Ed448DSIGN) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (SigDSIGN Ed448DSIGN) x -> SigDSIGN Ed448DSIGN
$cfrom :: forall x. SigDSIGN Ed448DSIGN -> Rep (SigDSIGN Ed448DSIGN) x
Generic, SigDSIGN Ed448DSIGN -> Int
SigDSIGN Ed448DSIGN -> Ptr p -> IO ()
SigDSIGN Ed448DSIGN -> (Ptr p -> IO a) -> IO a
(SigDSIGN Ed448DSIGN -> Int)
-> (forall p a. SigDSIGN Ed448DSIGN -> (Ptr p -> IO a) -> IO a)
-> (forall p. SigDSIGN Ed448DSIGN -> Ptr p -> IO ())
-> ByteArrayAccess (SigDSIGN Ed448DSIGN)
forall p. SigDSIGN Ed448DSIGN -> Ptr p -> IO ()
forall ba.
(ba -> Int)
-> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
-> (forall p. ba -> Ptr p -> IO ())
-> ByteArrayAccess ba
forall p a. SigDSIGN Ed448DSIGN -> (Ptr p -> IO a) -> IO a
copyByteArrayToPtr :: SigDSIGN Ed448DSIGN -> Ptr p -> IO ()
$ccopyByteArrayToPtr :: forall p. SigDSIGN Ed448DSIGN -> Ptr p -> IO ()
withByteArray :: SigDSIGN Ed448DSIGN -> (Ptr p -> IO a) -> IO a
$cwithByteArray :: forall p a. SigDSIGN Ed448DSIGN -> (Ptr p -> IO a) -> IO a
length :: SigDSIGN Ed448DSIGN -> Int
$clength :: SigDSIGN Ed448DSIGN -> Int
ByteArrayAccess)
        deriving Context -> SigDSIGN Ed448DSIGN -> IO (Maybe ThunkInfo)
Proxy (SigDSIGN Ed448DSIGN) -> String
(Context -> SigDSIGN Ed448DSIGN -> IO (Maybe ThunkInfo))
-> (Context -> SigDSIGN Ed448DSIGN -> IO (Maybe ThunkInfo))
-> (Proxy (SigDSIGN Ed448DSIGN) -> String)
-> NoThunks (SigDSIGN Ed448DSIGN)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (SigDSIGN Ed448DSIGN) -> String
$cshowTypeOf :: Proxy (SigDSIGN Ed448DSIGN) -> String
wNoThunks :: Context -> SigDSIGN Ed448DSIGN -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> SigDSIGN Ed448DSIGN -> IO (Maybe ThunkInfo)
noThunks :: Context -> SigDSIGN Ed448DSIGN -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> SigDSIGN Ed448DSIGN -> IO (Maybe ThunkInfo)
NoThunks via InspectHeap Signature

    --
    -- Metadata and basic key operations
    --

    algorithmNameDSIGN :: proxy Ed448DSIGN -> String
algorithmNameDSIGN proxy Ed448DSIGN
_ = String
"ed448"

    deriveVerKeyDSIGN :: SignKeyDSIGN Ed448DSIGN -> VerKeyDSIGN Ed448DSIGN
deriveVerKeyDSIGN (SignKeyEd448DSIGN sk) = PublicKey -> VerKeyDSIGN Ed448DSIGN
VerKeyEd448DSIGN (PublicKey -> VerKeyDSIGN Ed448DSIGN)
-> PublicKey -> VerKeyDSIGN Ed448DSIGN
forall a b. (a -> b) -> a -> b
$ SecretKey -> PublicKey
toPublic SecretKey
sk


    --
    -- Core algorithm operations
    --

    type Signable Ed448DSIGN = SignableRepresentation

    signDSIGN :: ContextDSIGN Ed448DSIGN
-> a -> SignKeyDSIGN Ed448DSIGN -> SigDSIGN Ed448DSIGN
signDSIGN () a
a (SignKeyEd448DSIGN sk) =
        let vk :: PublicKey
vk = SecretKey -> PublicKey
toPublic SecretKey
sk
            bs :: ByteString
bs = a -> ByteString
forall a. SignableRepresentation a => a -> ByteString
getSignableRepresentation a
a
         in Signature -> SigDSIGN Ed448DSIGN
SigEd448DSIGN (Signature -> SigDSIGN Ed448DSIGN)
-> Signature -> SigDSIGN Ed448DSIGN
forall a b. (a -> b) -> a -> b
$ SecretKey -> PublicKey -> ByteString -> Signature
forall ba.
ByteArrayAccess ba =>
SecretKey -> PublicKey -> ba -> Signature
sign SecretKey
sk PublicKey
vk ByteString
bs

    verifyDSIGN :: ContextDSIGN Ed448DSIGN
-> VerKeyDSIGN Ed448DSIGN
-> a
-> SigDSIGN Ed448DSIGN
-> Either String ()
verifyDSIGN () (VerKeyEd448DSIGN vk) a
a (SigEd448DSIGN sig) =
        if PublicKey -> ByteString -> Signature -> Bool
forall ba.
ByteArrayAccess ba =>
PublicKey -> ba -> Signature -> Bool
verify PublicKey
vk (a -> ByteString
forall a. SignableRepresentation a => a -> ByteString
getSignableRepresentation a
a) Signature
sig
          then () -> Either String ()
forall a b. b -> Either a b
Right ()
          else String -> Either String ()
forall a b. a -> Either a b
Left String
"Verification failed"

    --
    -- Key generation
    --

    genKeyDSIGN :: Seed -> SignKeyDSIGN Ed448DSIGN
genKeyDSIGN Seed
seed =
        let sk :: SecretKey
sk = Seed
-> (forall (m :: * -> *). MonadRandom m => m SecretKey)
-> SecretKey
forall a. Seed -> (forall (m :: * -> *). MonadRandom m => m a) -> a
runMonadRandomWithSeed Seed
seed forall (m :: * -> *). MonadRandom m => m SecretKey
Ed448.generateSecretKey
         in SecretKey -> SignKeyDSIGN Ed448DSIGN
SignKeyEd448DSIGN SecretKey
sk

    --
    -- raw serialise/deserialise
    --

    rawSerialiseVerKeyDSIGN :: VerKeyDSIGN Ed448DSIGN -> ByteString
rawSerialiseVerKeyDSIGN   = VerKeyDSIGN Ed448DSIGN -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert
    rawSerialiseSignKeyDSIGN :: SignKeyDSIGN Ed448DSIGN -> ByteString
rawSerialiseSignKeyDSIGN  = SignKeyDSIGN Ed448DSIGN -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert
    rawSerialiseSigDSIGN :: SigDSIGN Ed448DSIGN -> ByteString
rawSerialiseSigDSIGN      = SigDSIGN Ed448DSIGN -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert

    rawDeserialiseVerKeyDSIGN :: ByteString -> Maybe (VerKeyDSIGN Ed448DSIGN)
rawDeserialiseVerKeyDSIGN  = (PublicKey -> VerKeyDSIGN Ed448DSIGN)
-> Maybe PublicKey -> Maybe (VerKeyDSIGN Ed448DSIGN)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PublicKey -> VerKeyDSIGN Ed448DSIGN
VerKeyEd448DSIGN
                               (Maybe PublicKey -> Maybe (VerKeyDSIGN Ed448DSIGN))
-> (ByteString -> Maybe PublicKey)
-> ByteString
-> Maybe (VerKeyDSIGN Ed448DSIGN)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoFailable PublicKey -> Maybe PublicKey
forall a. CryptoFailable a -> Maybe a
cryptoFailableToMaybe (CryptoFailable PublicKey -> Maybe PublicKey)
-> (ByteString -> CryptoFailable PublicKey)
-> ByteString
-> Maybe PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> CryptoFailable PublicKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable PublicKey
Ed448.publicKey
    rawDeserialiseSignKeyDSIGN :: ByteString -> Maybe (SignKeyDSIGN Ed448DSIGN)
rawDeserialiseSignKeyDSIGN = (SecretKey -> SignKeyDSIGN Ed448DSIGN)
-> Maybe SecretKey -> Maybe (SignKeyDSIGN Ed448DSIGN)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SecretKey -> SignKeyDSIGN Ed448DSIGN
SignKeyEd448DSIGN
                               (Maybe SecretKey -> Maybe (SignKeyDSIGN Ed448DSIGN))
-> (ByteString -> Maybe SecretKey)
-> ByteString
-> Maybe (SignKeyDSIGN Ed448DSIGN)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoFailable SecretKey -> Maybe SecretKey
forall a. CryptoFailable a -> Maybe a
cryptoFailableToMaybe (CryptoFailable SecretKey -> Maybe SecretKey)
-> (ByteString -> CryptoFailable SecretKey)
-> ByteString
-> Maybe SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed448.secretKey
    rawDeserialiseSigDSIGN :: ByteString -> Maybe (SigDSIGN Ed448DSIGN)
rawDeserialiseSigDSIGN     = (Signature -> SigDSIGN Ed448DSIGN)
-> Maybe Signature -> Maybe (SigDSIGN Ed448DSIGN)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Signature -> SigDSIGN Ed448DSIGN
SigEd448DSIGN
                               (Maybe Signature -> Maybe (SigDSIGN Ed448DSIGN))
-> (ByteString -> Maybe Signature)
-> ByteString
-> Maybe (SigDSIGN Ed448DSIGN)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoFailable Signature -> Maybe Signature
forall a. CryptoFailable a -> Maybe a
cryptoFailableToMaybe (CryptoFailable Signature -> Maybe Signature)
-> (ByteString -> CryptoFailable Signature)
-> ByteString
-> Maybe Signature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> CryptoFailable Signature
forall ba. ByteArrayAccess ba => ba -> CryptoFailable Signature
Ed448.signature


instance ToCBOR (VerKeyDSIGN Ed448DSIGN) where
  toCBOR :: VerKeyDSIGN Ed448DSIGN -> Encoding
toCBOR = VerKeyDSIGN Ed448DSIGN -> Encoding
forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> Encoding
encodeVerKeyDSIGN
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerKeyDSIGN Ed448DSIGN) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_ = Proxy (VerKeyDSIGN Ed448DSIGN) -> Size
forall v. DSIGNAlgorithm v => Proxy (VerKeyDSIGN v) -> Size
encodedVerKeyDSIGNSizeExpr

instance FromCBOR (VerKeyDSIGN Ed448DSIGN) where
  fromCBOR :: Decoder s (VerKeyDSIGN Ed448DSIGN)
fromCBOR = Decoder s (VerKeyDSIGN Ed448DSIGN)
forall v s. DSIGNAlgorithm v => Decoder s (VerKeyDSIGN v)
decodeVerKeyDSIGN

instance ToCBOR (SignKeyDSIGN Ed448DSIGN) where
  toCBOR :: SignKeyDSIGN Ed448DSIGN -> Encoding
toCBOR = SignKeyDSIGN Ed448DSIGN -> Encoding
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> Encoding
encodeSignKeyDSIGN
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SignKeyDSIGN Ed448DSIGN) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_ = Proxy (SignKeyDSIGN Ed448DSIGN) -> Size
forall v. DSIGNAlgorithm v => Proxy (SignKeyDSIGN v) -> Size
encodedSignKeyDESIGNSizeExpr

instance FromCBOR (SignKeyDSIGN Ed448DSIGN) where
  fromCBOR :: Decoder s (SignKeyDSIGN Ed448DSIGN)
fromCBOR = Decoder s (SignKeyDSIGN Ed448DSIGN)
forall v s. DSIGNAlgorithm v => Decoder s (SignKeyDSIGN v)
decodeSignKeyDSIGN

instance ToCBOR (SigDSIGN Ed448DSIGN) where
  toCBOR :: SigDSIGN Ed448DSIGN -> Encoding
toCBOR = SigDSIGN Ed448DSIGN -> Encoding
forall v. DSIGNAlgorithm v => SigDSIGN v -> Encoding
encodeSigDSIGN
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SigDSIGN Ed448DSIGN) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_ = Proxy (SigDSIGN Ed448DSIGN) -> Size
forall v. DSIGNAlgorithm v => Proxy (SigDSIGN v) -> Size
encodedSigDSIGNSizeExpr

instance FromCBOR (SigDSIGN Ed448DSIGN) where
  fromCBOR :: Decoder s (SigDSIGN Ed448DSIGN)
fromCBOR = Decoder s (SigDSIGN Ed448DSIGN)
forall v s. DSIGNAlgorithm v => Decoder s (SigDSIGN v)
decodeSigDSIGN


cryptoFailableToMaybe :: CryptoFailable a -> Maybe a
cryptoFailableToMaybe :: CryptoFailable a -> Maybe a
cryptoFailableToMaybe (CryptoPassed a
a) = a -> Maybe a
forall a. a -> Maybe a
Just a
a
cryptoFailableToMaybe (CryptoFailed CryptoError
_) = Maybe a
forall a. Maybe a
Nothing