{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
module Cardano.Crypto.DSIGN.NeverUsed
  ( NeverDSIGN
  , VerKeyDSIGN (..)
  , SignKeyDSIGN (..)
  , SigDSIGN (..)
  )
where

import GHC.Generics (Generic)

import NoThunks.Class (NoThunks)

import Cardano.Crypto.DSIGN.Class


-- | DSIGN never used
--
-- The type of keys and signatures is isomorphic to unit, but when actually
-- trying to sign or verify something a runtime exception will be thrown.
data NeverDSIGN

instance DSIGNAlgorithm NeverDSIGN where
  type SeedSizeDSIGN NeverDSIGN = 0
  type SizeVerKeyDSIGN  NeverDSIGN = 0
  type SizeSignKeyDSIGN NeverDSIGN = 0
  type SizeSigDSIGN     NeverDSIGN = 0

  data VerKeyDSIGN  NeverDSIGN = NeverUsedVerKeyDSIGN
     deriving (Int -> VerKeyDSIGN NeverDSIGN -> ShowS
[VerKeyDSIGN NeverDSIGN] -> ShowS
VerKeyDSIGN NeverDSIGN -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VerKeyDSIGN NeverDSIGN] -> ShowS
$cshowList :: [VerKeyDSIGN NeverDSIGN] -> ShowS
show :: VerKeyDSIGN NeverDSIGN -> String
$cshow :: VerKeyDSIGN NeverDSIGN -> String
showsPrec :: Int -> VerKeyDSIGN NeverDSIGN -> ShowS
$cshowsPrec :: Int -> VerKeyDSIGN NeverDSIGN -> ShowS
Show, VerKeyDSIGN NeverDSIGN -> VerKeyDSIGN NeverDSIGN -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VerKeyDSIGN NeverDSIGN -> VerKeyDSIGN NeverDSIGN -> Bool
$c/= :: VerKeyDSIGN NeverDSIGN -> VerKeyDSIGN NeverDSIGN -> Bool
== :: VerKeyDSIGN NeverDSIGN -> VerKeyDSIGN NeverDSIGN -> Bool
$c== :: VerKeyDSIGN NeverDSIGN -> VerKeyDSIGN NeverDSIGN -> Bool
Eq, forall x. Rep (VerKeyDSIGN NeverDSIGN) x -> VerKeyDSIGN NeverDSIGN
forall x. VerKeyDSIGN NeverDSIGN -> Rep (VerKeyDSIGN NeverDSIGN) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (VerKeyDSIGN NeverDSIGN) x -> VerKeyDSIGN NeverDSIGN
$cfrom :: forall x. VerKeyDSIGN NeverDSIGN -> Rep (VerKeyDSIGN NeverDSIGN) x
Generic, Context -> VerKeyDSIGN NeverDSIGN -> IO (Maybe ThunkInfo)
Proxy (VerKeyDSIGN NeverDSIGN) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (VerKeyDSIGN NeverDSIGN) -> String
$cshowTypeOf :: Proxy (VerKeyDSIGN NeverDSIGN) -> String
wNoThunks :: Context -> VerKeyDSIGN NeverDSIGN -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> VerKeyDSIGN NeverDSIGN -> IO (Maybe ThunkInfo)
noThunks :: Context -> VerKeyDSIGN NeverDSIGN -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> VerKeyDSIGN NeverDSIGN -> IO (Maybe ThunkInfo)
NoThunks)

  data SignKeyDSIGN NeverDSIGN = NeverUsedSignKeyDSIGN
     deriving (Int -> SignKeyDSIGN NeverDSIGN -> ShowS
[SignKeyDSIGN NeverDSIGN] -> ShowS
SignKeyDSIGN NeverDSIGN -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignKeyDSIGN NeverDSIGN] -> ShowS
$cshowList :: [SignKeyDSIGN NeverDSIGN] -> ShowS
show :: SignKeyDSIGN NeverDSIGN -> String
$cshow :: SignKeyDSIGN NeverDSIGN -> String
showsPrec :: Int -> SignKeyDSIGN NeverDSIGN -> ShowS
$cshowsPrec :: Int -> SignKeyDSIGN NeverDSIGN -> ShowS
Show, SignKeyDSIGN NeverDSIGN -> SignKeyDSIGN NeverDSIGN -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignKeyDSIGN NeverDSIGN -> SignKeyDSIGN NeverDSIGN -> Bool
$c/= :: SignKeyDSIGN NeverDSIGN -> SignKeyDSIGN NeverDSIGN -> Bool
== :: SignKeyDSIGN NeverDSIGN -> SignKeyDSIGN NeverDSIGN -> Bool
$c== :: SignKeyDSIGN NeverDSIGN -> SignKeyDSIGN NeverDSIGN -> Bool
Eq, forall x.
Rep (SignKeyDSIGN NeverDSIGN) x -> SignKeyDSIGN NeverDSIGN
forall x.
SignKeyDSIGN NeverDSIGN -> Rep (SignKeyDSIGN NeverDSIGN) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep (SignKeyDSIGN NeverDSIGN) x -> SignKeyDSIGN NeverDSIGN
$cfrom :: forall x.
SignKeyDSIGN NeverDSIGN -> Rep (SignKeyDSIGN NeverDSIGN) x
Generic, Context -> SignKeyDSIGN NeverDSIGN -> IO (Maybe ThunkInfo)
Proxy (SignKeyDSIGN NeverDSIGN) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (SignKeyDSIGN NeverDSIGN) -> String
$cshowTypeOf :: Proxy (SignKeyDSIGN NeverDSIGN) -> String
wNoThunks :: Context -> SignKeyDSIGN NeverDSIGN -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> SignKeyDSIGN NeverDSIGN -> IO (Maybe ThunkInfo)
noThunks :: Context -> SignKeyDSIGN NeverDSIGN -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> SignKeyDSIGN NeverDSIGN -> IO (Maybe ThunkInfo)
NoThunks)

  data SigDSIGN     NeverDSIGN = NeverUsedSigDSIGN
     deriving (Int -> SigDSIGN NeverDSIGN -> ShowS
[SigDSIGN NeverDSIGN] -> ShowS
SigDSIGN NeverDSIGN -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SigDSIGN NeverDSIGN] -> ShowS
$cshowList :: [SigDSIGN NeverDSIGN] -> ShowS
show :: SigDSIGN NeverDSIGN -> String
$cshow :: SigDSIGN NeverDSIGN -> String
showsPrec :: Int -> SigDSIGN NeverDSIGN -> ShowS
$cshowsPrec :: Int -> SigDSIGN NeverDSIGN -> ShowS
Show, SigDSIGN NeverDSIGN -> SigDSIGN NeverDSIGN -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SigDSIGN NeverDSIGN -> SigDSIGN NeverDSIGN -> Bool
$c/= :: SigDSIGN NeverDSIGN -> SigDSIGN NeverDSIGN -> Bool
== :: SigDSIGN NeverDSIGN -> SigDSIGN NeverDSIGN -> Bool
$c== :: SigDSIGN NeverDSIGN -> SigDSIGN NeverDSIGN -> Bool
Eq, forall x. Rep (SigDSIGN NeverDSIGN) x -> SigDSIGN NeverDSIGN
forall x. SigDSIGN NeverDSIGN -> Rep (SigDSIGN NeverDSIGN) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (SigDSIGN NeverDSIGN) x -> SigDSIGN NeverDSIGN
$cfrom :: forall x. SigDSIGN NeverDSIGN -> Rep (SigDSIGN NeverDSIGN) x
Generic, Context -> SigDSIGN NeverDSIGN -> IO (Maybe ThunkInfo)
Proxy (SigDSIGN NeverDSIGN) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (SigDSIGN NeverDSIGN) -> String
$cshowTypeOf :: Proxy (SigDSIGN NeverDSIGN) -> String
wNoThunks :: Context -> SigDSIGN NeverDSIGN -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> SigDSIGN NeverDSIGN -> IO (Maybe ThunkInfo)
noThunks :: Context -> SigDSIGN NeverDSIGN -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> SigDSIGN NeverDSIGN -> IO (Maybe ThunkInfo)
NoThunks)

  algorithmNameDSIGN :: forall (proxy :: * -> *). proxy NeverDSIGN -> String
algorithmNameDSIGN proxy NeverDSIGN
_ = String
"never"

  deriveVerKeyDSIGN :: SignKeyDSIGN NeverDSIGN -> VerKeyDSIGN NeverDSIGN
deriveVerKeyDSIGN SignKeyDSIGN NeverDSIGN
_ = VerKeyDSIGN NeverDSIGN
NeverUsedVerKeyDSIGN

  signDSIGN :: forall a.
(Signable NeverDSIGN a, HasCallStack) =>
ContextDSIGN NeverDSIGN
-> a -> SignKeyDSIGN NeverDSIGN -> SigDSIGN NeverDSIGN
signDSIGN   = forall a. HasCallStack => String -> a
error String
"DSIGN not available"
  verifyDSIGN :: forall a.
(Signable NeverDSIGN a, HasCallStack) =>
ContextDSIGN NeverDSIGN
-> VerKeyDSIGN NeverDSIGN
-> a
-> SigDSIGN NeverDSIGN
-> Either String ()
verifyDSIGN = forall a. HasCallStack => String -> a
error String
"DSIGN not available"

  genKeyDSIGN :: Seed -> SignKeyDSIGN NeverDSIGN
genKeyDSIGN       Seed
_ = SignKeyDSIGN NeverDSIGN
NeverUsedSignKeyDSIGN

  rawSerialiseVerKeyDSIGN :: VerKeyDSIGN NeverDSIGN -> ByteString
rawSerialiseVerKeyDSIGN  VerKeyDSIGN NeverDSIGN
_ = forall a. Monoid a => a
mempty
  rawSerialiseSignKeyDSIGN :: SignKeyDSIGN NeverDSIGN -> ByteString
rawSerialiseSignKeyDSIGN SignKeyDSIGN NeverDSIGN
_ = forall a. Monoid a => a
mempty
  rawSerialiseSigDSIGN :: SigDSIGN NeverDSIGN -> ByteString
rawSerialiseSigDSIGN     SigDSIGN NeverDSIGN
_ = forall a. Monoid a => a
mempty

  rawDeserialiseVerKeyDSIGN :: ByteString -> Maybe (VerKeyDSIGN NeverDSIGN)
rawDeserialiseVerKeyDSIGN  ByteString
_ = forall a. a -> Maybe a
Just VerKeyDSIGN NeverDSIGN
NeverUsedVerKeyDSIGN
  rawDeserialiseSignKeyDSIGN :: ByteString -> Maybe (SignKeyDSIGN NeverDSIGN)
rawDeserialiseSignKeyDSIGN ByteString
_ = forall a. a -> Maybe a
Just SignKeyDSIGN NeverDSIGN
NeverUsedSignKeyDSIGN
  rawDeserialiseSigDSIGN :: ByteString -> Maybe (SigDSIGN NeverDSIGN)
rawDeserialiseSigDSIGN     ByteString
_ = forall a. a -> Maybe a
Just SigDSIGN NeverDSIGN
NeverUsedSigDSIGN