{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Crypto.Orphans () where

import Cardano.Ledger.Binary (
  DecCBOR (..),
  EncCBOR (..),
  FromCBOR (..),
  Size,
  ToCBOR (..),
  encodeBytes,
  fromByronCBOR,
  toByronCBOR,
  toCborError,
  withWordSize,
 )
import Cardano.Prelude hiding (toCborError)
import Crypto.Error (CryptoFailable (..))
import qualified Crypto.PubKey.Ed25519 as Ed25519
import Data.Aeson (FromJSON (..), ToJSON (..))
import qualified Data.ByteArray as BA
import qualified Data.ByteString as BS
import Data.ByteString.Base64.Type (getByteString64, makeByteString64)
import qualified Data.Text as T

fromByteStringToBytes :: ByteString -> BA.Bytes
fromByteStringToBytes :: ByteString -> Bytes
fromByteStringToBytes = ByteString -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert

fromByteStringToScrubbedBytes :: ByteString -> BA.ScrubbedBytes
fromByteStringToScrubbedBytes :: ByteString -> ScrubbedBytes
fromByteStringToScrubbedBytes = ByteString -> ScrubbedBytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert

toByteString :: BA.ByteArrayAccess bin => bin -> ByteString
toByteString :: forall bin. ByteArrayAccess bin => bin -> ByteString
toByteString = bin -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert

fromCryptoFailable :: T.Text -> CryptoFailable a -> Either T.Text a
fromCryptoFailable :: forall a. Text -> CryptoFailable a -> Either Text a
fromCryptoFailable Text
item (CryptoFailed CryptoError
e) =
  Text -> Either Text a
forall a b. a -> Either a b
Left (Text -> Either Text a) -> Text -> Either Text a
forall a b. (a -> b) -> a -> b
$ Text
"Cardano.Crypto.Orphan." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
item Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" failed because " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CryptoError -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show CryptoError
e
fromCryptoFailable Text
_ (CryptoPassed a
r) = a -> Either Text a
forall a. a -> Either Text a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r

instance FromJSON Ed25519.PublicKey where
  parseJSON :: Value -> Parser PublicKey
parseJSON Value
v = do
    CryptoFailable PublicKey
res <-
      Bytes -> CryptoFailable PublicKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable PublicKey
Ed25519.publicKey
        (Bytes -> CryptoFailable PublicKey)
-> (ByteString64 -> Bytes)
-> ByteString64
-> CryptoFailable PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Bytes
fromByteStringToBytes
        (ByteString -> Bytes)
-> (ByteString64 -> ByteString) -> ByteString64 -> Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString64 -> ByteString
getByteString64
        (ByteString64 -> CryptoFailable PublicKey)
-> Parser ByteString64 -> Parser (CryptoFailable PublicKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ByteString64
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Either Text PublicKey -> Parser PublicKey
forall e a. Buildable e => Either e a -> Parser a
toAesonError (Either Text PublicKey -> Parser PublicKey)
-> Either Text PublicKey -> Parser PublicKey
forall a b. (a -> b) -> a -> b
$ Text -> CryptoFailable PublicKey -> Either Text PublicKey
forall a. Text -> CryptoFailable a -> Either Text a
fromCryptoFailable Text
"parseJSON Ed25519.PublicKey" CryptoFailable PublicKey
res

instance ToJSON Ed25519.PublicKey where
  toJSON :: PublicKey -> Value
toJSON = ByteString64 -> Value
forall a. ToJSON a => a -> Value
toJSON (ByteString64 -> Value)
-> (PublicKey -> ByteString64) -> PublicKey -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> ByteString64
makeByteString64 (ByteString -> ByteString64)
-> (PublicKey -> ByteString) -> PublicKey -> ByteString64
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. PublicKey -> ByteString
forall bin. ByteArrayAccess bin => bin -> ByteString
toByteString

instance FromJSON Ed25519.Signature where
  parseJSON :: Value -> Parser Signature
parseJSON Value
v = do
    CryptoFailable Signature
res <-
      Bytes -> CryptoFailable Signature
forall ba. ByteArrayAccess ba => ba -> CryptoFailable Signature
Ed25519.signature
        (Bytes -> CryptoFailable Signature)
-> (ByteString64 -> Bytes)
-> ByteString64
-> CryptoFailable Signature
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Bytes
fromByteStringToBytes
        (ByteString -> Bytes)
-> (ByteString64 -> ByteString) -> ByteString64 -> Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString64 -> ByteString
getByteString64
        (ByteString64 -> CryptoFailable Signature)
-> Parser ByteString64 -> Parser (CryptoFailable Signature)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ByteString64
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Either Text Signature -> Parser Signature
forall e a. Buildable e => Either e a -> Parser a
toAesonError (Either Text Signature -> Parser Signature)
-> Either Text Signature -> Parser Signature
forall a b. (a -> b) -> a -> b
$ Text -> CryptoFailable Signature -> Either Text Signature
forall a. Text -> CryptoFailable a -> Either Text a
fromCryptoFailable Text
"parseJSON Ed25519.Signature" CryptoFailable Signature
res

instance ToJSON Ed25519.Signature where
  toJSON :: Signature -> Value
toJSON = ByteString64 -> Value
forall a. ToJSON a => a -> Value
toJSON (ByteString64 -> Value)
-> (Signature -> ByteString64) -> Signature -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> ByteString64
makeByteString64 (ByteString -> ByteString64)
-> (Signature -> ByteString) -> Signature -> ByteString64
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Signature -> ByteString
forall bin. ByteArrayAccess bin => bin -> ByteString
toByteString

instance ToCBOR Ed25519.PublicKey where
  toCBOR :: PublicKey -> Encoding
toCBOR = PublicKey -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR Ed25519.PublicKey where
  fromCBOR :: forall s. Decoder s PublicKey
fromCBOR = Decoder s PublicKey
forall a s. DecCBOR a => Decoder s a
fromByronCBOR

instance ToCBOR Ed25519.SecretKey where
  toCBOR :: SecretKey -> Encoding
toCBOR = SecretKey -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR Ed25519.SecretKey where
  fromCBOR :: forall s. Decoder s SecretKey
fromCBOR = Decoder s SecretKey
forall a s. DecCBOR a => Decoder s a
fromByronCBOR

instance ToCBOR Ed25519.Signature where
  toCBOR :: Signature -> Encoding
toCBOR = Signature -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR Ed25519.Signature where
  fromCBOR :: forall s. Decoder s Signature
fromCBOR = Decoder s Signature
forall a s. DecCBOR a => Decoder s a
fromByronCBOR

instance EncCBOR Ed25519.PublicKey where
  encCBOR :: PublicKey -> Encoding
encCBOR = ByteString -> Encoding
encodeBytes (ByteString -> Encoding)
-> (PublicKey -> ByteString) -> PublicKey -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. PublicKey -> ByteString
forall bin. ByteArrayAccess bin => bin -> ByteString
toByteString
  encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy PublicKey -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
_ Proxy PublicKey
_ = Int -> Size
bsSize Int
32

instance DecCBOR Ed25519.PublicKey where
  decCBOR :: forall s. Decoder s PublicKey
decCBOR = do
    CryptoFailable PublicKey
res <- Bytes -> CryptoFailable PublicKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable PublicKey
Ed25519.publicKey (Bytes -> CryptoFailable PublicKey)
-> (ByteString -> Bytes) -> ByteString -> CryptoFailable PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Bytes
fromByteStringToBytes (ByteString -> CryptoFailable PublicKey)
-> Decoder s ByteString -> Decoder s (CryptoFailable PublicKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s ByteString
forall s. Decoder s ByteString
forall a s. DecCBOR a => Decoder s a
decCBOR
    Either Text PublicKey -> Decoder s PublicKey
forall (m :: * -> *) e a.
(MonadFail m, Buildable e) =>
Either e a -> m a
toCborError (Either Text PublicKey -> Decoder s PublicKey)
-> Either Text PublicKey -> Decoder s PublicKey
forall a b. (a -> b) -> a -> b
$ Text -> CryptoFailable PublicKey -> Either Text PublicKey
forall a. Text -> CryptoFailable a -> Either Text a
fromCryptoFailable Text
"decCBOR Ed25519.PublicKey" CryptoFailable PublicKey
res

instance EncCBOR Ed25519.SecretKey where
  encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy SecretKey -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
_ Proxy SecretKey
_ = Int -> Size
bsSize Int
64
  encCBOR :: SecretKey -> Encoding
encCBOR SecretKey
sk =
    ByteString -> Encoding
encodeBytes
      (ByteString -> Encoding) -> ByteString -> Encoding
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
BS.append (SecretKey -> ByteString
forall bin. ByteArrayAccess bin => bin -> ByteString
toByteString SecretKey
sk) (PublicKey -> ByteString
forall bin. ByteArrayAccess bin => bin -> ByteString
toByteString (PublicKey -> ByteString) -> PublicKey -> ByteString
forall a b. (a -> b) -> a -> b
$ SecretKey -> PublicKey
Ed25519.toPublic SecretKey
sk)

instance DecCBOR Ed25519.SecretKey where
  decCBOR :: forall s. Decoder s SecretKey
decCBOR = do
    CryptoFailable SecretKey
res <-
      ScrubbedBytes -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed25519.secretKey
        (ScrubbedBytes -> CryptoFailable SecretKey)
-> (ByteString -> ScrubbedBytes)
-> ByteString
-> CryptoFailable SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> ScrubbedBytes
fromByteStringToScrubbedBytes
        (ByteString -> ScrubbedBytes)
-> (ByteString -> ByteString) -> ByteString -> ScrubbedBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> ByteString -> ByteString
BS.take Int
Ed25519.secretKeySize
        (ByteString -> CryptoFailable SecretKey)
-> Decoder s ByteString -> Decoder s (CryptoFailable SecretKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s ByteString
forall s. Decoder s ByteString
forall a s. DecCBOR a => Decoder s a
decCBOR
    Either Text SecretKey -> Decoder s SecretKey
forall (m :: * -> *) e a.
(MonadFail m, Buildable e) =>
Either e a -> m a
toCborError (Either Text SecretKey -> Decoder s SecretKey)
-> Either Text SecretKey -> Decoder s SecretKey
forall a b. (a -> b) -> a -> b
$ Text -> CryptoFailable SecretKey -> Either Text SecretKey
forall a. Text -> CryptoFailable a -> Either Text a
fromCryptoFailable Text
"decCBOR Ed25519.SecretKey" CryptoFailable SecretKey
res

instance EncCBOR Ed25519.Signature where
  encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy Signature -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
_ Proxy Signature
_ = Int -> Size
bsSize Int
64
  encCBOR :: Signature -> Encoding
encCBOR = ByteString -> Encoding
encodeBytes (ByteString -> Encoding)
-> (Signature -> ByteString) -> Signature -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Signature -> ByteString
forall bin. ByteArrayAccess bin => bin -> ByteString
toByteString

instance DecCBOR Ed25519.Signature where
  decCBOR :: forall s. Decoder s Signature
decCBOR = do
    CryptoFailable Signature
res <- Bytes -> CryptoFailable Signature
forall ba. ByteArrayAccess ba => ba -> CryptoFailable Signature
Ed25519.signature (Bytes -> CryptoFailable Signature)
-> (ByteString -> Bytes) -> ByteString -> CryptoFailable Signature
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Bytes
fromByteStringToBytes (ByteString -> CryptoFailable Signature)
-> Decoder s ByteString -> Decoder s (CryptoFailable Signature)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s ByteString
forall s. Decoder s ByteString
forall a s. DecCBOR a => Decoder s a
decCBOR
    Either Text Signature -> Decoder s Signature
forall (m :: * -> *) e a.
(MonadFail m, Buildable e) =>
Either e a -> m a
toCborError (Either Text Signature -> Decoder s Signature)
-> Either Text Signature -> Decoder s Signature
forall a b. (a -> b) -> a -> b
$ Text -> CryptoFailable Signature -> Either Text Signature
forall a. Text -> CryptoFailable a -> Either Text a
fromCryptoFailable Text
"decCBOR Ed25519.Signature" CryptoFailable Signature
res

-- Helper for encodedSizeExpr in EncCBOR instances
bsSize :: Int -> Size
bsSize :: Int -> Size
bsSize Int
x = Int -> Size
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall s a. (Integral s, Integral a) => s -> a
withWordSize Int
x)