{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.Crypto.Signing.Safe.PassPhrase
  ( PassPhrase (..),
    emptyPassphrase,
    passphraseLength,
  )
where

import Cardano.Binary (FromCBOR (..), ToCBOR (..))
import Cardano.Prelude
import Data.ByteArray (ByteArray, ByteArrayAccess, ScrubbedBytes)
import qualified Data.ByteArray as ByteArray
import qualified Data.ByteString as BS
import Data.Default (Default (..))
import Formatting (int, sformat)
import Formatting.Buildable (Buildable (..))
import qualified Prelude

newtype PassPhrase
  = PassPhrase ScrubbedBytes
  deriving (PassPhrase -> PassPhrase -> Bool
(PassPhrase -> PassPhrase -> Bool)
-> (PassPhrase -> PassPhrase -> Bool) -> Eq PassPhrase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PassPhrase -> PassPhrase -> Bool
$c/= :: PassPhrase -> PassPhrase -> Bool
== :: PassPhrase -> PassPhrase -> Bool
$c== :: PassPhrase -> PassPhrase -> Bool
Eq, Eq PassPhrase
Eq PassPhrase
-> (PassPhrase -> PassPhrase -> Ordering)
-> (PassPhrase -> PassPhrase -> Bool)
-> (PassPhrase -> PassPhrase -> Bool)
-> (PassPhrase -> PassPhrase -> Bool)
-> (PassPhrase -> PassPhrase -> Bool)
-> (PassPhrase -> PassPhrase -> PassPhrase)
-> (PassPhrase -> PassPhrase -> PassPhrase)
-> Ord PassPhrase
PassPhrase -> PassPhrase -> Bool
PassPhrase -> PassPhrase -> Ordering
PassPhrase -> PassPhrase -> PassPhrase
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
min :: PassPhrase -> PassPhrase -> PassPhrase
$cmin :: PassPhrase -> PassPhrase -> PassPhrase
max :: PassPhrase -> PassPhrase -> PassPhrase
$cmax :: PassPhrase -> PassPhrase -> PassPhrase
>= :: PassPhrase -> PassPhrase -> Bool
$c>= :: PassPhrase -> PassPhrase -> Bool
> :: PassPhrase -> PassPhrase -> Bool
$c> :: PassPhrase -> PassPhrase -> Bool
<= :: PassPhrase -> PassPhrase -> Bool
$c<= :: PassPhrase -> PassPhrase -> Bool
< :: PassPhrase -> PassPhrase -> Bool
$c< :: PassPhrase -> PassPhrase -> Bool
compare :: PassPhrase -> PassPhrase -> Ordering
$ccompare :: PassPhrase -> PassPhrase -> Ordering
$cp1Ord :: Eq PassPhrase
Ord, b -> PassPhrase -> PassPhrase
NonEmpty PassPhrase -> PassPhrase
PassPhrase -> PassPhrase -> PassPhrase
(PassPhrase -> PassPhrase -> PassPhrase)
-> (NonEmpty PassPhrase -> PassPhrase)
-> (forall b. Integral b => b -> PassPhrase -> PassPhrase)
-> Semigroup PassPhrase
forall b. Integral b => b -> PassPhrase -> PassPhrase
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> PassPhrase -> PassPhrase
$cstimes :: forall b. Integral b => b -> PassPhrase -> PassPhrase
sconcat :: NonEmpty PassPhrase -> PassPhrase
$csconcat :: NonEmpty PassPhrase -> PassPhrase
<> :: PassPhrase -> PassPhrase -> PassPhrase
$c<> :: PassPhrase -> PassPhrase -> PassPhrase
Semigroup, Semigroup PassPhrase
PassPhrase
Semigroup PassPhrase
-> PassPhrase
-> (PassPhrase -> PassPhrase -> PassPhrase)
-> ([PassPhrase] -> PassPhrase)
-> Monoid PassPhrase
[PassPhrase] -> PassPhrase
PassPhrase -> PassPhrase -> PassPhrase
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [PassPhrase] -> PassPhrase
$cmconcat :: [PassPhrase] -> PassPhrase
mappend :: PassPhrase -> PassPhrase -> PassPhrase
$cmappend :: PassPhrase -> PassPhrase -> PassPhrase
mempty :: PassPhrase
$cmempty :: PassPhrase
$cp1Monoid :: Semigroup PassPhrase
Monoid, PassPhrase -> ()
(PassPhrase -> ()) -> NFData PassPhrase
forall a. (a -> ()) -> NFData a
rnf :: PassPhrase -> ()
$crnf :: PassPhrase -> ()
NFData, Eq PassPhrase
Ord PassPhrase
Monoid PassPhrase
ByteArrayAccess PassPhrase
Eq PassPhrase
-> Ord PassPhrase
-> Monoid PassPhrase
-> ByteArrayAccess PassPhrase
-> (forall p a. Int -> (Ptr p -> IO a) -> IO (a, PassPhrase))
-> ByteArray PassPhrase
Int -> (Ptr p -> IO a) -> IO (a, PassPhrase)
forall ba.
Eq ba
-> Ord ba
-> Monoid ba
-> ByteArrayAccess ba
-> (forall p a. Int -> (Ptr p -> IO a) -> IO (a, ba))
-> ByteArray ba
forall p a. Int -> (Ptr p -> IO a) -> IO (a, PassPhrase)
allocRet :: Int -> (Ptr p -> IO a) -> IO (a, PassPhrase)
$callocRet :: forall p a. Int -> (Ptr p -> IO a) -> IO (a, PassPhrase)
$cp4ByteArray :: ByteArrayAccess PassPhrase
$cp3ByteArray :: Monoid PassPhrase
$cp2ByteArray :: Ord PassPhrase
$cp1ByteArray :: Eq PassPhrase
ByteArray, PassPhrase -> Int
PassPhrase -> Ptr p -> IO ()
PassPhrase -> (Ptr p -> IO a) -> IO a
(PassPhrase -> Int)
-> (forall p a. PassPhrase -> (Ptr p -> IO a) -> IO a)
-> (forall p. PassPhrase -> Ptr p -> IO ())
-> ByteArrayAccess PassPhrase
forall p. PassPhrase -> 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. PassPhrase -> (Ptr p -> IO a) -> IO a
copyByteArrayToPtr :: PassPhrase -> Ptr p -> IO ()
$ccopyByteArrayToPtr :: forall p. PassPhrase -> Ptr p -> IO ()
withByteArray :: PassPhrase -> (Ptr p -> IO a) -> IO a
$cwithByteArray :: forall p a. PassPhrase -> (Ptr p -> IO a) -> IO a
length :: PassPhrase -> Int
$clength :: PassPhrase -> Int
ByteArrayAccess)

passphraseLength :: Int
passphraseLength :: Int
passphraseLength = Int
32

-- | Empty passphrase used in development
emptyPassphrase :: PassPhrase
emptyPassphrase :: PassPhrase
emptyPassphrase = ScrubbedBytes -> PassPhrase
PassPhrase ScrubbedBytes
forall a. Monoid a => a
mempty

instance Show PassPhrase where
  show :: PassPhrase -> String
show PassPhrase
_ = String
"<passphrase>"

instance Buildable PassPhrase where
  build :: PassPhrase -> Builder
build PassPhrase
_ = Builder
"<passphrase>"

instance Default PassPhrase where
  def :: PassPhrase
def = PassPhrase
emptyPassphrase

instance ToCBOR PassPhrase where
  toCBOR :: PassPhrase -> Encoding
toCBOR PassPhrase
pp = ByteString -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (PassPhrase -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert PassPhrase
pp :: ByteString)

instance FromCBOR PassPhrase where
  fromCBOR :: Decoder s PassPhrase
fromCBOR = do
    ByteString
bs <- forall s. FromCBOR ByteString => Decoder s ByteString
forall a s. FromCBOR a => Decoder s a
fromCBOR @ByteString
    let bl :: Int
bl = ByteString -> Int
BS.length ByteString
bs
    -- Currently passphrase may be either 32-byte long or empty (for
    -- unencrypted keys).
    Either Text PassPhrase -> Decoder s PassPhrase
forall e a s. Buildable e => Either e a -> Decoder s a
toCborError (Either Text PassPhrase -> Decoder s PassPhrase)
-> Either Text PassPhrase -> Decoder s PassPhrase
forall a b. (a -> b) -> a -> b
$
      if Int
bl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
bl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
passphraseLength
        then PassPhrase -> Either Text PassPhrase
forall a b. b -> Either a b
Right (PassPhrase -> Either Text PassPhrase)
-> PassPhrase -> Either Text PassPhrase
forall a b. (a -> b) -> a -> b
$ ByteString -> PassPhrase
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert ByteString
bs
        else
          Text -> Either Text PassPhrase
forall a b. a -> Either a b
Left (Text -> Either Text PassPhrase) -> Text -> Either Text PassPhrase
forall a b. (a -> b) -> a -> b
$
            Format Text (Int -> Int -> Text) -> Int -> Int -> Text
forall a. Format Text a -> a
sformat
              (Format (Int -> Int -> Text) (Int -> Int -> Text)
"put@PassPhrase: expected length 0 or " Format (Int -> Int -> Text) (Int -> Int -> Text)
-> Format Text (Int -> Int -> Text)
-> Format Text (Int -> Int -> Text)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (Int -> Text) (Int -> Int -> Text)
forall a r. Integral a => Format r (a -> r)
int Format (Int -> Text) (Int -> Int -> Text)
-> Format Text (Int -> Text) -> Format Text (Int -> Int -> Text)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (Int -> Text) (Int -> Text)
", not " Format (Int -> Text) (Int -> Text)
-> Format Text (Int -> Text) -> Format Text (Int -> Text)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Text (Int -> Text)
forall a r. Integral a => Format r (a -> r)
int)
              Int
passphraseLength
              Int
bl

{-instance Monoid PassPhrase where
    mempty = PassPhrase mempty
    mappend (PassPhrase p1) (PassPhrase p2) = PassPhrase (p1 `mappend` p2)-}