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

module Cardano.Crypto.Orphans () where

import Cardano.Binary
  ( FromCBOR (..),
    Size,
    ToCBOR (..),
    encodeBytes,
    withWordSize,
  )
import Cardano.Prelude
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 :: 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 :: 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 (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 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 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 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 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 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 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 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 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 = ByteString -> Encoding
encodeBytes (ByteString -> Encoding)
-> (PublicKey -> ByteString) -> PublicKey -> Encoding
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. ToCBOR t => Proxy t -> Size) -> Proxy PublicKey -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_ Proxy PublicKey
_ = Int -> Size
bsSize Int
32

instance FromCBOR Ed25519.PublicKey where
  fromCBOR :: Decoder s PublicKey
fromCBOR = 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 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 a s. FromCBOR a => Decoder s a
fromCBOR
    Either Text PublicKey -> Decoder s PublicKey
forall e a s. Buildable e => Either e a -> Decoder s 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
"fromCBOR Ed25519.PublicKey" CryptoFailable PublicKey
res

instance ToCBOR Ed25519.SecretKey where
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy SecretKey -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_ Proxy SecretKey
_ = Int -> Size
bsSize Int
64
  toCBOR :: SecretKey -> Encoding
toCBOR 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 FromCBOR Ed25519.SecretKey where
  fromCBOR :: Decoder s SecretKey
fromCBOR = 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 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 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 a s. FromCBOR a => Decoder s a
fromCBOR
    Either Text SecretKey -> Decoder s SecretKey
forall e a s. Buildable e => Either e a -> Decoder s 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
"fromCBOR Ed25519.SecretKey" CryptoFailable SecretKey
res

instance ToCBOR Ed25519.Signature where
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Signature -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_ Proxy Signature
_ = Int -> Size
bsSize Int
64
  toCBOR :: Signature -> Encoding
toCBOR = ByteString -> Encoding
encodeBytes (ByteString -> Encoding)
-> (Signature -> ByteString) -> Signature -> Encoding
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 FromCBOR Ed25519.Signature where
  fromCBOR :: Decoder s Signature
fromCBOR = 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 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 a s. FromCBOR a => Decoder s a
fromCBOR
    Either Text Signature -> Decoder s Signature
forall e a s. Buildable e => Either e a -> Decoder s 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
"fromCBOR Ed25519.Signature" CryptoFailable Signature
res

-- Helper for encodedSizeExpr in ToCBOR 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)