{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}

-- |
-- Module      : Simplex.Messaging.Crypto
-- Copyright   : (c) simplex.chat
-- License     : AGPL-3
--
-- Maintainer  : chat@simplex.chat
-- Stability   : experimental
-- Portability : non-portable
--
-- This module provides cryptography implementation for SMP protocols based on
-- <https://hackage.haskell.org/package/cryptonite cryptonite package>.
module Simplex.Messaging.Crypto
  ( -- * Cryptographic keys
    Algorithm (..),
    SAlgorithm (..),
    Alg (..),
    AuthAlg (..),
    DhAlg (..),
    DhAlgorithm,
    PrivateKey (..),
    PublicKey (..),
    PrivateKeyEd25519,
    PublicKeyEd25519,
    PrivateKeyX25519,
    PublicKeyX25519,
    PrivateKeyX448,
    PublicKeyX448,
    APrivateKey (..),
    APublicKey (..),
    APrivateSignKey (..),
    APublicVerifyKey (..),
    APrivateDhKey (..),
    APublicDhKey (..),
    APrivateAuthKey (..),
    APublicAuthKey (..),
    CryptoPublicKey (..),
    CryptoPrivateKey (..),
    AAuthKeyPair,
    KeyPair,
    KeyPairX25519,
    KeyPairEd25519,
    ASignatureKeyPair,
    DhSecret (..),
    DhSecretX25519,
    ADhSecret (..),
    KeyHash (..),
    newRandom,
    newRandomDRG,
    generateAKeyPair,
    generateKeyPair,
    generateSignatureKeyPair,
    generateAuthKeyPair,
    generatePrivateAuthKey,
    generateDhKeyPair,
    privateToX509,
    x509ToPublic,
    x509ToPublic',
    x509ToPrivate,
    x509ToPrivate',
    publicKey,
    signatureKeyPair,
    publicToX509,
    encodeASNObj,

    -- * key encoding/decoding
    encodePubKey,
    decodePubKey,
    encodePrivKey,
    decodePrivKey,
    pubKeyBytes,

    -- * sign/verify
    Signature (..),
    ASignature (..),
    CryptoSignature (..),
    SignatureSize (..),
    SignatureAlgorithm,
    AuthAlgorithm,
    AlgorithmI (..),
    sign,
    sign',
    verify,
    verify',
    validSignatureSize,
    checkAlgorithm,

    -- * crypto_box authenticator, as discussed in https://groups.google.com/g/sci.crypt/c/73yb5a9pz2Y/m/LNgRO7IYXOwJ
    CbAuthenticator (..),
    cbAuthenticatorSize,
    cbAuthenticate,
    cbVerify,

    -- * DH derivation
    dh',
    dhBytes',

    -- * AES256 AEAD-GCM scheme
    Key (..),
    IV (..),
    GCMIV (unGCMIV), -- constructor is not exported
    AuthTag (..),
    encryptAEAD,
    decryptAEAD,
    encryptAESNoPad,
    decryptAESNoPad,
    authTagSize,
    randomAesKey,
    randomGCMIV,
    ivSize,
    gcmIVSize,
    gcmIV,

    -- * NaCl crypto_box
    CbNonce (unCbNonce),
    pattern CbNonce,
    cbEncrypt,
    cbEncryptNoPad,
    cbEncryptMaxLenBS,
    cbDecrypt,
    cbDecryptNoPad,
    sbDecrypt_,
    sbEncrypt_,
    sbEncryptNoPad,
    sbDecryptNoPad,
    cbNonce,
    randomCbNonce,
    reverseNonce,

    -- * NaCl crypto_secretbox
    SbKey (unSbKey),
    pattern SbKey,
    sbEncrypt,
    sbDecrypt,
    sbKey,
    unsafeSbKey,
    randomSbKey,

    -- * secret_box chains
    SbChainKey,
    SbKeyNonce,
    sbcInit,
    sbcHkdf,
    hkdf,

    -- * pseudo-random bytes
    randomBytes,

    -- * digests
    sha256Hash,
    sha512Hash,
    sha3_256,
    sha3_384,

    -- * Message padding / un-padding
    canPad,
    pad,
    unPad,

    -- * X509 Certificates
    signCertificate,
    signX509,
    verifyX509,
    certificateFingerprint,
    signedFingerprint,
    SignatureAlgorithmX509 (..),
    SignedObject (..),
    encodeCertChain,
    certChainP,

    -- * Cryptography error type
    CryptoError (..),

    -- * Limited size ByteStrings
    MaxLenBS,
    pattern MaxLenBS,
    maxLenBS,
    unsafeMaxLenBS,
    appendMaxLenBS,
  )
where

import Control.Concurrent.STM
import Control.Exception (Exception)
import Control.Monad
import Control.Monad.Except
import Control.Monad.Trans.Except
import Crypto.Cipher.AES (AES256)
import qualified Crypto.Cipher.Types as AES
import qualified Crypto.Cipher.XSalsa as XSalsa
import qualified Crypto.Error as CE
import Crypto.Hash (Digest, SHA3_256, SHA3_384, SHA256 (..), SHA512 (..), hash, hashDigestSize)
import qualified Crypto.KDF.HKDF as H
import qualified Crypto.MAC.Poly1305 as Poly1305
import qualified Crypto.PubKey.Curve25519 as X25519
import qualified Crypto.PubKey.Curve448 as X448
import qualified Crypto.PubKey.Ed25519 as Ed25519
import qualified Crypto.PubKey.Ed448 as Ed448
import Crypto.Random (ChaChaDRG, MonadPseudoRandom, drgNew, randomBytesGenerate, withDRG)
import Data.ASN1.BinaryEncoding
import Data.ASN1.Encoding
import Data.ASN1.Types
import Data.Aeson (FromJSON (..), ToJSON (..))
import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.Bifunctor (bimap, first)
import Data.ByteArray (ByteArrayAccess)
import qualified Data.ByteArray as BA
import Data.ByteString.Base64 (decode)
import qualified Data.ByteString.Base64.URL as U
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import Data.ByteString.Lazy (fromStrict, toStrict)
import Data.Constraint (Dict (..))
import Data.Kind (Constraint, Type)
import qualified Data.List.NonEmpty as L
import Data.String
import Data.Type.Equality
import Data.Typeable (Proxy (Proxy), Typeable)
import Data.Word (Word32)
import qualified Data.X509 as X
import Data.X509.Validation (Fingerprint (..), getFingerprint)
import GHC.TypeLits (ErrorMessage (..), KnownNat, Nat, TypeError, natVal, type (+))
import Network.Transport.Internal (decodeWord16, encodeWord16)
import Simplex.Messaging.Agent.Store.DB (Binary (..), FromField (..), ToField (..), blobFieldDecoder)
import Simplex.Messaging.Encoding
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (parseAll, parseString)
import Simplex.Messaging.Util ((<$?>))

-- | Cryptographic algorithms.
data Algorithm = Ed25519 | Ed448 | X25519 | X448

-- | Singleton types for 'Algorithm'.
data SAlgorithm :: Algorithm -> Type where
  SEd25519 :: SAlgorithm Ed25519
  SEd448 :: SAlgorithm Ed448
  SX25519 :: SAlgorithm X25519
  SX448 :: SAlgorithm X448

deriving instance Show (SAlgorithm a)

data Alg = forall a. AlgorithmI a => Alg (SAlgorithm a)

data AuthAlg
  = forall a.
    (AlgorithmI a, AuthAlgorithm a) =>
    AuthAlg (SAlgorithm a)

data DhAlg
  = forall a.
    (AlgorithmI a, DhAlgorithm a) =>
    DhAlg (SAlgorithm a)

class AlgorithmI (a :: Algorithm) where sAlgorithm :: SAlgorithm a

instance AlgorithmI Ed25519 where sAlgorithm :: SAlgorithm 'Ed25519
sAlgorithm = SAlgorithm 'Ed25519
SEd25519

instance AlgorithmI Ed448 where sAlgorithm :: SAlgorithm 'Ed448
sAlgorithm = SAlgorithm 'Ed448
SEd448

instance AlgorithmI X25519 where sAlgorithm :: SAlgorithm 'X25519
sAlgorithm = SAlgorithm 'X25519
SX25519

instance AlgorithmI X448 where sAlgorithm :: SAlgorithm 'X448
sAlgorithm = SAlgorithm 'X448
SX448

checkAlgorithm :: forall t a a'. (AlgorithmI a, AlgorithmI a') => t a' -> Either String (t a)
checkAlgorithm :: forall (t :: Algorithm -> *) (a :: Algorithm) (a' :: Algorithm).
(AlgorithmI a, AlgorithmI a') =>
t a' -> Either String (t a)
checkAlgorithm t a'
x = case SAlgorithm a -> SAlgorithm a' -> Maybe (a :~: a')
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: Algorithm) (b :: Algorithm).
SAlgorithm a -> SAlgorithm b -> Maybe (a :~: b)
testEquality (forall (a :: Algorithm). AlgorithmI a => SAlgorithm a
sAlgorithm @a) (forall (a :: Algorithm). AlgorithmI a => SAlgorithm a
sAlgorithm @a') of
  Just a :~: a'
Refl -> t a -> Either String (t a)
forall a b. b -> Either a b
Right t a
t a'
x
  Maybe (a :~: a')
Nothing -> String -> Either String (t a)
forall a b. a -> Either a b
Left String
"bad algorithm"

instance TestEquality SAlgorithm where
  testEquality :: forall (a :: Algorithm) (b :: Algorithm).
SAlgorithm a -> SAlgorithm b -> Maybe (a :~: b)
testEquality SAlgorithm a
SEd25519 SAlgorithm b
SEd25519 = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  testEquality SAlgorithm a
SEd448 SAlgorithm b
SEd448 = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  testEquality SAlgorithm a
SX25519 SAlgorithm b
SX25519 = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  testEquality SAlgorithm a
SX448 SAlgorithm b
SX448 = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  testEquality SAlgorithm a
_ SAlgorithm b
_ = Maybe (a :~: b)
forall a. Maybe a
Nothing

-- | GADT for public keys.
data PublicKey (a :: Algorithm) where
  PublicKeyEd25519 :: Ed25519.PublicKey -> PublicKey Ed25519
  PublicKeyEd448 :: Ed448.PublicKey -> PublicKey Ed448
  PublicKeyX25519 :: X25519.PublicKey -> PublicKey X25519
  PublicKeyX448 :: X448.PublicKey -> PublicKey X448

deriving instance Eq (PublicKey a)

deriving instance Show (PublicKey a)

data APublicKey
  = forall a.
    AlgorithmI a =>
    APublicKey (SAlgorithm a) (PublicKey a)

instance Encoding APublicKey where
  smpEncode :: APublicKey -> ByteString
smpEncode = ByteString -> ByteString
forall a. Encoding a => a -> ByteString
smpEncode (ByteString -> ByteString)
-> (APublicKey -> ByteString) -> APublicKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APublicKey -> ByteString
forall k. CryptoPublicKey k => k -> ByteString
encodePubKey
  {-# INLINE smpEncode #-}
  smpDecode :: ByteString -> Either String APublicKey
smpDecode = ByteString -> Either String APublicKey
forall k. CryptoPublicKey k => ByteString -> Either String k
decodePubKey
  {-# INLINE smpDecode #-}

deriving instance Show APublicKey

type PublicKeyEd25519 = PublicKey Ed25519

type PublicKeyX25519 = PublicKey X25519

type PublicKeyX448 = PublicKey X448

-- | GADT for private keys.
data PrivateKey (a :: Algorithm) where
  PrivateKeyEd25519 :: Ed25519.SecretKey -> PrivateKey Ed25519
  PrivateKeyEd448 :: Ed448.SecretKey -> PrivateKey Ed448
  PrivateKeyX25519 :: X25519.SecretKey -> PrivateKey X25519
  PrivateKeyX448 :: X448.SecretKey -> PrivateKey X448

deriving instance Eq (PrivateKey a)

deriving instance Show (PrivateKey a)

-- Do not enable, to avoid leaking key data
-- instance StrEncoding (PrivateKey Ed25519) where

-- Used in notification store log
instance StrEncoding (PrivateKey X25519) where
  strEncode :: PrivateKey 'X25519 -> ByteString
strEncode = ByteString -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode (ByteString -> ByteString)
-> (PrivateKey 'X25519 -> ByteString)
-> PrivateKey 'X25519
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivateKey 'X25519 -> ByteString
forall pk. CryptoPrivateKey pk => pk -> ByteString
encodePrivKey
  {-# INLINE strEncode #-}
  strDecode :: ByteString -> Either String (PrivateKey 'X25519)
strDecode = ByteString -> Either String (PrivateKey 'X25519)
forall k. CryptoPrivateKey k => ByteString -> Either String k
decodePrivKey
  {-# INLINE strDecode #-}

data APrivateKey
  = forall a.
    AlgorithmI a =>
    APrivateKey (SAlgorithm a) (PrivateKey a)

deriving instance Show APrivateKey

type PrivateKeyEd25519 = PrivateKey Ed25519

type PrivateKeyX25519 = PrivateKey X25519

type PrivateKeyX448 = PrivateKey X448

type family SignatureAlgorithm (a :: Algorithm) :: Constraint where
  SignatureAlgorithm Ed25519 = ()
  SignatureAlgorithm Ed448 = ()
  SignatureAlgorithm a =
    (Int ~ Bool, TypeError (Text "Algorithm " :<>: ShowType a :<>: Text " cannot be used to sign/verify"))

signatureAlgorithm :: SAlgorithm a -> Maybe (Dict (SignatureAlgorithm a))
signatureAlgorithm :: forall (a :: Algorithm).
SAlgorithm a -> Maybe (Dict (SignatureAlgorithm a))
signatureAlgorithm = \case
  SAlgorithm a
SEd25519 -> Dict (() :: Constraint) -> Maybe (Dict (() :: Constraint))
forall a. a -> Maybe a
Just Dict (() :: Constraint)
forall (a :: Constraint). a => Dict a
Dict
  SAlgorithm a
SEd448 -> Dict (() :: Constraint) -> Maybe (Dict (() :: Constraint))
forall a. a -> Maybe a
Just Dict (() :: Constraint)
forall (a :: Constraint). a => Dict a
Dict
  SAlgorithm a
_ -> Maybe (Dict (SignatureAlgorithm a))
forall a. Maybe a
Nothing

data APrivateSignKey
  = forall a.
    (AlgorithmI a, SignatureAlgorithm a) =>
    APrivateSignKey (SAlgorithm a) (PrivateKey a)

deriving instance Show APrivateSignKey

instance Encoding APrivateSignKey where
  smpEncode :: APrivateSignKey -> ByteString
smpEncode = ByteString -> ByteString
forall a. Encoding a => a -> ByteString
smpEncode (ByteString -> ByteString)
-> (APrivateSignKey -> ByteString) -> APrivateSignKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APrivateSignKey -> ByteString
forall pk. CryptoPrivateKey pk => pk -> ByteString
encodePrivKey
  {-# INLINE smpEncode #-}
  smpDecode :: ByteString -> Either String APrivateSignKey
smpDecode = ByteString -> Either String APrivateSignKey
forall k. CryptoPrivateKey k => ByteString -> Either String k
decodePrivKey
  {-# INLINE smpDecode #-}

instance StrEncoding APrivateSignKey where
  strEncode :: APrivateSignKey -> ByteString
strEncode = ByteString -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode (ByteString -> ByteString)
-> (APrivateSignKey -> ByteString) -> APrivateSignKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APrivateSignKey -> ByteString
forall pk. CryptoPrivateKey pk => pk -> ByteString
encodePrivKey
  {-# INLINE strEncode #-}
  strDecode :: ByteString -> Either String APrivateSignKey
strDecode = ByteString -> Either String APrivateSignKey
forall k. CryptoPrivateKey k => ByteString -> Either String k
decodePrivKey
  {-# INLINE strDecode #-}

data APublicVerifyKey
  = forall a.
    (AlgorithmI a, SignatureAlgorithm a) =>
    APublicVerifyKey (SAlgorithm a) (PublicKey a)

deriving instance Show APublicVerifyKey

data APrivateDhKey
  = forall a.
    (AlgorithmI a, DhAlgorithm a) =>
    APrivateDhKey (SAlgorithm a) (PrivateKey a)

deriving instance Show APrivateDhKey

data APublicDhKey
  = forall a.
    (AlgorithmI a, DhAlgorithm a) =>
    APublicDhKey (SAlgorithm a) (PublicKey a)

deriving instance Show APublicDhKey

data DhSecret (a :: Algorithm) where
  DhSecretX25519 :: X25519.DhSecret -> DhSecret X25519
  DhSecretX448 :: X448.DhSecret -> DhSecret X448

deriving instance Eq (DhSecret a)

deriving instance Show (DhSecret a)

data ADhSecret
  = forall a.
    (AlgorithmI a, DhAlgorithm a) =>
    ADhSecret (SAlgorithm a) (DhSecret a)

type DhSecretX25519 = DhSecret X25519

type family DhAlgorithm (a :: Algorithm) :: Constraint where
  DhAlgorithm X25519 = ()
  DhAlgorithm X448 = ()
  DhAlgorithm a =
    (Int ~ Bool, TypeError (Text "Algorithm " :<>: ShowType a :<>: Text " cannot be used for DH exchange"))

dhAlgorithm :: SAlgorithm a -> Maybe (Dict (DhAlgorithm a))
dhAlgorithm :: forall (a :: Algorithm).
SAlgorithm a -> Maybe (Dict (DhAlgorithm a))
dhAlgorithm = \case
  SAlgorithm a
SX25519 -> Dict (() :: Constraint) -> Maybe (Dict (() :: Constraint))
forall a. a -> Maybe a
Just Dict (() :: Constraint)
forall (a :: Constraint). a => Dict a
Dict
  SAlgorithm a
SX448 -> Dict (() :: Constraint) -> Maybe (Dict (() :: Constraint))
forall a. a -> Maybe a
Just Dict (() :: Constraint)
forall (a :: Constraint). a => Dict a
Dict
  SAlgorithm a
_ -> Maybe (Dict (DhAlgorithm a))
forall a. Maybe a
Nothing

data APrivateAuthKey
  = forall a.
    (AlgorithmI a, AuthAlgorithm a) =>
    APrivateAuthKey (SAlgorithm a) (PrivateKey a)

instance Eq APrivateAuthKey where
  APrivateAuthKey SAlgorithm a
a PrivateKey a
k == :: APrivateAuthKey -> APrivateAuthKey -> Bool
== APrivateAuthKey SAlgorithm a
a' PrivateKey a
k' = case SAlgorithm a -> SAlgorithm a -> Maybe (a :~: a)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: Algorithm) (b :: Algorithm).
SAlgorithm a -> SAlgorithm b -> Maybe (a :~: b)
testEquality SAlgorithm a
a SAlgorithm a
a' of
    Just a :~: a
Refl -> PrivateKey a
k PrivateKey a -> PrivateKey a -> Bool
forall a. Eq a => a -> a -> Bool
== PrivateKey a
PrivateKey a
k'
    Maybe (a :~: a)
Nothing -> Bool
False

deriving instance Show APrivateAuthKey

instance Encoding APrivateAuthKey where
  smpEncode :: APrivateAuthKey -> ByteString
smpEncode = ByteString -> ByteString
forall a. Encoding a => a -> ByteString
smpEncode (ByteString -> ByteString)
-> (APrivateAuthKey -> ByteString) -> APrivateAuthKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APrivateAuthKey -> ByteString
forall pk. CryptoPrivateKey pk => pk -> ByteString
encodePrivKey
  {-# INLINE smpEncode #-}
  smpDecode :: ByteString -> Either String APrivateAuthKey
smpDecode = ByteString -> Either String APrivateAuthKey
forall k. CryptoPrivateKey k => ByteString -> Either String k
decodePrivKey
  {-# INLINE smpDecode #-}

instance StrEncoding APrivateAuthKey where
  strEncode :: APrivateAuthKey -> ByteString
strEncode = ByteString -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode (ByteString -> ByteString)
-> (APrivateAuthKey -> ByteString) -> APrivateAuthKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APrivateAuthKey -> ByteString
forall pk. CryptoPrivateKey pk => pk -> ByteString
encodePrivKey
  {-# INLINE strEncode #-}
  strDecode :: ByteString -> Either String APrivateAuthKey
strDecode = ByteString -> Either String APrivateAuthKey
forall k. CryptoPrivateKey k => ByteString -> Either String k
decodePrivKey
  {-# INLINE strDecode #-}

data APublicAuthKey
  = forall a.
    (AlgorithmI a, AuthAlgorithm a) =>
    APublicAuthKey (SAlgorithm a) (PublicKey a)

instance Eq APublicAuthKey where
  APublicAuthKey SAlgorithm a
a PublicKey a
k == :: APublicAuthKey -> APublicAuthKey -> Bool
== APublicAuthKey SAlgorithm a
a' PublicKey a
k' = case SAlgorithm a -> SAlgorithm a -> Maybe (a :~: a)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: Algorithm) (b :: Algorithm).
SAlgorithm a -> SAlgorithm b -> Maybe (a :~: b)
testEquality SAlgorithm a
a SAlgorithm a
a' of
    Just a :~: a
Refl -> PublicKey a
k PublicKey a -> PublicKey a -> Bool
forall a. Eq a => a -> a -> Bool
== PublicKey a
PublicKey a
k'
    Maybe (a :~: a)
Nothing -> Bool
False

deriving instance Show APublicAuthKey

-- either X25519 or Ed algorithm that can be used to authorize commands to SMP server
type family AuthAlgorithm (a :: Algorithm) :: Constraint where
  AuthAlgorithm Ed25519 = ()
  AuthAlgorithm Ed448 = ()
  AuthAlgorithm X25519 = ()
  AuthAlgorithm a =
    (Int ~ Bool, TypeError (Text "Algorithm " :<>: ShowType a :<>: Text " cannot be used for authorization"))

authAlgorithm :: SAlgorithm a -> Maybe (Dict (AuthAlgorithm a))
authAlgorithm :: forall (a :: Algorithm).
SAlgorithm a -> Maybe (Dict (AuthAlgorithm a))
authAlgorithm = \case
  SAlgorithm a
SEd25519 -> Dict (() :: Constraint) -> Maybe (Dict (() :: Constraint))
forall a. a -> Maybe a
Just Dict (() :: Constraint)
forall (a :: Constraint). a => Dict a
Dict
  SAlgorithm a
SEd448 -> Dict (() :: Constraint) -> Maybe (Dict (() :: Constraint))
forall a. a -> Maybe a
Just Dict (() :: Constraint)
forall (a :: Constraint). a => Dict a
Dict
  SAlgorithm a
SX25519 -> Dict (() :: Constraint) -> Maybe (Dict (() :: Constraint))
forall a. a -> Maybe a
Just Dict (() :: Constraint)
forall (a :: Constraint). a => Dict a
Dict
  SAlgorithm a
_ -> Maybe (Dict (AuthAlgorithm a))
forall a. Maybe a
Nothing

dhBytes' :: DhSecret a -> ByteString
dhBytes' :: forall (a :: Algorithm). DhSecret a -> ByteString
dhBytes' = \case
  DhSecretX25519 DhSecret
s -> DhSecret -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert DhSecret
s
  DhSecretX448 DhSecret
s -> DhSecret -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert DhSecret
s

instance AlgorithmI a => StrEncoding (DhSecret a) where
  strEncode :: DhSecret a -> ByteString
strEncode = ByteString -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode (ByteString -> ByteString)
-> (DhSecret a -> ByteString) -> DhSecret a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DhSecret a -> ByteString
forall (a :: Algorithm). DhSecret a -> ByteString
dhBytes'
  strDecode :: ByteString -> Either String (DhSecret a)
strDecode = (\(ADhSecret SAlgorithm a
_ DhSecret a
s) -> DhSecret a -> Either String (DhSecret a)
forall (t :: Algorithm -> *) (a :: Algorithm) (a' :: Algorithm).
(AlgorithmI a, AlgorithmI a') =>
t a' -> Either String (t a)
checkAlgorithm DhSecret a
s) (ADhSecret -> Either String (DhSecret a))
-> (ByteString -> Either String ADhSecret)
-> ByteString
-> Either String (DhSecret a)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ByteString -> Either String ADhSecret
forall a. StrEncoding a => ByteString -> Either String a
strDecode

instance StrEncoding ADhSecret where
  strEncode :: ADhSecret -> ByteString
strEncode (ADhSecret SAlgorithm a
_ DhSecret a
s) = ByteString -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ DhSecret a -> ByteString
forall (a :: Algorithm). DhSecret a -> ByteString
dhBytes' DhSecret a
s
  strDecode :: ByteString -> Either String ADhSecret
strDecode = CryptoFailable ADhSecret -> Either String ADhSecret
forall {b}. CryptoFailable b -> Either String b
cryptoPassed (CryptoFailable ADhSecret -> Either String ADhSecret)
-> (ByteString -> CryptoFailable ADhSecret)
-> ByteString
-> Either String ADhSecret
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> CryptoFailable ADhSecret
secret
    where
      secret :: ByteString -> CryptoFailable ADhSecret
secret ByteString
bs
        | ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x25519_size = SAlgorithm 'X25519 -> DhSecret 'X25519 -> ADhSecret
forall (a :: Algorithm).
(AlgorithmI a, DhAlgorithm a) =>
SAlgorithm a -> DhSecret a -> ADhSecret
ADhSecret SAlgorithm 'X25519
SX25519 (DhSecret 'X25519 -> ADhSecret)
-> (DhSecret -> DhSecret 'X25519) -> DhSecret -> ADhSecret
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DhSecret -> DhSecret 'X25519
DhSecretX25519 (DhSecret -> ADhSecret)
-> CryptoFailable DhSecret -> CryptoFailable ADhSecret
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> CryptoFailable DhSecret
forall b. ByteArrayAccess b => b -> CryptoFailable DhSecret
X25519.dhSecret ByteString
bs
        | ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x448_size = SAlgorithm 'X448 -> DhSecret 'X448 -> ADhSecret
forall (a :: Algorithm).
(AlgorithmI a, DhAlgorithm a) =>
SAlgorithm a -> DhSecret a -> ADhSecret
ADhSecret SAlgorithm 'X448
SX448 (DhSecret 'X448 -> ADhSecret)
-> (DhSecret -> DhSecret 'X448) -> DhSecret -> ADhSecret
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DhSecret -> DhSecret 'X448
DhSecretX448 (DhSecret -> ADhSecret)
-> CryptoFailable DhSecret -> CryptoFailable ADhSecret
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> CryptoFailable DhSecret
forall b. ByteArrayAccess b => b -> CryptoFailable DhSecret
X448.dhSecret ByteString
bs
        | Bool
otherwise = CryptoError -> CryptoFailable ADhSecret
forall a. CryptoError -> CryptoFailable a
CE.CryptoFailed CryptoError
CE.CryptoError_SharedSecretSizeInvalid
      cryptoPassed :: CryptoFailable b -> Either String b
cryptoPassed = \case
        CE.CryptoPassed b
s -> b -> Either String b
forall a b. b -> Either a b
Right b
s
        CE.CryptoFailed CryptoError
e -> String -> Either String b
forall a b. a -> Either a b
Left (String -> Either String b) -> String -> Either String b
forall a b. (a -> b) -> a -> b
$ CryptoError -> String
forall a. Show a => a -> String
show CryptoError
e

instance AlgorithmI a => IsString (DhSecret a) where
  fromString :: String -> DhSecret a
fromString = (ByteString -> Either String (DhSecret a)) -> String -> DhSecret a
forall a. (ByteString -> Either String a) -> String -> a
parseString ByteString -> Either String (DhSecret a)
forall a. StrEncoding a => ByteString -> Either String a
strDecode

-- | Class for public key types
class CryptoPublicKey k where
  toPubKey :: (forall a. AlgorithmI a => PublicKey a -> b) -> k -> b
  pubKey :: APublicKey -> Either String k

instance CryptoPublicKey APublicKey where
  toPubKey :: forall b.
(forall (a :: Algorithm). AlgorithmI a => PublicKey a -> b)
-> APublicKey -> b
toPubKey forall (a :: Algorithm). AlgorithmI a => PublicKey a -> b
f (APublicKey SAlgorithm a
_ PublicKey a
k) = PublicKey a -> b
forall (a :: Algorithm). AlgorithmI a => PublicKey a -> b
f PublicKey a
k
  pubKey :: APublicKey -> Either String APublicKey
pubKey = APublicKey -> Either String APublicKey
forall a b. b -> Either a b
Right

instance CryptoPublicKey APublicVerifyKey where
  toPubKey :: forall b.
(forall (a :: Algorithm). AlgorithmI a => PublicKey a -> b)
-> APublicVerifyKey -> b
toPubKey forall (a :: Algorithm). AlgorithmI a => PublicKey a -> b
f (APublicVerifyKey SAlgorithm a
_ PublicKey a
k) = PublicKey a -> b
forall (a :: Algorithm). AlgorithmI a => PublicKey a -> b
f PublicKey a
k
  pubKey :: APublicKey -> Either String APublicVerifyKey
pubKey (APublicKey SAlgorithm a
a PublicKey a
k) = case SAlgorithm a -> Maybe (Dict (SignatureAlgorithm a))
forall (a :: Algorithm).
SAlgorithm a -> Maybe (Dict (SignatureAlgorithm a))
signatureAlgorithm SAlgorithm a
a of
    Just Dict (SignatureAlgorithm a)
Dict -> APublicVerifyKey -> Either String APublicVerifyKey
forall a b. b -> Either a b
Right (APublicVerifyKey -> Either String APublicVerifyKey)
-> APublicVerifyKey -> Either String APublicVerifyKey
forall a b. (a -> b) -> a -> b
$ SAlgorithm a -> PublicKey a -> APublicVerifyKey
forall (a :: Algorithm).
(AlgorithmI a, SignatureAlgorithm a) =>
SAlgorithm a -> PublicKey a -> APublicVerifyKey
APublicVerifyKey SAlgorithm a
a PublicKey a
k
    Maybe (Dict (SignatureAlgorithm a))
_ -> String -> Either String APublicVerifyKey
forall a b. a -> Either a b
Left String
"key does not support signature algorithms"

instance CryptoPublicKey APublicAuthKey where
  toPubKey :: forall b.
(forall (a :: Algorithm). AlgorithmI a => PublicKey a -> b)
-> APublicAuthKey -> b
toPubKey forall (a :: Algorithm). AlgorithmI a => PublicKey a -> b
f (APublicAuthKey SAlgorithm a
_ PublicKey a
k) = PublicKey a -> b
forall (a :: Algorithm). AlgorithmI a => PublicKey a -> b
f PublicKey a
k
  pubKey :: APublicKey -> Either String APublicAuthKey
pubKey (APublicKey SAlgorithm a
a PublicKey a
k) = case SAlgorithm a -> Maybe (Dict (AuthAlgorithm a))
forall (a :: Algorithm).
SAlgorithm a -> Maybe (Dict (AuthAlgorithm a))
authAlgorithm SAlgorithm a
a of
    Just Dict (AuthAlgorithm a)
Dict -> APublicAuthKey -> Either String APublicAuthKey
forall a b. b -> Either a b
Right (APublicAuthKey -> Either String APublicAuthKey)
-> APublicAuthKey -> Either String APublicAuthKey
forall a b. (a -> b) -> a -> b
$ SAlgorithm a -> PublicKey a -> APublicAuthKey
forall (a :: Algorithm).
(AlgorithmI a, AuthAlgorithm a) =>
SAlgorithm a -> PublicKey a -> APublicAuthKey
APublicAuthKey SAlgorithm a
a PublicKey a
k
    Maybe (Dict (AuthAlgorithm a))
_ -> String -> Either String APublicAuthKey
forall a b. a -> Either a b
Left String
"key does not support auth algorithms"

instance CryptoPublicKey APublicDhKey where
  toPubKey :: forall b.
(forall (a :: Algorithm). AlgorithmI a => PublicKey a -> b)
-> APublicDhKey -> b
toPubKey forall (a :: Algorithm). AlgorithmI a => PublicKey a -> b
f (APublicDhKey SAlgorithm a
_ PublicKey a
k) = PublicKey a -> b
forall (a :: Algorithm). AlgorithmI a => PublicKey a -> b
f PublicKey a
k
  pubKey :: APublicKey -> Either String APublicDhKey
pubKey (APublicKey SAlgorithm a
a PublicKey a
k) = case SAlgorithm a -> Maybe (Dict (DhAlgorithm a))
forall (a :: Algorithm).
SAlgorithm a -> Maybe (Dict (DhAlgorithm a))
dhAlgorithm SAlgorithm a
a of
    Just Dict (DhAlgorithm a)
Dict -> APublicDhKey -> Either String APublicDhKey
forall a b. b -> Either a b
Right (APublicDhKey -> Either String APublicDhKey)
-> APublicDhKey -> Either String APublicDhKey
forall a b. (a -> b) -> a -> b
$ SAlgorithm a -> PublicKey a -> APublicDhKey
forall (a :: Algorithm).
(AlgorithmI a, DhAlgorithm a) =>
SAlgorithm a -> PublicKey a -> APublicDhKey
APublicDhKey SAlgorithm a
a PublicKey a
k
    Maybe (Dict (DhAlgorithm a))
_ -> String -> Either String APublicDhKey
forall a b. a -> Either a b
Left String
"key does not support DH algorithms"

instance AlgorithmI a => CryptoPublicKey (PublicKey a) where
  toPubKey :: forall b.
(forall (a :: Algorithm). AlgorithmI a => PublicKey a -> b)
-> PublicKey a -> b
toPubKey = (PublicKey a -> b) -> PublicKey a -> b
(forall (a :: Algorithm). AlgorithmI a => PublicKey a -> b)
-> PublicKey a -> b
forall a. a -> a
id
  pubKey :: APublicKey -> Either String (PublicKey a)
pubKey (APublicKey SAlgorithm a
_ PublicKey a
k) = PublicKey a -> Either String (PublicKey a)
forall (t :: Algorithm -> *) (a :: Algorithm) (a' :: Algorithm).
(AlgorithmI a, AlgorithmI a') =>
t a' -> Either String (t a)
checkAlgorithm PublicKey a
k

instance Encoding APublicVerifyKey where
  smpEncode :: APublicVerifyKey -> ByteString
smpEncode = ByteString -> ByteString
forall a. Encoding a => a -> ByteString
smpEncode (ByteString -> ByteString)
-> (APublicVerifyKey -> ByteString)
-> APublicVerifyKey
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APublicVerifyKey -> ByteString
forall k. CryptoPublicKey k => k -> ByteString
encodePubKey
  {-# INLINE smpEncode #-}
  smpDecode :: ByteString -> Either String APublicVerifyKey
smpDecode = ByteString -> Either String APublicVerifyKey
forall k. CryptoPublicKey k => ByteString -> Either String k
decodePubKey
  {-# INLINE smpDecode #-}

instance Encoding APublicAuthKey where
  smpEncode :: APublicAuthKey -> ByteString
smpEncode = ByteString -> ByteString
forall a. Encoding a => a -> ByteString
smpEncode (ByteString -> ByteString)
-> (APublicAuthKey -> ByteString) -> APublicAuthKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APublicAuthKey -> ByteString
forall k. CryptoPublicKey k => k -> ByteString
encodePubKey
  {-# INLINE smpEncode #-}
  smpDecode :: ByteString -> Either String APublicAuthKey
smpDecode = ByteString -> Either String APublicAuthKey
forall k. CryptoPublicKey k => ByteString -> Either String k
decodePubKey
  {-# INLINE smpDecode #-}

instance Encoding APublicDhKey where
  smpEncode :: APublicDhKey -> ByteString
smpEncode = ByteString -> ByteString
forall a. Encoding a => a -> ByteString
smpEncode (ByteString -> ByteString)
-> (APublicDhKey -> ByteString) -> APublicDhKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APublicDhKey -> ByteString
forall k. CryptoPublicKey k => k -> ByteString
encodePubKey
  {-# INLINE smpEncode #-}
  smpDecode :: ByteString -> Either String APublicDhKey
smpDecode = ByteString -> Either String APublicDhKey
forall k. CryptoPublicKey k => ByteString -> Either String k
decodePubKey
  {-# INLINE smpDecode #-}

instance AlgorithmI a => Encoding (PublicKey a) where
  smpEncode :: PublicKey a -> ByteString
smpEncode = ByteString -> ByteString
forall a. Encoding a => a -> ByteString
smpEncode (ByteString -> ByteString)
-> (PublicKey a -> ByteString) -> PublicKey a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey a -> ByteString
forall k. CryptoPublicKey k => k -> ByteString
encodePubKey
  {-# INLINE smpEncode #-}
  smpDecode :: ByteString -> Either String (PublicKey a)
smpDecode = ByteString -> Either String (PublicKey a)
forall k. CryptoPublicKey k => ByteString -> Either String k
decodePubKey
  {-# INLINE smpDecode #-}

instance StrEncoding APublicVerifyKey where
  strEncode :: APublicVerifyKey -> ByteString
strEncode = ByteString -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode (ByteString -> ByteString)
-> (APublicVerifyKey -> ByteString)
-> APublicVerifyKey
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APublicVerifyKey -> ByteString
forall k. CryptoPublicKey k => k -> ByteString
encodePubKey
  {-# INLINE strEncode #-}
  strDecode :: ByteString -> Either String APublicVerifyKey
strDecode = ByteString -> Either String APublicVerifyKey
forall k. CryptoPublicKey k => ByteString -> Either String k
decodePubKey
  {-# INLINE strDecode #-}

instance StrEncoding APublicAuthKey where
  strEncode :: APublicAuthKey -> ByteString
strEncode = ByteString -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode (ByteString -> ByteString)
-> (APublicAuthKey -> ByteString) -> APublicAuthKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APublicAuthKey -> ByteString
forall k. CryptoPublicKey k => k -> ByteString
encodePubKey
  {-# INLINE strEncode #-}
  strDecode :: ByteString -> Either String APublicAuthKey
strDecode = ByteString -> Either String APublicAuthKey
forall k. CryptoPublicKey k => ByteString -> Either String k
decodePubKey
  {-# INLINE strDecode #-}

instance StrEncoding APublicDhKey where
  strEncode :: APublicDhKey -> ByteString
strEncode = ByteString -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode (ByteString -> ByteString)
-> (APublicDhKey -> ByteString) -> APublicDhKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APublicDhKey -> ByteString
forall k. CryptoPublicKey k => k -> ByteString
encodePubKey
  {-# INLINE strEncode #-}
  strDecode :: ByteString -> Either String APublicDhKey
strDecode = ByteString -> Either String APublicDhKey
forall k. CryptoPublicKey k => ByteString -> Either String k
decodePubKey
  {-# INLINE strDecode #-}

instance AlgorithmI a => StrEncoding (PublicKey a) where
  strEncode :: PublicKey a -> ByteString
strEncode = ByteString -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode (ByteString -> ByteString)
-> (PublicKey a -> ByteString) -> PublicKey a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey a -> ByteString
forall k. CryptoPublicKey k => k -> ByteString
encodePubKey
  {-# INLINE strEncode #-}
  strDecode :: ByteString -> Either String (PublicKey a)
strDecode = ByteString -> Either String (PublicKey a)
forall k. CryptoPublicKey k => ByteString -> Either String k
decodePubKey
  {-# INLINE strDecode #-}

instance AlgorithmI a => ToJSON (PublicKey a) where
  toJSON :: PublicKey a -> Value
toJSON = PublicKey a -> Value
forall a. StrEncoding a => a -> Value
strToJSON
  toEncoding :: PublicKey a -> Encoding
toEncoding = PublicKey a -> Encoding
forall a. StrEncoding a => a -> Encoding
strToJEncoding

instance AlgorithmI a => FromJSON (PublicKey a) where
  parseJSON :: Value -> Parser (PublicKey a)
parseJSON = String -> Value -> Parser (PublicKey a)
forall a. StrEncoding a => String -> Value -> Parser a
strParseJSON String
"PublicKey"

encodePubKey :: CryptoPublicKey k => k -> ByteString
encodePubKey :: forall k. CryptoPublicKey k => k -> ByteString
encodePubKey = (forall (a :: Algorithm).
 AlgorithmI a =>
 PublicKey a -> ByteString)
-> k -> ByteString
forall k b.
CryptoPublicKey k =>
(forall (a :: Algorithm). AlgorithmI a => PublicKey a -> b)
-> k -> b
forall b.
(forall (a :: Algorithm). AlgorithmI a => PublicKey a -> b)
-> k -> b
toPubKey ((forall (a :: Algorithm).
  AlgorithmI a =>
  PublicKey a -> ByteString)
 -> k -> ByteString)
-> (forall (a :: Algorithm).
    AlgorithmI a =>
    PublicKey a -> ByteString)
-> k
-> ByteString
forall a b. (a -> b) -> a -> b
$ PubKey -> ByteString
forall a. ASN1Object a => a -> ByteString
encodeASNObj (PubKey -> ByteString)
-> (PublicKey a -> PubKey) -> PublicKey a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey a -> PubKey
forall (a :: Algorithm). PublicKey a -> PubKey
publicToX509
{-# INLINE encodePubKey #-}

pubKeyBytes :: PublicKey a -> ByteString
pubKeyBytes :: forall (a :: Algorithm). PublicKey a -> ByteString
pubKeyBytes = \case
  PublicKeyEd25519 PublicKey
k -> PublicKey -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert PublicKey
k
  PublicKeyEd448 PublicKey
k -> PublicKey -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert PublicKey
k
  PublicKeyX25519 PublicKey
k -> PublicKey -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert PublicKey
k
  PublicKeyX448 PublicKey
k -> PublicKey -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert PublicKey
k

class CryptoPrivateKey pk where
  type PublicKeyType pk
  toPrivKey :: (forall a. AlgorithmI a => PrivateKey a -> b) -> pk -> b
  privKey :: APrivateKey -> Either String pk
  toPublic :: pk -> PublicKeyType pk

instance CryptoPrivateKey APrivateKey where
  type PublicKeyType APrivateKey = APublicKey
  toPrivKey :: forall b.
(forall (a :: Algorithm). AlgorithmI a => PrivateKey a -> b)
-> APrivateKey -> b
toPrivKey forall (a :: Algorithm). AlgorithmI a => PrivateKey a -> b
f (APrivateKey SAlgorithm a
_ PrivateKey a
k) = PrivateKey a -> b
forall (a :: Algorithm). AlgorithmI a => PrivateKey a -> b
f PrivateKey a
k
  {-# INLINE toPrivKey #-}
  privKey :: APrivateKey -> Either String APrivateKey
privKey = APrivateKey -> Either String APrivateKey
forall a b. b -> Either a b
Right
  {-# INLINE privKey #-}
  toPublic :: APrivateKey -> PublicKeyType APrivateKey
toPublic (APrivateKey SAlgorithm a
a PrivateKey a
k) = SAlgorithm a -> PublicKey a -> APublicKey
forall (a :: Algorithm).
AlgorithmI a =>
SAlgorithm a -> PublicKey a -> APublicKey
APublicKey SAlgorithm a
a (PrivateKey a -> PublicKeyType (PrivateKey a)
forall pk. CryptoPrivateKey pk => pk -> PublicKeyType pk
toPublic PrivateKey a
k)
  {-# INLINE toPublic #-}

instance CryptoPrivateKey APrivateSignKey where
  type PublicKeyType APrivateSignKey = APublicVerifyKey
  toPrivKey :: forall b.
(forall (a :: Algorithm). AlgorithmI a => PrivateKey a -> b)
-> APrivateSignKey -> b
toPrivKey forall (a :: Algorithm). AlgorithmI a => PrivateKey a -> b
f (APrivateSignKey SAlgorithm a
_ PrivateKey a
k) = PrivateKey a -> b
forall (a :: Algorithm). AlgorithmI a => PrivateKey a -> b
f PrivateKey a
k
  {-# INLINE toPrivKey #-}
  privKey :: APrivateKey -> Either String APrivateSignKey
privKey (APrivateKey SAlgorithm a
a PrivateKey a
k) = case SAlgorithm a -> Maybe (Dict (SignatureAlgorithm a))
forall (a :: Algorithm).
SAlgorithm a -> Maybe (Dict (SignatureAlgorithm a))
signatureAlgorithm SAlgorithm a
a of
    Just Dict (SignatureAlgorithm a)
Dict -> APrivateSignKey -> Either String APrivateSignKey
forall a b. b -> Either a b
Right (APrivateSignKey -> Either String APrivateSignKey)
-> APrivateSignKey -> Either String APrivateSignKey
forall a b. (a -> b) -> a -> b
$ SAlgorithm a -> PrivateKey a -> APrivateSignKey
forall (a :: Algorithm).
(AlgorithmI a, SignatureAlgorithm a) =>
SAlgorithm a -> PrivateKey a -> APrivateSignKey
APrivateSignKey SAlgorithm a
a PrivateKey a
k
    Maybe (Dict (SignatureAlgorithm a))
_ -> String -> Either String APrivateSignKey
forall a b. a -> Either a b
Left String
"key does not support signature algorithms"
  toPublic :: APrivateSignKey -> PublicKeyType APrivateSignKey
toPublic (APrivateSignKey SAlgorithm a
a PrivateKey a
k) = SAlgorithm a -> PublicKey a -> APublicVerifyKey
forall (a :: Algorithm).
(AlgorithmI a, SignatureAlgorithm a) =>
SAlgorithm a -> PublicKey a -> APublicVerifyKey
APublicVerifyKey SAlgorithm a
a (PrivateKey a -> PublicKeyType (PrivateKey a)
forall pk. CryptoPrivateKey pk => pk -> PublicKeyType pk
toPublic PrivateKey a
k)
  {-# INLINE toPublic #-}

instance CryptoPrivateKey APrivateAuthKey where
  type PublicKeyType APrivateAuthKey = APublicAuthKey
  toPrivKey :: forall b.
(forall (a :: Algorithm). AlgorithmI a => PrivateKey a -> b)
-> APrivateAuthKey -> b
toPrivKey forall (a :: Algorithm). AlgorithmI a => PrivateKey a -> b
f (APrivateAuthKey SAlgorithm a
_ PrivateKey a
k) = PrivateKey a -> b
forall (a :: Algorithm). AlgorithmI a => PrivateKey a -> b
f PrivateKey a
k
  {-# INLINE toPrivKey #-}
  privKey :: APrivateKey -> Either String APrivateAuthKey
privKey (APrivateKey SAlgorithm a
a PrivateKey a
k) = case SAlgorithm a -> Maybe (Dict (AuthAlgorithm a))
forall (a :: Algorithm).
SAlgorithm a -> Maybe (Dict (AuthAlgorithm a))
authAlgorithm SAlgorithm a
a of
    Just Dict (AuthAlgorithm a)
Dict -> APrivateAuthKey -> Either String APrivateAuthKey
forall a b. b -> Either a b
Right (APrivateAuthKey -> Either String APrivateAuthKey)
-> APrivateAuthKey -> Either String APrivateAuthKey
forall a b. (a -> b) -> a -> b
$ SAlgorithm a -> PrivateKey a -> APrivateAuthKey
forall (a :: Algorithm).
(AlgorithmI a, AuthAlgorithm a) =>
SAlgorithm a -> PrivateKey a -> APrivateAuthKey
APrivateAuthKey SAlgorithm a
a PrivateKey a
k
    Maybe (Dict (AuthAlgorithm a))
_ -> String -> Either String APrivateAuthKey
forall a b. a -> Either a b
Left String
"key does not support auth algorithms"
  toPublic :: APrivateAuthKey -> PublicKeyType APrivateAuthKey
toPublic (APrivateAuthKey SAlgorithm a
a PrivateKey a
k) = SAlgorithm a -> PublicKey a -> APublicAuthKey
forall (a :: Algorithm).
(AlgorithmI a, AuthAlgorithm a) =>
SAlgorithm a -> PublicKey a -> APublicAuthKey
APublicAuthKey SAlgorithm a
a (PrivateKey a -> PublicKeyType (PrivateKey a)
forall pk. CryptoPrivateKey pk => pk -> PublicKeyType pk
toPublic PrivateKey a
k)
  {-# INLINE toPublic #-}

instance CryptoPrivateKey APrivateDhKey where
  type PublicKeyType APrivateDhKey = APublicDhKey
  toPrivKey :: forall b.
(forall (a :: Algorithm). AlgorithmI a => PrivateKey a -> b)
-> APrivateDhKey -> b
toPrivKey forall (a :: Algorithm). AlgorithmI a => PrivateKey a -> b
f (APrivateDhKey SAlgorithm a
_ PrivateKey a
k) = PrivateKey a -> b
forall (a :: Algorithm). AlgorithmI a => PrivateKey a -> b
f PrivateKey a
k
  {-# INLINE toPrivKey #-}
  privKey :: APrivateKey -> Either String APrivateDhKey
privKey (APrivateKey SAlgorithm a
a PrivateKey a
k) = case SAlgorithm a -> Maybe (Dict (DhAlgorithm a))
forall (a :: Algorithm).
SAlgorithm a -> Maybe (Dict (DhAlgorithm a))
dhAlgorithm SAlgorithm a
a of
    Just Dict (DhAlgorithm a)
Dict -> APrivateDhKey -> Either String APrivateDhKey
forall a b. b -> Either a b
Right (APrivateDhKey -> Either String APrivateDhKey)
-> APrivateDhKey -> Either String APrivateDhKey
forall a b. (a -> b) -> a -> b
$ SAlgorithm a -> PrivateKey a -> APrivateDhKey
forall (a :: Algorithm).
(AlgorithmI a, DhAlgorithm a) =>
SAlgorithm a -> PrivateKey a -> APrivateDhKey
APrivateDhKey SAlgorithm a
a PrivateKey a
k
    Maybe (Dict (DhAlgorithm a))
_ -> String -> Either String APrivateDhKey
forall a b. a -> Either a b
Left String
"key does not support DH algorithm"
  toPublic :: APrivateDhKey -> PublicKeyType APrivateDhKey
toPublic (APrivateDhKey SAlgorithm a
a PrivateKey a
k) = SAlgorithm a -> PublicKey a -> APublicDhKey
forall (a :: Algorithm).
(AlgorithmI a, DhAlgorithm a) =>
SAlgorithm a -> PublicKey a -> APublicDhKey
APublicDhKey SAlgorithm a
a (PrivateKey a -> PublicKeyType (PrivateKey a)
forall pk. CryptoPrivateKey pk => pk -> PublicKeyType pk
toPublic PrivateKey a
k)
  {-# INLINE toPublic #-}

instance AlgorithmI a => CryptoPrivateKey (PrivateKey a) where
  type PublicKeyType (PrivateKey a) = PublicKey a
  toPrivKey :: forall b.
(forall (a :: Algorithm). AlgorithmI a => PrivateKey a -> b)
-> PrivateKey a -> b
toPrivKey = (PrivateKey a -> b) -> PrivateKey a -> b
(forall (a :: Algorithm). AlgorithmI a => PrivateKey a -> b)
-> PrivateKey a -> b
forall a. a -> a
id
  {-# INLINE toPrivKey #-}
  privKey :: APrivateKey -> Either String (PrivateKey a)
privKey (APrivateKey SAlgorithm a
_ PrivateKey a
k) = PrivateKey a -> Either String (PrivateKey a)
forall (t :: Algorithm -> *) (a :: Algorithm) (a' :: Algorithm).
(AlgorithmI a, AlgorithmI a') =>
t a' -> Either String (t a)
checkAlgorithm PrivateKey a
k
  {-# INLINE privKey #-}
  toPublic :: PrivateKey a -> PublicKeyType (PrivateKey a)
toPublic = PrivateKey a -> PublicKeyType (PrivateKey a)
PrivateKey a -> PublicKey a
forall (a :: Algorithm). PrivateKey a -> PublicKey a
publicKey
  {-# INLINE toPublic #-}

publicKey :: PrivateKey a -> PublicKey a
publicKey :: forall (a :: Algorithm). PrivateKey a -> PublicKey a
publicKey = \case
  PrivateKeyEd25519 SecretKey
pk -> PublicKey -> PublicKey 'Ed25519
PublicKeyEd25519 (SecretKey -> PublicKey
Ed25519.toPublic SecretKey
pk)
  PrivateKeyEd448 SecretKey
pk -> PublicKey -> PublicKey 'Ed448
PublicKeyEd448 (SecretKey -> PublicKey
Ed448.toPublic SecretKey
pk)
  PrivateKeyX25519 SecretKey
pk -> PublicKey -> PublicKey 'X25519
PublicKeyX25519 (SecretKey -> PublicKey
X25519.toPublic SecretKey
pk)
  PrivateKeyX448 SecretKey
pk -> PublicKey -> PublicKey 'X448
PublicKeyX448 (SecretKey -> PublicKey
X448.toPublic SecretKey
pk)

-- | Expand signature private key to a key pair.
signatureKeyPair :: APrivateSignKey -> ASignatureKeyPair
signatureKeyPair :: APrivateSignKey -> ASignatureKeyPair
signatureKeyPair ak :: APrivateSignKey
ak@(APrivateSignKey SAlgorithm a
a PrivateKey a
k) = (SAlgorithm a -> PublicKey a -> APublicVerifyKey
forall (a :: Algorithm).
(AlgorithmI a, SignatureAlgorithm a) =>
SAlgorithm a -> PublicKey a -> APublicVerifyKey
APublicVerifyKey SAlgorithm a
a (PrivateKey a -> PublicKeyType (PrivateKey a)
forall pk. CryptoPrivateKey pk => pk -> PublicKeyType pk
toPublic PrivateKey a
k), APrivateSignKey
ak)

encodePrivKey :: CryptoPrivateKey pk => pk -> ByteString
encodePrivKey :: forall pk. CryptoPrivateKey pk => pk -> ByteString
encodePrivKey = (forall (a :: Algorithm).
 AlgorithmI a =>
 PrivateKey a -> ByteString)
-> pk -> ByteString
forall pk b.
CryptoPrivateKey pk =>
(forall (a :: Algorithm). AlgorithmI a => PrivateKey a -> b)
-> pk -> b
forall b.
(forall (a :: Algorithm). AlgorithmI a => PrivateKey a -> b)
-> pk -> b
toPrivKey ((forall (a :: Algorithm).
  AlgorithmI a =>
  PrivateKey a -> ByteString)
 -> pk -> ByteString)
-> (forall (a :: Algorithm).
    AlgorithmI a =>
    PrivateKey a -> ByteString)
-> pk
-> ByteString
forall a b. (a -> b) -> a -> b
$ PrivKey -> ByteString
forall a. ASN1Object a => a -> ByteString
encodeASNObj (PrivKey -> ByteString)
-> (PrivateKey a -> PrivKey) -> PrivateKey a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivateKey a -> PrivKey
forall (a :: Algorithm). PrivateKey a -> PrivKey
privateToX509

instance AlgorithmI a => IsString (PrivateKey a) where
  fromString :: String -> PrivateKey a
fromString = (ByteString -> Either String (PrivateKey a))
-> String -> PrivateKey a
forall a. (ByteString -> Either String a) -> String -> a
parseString ((ByteString -> Either String (PrivateKey a))
 -> String -> PrivateKey a)
-> (ByteString -> Either String (PrivateKey a))
-> String
-> PrivateKey a
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
decode (ByteString -> Either String ByteString)
-> (ByteString -> Either String (PrivateKey a))
-> ByteString
-> Either String (PrivateKey a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ByteString -> Either String (PrivateKey a)
forall k. CryptoPrivateKey k => ByteString -> Either String k
decodePrivKey

instance AlgorithmI a => IsString (PublicKey a) where
  fromString :: String -> PublicKey a
fromString = (ByteString -> Either String (PublicKey a))
-> String -> PublicKey a
forall a. (ByteString -> Either String a) -> String -> a
parseString ((ByteString -> Either String (PublicKey a))
 -> String -> PublicKey a)
-> (ByteString -> Either String (PublicKey a))
-> String
-> PublicKey a
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
decode (ByteString -> Either String ByteString)
-> (ByteString -> Either String (PublicKey a))
-> ByteString
-> Either String (PublicKey a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ByteString -> Either String (PublicKey a)
forall k. CryptoPublicKey k => ByteString -> Either String k
decodePubKey

instance AlgorithmI a => ToJSON (PrivateKey a) where
  toJSON :: PrivateKey a -> Value
toJSON = ByteString -> Value
forall a. StrEncoding a => a -> Value
strToJSON (ByteString -> Value)
-> (PrivateKey a -> ByteString) -> PrivateKey a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode (ByteString -> ByteString)
-> (PrivateKey a -> ByteString) -> PrivateKey a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivateKey a -> ByteString
forall pk. CryptoPrivateKey pk => pk -> ByteString
encodePrivKey
  toEncoding :: PrivateKey a -> Encoding
toEncoding = ByteString -> Encoding
forall a. StrEncoding a => a -> Encoding
strToJEncoding (ByteString -> Encoding)
-> (PrivateKey a -> ByteString) -> PrivateKey a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode (ByteString -> ByteString)
-> (PrivateKey a -> ByteString) -> PrivateKey a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivateKey a -> ByteString
forall pk. CryptoPrivateKey pk => pk -> ByteString
encodePrivKey

instance AlgorithmI a => FromJSON (PrivateKey a) where
  parseJSON :: Value -> Parser (PrivateKey a)
parseJSON Value
v = (ByteString -> Either String (PrivateKey a)
forall k. CryptoPrivateKey k => ByteString -> Either String k
decodePrivKey (ByteString -> Either String (PrivateKey a))
-> (ByteString -> Either String ByteString)
-> ByteString
-> Either String (PrivateKey a)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ByteString -> Either String ByteString
U.decode) (ByteString -> Either String (PrivateKey a))
-> Parser ByteString -> Parser (PrivateKey a)
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> String -> Value -> Parser ByteString
forall a. StrEncoding a => String -> Value -> Parser a
strParseJSON String
"PrivateKey" Value
v

type KeyPairType pk = (PublicKeyType pk, pk)

type KeyPair a = KeyPairType (PrivateKey a)

type KeyPairX25519 = KeyPair X25519

type KeyPairEd25519 = KeyPair Ed25519

-- TODO narrow key pair types to have the same algorithm in both keys
type AKeyPair = KeyPairType APrivateKey

type ASignatureKeyPair = KeyPairType APrivateSignKey

type ADhKeyPair = KeyPairType APrivateDhKey

type AAuthKeyPair = KeyPairType APrivateAuthKey

newRandom :: IO (TVar ChaChaDRG)
newRandom :: IO (TVar ChaChaDRG)
newRandom = ChaChaDRG -> IO (TVar ChaChaDRG)
forall a. a -> IO (TVar a)
newTVarIO (ChaChaDRG -> IO (TVar ChaChaDRG))
-> IO ChaChaDRG -> IO (TVar ChaChaDRG)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO ChaChaDRG
forall (randomly :: * -> *).
MonadRandom randomly =>
randomly ChaChaDRG
drgNew

newRandomDRG :: TVar ChaChaDRG -> STM (TVar ChaChaDRG)
newRandomDRG :: TVar ChaChaDRG -> STM (TVar ChaChaDRG)
newRandomDRG TVar ChaChaDRG
g = ChaChaDRG -> STM (TVar ChaChaDRG)
forall a. a -> STM (TVar a)
newTVar (ChaChaDRG -> STM (TVar ChaChaDRG))
-> STM ChaChaDRG -> STM (TVar ChaChaDRG)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TVar ChaChaDRG
-> (ChaChaDRG -> (ChaChaDRG, ChaChaDRG)) -> STM ChaChaDRG
forall s a. TVar s -> (s -> (a, s)) -> STM a
stateTVar TVar ChaChaDRG
g (ChaChaDRG
-> MonadPseudoRandom ChaChaDRG ChaChaDRG -> (ChaChaDRG, ChaChaDRG)
forall gen a. DRG gen => gen -> MonadPseudoRandom gen a -> (a, gen)
`withDRG` MonadPseudoRandom ChaChaDRG ChaChaDRG
forall (randomly :: * -> *).
MonadRandom randomly =>
randomly ChaChaDRG
drgNew)

generateAKeyPair :: AlgorithmI a => SAlgorithm a -> TVar ChaChaDRG -> STM AKeyPair
generateAKeyPair :: forall (a :: Algorithm).
AlgorithmI a =>
SAlgorithm a -> TVar ChaChaDRG -> STM AKeyPair
generateAKeyPair SAlgorithm a
a TVar ChaChaDRG
g = (PublicKey a -> APublicKey)
-> (PrivateKey a -> APrivateKey)
-> (PublicKey a, PrivateKey a)
-> (APublicKey, APrivateKey)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (SAlgorithm a -> PublicKey a -> APublicKey
forall (a :: Algorithm).
AlgorithmI a =>
SAlgorithm a -> PublicKey a -> APublicKey
APublicKey SAlgorithm a
a) (SAlgorithm a -> PrivateKey a -> APrivateKey
forall (a :: Algorithm).
AlgorithmI a =>
SAlgorithm a -> PrivateKey a -> APrivateKey
APrivateKey SAlgorithm a
a) ((PublicKey a, PrivateKey a) -> (APublicKey, APrivateKey))
-> STM (PublicKey a, PrivateKey a) -> STM (APublicKey, APrivateKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar ChaChaDRG -> STM (KeyPair a)
forall (a :: Algorithm).
AlgorithmI a =>
TVar ChaChaDRG -> STM (KeyPair a)
generateKeyPair TVar ChaChaDRG
g

generateSignatureKeyPair :: (AlgorithmI a, SignatureAlgorithm a) => SAlgorithm a -> TVar ChaChaDRG -> STM ASignatureKeyPair
generateSignatureKeyPair :: forall (a :: Algorithm).
(AlgorithmI a, SignatureAlgorithm a) =>
SAlgorithm a -> TVar ChaChaDRG -> STM ASignatureKeyPair
generateSignatureKeyPair SAlgorithm a
a TVar ChaChaDRG
g = (PublicKey a -> APublicVerifyKey)
-> (PrivateKey a -> APrivateSignKey)
-> (PublicKey a, PrivateKey a)
-> (APublicVerifyKey, APrivateSignKey)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (SAlgorithm a -> PublicKey a -> APublicVerifyKey
forall (a :: Algorithm).
(AlgorithmI a, SignatureAlgorithm a) =>
SAlgorithm a -> PublicKey a -> APublicVerifyKey
APublicVerifyKey SAlgorithm a
a) (SAlgorithm a -> PrivateKey a -> APrivateSignKey
forall (a :: Algorithm).
(AlgorithmI a, SignatureAlgorithm a) =>
SAlgorithm a -> PrivateKey a -> APrivateSignKey
APrivateSignKey SAlgorithm a
a) ((PublicKey a, PrivateKey a)
 -> (APublicVerifyKey, APrivateSignKey))
-> STM (PublicKey a, PrivateKey a)
-> STM (APublicVerifyKey, APrivateSignKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar ChaChaDRG -> STM (KeyPair a)
forall (a :: Algorithm).
AlgorithmI a =>
TVar ChaChaDRG -> STM (KeyPair a)
generateKeyPair TVar ChaChaDRG
g

generateAuthKeyPair :: (AlgorithmI a, AuthAlgorithm a) => SAlgorithm a -> TVar ChaChaDRG -> STM AAuthKeyPair
generateAuthKeyPair :: forall (a :: Algorithm).
(AlgorithmI a, AuthAlgorithm a) =>
SAlgorithm a -> TVar ChaChaDRG -> STM AAuthKeyPair
generateAuthKeyPair SAlgorithm a
a TVar ChaChaDRG
g = (PublicKey a -> APublicAuthKey)
-> (PrivateKey a -> APrivateAuthKey)
-> (PublicKey a, PrivateKey a)
-> (APublicAuthKey, APrivateAuthKey)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (SAlgorithm a -> PublicKey a -> APublicAuthKey
forall (a :: Algorithm).
(AlgorithmI a, AuthAlgorithm a) =>
SAlgorithm a -> PublicKey a -> APublicAuthKey
APublicAuthKey SAlgorithm a
a) (SAlgorithm a -> PrivateKey a -> APrivateAuthKey
forall (a :: Algorithm).
(AlgorithmI a, AuthAlgorithm a) =>
SAlgorithm a -> PrivateKey a -> APrivateAuthKey
APrivateAuthKey SAlgorithm a
a) ((PublicKey a, PrivateKey a) -> (APublicAuthKey, APrivateAuthKey))
-> STM (PublicKey a, PrivateKey a)
-> STM (APublicAuthKey, APrivateAuthKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar ChaChaDRG -> STM (KeyPair a)
forall (a :: Algorithm).
AlgorithmI a =>
TVar ChaChaDRG -> STM (KeyPair a)
generateKeyPair TVar ChaChaDRG
g

generatePrivateAuthKey :: (AlgorithmI a, AuthAlgorithm a) => SAlgorithm a -> TVar ChaChaDRG -> STM APrivateAuthKey
generatePrivateAuthKey :: forall (a :: Algorithm).
(AlgorithmI a, AuthAlgorithm a) =>
SAlgorithm a -> TVar ChaChaDRG -> STM APrivateAuthKey
generatePrivateAuthKey SAlgorithm a
a TVar ChaChaDRG
g = SAlgorithm a -> PrivateKey a -> APrivateAuthKey
forall (a :: Algorithm).
(AlgorithmI a, AuthAlgorithm a) =>
SAlgorithm a -> PrivateKey a -> APrivateAuthKey
APrivateAuthKey SAlgorithm a
a (PrivateKey a -> APrivateAuthKey)
-> STM (PrivateKey a) -> STM APrivateAuthKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar ChaChaDRG -> STM (PrivateKey a)
forall (a :: Algorithm).
AlgorithmI a =>
TVar ChaChaDRG -> STM (PrivateKey a)
generatePrivateKey TVar ChaChaDRG
g

generateDhKeyPair :: (AlgorithmI a, DhAlgorithm a) => SAlgorithm a -> TVar ChaChaDRG -> STM ADhKeyPair
generateDhKeyPair :: forall (a :: Algorithm).
(AlgorithmI a, DhAlgorithm a) =>
SAlgorithm a -> TVar ChaChaDRG -> STM ADhKeyPair
generateDhKeyPair SAlgorithm a
a TVar ChaChaDRG
g = (PublicKey a -> APublicDhKey)
-> (PrivateKey a -> APrivateDhKey)
-> (PublicKey a, PrivateKey a)
-> (APublicDhKey, APrivateDhKey)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (SAlgorithm a -> PublicKey a -> APublicDhKey
forall (a :: Algorithm).
(AlgorithmI a, DhAlgorithm a) =>
SAlgorithm a -> PublicKey a -> APublicDhKey
APublicDhKey SAlgorithm a
a) (SAlgorithm a -> PrivateKey a -> APrivateDhKey
forall (a :: Algorithm).
(AlgorithmI a, DhAlgorithm a) =>
SAlgorithm a -> PrivateKey a -> APrivateDhKey
APrivateDhKey SAlgorithm a
a) ((PublicKey a, PrivateKey a) -> (APublicDhKey, APrivateDhKey))
-> STM (PublicKey a, PrivateKey a)
-> STM (APublicDhKey, APrivateDhKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar ChaChaDRG -> STM (KeyPair a)
forall (a :: Algorithm).
AlgorithmI a =>
TVar ChaChaDRG -> STM (KeyPair a)
generateKeyPair TVar ChaChaDRG
g

generateKeyPair :: forall a. AlgorithmI a => TVar ChaChaDRG -> STM (KeyPair a)
generateKeyPair :: forall (a :: Algorithm).
AlgorithmI a =>
TVar ChaChaDRG -> STM (KeyPair a)
generateKeyPair TVar ChaChaDRG
g = TVar ChaChaDRG
-> (ChaChaDRG -> ((PublicKey a, PrivateKey a), ChaChaDRG))
-> STM (PublicKey a, PrivateKey a)
forall s a. TVar s -> (s -> (a, s)) -> STM a
stateTVar TVar ChaChaDRG
g (ChaChaDRG
-> MonadPseudoRandom ChaChaDRG (PublicKey a, PrivateKey a)
-> ((PublicKey a, PrivateKey a), ChaChaDRG)
forall gen a. DRG gen => gen -> MonadPseudoRandom gen a -> (a, gen)
`withDRG` MonadPseudoRandom
  ChaChaDRG (PublicKeyType (PrivateKey a), PrivateKey a)
MonadPseudoRandom ChaChaDRG (PublicKey a, PrivateKey a)
forall (a :: Algorithm).
AlgorithmI a =>
MonadPseudoRandom ChaChaDRG (KeyPair a)
generateKeyPair_)

generateKeyPair_ :: forall a. AlgorithmI a => MonadPseudoRandom ChaChaDRG (KeyPair a)
generateKeyPair_ :: forall (a :: Algorithm).
AlgorithmI a =>
MonadPseudoRandom ChaChaDRG (KeyPair a)
generateKeyPair_ = do
  PrivateKey a
pk <- MonadPseudoRandom ChaChaDRG (PrivateKey a)
forall (a :: Algorithm).
AlgorithmI a =>
MonadPseudoRandom ChaChaDRG (PrivateKey a)
generatePrivateKey_
  (PublicKey a, PrivateKey a)
-> MonadPseudoRandom ChaChaDRG (PublicKey a, PrivateKey a)
forall a. a -> MonadPseudoRandom ChaChaDRG a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrivateKey a -> PublicKeyType (PrivateKey a)
forall pk. CryptoPrivateKey pk => pk -> PublicKeyType pk
toPublic PrivateKey a
pk, PrivateKey a
pk)

generatePrivateKey :: forall a. AlgorithmI a => TVar ChaChaDRG -> STM (PrivateKey a)
generatePrivateKey :: forall (a :: Algorithm).
AlgorithmI a =>
TVar ChaChaDRG -> STM (PrivateKey a)
generatePrivateKey TVar ChaChaDRG
g = TVar ChaChaDRG
-> (ChaChaDRG -> (PrivateKey a, ChaChaDRG)) -> STM (PrivateKey a)
forall s a. TVar s -> (s -> (a, s)) -> STM a
stateTVar TVar ChaChaDRG
g (ChaChaDRG
-> MonadPseudoRandom ChaChaDRG (PrivateKey a)
-> (PrivateKey a, ChaChaDRG)
forall gen a. DRG gen => gen -> MonadPseudoRandom gen a -> (a, gen)
`withDRG` MonadPseudoRandom ChaChaDRG (PrivateKey a)
forall (a :: Algorithm).
AlgorithmI a =>
MonadPseudoRandom ChaChaDRG (PrivateKey a)
generatePrivateKey_)

generatePrivateKey_ :: forall a. AlgorithmI a => MonadPseudoRandom ChaChaDRG (PrivateKey a)
generatePrivateKey_ :: forall (a :: Algorithm).
AlgorithmI a =>
MonadPseudoRandom ChaChaDRG (PrivateKey a)
generatePrivateKey_ = case forall (a :: Algorithm). AlgorithmI a => SAlgorithm a
sAlgorithm @a of
  SAlgorithm a
SEd25519 -> SecretKey -> PrivateKey a
SecretKey -> PrivateKey 'Ed25519
PrivateKeyEd25519 (SecretKey -> PrivateKey a)
-> MonadPseudoRandom ChaChaDRG SecretKey
-> MonadPseudoRandom ChaChaDRG (PrivateKey a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MonadPseudoRandom ChaChaDRG SecretKey
forall (m :: * -> *). MonadRandom m => m SecretKey
Ed25519.generateSecretKey
  SAlgorithm a
SEd448 -> SecretKey -> PrivateKey a
SecretKey -> PrivateKey 'Ed448
PrivateKeyEd448 (SecretKey -> PrivateKey a)
-> MonadPseudoRandom ChaChaDRG SecretKey
-> MonadPseudoRandom ChaChaDRG (PrivateKey a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MonadPseudoRandom ChaChaDRG SecretKey
forall (m :: * -> *). MonadRandom m => m SecretKey
Ed448.generateSecretKey
  SAlgorithm a
SX25519 -> SecretKey -> PrivateKey a
SecretKey -> PrivateKey 'X25519
PrivateKeyX25519 (SecretKey -> PrivateKey a)
-> MonadPseudoRandom ChaChaDRG SecretKey
-> MonadPseudoRandom ChaChaDRG (PrivateKey a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MonadPseudoRandom ChaChaDRG SecretKey
forall (m :: * -> *). MonadRandom m => m SecretKey
X25519.generateSecretKey
  SAlgorithm a
SX448 -> SecretKey -> PrivateKey a
SecretKey -> PrivateKey 'X448
PrivateKeyX448 (SecretKey -> PrivateKey a)
-> MonadPseudoRandom ChaChaDRG SecretKey
-> MonadPseudoRandom ChaChaDRG (PrivateKey a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MonadPseudoRandom ChaChaDRG SecretKey
forall (m :: * -> *). MonadRandom m => m SecretKey
X448.generateSecretKey

instance ToField APrivateSignKey where toField :: APrivateSignKey -> SQLData
toField = Binary ByteString -> SQLData
forall a. ToField a => a -> SQLData
toField (Binary ByteString -> SQLData)
-> (APrivateSignKey -> Binary ByteString)
-> APrivateSignKey
-> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Binary ByteString
forall a. a -> Binary a
Binary (ByteString -> Binary ByteString)
-> (APrivateSignKey -> ByteString)
-> APrivateSignKey
-> Binary ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APrivateSignKey -> ByteString
forall pk. CryptoPrivateKey pk => pk -> ByteString
encodePrivKey

instance ToField APublicVerifyKey where toField :: APublicVerifyKey -> SQLData
toField = Binary ByteString -> SQLData
forall a. ToField a => a -> SQLData
toField (Binary ByteString -> SQLData)
-> (APublicVerifyKey -> Binary ByteString)
-> APublicVerifyKey
-> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Binary ByteString
forall a. a -> Binary a
Binary (ByteString -> Binary ByteString)
-> (APublicVerifyKey -> ByteString)
-> APublicVerifyKey
-> Binary ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APublicVerifyKey -> ByteString
forall k. CryptoPublicKey k => k -> ByteString
encodePubKey

instance ToField APrivateAuthKey where toField :: APrivateAuthKey -> SQLData
toField = Binary ByteString -> SQLData
forall a. ToField a => a -> SQLData
toField (Binary ByteString -> SQLData)
-> (APrivateAuthKey -> Binary ByteString)
-> APrivateAuthKey
-> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Binary ByteString
forall a. a -> Binary a
Binary (ByteString -> Binary ByteString)
-> (APrivateAuthKey -> ByteString)
-> APrivateAuthKey
-> Binary ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APrivateAuthKey -> ByteString
forall pk. CryptoPrivateKey pk => pk -> ByteString
encodePrivKey

instance ToField APublicAuthKey where toField :: APublicAuthKey -> SQLData
toField = Binary ByteString -> SQLData
forall a. ToField a => a -> SQLData
toField (Binary ByteString -> SQLData)
-> (APublicAuthKey -> Binary ByteString)
-> APublicAuthKey
-> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Binary ByteString
forall a. a -> Binary a
Binary (ByteString -> Binary ByteString)
-> (APublicAuthKey -> ByteString)
-> APublicAuthKey
-> Binary ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APublicAuthKey -> ByteString
forall k. CryptoPublicKey k => k -> ByteString
encodePubKey

instance ToField APrivateDhKey where toField :: APrivateDhKey -> SQLData
toField = Binary ByteString -> SQLData
forall a. ToField a => a -> SQLData
toField (Binary ByteString -> SQLData)
-> (APrivateDhKey -> Binary ByteString) -> APrivateDhKey -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Binary ByteString
forall a. a -> Binary a
Binary (ByteString -> Binary ByteString)
-> (APrivateDhKey -> ByteString)
-> APrivateDhKey
-> Binary ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APrivateDhKey -> ByteString
forall pk. CryptoPrivateKey pk => pk -> ByteString
encodePrivKey

instance ToField APublicDhKey where toField :: APublicDhKey -> SQLData
toField = Binary ByteString -> SQLData
forall a. ToField a => a -> SQLData
toField (Binary ByteString -> SQLData)
-> (APublicDhKey -> Binary ByteString) -> APublicDhKey -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Binary ByteString
forall a. a -> Binary a
Binary (ByteString -> Binary ByteString)
-> (APublicDhKey -> ByteString)
-> APublicDhKey
-> Binary ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APublicDhKey -> ByteString
forall k. CryptoPublicKey k => k -> ByteString
encodePubKey

instance AlgorithmI a => ToField (PrivateKey a) where toField :: PrivateKey a -> SQLData
toField = Binary ByteString -> SQLData
forall a. ToField a => a -> SQLData
toField (Binary ByteString -> SQLData)
-> (PrivateKey a -> Binary ByteString) -> PrivateKey a -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Binary ByteString
forall a. a -> Binary a
Binary (ByteString -> Binary ByteString)
-> (PrivateKey a -> ByteString)
-> PrivateKey a
-> Binary ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivateKey a -> ByteString
forall pk. CryptoPrivateKey pk => pk -> ByteString
encodePrivKey

instance AlgorithmI a => ToField (PublicKey a) where toField :: PublicKey a -> SQLData
toField = Binary ByteString -> SQLData
forall a. ToField a => a -> SQLData
toField (Binary ByteString -> SQLData)
-> (PublicKey a -> Binary ByteString) -> PublicKey a -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Binary ByteString
forall a. a -> Binary a
Binary (ByteString -> Binary ByteString)
-> (PublicKey a -> ByteString) -> PublicKey a -> Binary ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey a -> ByteString
forall k. CryptoPublicKey k => k -> ByteString
encodePubKey

instance ToField (DhSecret a) where toField :: DhSecret a -> SQLData
toField = Binary ByteString -> SQLData
forall a. ToField a => a -> SQLData
toField (Binary ByteString -> SQLData)
-> (DhSecret a -> Binary ByteString) -> DhSecret a -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Binary ByteString
forall a. a -> Binary a
Binary (ByteString -> Binary ByteString)
-> (DhSecret a -> ByteString) -> DhSecret a -> Binary ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DhSecret a -> ByteString
forall (a :: Algorithm). DhSecret a -> ByteString
dhBytes'

instance FromField APrivateSignKey where fromField :: FieldParser APrivateSignKey
fromField = (ByteString -> Either String APrivateSignKey)
-> FieldParser APrivateSignKey
forall k.
Typeable k =>
(ByteString -> Either String k) -> FieldParser k
blobFieldDecoder ByteString -> Either String APrivateSignKey
forall k. CryptoPrivateKey k => ByteString -> Either String k
decodePrivKey

instance FromField APublicVerifyKey where fromField :: FieldParser APublicVerifyKey
fromField = (ByteString -> Either String APublicVerifyKey)
-> FieldParser APublicVerifyKey
forall k.
Typeable k =>
(ByteString -> Either String k) -> FieldParser k
blobFieldDecoder ByteString -> Either String APublicVerifyKey
forall k. CryptoPublicKey k => ByteString -> Either String k
decodePubKey

instance FromField APrivateAuthKey where fromField :: FieldParser APrivateAuthKey
fromField = (ByteString -> Either String APrivateAuthKey)
-> FieldParser APrivateAuthKey
forall k.
Typeable k =>
(ByteString -> Either String k) -> FieldParser k
blobFieldDecoder ByteString -> Either String APrivateAuthKey
forall k. CryptoPrivateKey k => ByteString -> Either String k
decodePrivKey

instance FromField APublicAuthKey where fromField :: FieldParser APublicAuthKey
fromField = (ByteString -> Either String APublicAuthKey)
-> FieldParser APublicAuthKey
forall k.
Typeable k =>
(ByteString -> Either String k) -> FieldParser k
blobFieldDecoder ByteString -> Either String APublicAuthKey
forall k. CryptoPublicKey k => ByteString -> Either String k
decodePubKey

instance FromField APrivateDhKey where fromField :: FieldParser APrivateDhKey
fromField = (ByteString -> Either String APrivateDhKey)
-> FieldParser APrivateDhKey
forall k.
Typeable k =>
(ByteString -> Either String k) -> FieldParser k
blobFieldDecoder ByteString -> Either String APrivateDhKey
forall k. CryptoPrivateKey k => ByteString -> Either String k
decodePrivKey

instance FromField APublicDhKey where fromField :: FieldParser APublicDhKey
fromField = (ByteString -> Either String APublicDhKey)
-> FieldParser APublicDhKey
forall k.
Typeable k =>
(ByteString -> Either String k) -> FieldParser k
blobFieldDecoder ByteString -> Either String APublicDhKey
forall k. CryptoPublicKey k => ByteString -> Either String k
decodePubKey

instance (Typeable a, AlgorithmI a) => FromField (PrivateKey a) where fromField :: FieldParser (PrivateKey a)
fromField = (ByteString -> Either String (PrivateKey a))
-> FieldParser (PrivateKey a)
forall k.
Typeable k =>
(ByteString -> Either String k) -> FieldParser k
blobFieldDecoder ByteString -> Either String (PrivateKey a)
forall k. CryptoPrivateKey k => ByteString -> Either String k
decodePrivKey

instance (Typeable a, AlgorithmI a) => FromField (PublicKey a) where fromField :: FieldParser (PublicKey a)
fromField = (ByteString -> Either String (PublicKey a))
-> FieldParser (PublicKey a)
forall k.
Typeable k =>
(ByteString -> Either String k) -> FieldParser k
blobFieldDecoder ByteString -> Either String (PublicKey a)
forall k. CryptoPublicKey k => ByteString -> Either String k
decodePubKey

instance (Typeable a, AlgorithmI a) => FromField (DhSecret a) where fromField :: FieldParser (DhSecret a)
fromField = (ByteString -> Either String (DhSecret a))
-> FieldParser (DhSecret a)
forall k.
Typeable k =>
(ByteString -> Either String k) -> FieldParser k
blobFieldDecoder ByteString -> Either String (DhSecret a)
forall a. StrEncoding a => ByteString -> Either String a
strDecode

instance IsString ASignature where
  fromString :: String -> ASignature
fromString = (ByteString -> Either String ASignature) -> String -> ASignature
forall a. (ByteString -> Either String a) -> String -> a
parseString ((ByteString -> Either String ASignature) -> String -> ASignature)
-> (ByteString -> Either String ASignature) -> String -> ASignature
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
decode (ByteString -> Either String ByteString)
-> (ByteString -> Either String ASignature)
-> ByteString
-> Either String ASignature
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ByteString -> Either String ASignature
forall s. CryptoSignature s => ByteString -> Either String s
decodeSignature

data Signature (a :: Algorithm) where
  SignatureEd25519 :: Ed25519.Signature -> Signature Ed25519
  SignatureEd448 :: Ed448.Signature -> Signature Ed448

deriving instance Eq (Signature a)

deriving instance Show (Signature a)

data ASignature
  = forall a.
    (AlgorithmI a, SignatureAlgorithm a) =>
    ASignature (SAlgorithm a) (Signature a)

deriving instance Show ASignature

class CryptoSignature s where
  signatureBytes :: s -> ByteString
  decodeSignature :: ByteString -> Either String s

instance CryptoSignature (Signature s) => StrEncoding (Signature s) where
  strEncode :: Signature s -> ByteString
strEncode = ByteString -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode (ByteString -> ByteString)
-> (Signature s -> ByteString) -> Signature s -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature s -> ByteString
forall s. CryptoSignature s => s -> ByteString
signatureBytes
  {-# INLINE strEncode #-}
  strDecode :: ByteString -> Either String (Signature s)
strDecode = ByteString -> Either String (Signature s)
forall s. CryptoSignature s => ByteString -> Either String s
decodeSignature
  {-# INLINE strDecode #-}

instance CryptoSignature (Signature s) => ToJSON (Signature s) where
  toJSON :: Signature s -> Value
toJSON = Signature s -> Value
forall a. StrEncoding a => a -> Value
strToJSON
  toEncoding :: Signature s -> Encoding
toEncoding = Signature s -> Encoding
forall a. StrEncoding a => a -> Encoding
strToJEncoding

instance CryptoSignature (Signature s) => FromJSON (Signature s) where
  parseJSON :: Value -> Parser (Signature s)
parseJSON = String -> Value -> Parser (Signature s)
forall a. StrEncoding a => String -> Value -> Parser a
strParseJSON String
"Signature"

instance CryptoSignature (Signature s) => Encoding (Signature s) where
  smpEncode :: Signature s -> ByteString
smpEncode = ByteString -> ByteString
forall a. Encoding a => a -> ByteString
smpEncode (ByteString -> ByteString)
-> (Signature s -> ByteString) -> Signature s -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature s -> ByteString
forall s. CryptoSignature s => s -> ByteString
signatureBytes
  {-# INLINE smpEncode #-}
  smpP :: Parser (Signature s)
smpP = ByteString -> Either String (Signature s)
forall s. CryptoSignature s => ByteString -> Either String s
decodeSignature (ByteString -> Either String (Signature s))
-> Parser ByteString ByteString -> Parser (Signature s)
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> Parser ByteString ByteString
forall a. Encoding a => Parser a
smpP
  {-# INLINE smpP #-}

instance CryptoSignature ASignature where
  signatureBytes :: ASignature -> ByteString
signatureBytes (ASignature SAlgorithm a
_ Signature a
sig) = Signature a -> ByteString
forall s. CryptoSignature s => s -> ByteString
signatureBytes Signature a
sig
  {-# INLINE signatureBytes #-}
  decodeSignature :: ByteString -> Either String ASignature
decodeSignature ByteString
s
    | ByteString -> Int
B.length ByteString
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
Ed25519.signatureSize =
        SAlgorithm 'Ed25519 -> Signature 'Ed25519 -> ASignature
forall (a :: Algorithm).
(AlgorithmI a, SignatureAlgorithm a) =>
SAlgorithm a -> Signature a -> ASignature
ASignature SAlgorithm 'Ed25519
SEd25519 (Signature 'Ed25519 -> ASignature)
-> (Signature -> Signature 'Ed25519) -> Signature -> ASignature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> Signature 'Ed25519
SignatureEd25519 (Signature -> ASignature)
-> Either String Signature -> Either String ASignature
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> CryptoFailable Signature)
-> ByteString -> Either String Signature
forall {a} {c}. (a -> CryptoFailable c) -> a -> Either String c
ed ByteString -> CryptoFailable Signature
forall ba. ByteArrayAccess ba => ba -> CryptoFailable Signature
Ed25519.signature ByteString
s
    | ByteString -> Int
B.length ByteString
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
Ed448.signatureSize =
        SAlgorithm 'Ed448 -> Signature 'Ed448 -> ASignature
forall (a :: Algorithm).
(AlgorithmI a, SignatureAlgorithm a) =>
SAlgorithm a -> Signature a -> ASignature
ASignature SAlgorithm 'Ed448
SEd448 (Signature 'Ed448 -> ASignature)
-> (Signature -> Signature 'Ed448) -> Signature -> ASignature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> Signature 'Ed448
SignatureEd448 (Signature -> ASignature)
-> Either String Signature -> Either String ASignature
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> CryptoFailable Signature)
-> ByteString -> Either String Signature
forall {a} {c}. (a -> CryptoFailable c) -> a -> Either String c
ed ByteString -> CryptoFailable Signature
forall ba. ByteArrayAccess ba => ba -> CryptoFailable Signature
Ed448.signature ByteString
s
    | Bool
otherwise = String -> Either String ASignature
forall a b. a -> Either a b
Left String
"bad signature size"
    where
      ed :: (a -> CryptoFailable c) -> a -> Either String c
ed a -> CryptoFailable c
alg = (CryptoError -> String) -> Either CryptoError c -> Either String c
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first CryptoError -> String
forall a. Show a => a -> String
show (Either CryptoError c -> Either String c)
-> (a -> Either CryptoError c) -> a -> Either String c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoFailable c -> Either CryptoError c
forall a. CryptoFailable a -> Either CryptoError a
CE.eitherCryptoError (CryptoFailable c -> Either CryptoError c)
-> (a -> CryptoFailable c) -> a -> Either CryptoError c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> CryptoFailable c
alg

instance CryptoSignature (Maybe ASignature) where
  signatureBytes :: Maybe ASignature -> ByteString
signatureBytes = ByteString
-> (ASignature -> ByteString) -> Maybe ASignature -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" ASignature -> ByteString
forall s. CryptoSignature s => s -> ByteString
signatureBytes
  {-# INLINE signatureBytes #-}
  decodeSignature :: ByteString -> Either String (Maybe ASignature)
decodeSignature ByteString
s
    | ByteString -> Bool
B.null ByteString
s = Maybe ASignature -> Either String (Maybe ASignature)
forall a b. b -> Either a b
Right Maybe ASignature
forall a. Maybe a
Nothing
    | Bool
otherwise = ASignature -> Maybe ASignature
forall a. a -> Maybe a
Just (ASignature -> Maybe ASignature)
-> Either String ASignature -> Either String (Maybe ASignature)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either String ASignature
forall s. CryptoSignature s => ByteString -> Either String s
decodeSignature ByteString
s

instance AlgorithmI a => CryptoSignature (Signature a) where
  signatureBytes :: Signature a -> ByteString
signatureBytes = \case
    SignatureEd25519 Signature
s -> Signature -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert Signature
s
    SignatureEd448 Signature
s -> Signature -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert Signature
s
  {-# INLINE signatureBytes #-}
  decodeSignature :: ByteString -> Either String (Signature a)
decodeSignature ByteString
s = do
    ASignature SAlgorithm a
_ Signature a
sig <- ByteString -> Either String ASignature
forall s. CryptoSignature s => ByteString -> Either String s
decodeSignature ByteString
s
    Signature a -> Either String (Signature a)
forall (t :: Algorithm -> *) (a :: Algorithm) (a' :: Algorithm).
(AlgorithmI a, AlgorithmI a') =>
t a' -> Either String (t a)
checkAlgorithm Signature a
sig

class SignatureSize s where signatureSize :: s -> Int

instance SignatureSize (Signature a) where
  signatureSize :: Signature a -> Int
signatureSize = \case
    SignatureEd25519 Signature
_ -> Int
Ed25519.signatureSize
    SignatureEd448 Signature
_ -> Int
Ed448.signatureSize
  {-# INLINE signatureSize #-}

instance SignatureSize ASignature where
  signatureSize :: ASignature -> Int
signatureSize (ASignature SAlgorithm a
_ Signature a
s) = Signature a -> Int
forall s. SignatureSize s => s -> Int
signatureSize Signature a
s
  {-# INLINE signatureSize #-}

instance SignatureSize APrivateSignKey where
  signatureSize :: APrivateSignKey -> Int
signatureSize (APrivateSignKey SAlgorithm a
_ PrivateKey a
k) = PrivateKey a -> Int
forall s. SignatureSize s => s -> Int
signatureSize PrivateKey a
k
  {-# INLINE signatureSize #-}

instance SignatureSize APublicVerifyKey where
  signatureSize :: APublicVerifyKey -> Int
signatureSize (APublicVerifyKey SAlgorithm a
_ PublicKey a
k) = PublicKey a -> Int
forall s. SignatureSize s => s -> Int
signatureSize PublicKey a
k
  {-# INLINE signatureSize #-}

instance SignatureAlgorithm a => SignatureSize (PrivateKey a) where
  signatureSize :: PrivateKey a -> Int
signatureSize = \case
    PrivateKeyEd25519 SecretKey
_ -> Int
Ed25519.signatureSize
    PrivateKeyEd448 SecretKey
_ -> Int
Ed448.signatureSize
  {-# INLINE signatureSize #-}

instance SignatureAlgorithm a => SignatureSize (PublicKey a) where
  signatureSize :: PublicKey a -> Int
signatureSize = \case
    PublicKeyEd25519 PublicKey
_ -> Int
Ed25519.signatureSize
    PublicKeyEd448 PublicKey
_ -> Int
Ed448.signatureSize
  {-# INLINE signatureSize #-}

-- | Various cryptographic or related errors.
data CryptoError
  = -- | AES initialization error
    AESCipherError CE.CryptoError
  | -- | IV generation error
    CryptoIVError
  | -- | AES decryption error
    AESDecryptError
  | -- CryptoBox decryption error
    CBDecryptError
  | -- Poly1305 initialization error
    CryptoPoly1305Error CE.CryptoError
  | -- | message is larger that allowed padded length minus 2 (to prepend message length)
    -- (or required un-padded length is larger than the message length)
    CryptoLargeMsgError
  | -- | padded message is shorter than 2 bytes
    CryptoInvalidMsgError
  | -- | failure parsing message header
    CryptoHeaderError String
  | -- | no sending chain key in ratchet state
    CERatchetState
  | -- | no decapsulation key in ratchet state
    CERatchetKEMState
  | -- | header decryption error (could indicate that another key should be tried)
    CERatchetHeader
  | -- | too many skipped messages
    CERatchetTooManySkipped Word32
  | -- | earlier message number (or, possibly, skipped message that failed to decrypt?)
    CERatchetEarlierMessage Word32
  | -- | duplicate message number
    CERatchetDuplicateMessage
  deriving (CryptoError -> CryptoError -> Bool
(CryptoError -> CryptoError -> Bool)
-> (CryptoError -> CryptoError -> Bool) -> Eq CryptoError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CryptoError -> CryptoError -> Bool
== :: CryptoError -> CryptoError -> Bool
$c/= :: CryptoError -> CryptoError -> Bool
/= :: CryptoError -> CryptoError -> Bool
Eq, Int -> CryptoError -> ShowS
[CryptoError] -> ShowS
CryptoError -> String
(Int -> CryptoError -> ShowS)
-> (CryptoError -> String)
-> ([CryptoError] -> ShowS)
-> Show CryptoError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CryptoError -> ShowS
showsPrec :: Int -> CryptoError -> ShowS
$cshow :: CryptoError -> String
show :: CryptoError -> String
$cshowList :: [CryptoError] -> ShowS
showList :: [CryptoError] -> ShowS
Show, Show CryptoError
Typeable CryptoError
(Typeable CryptoError, Show CryptoError) =>
(CryptoError -> SomeException)
-> (SomeException -> Maybe CryptoError)
-> (CryptoError -> String)
-> Exception CryptoError
SomeException -> Maybe CryptoError
CryptoError -> String
CryptoError -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: CryptoError -> SomeException
toException :: CryptoError -> SomeException
$cfromException :: SomeException -> Maybe CryptoError
fromException :: SomeException -> Maybe CryptoError
$cdisplayException :: CryptoError -> String
displayException :: CryptoError -> String
Exception)

aesKeySize :: Int
aesKeySize :: Int
aesKeySize = Int
256 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8

authTagSize :: Int
authTagSize :: Int
authTagSize = Int
128 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8

x25519_size :: Int
x25519_size :: Int
x25519_size = Int
32

x448_size :: Int
x448_size :: Int
x448_size = Int
448 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
8

validSignatureSize :: Int -> Bool
validSignatureSize :: Int -> Bool
validSignatureSize Int
n =
  Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
Ed25519.signatureSize Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
Ed448.signatureSize
{-# INLINE validSignatureSize #-}

-- | AES key newtype.
newtype Key = Key {Key -> ByteString
unKey :: ByteString}
  deriving (Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
/= :: Key -> Key -> Bool
Eq, Eq Key
Eq Key =>
(Key -> Key -> Ordering)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Key)
-> (Key -> Key -> Key)
-> Ord Key
Key -> Key -> Bool
Key -> Key -> Ordering
Key -> Key -> Key
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
$ccompare :: Key -> Key -> Ordering
compare :: Key -> Key -> Ordering
$c< :: Key -> Key -> Bool
< :: Key -> Key -> Bool
$c<= :: Key -> Key -> Bool
<= :: Key -> Key -> Bool
$c> :: Key -> Key -> Bool
> :: Key -> Key -> Bool
$c>= :: Key -> Key -> Bool
>= :: Key -> Key -> Bool
$cmax :: Key -> Key -> Key
max :: Key -> Key -> Key
$cmin :: Key -> Key -> Key
min :: Key -> Key -> Key
Ord, Int -> Key -> ShowS
[Key] -> ShowS
Key -> String
(Int -> Key -> ShowS)
-> (Key -> String) -> ([Key] -> ShowS) -> Show Key
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Key -> ShowS
showsPrec :: Int -> Key -> ShowS
$cshow :: Key -> String
show :: Key -> String
$cshowList :: [Key] -> ShowS
showList :: [Key] -> ShowS
Show)
  deriving newtype (FieldParser Key
FieldParser Key -> FromField Key
forall a. FieldParser a -> FromField a
$cfromField :: FieldParser Key
fromField :: FieldParser Key
FromField)

instance ToField Key where toField :: Key -> SQLData
toField (Key ByteString
s) = Binary ByteString -> SQLData
forall a. ToField a => a -> SQLData
toField (Binary ByteString -> SQLData) -> Binary ByteString -> SQLData
forall a b. (a -> b) -> a -> b
$ ByteString -> Binary ByteString
forall a. a -> Binary a
Binary ByteString
s

instance ToJSON Key where
  toJSON :: Key -> Value
toJSON = ByteString -> Value
forall a. StrEncoding a => a -> Value
strToJSON (ByteString -> Value) -> (Key -> ByteString) -> Key -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> ByteString
unKey
  toEncoding :: Key -> Encoding
toEncoding = ByteString -> Encoding
forall a. StrEncoding a => a -> Encoding
strToJEncoding (ByteString -> Encoding) -> (Key -> ByteString) -> Key -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> ByteString
unKey

instance FromJSON Key where
  parseJSON :: Value -> Parser Key
parseJSON = (ByteString -> Key) -> Parser ByteString -> Parser Key
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Key
Key (Parser ByteString -> Parser Key)
-> (Value -> Parser ByteString) -> Value -> Parser Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Value -> Parser ByteString
forall a. StrEncoding a => String -> Value -> Parser a
strParseJSON String
"Key"

-- | IV bytes newtype.
newtype IV = IV {IV -> ByteString
unIV :: ByteString}
  deriving (IV -> IV -> Bool
(IV -> IV -> Bool) -> (IV -> IV -> Bool) -> Eq IV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IV -> IV -> Bool
== :: IV -> IV -> Bool
$c/= :: IV -> IV -> Bool
/= :: IV -> IV -> Bool
Eq, Int -> IV -> ShowS
[IV] -> ShowS
IV -> String
(Int -> IV -> ShowS)
-> (IV -> String) -> ([IV] -> ShowS) -> Show IV
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IV -> ShowS
showsPrec :: Int -> IV -> ShowS
$cshow :: IV -> String
show :: IV -> String
$cshowList :: [IV] -> ShowS
showList :: [IV] -> ShowS
Show)

instance Encoding IV where
  smpEncode :: IV -> ByteString
smpEncode = IV -> ByteString
unIV
  smpP :: Parser IV
smpP = ByteString -> IV
IV (ByteString -> IV) -> Parser ByteString ByteString -> Parser IV
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser ByteString ByteString
A.take (forall c. BlockCipher c => Int
ivSize @AES256)

instance ToJSON IV where
  toJSON :: IV -> Value
toJSON = ByteString -> Value
forall a. StrEncoding a => a -> Value
strToJSON (ByteString -> Value) -> (IV -> ByteString) -> IV -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IV -> ByteString
unIV
  toEncoding :: IV -> Encoding
toEncoding = ByteString -> Encoding
forall a. StrEncoding a => a -> Encoding
strToJEncoding (ByteString -> Encoding) -> (IV -> ByteString) -> IV -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IV -> ByteString
unIV

instance FromJSON IV where
  parseJSON :: Value -> Parser IV
parseJSON = (ByteString -> IV) -> Parser ByteString -> Parser IV
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> IV
IV (Parser ByteString -> Parser IV)
-> (Value -> Parser ByteString) -> Value -> Parser IV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Value -> Parser ByteString
forall a. StrEncoding a => String -> Value -> Parser a
strParseJSON String
"IV"

-- | GCMIV bytes newtype.
newtype GCMIV = GCMIV {GCMIV -> ByteString
unGCMIV :: ByteString}

gcmIV :: ByteString -> Either CryptoError GCMIV
gcmIV :: ByteString -> Either CryptoError GCMIV
gcmIV ByteString
s
  | ByteString -> Int
B.length ByteString
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
gcmIVSize = GCMIV -> Either CryptoError GCMIV
forall a b. b -> Either a b
Right (GCMIV -> Either CryptoError GCMIV)
-> GCMIV -> Either CryptoError GCMIV
forall a b. (a -> b) -> a -> b
$ ByteString -> GCMIV
GCMIV ByteString
s
  | Bool
otherwise = CryptoError -> Either CryptoError GCMIV
forall a b. a -> Either a b
Left CryptoError
CryptoIVError

newtype AuthTag = AuthTag {AuthTag -> AuthTag
unAuthTag :: AES.AuthTag}

instance Encoding AuthTag where
  smpEncode :: AuthTag -> ByteString
smpEncode = AuthTag -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (AuthTag -> ByteString)
-> (AuthTag -> AuthTag) -> AuthTag -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthTag -> AuthTag
unAuthTag
  smpP :: Parser AuthTag
smpP = AuthTag -> AuthTag
AuthTag (AuthTag -> AuthTag)
-> (ByteString -> AuthTag) -> ByteString -> AuthTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> AuthTag
AES.AuthTag (Bytes -> AuthTag)
-> (ByteString -> Bytes) -> ByteString -> AuthTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ByteString -> AuthTag)
-> Parser ByteString ByteString -> Parser AuthTag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser ByteString ByteString
A.take Int
authTagSize

-- | Certificate fingerpint newtype.
--
-- Previously was used for server's public key hash in ad-hoc transport scheme, kept as is for compatibility.
newtype KeyHash = KeyHash {KeyHash -> ByteString
unKeyHash :: ByteString} deriving (KeyHash -> KeyHash -> Bool
(KeyHash -> KeyHash -> Bool)
-> (KeyHash -> KeyHash -> Bool) -> Eq KeyHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KeyHash -> KeyHash -> Bool
== :: KeyHash -> KeyHash -> Bool
$c/= :: KeyHash -> KeyHash -> Bool
/= :: KeyHash -> KeyHash -> Bool
Eq, Eq KeyHash
Eq KeyHash =>
(KeyHash -> KeyHash -> Ordering)
-> (KeyHash -> KeyHash -> Bool)
-> (KeyHash -> KeyHash -> Bool)
-> (KeyHash -> KeyHash -> Bool)
-> (KeyHash -> KeyHash -> Bool)
-> (KeyHash -> KeyHash -> KeyHash)
-> (KeyHash -> KeyHash -> KeyHash)
-> Ord KeyHash
KeyHash -> KeyHash -> Bool
KeyHash -> KeyHash -> Ordering
KeyHash -> KeyHash -> KeyHash
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
$ccompare :: KeyHash -> KeyHash -> Ordering
compare :: KeyHash -> KeyHash -> Ordering
$c< :: KeyHash -> KeyHash -> Bool
< :: KeyHash -> KeyHash -> Bool
$c<= :: KeyHash -> KeyHash -> Bool
<= :: KeyHash -> KeyHash -> Bool
$c> :: KeyHash -> KeyHash -> Bool
> :: KeyHash -> KeyHash -> Bool
$c>= :: KeyHash -> KeyHash -> Bool
>= :: KeyHash -> KeyHash -> Bool
$cmax :: KeyHash -> KeyHash -> KeyHash
max :: KeyHash -> KeyHash -> KeyHash
$cmin :: KeyHash -> KeyHash -> KeyHash
min :: KeyHash -> KeyHash -> KeyHash
Ord, Int -> KeyHash -> ShowS
[KeyHash] -> ShowS
KeyHash -> String
(Int -> KeyHash -> ShowS)
-> (KeyHash -> String) -> ([KeyHash] -> ShowS) -> Show KeyHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KeyHash -> ShowS
showsPrec :: Int -> KeyHash -> ShowS
$cshow :: KeyHash -> String
show :: KeyHash -> String
$cshowList :: [KeyHash] -> ShowS
showList :: [KeyHash] -> ShowS
Show)

instance Encoding KeyHash where
  smpEncode :: KeyHash -> ByteString
smpEncode = ByteString -> ByteString
forall a. Encoding a => a -> ByteString
smpEncode (ByteString -> ByteString)
-> (KeyHash -> ByteString) -> KeyHash -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash -> ByteString
unKeyHash
  smpP :: Parser KeyHash
smpP = ByteString -> KeyHash
KeyHash (ByteString -> KeyHash)
-> Parser ByteString ByteString -> Parser KeyHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
forall a. Encoding a => Parser a
smpP

instance StrEncoding KeyHash where
  strEncode :: KeyHash -> ByteString
strEncode = ByteString -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode (ByteString -> ByteString)
-> (KeyHash -> ByteString) -> KeyHash -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash -> ByteString
unKeyHash
  strP :: Parser KeyHash
strP = ByteString -> KeyHash
KeyHash (ByteString -> KeyHash)
-> Parser ByteString ByteString -> Parser KeyHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
forall a. StrEncoding a => Parser a
strP

instance ToJSON KeyHash where
  toEncoding :: KeyHash -> Encoding
toEncoding = KeyHash -> Encoding
forall a. StrEncoding a => a -> Encoding
strToJEncoding
  toJSON :: KeyHash -> Value
toJSON = KeyHash -> Value
forall a. StrEncoding a => a -> Value
strToJSON

instance FromJSON KeyHash where
  parseJSON :: Value -> Parser KeyHash
parseJSON = String -> Value -> Parser KeyHash
forall a. StrEncoding a => String -> Value -> Parser a
strParseJSON String
"KeyHash"

instance IsString KeyHash where
  fromString :: String -> KeyHash
fromString = (ByteString -> Either String KeyHash) -> String -> KeyHash
forall a. (ByteString -> Either String a) -> String -> a
parseString ((ByteString -> Either String KeyHash) -> String -> KeyHash)
-> (ByteString -> Either String KeyHash) -> String -> KeyHash
forall a b. (a -> b) -> a -> b
$ Parser KeyHash -> ByteString -> Either String KeyHash
forall a. Parser a -> ByteString -> Either String a
parseAll Parser KeyHash
forall a. StrEncoding a => Parser a
strP

instance ToField KeyHash where toField :: KeyHash -> SQLData
toField = Binary ByteString -> SQLData
forall a. ToField a => a -> SQLData
toField (Binary ByteString -> SQLData)
-> (KeyHash -> Binary ByteString) -> KeyHash -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Binary ByteString
forall a. a -> Binary a
Binary (ByteString -> Binary ByteString)
-> (KeyHash -> ByteString) -> KeyHash -> Binary ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode

instance FromField KeyHash where fromField :: FieldParser KeyHash
fromField = (ByteString -> Either String KeyHash) -> FieldParser KeyHash
forall k.
Typeable k =>
(ByteString -> Either String k) -> FieldParser k
blobFieldDecoder ((ByteString -> Either String KeyHash) -> FieldParser KeyHash)
-> (ByteString -> Either String KeyHash) -> FieldParser KeyHash
forall a b. (a -> b) -> a -> b
$ Parser KeyHash -> ByteString -> Either String KeyHash
forall a. Parser a -> ByteString -> Either String a
parseAll Parser KeyHash
forall a. StrEncoding a => Parser a
strP

-- | SHA256 digest.
sha256Hash :: ByteString -> ByteString
sha256Hash :: ByteString -> ByteString
sha256Hash = Digest SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (Digest SHA256 -> ByteString)
-> (ByteString -> Digest SHA256) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Digest SHA256
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash :: ByteString -> Digest SHA256)
{-# INLINE sha256Hash #-}

-- | SHA512 digest.
sha512Hash :: ByteString -> ByteString
sha512Hash :: ByteString -> ByteString
sha512Hash = Digest SHA512 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (Digest SHA512 -> ByteString)
-> (ByteString -> Digest SHA512) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Digest SHA512
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash :: ByteString -> Digest SHA512)
{-# INLINE sha512Hash #-}

-- | SHA3-256 digest.
sha3_256 :: ByteString -> ByteString
sha3_256 :: ByteString -> ByteString
sha3_256 = Digest SHA3_256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (Digest SHA3_256 -> ByteString)
-> (ByteString -> Digest SHA3_256) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Digest SHA3_256
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash :: ByteString -> Digest SHA3_256)
{-# INLINE sha3_256 #-}

-- | SHA3-384 digest.
sha3_384 :: ByteString -> ByteString
sha3_384 :: ByteString -> ByteString
sha3_384 = Digest SHA3_384 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (Digest SHA3_384 -> ByteString)
-> (ByteString -> Digest SHA3_384) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Digest SHA3_384
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash :: ByteString -> Digest SHA3_384)
{-# INLINE sha3_384 #-}

-- | AEAD-GCM encryption with associated data.
--
-- Used as part of double ratchet encryption.
-- This function requires 16 bytes IV, it transforms IV in cryptonite_aes_gcm_init here:
-- https://github.com/haskell-crypto/cryptonite/blob/master/cbits/cryptonite_aes.c
encryptAEAD :: Key -> IV -> Int -> ByteString -> ByteString -> ExceptT CryptoError IO (AuthTag, ByteString)
encryptAEAD :: Key
-> IV
-> Int
-> ByteString
-> ByteString
-> ExceptT CryptoError IO (AuthTag, ByteString)
encryptAEAD Key
aesKey IV
ivBytes Int
paddedLen ByteString
ad ByteString
msg = do
  AEAD AES256
aead <- forall c.
BlockCipher c =>
Key -> IV -> ExceptT CryptoError IO (AEAD c)
initAEAD @AES256 Key
aesKey IV
ivBytes
  ByteString
msg' <- Either CryptoError ByteString -> ExceptT CryptoError IO ByteString
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either CryptoError ByteString
 -> ExceptT CryptoError IO ByteString)
-> Either CryptoError ByteString
-> ExceptT CryptoError IO ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> Either CryptoError ByteString
pad ByteString
msg Int
paddedLen
  (AuthTag, ByteString)
-> ExceptT CryptoError IO (AuthTag, ByteString)
forall a. a -> ExceptT CryptoError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((AuthTag, ByteString)
 -> ExceptT CryptoError IO (AuthTag, ByteString))
-> ((AuthTag, ByteString) -> (AuthTag, ByteString))
-> (AuthTag, ByteString)
-> ExceptT CryptoError IO (AuthTag, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AuthTag -> AuthTag)
-> (AuthTag, ByteString) -> (AuthTag, ByteString)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first AuthTag -> AuthTag
AuthTag ((AuthTag, ByteString)
 -> ExceptT CryptoError IO (AuthTag, ByteString))
-> (AuthTag, ByteString)
-> ExceptT CryptoError IO (AuthTag, ByteString)
forall a b. (a -> b) -> a -> b
$ AEAD AES256
-> ByteString -> ByteString -> Int -> (AuthTag, ByteString)
forall aad ba a.
(ByteArrayAccess aad, ByteArray ba) =>
AEAD a -> aad -> ba -> Int -> (AuthTag, ba)
AES.aeadSimpleEncrypt AEAD AES256
aead ByteString
ad ByteString
msg' Int
authTagSize

-- Used to encrypt WebRTC frames.
-- This function requires 12 bytes IV, it does not transform IV.
encryptAESNoPad :: Key -> GCMIV -> ByteString -> ExceptT CryptoError IO (AuthTag, ByteString)
encryptAESNoPad :: Key
-> GCMIV
-> ByteString
-> ExceptT CryptoError IO (AuthTag, ByteString)
encryptAESNoPad Key
key GCMIV
iv = Key
-> GCMIV
-> ByteString
-> ByteString
-> ExceptT CryptoError IO (AuthTag, ByteString)
encryptAEADNoPad Key
key GCMIV
iv ByteString
""
{-# INLINE encryptAESNoPad #-}

encryptAEADNoPad :: Key -> GCMIV -> ByteString -> ByteString -> ExceptT CryptoError IO (AuthTag, ByteString)
encryptAEADNoPad :: Key
-> GCMIV
-> ByteString
-> ByteString
-> ExceptT CryptoError IO (AuthTag, ByteString)
encryptAEADNoPad Key
aesKey GCMIV
ivBytes ByteString
ad ByteString
msg = do
  AEAD AES256
aead <- Key -> GCMIV -> ExceptT CryptoError IO (AEAD AES256)
initAEADGCM Key
aesKey GCMIV
ivBytes
  (AuthTag, ByteString)
-> ExceptT CryptoError IO (AuthTag, ByteString)
forall a. a -> ExceptT CryptoError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((AuthTag, ByteString)
 -> ExceptT CryptoError IO (AuthTag, ByteString))
-> ((AuthTag, ByteString) -> (AuthTag, ByteString))
-> (AuthTag, ByteString)
-> ExceptT CryptoError IO (AuthTag, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AuthTag -> AuthTag)
-> (AuthTag, ByteString) -> (AuthTag, ByteString)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first AuthTag -> AuthTag
AuthTag ((AuthTag, ByteString)
 -> ExceptT CryptoError IO (AuthTag, ByteString))
-> (AuthTag, ByteString)
-> ExceptT CryptoError IO (AuthTag, ByteString)
forall a b. (a -> b) -> a -> b
$ AEAD AES256
-> ByteString -> ByteString -> Int -> (AuthTag, ByteString)
forall aad ba a.
(ByteArrayAccess aad, ByteArray ba) =>
AEAD a -> aad -> ba -> Int -> (AuthTag, ba)
AES.aeadSimpleEncrypt AEAD AES256
aead ByteString
ad ByteString
msg Int
authTagSize

-- | AEAD-GCM decryption with associated data.
--
-- Used as part of double ratchet encryption.
-- This function requires 16 bytes IV, it transforms IV in cryptonite_aes_gcm_init here:
-- https://github.com/haskell-crypto/cryptonite/blob/master/cbits/cryptonite_aes.c
-- To make it compatible with WebCrypto we will need to start using initAEADGCM.
decryptAEAD :: Key -> IV -> ByteString -> ByteString -> AuthTag -> ExceptT CryptoError IO ByteString
decryptAEAD :: Key
-> IV
-> ByteString
-> ByteString
-> AuthTag
-> ExceptT CryptoError IO ByteString
decryptAEAD Key
aesKey IV
ivBytes ByteString
ad ByteString
msg (AuthTag AuthTag
authTag) = do
  AEAD AES256
aead <- forall c.
BlockCipher c =>
Key -> IV -> ExceptT CryptoError IO (AEAD c)
initAEAD @AES256 Key
aesKey IV
ivBytes
  Either CryptoError ByteString -> ExceptT CryptoError IO ByteString
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either CryptoError ByteString
 -> ExceptT CryptoError IO ByteString)
-> (ByteString -> Either CryptoError ByteString)
-> ByteString
-> ExceptT CryptoError IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either CryptoError ByteString
unPad (ByteString -> ExceptT CryptoError IO ByteString)
-> ExceptT CryptoError IO ByteString
-> ExceptT CryptoError IO ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CryptoError
-> Maybe ByteString -> ExceptT CryptoError IO ByteString
forall a. CryptoError -> Maybe a -> ExceptT CryptoError IO a
maybeError CryptoError
AESDecryptError (AEAD AES256
-> ByteString -> ByteString -> AuthTag -> Maybe ByteString
forall aad ba a.
(ByteArrayAccess aad, ByteArray ba) =>
AEAD a -> aad -> ba -> AuthTag -> Maybe ba
AES.aeadSimpleDecrypt AEAD AES256
aead ByteString
ad ByteString
msg AuthTag
authTag)

-- Used to decrypt WebRTC frames.
-- This function requires 12 bytes IV, it does not transform IV.
decryptAESNoPad :: Key -> GCMIV -> ByteString -> AuthTag -> ExceptT CryptoError IO ByteString
decryptAESNoPad :: Key
-> GCMIV
-> ByteString
-> AuthTag
-> ExceptT CryptoError IO ByteString
decryptAESNoPad Key
key GCMIV
iv = Key
-> GCMIV
-> ByteString
-> ByteString
-> AuthTag
-> ExceptT CryptoError IO ByteString
decryptAEADNoPad Key
key GCMIV
iv ByteString
""
{-# INLINE decryptAESNoPad #-}

decryptAEADNoPad :: Key -> GCMIV -> ByteString -> ByteString -> AuthTag -> ExceptT CryptoError IO ByteString
decryptAEADNoPad :: Key
-> GCMIV
-> ByteString
-> ByteString
-> AuthTag
-> ExceptT CryptoError IO ByteString
decryptAEADNoPad Key
aesKey GCMIV
iv ByteString
ad ByteString
msg (AuthTag AuthTag
tag) = do
  AEAD AES256
aead <- Key -> GCMIV -> ExceptT CryptoError IO (AEAD AES256)
initAEADGCM Key
aesKey GCMIV
iv
  CryptoError
-> Maybe ByteString -> ExceptT CryptoError IO ByteString
forall a. CryptoError -> Maybe a -> ExceptT CryptoError IO a
maybeError CryptoError
AESDecryptError (AEAD AES256
-> ByteString -> ByteString -> AuthTag -> Maybe ByteString
forall aad ba a.
(ByteArrayAccess aad, ByteArray ba) =>
AEAD a -> aad -> ba -> AuthTag -> Maybe ba
AES.aeadSimpleDecrypt AEAD AES256
aead ByteString
ad ByteString
msg AuthTag
tag)

maxMsgLen :: Int
maxMsgLen :: Int
maxMsgLen = Int
2 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
16 :: Int) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3

canPad :: Int -> Int -> Bool
canPad :: Int -> Int -> Bool
canPad Int
msgLen Int
paddedLen = Int
msgLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxMsgLen Bool -> Bool -> Bool
&& Int
padLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
  where
    padLen :: Int
padLen = Int
paddedLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
msgLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2

pad :: ByteString -> Int -> Either CryptoError ByteString
pad :: ByteString -> Int -> Either CryptoError ByteString
pad ByteString
msg Int
paddedLen
  | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxMsgLen Bool -> Bool -> Bool
&& Int
padLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = ByteString -> Either CryptoError ByteString
forall a b. b -> Either a b
Right (ByteString -> Either CryptoError ByteString)
-> ByteString -> Either CryptoError ByteString
forall a b. (a -> b) -> a -> b
$ Word16 -> ByteString
encodeWord16 (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
msg ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> ByteString
B.replicate Int
padLen Char
'#'
  | Bool
otherwise = CryptoError -> Either CryptoError ByteString
forall a b. a -> Either a b
Left CryptoError
CryptoLargeMsgError
  where
    len :: Int
len = ByteString -> Int
B.length ByteString
msg
    padLen :: Int
padLen = Int
paddedLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2

unPad :: ByteString -> Either CryptoError ByteString
unPad :: ByteString -> Either CryptoError ByteString
unPad ByteString
padded
  | ByteString -> Int
B.length ByteString
lenWrd Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 Bool -> Bool -> Bool
&& ByteString -> Int
B.length ByteString
rest Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = ByteString -> Either CryptoError ByteString
forall a b. b -> Either a b
Right (ByteString -> Either CryptoError ByteString)
-> ByteString -> Either CryptoError ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.take Int
len ByteString
rest
  | Bool
otherwise = CryptoError -> Either CryptoError ByteString
forall a b. a -> Either a b
Left CryptoError
CryptoInvalidMsgError
  where
    (ByteString
lenWrd, ByteString
rest) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
2 ByteString
padded
    len :: Int
len = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Word16 -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> Word16
decodeWord16 ByteString
lenWrd

newtype MaxLenBS (i :: Nat) = MLBS {forall (i :: Nat). MaxLenBS i -> ByteString
unMaxLenBS :: ByteString}

pattern MaxLenBS :: ByteString -> MaxLenBS i
pattern $mMaxLenBS :: forall {r} {i :: Nat}.
MaxLenBS i -> (ByteString -> r) -> ((# #) -> r) -> r
MaxLenBS s <- MLBS s

{-# COMPLETE MaxLenBS #-}

instance KnownNat i => Encoding (MaxLenBS i) where
  smpEncode :: MaxLenBS i -> ByteString
smpEncode (MLBS ByteString
s) = ByteString -> ByteString
forall a. Encoding a => a -> ByteString
smpEncode ByteString
s
  smpP :: Parser (MaxLenBS i)
smpP = (CryptoError -> String)
-> Either CryptoError (MaxLenBS i) -> Either String (MaxLenBS i)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first CryptoError -> String
forall a. Show a => a -> String
show (Either CryptoError (MaxLenBS i) -> Either String (MaxLenBS i))
-> (ByteString -> Either CryptoError (MaxLenBS i))
-> ByteString
-> Either String (MaxLenBS i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either CryptoError (MaxLenBS i)
forall (i :: Nat).
KnownNat i =>
ByteString -> Either CryptoError (MaxLenBS i)
maxLenBS (ByteString -> Either String (MaxLenBS i))
-> Parser ByteString ByteString -> Parser (MaxLenBS i)
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> Parser ByteString ByteString
forall a. Encoding a => Parser a
smpP

instance KnownNat i => StrEncoding (MaxLenBS i) where
  strEncode :: MaxLenBS i -> ByteString
strEncode (MLBS ByteString
s) = ByteString -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode ByteString
s
  strP :: Parser (MaxLenBS i)
strP = (CryptoError -> String)
-> Either CryptoError (MaxLenBS i) -> Either String (MaxLenBS i)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first CryptoError -> String
forall a. Show a => a -> String
show (Either CryptoError (MaxLenBS i) -> Either String (MaxLenBS i))
-> (ByteString -> Either CryptoError (MaxLenBS i))
-> ByteString
-> Either String (MaxLenBS i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either CryptoError (MaxLenBS i)
forall (i :: Nat).
KnownNat i =>
ByteString -> Either CryptoError (MaxLenBS i)
maxLenBS (ByteString -> Either String (MaxLenBS i))
-> Parser ByteString ByteString -> Parser (MaxLenBS i)
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> Parser ByteString ByteString
forall a. StrEncoding a => Parser a
strP

maxLenBS :: forall i. KnownNat i => ByteString -> Either CryptoError (MaxLenBS i)
maxLenBS :: forall (i :: Nat).
KnownNat i =>
ByteString -> Either CryptoError (MaxLenBS i)
maxLenBS ByteString
s
  | ByteString -> Int
B.length ByteString
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> forall (i :: Nat). KnownNat i => Int
maxLength @i = CryptoError -> Either CryptoError (MaxLenBS i)
forall a b. a -> Either a b
Left CryptoError
CryptoLargeMsgError
  | Bool
otherwise = MaxLenBS i -> Either CryptoError (MaxLenBS i)
forall a b. b -> Either a b
Right (MaxLenBS i -> Either CryptoError (MaxLenBS i))
-> MaxLenBS i -> Either CryptoError (MaxLenBS i)
forall a b. (a -> b) -> a -> b
$ ByteString -> MaxLenBS i
forall (i :: Nat). ByteString -> MaxLenBS i
MLBS ByteString
s

unsafeMaxLenBS :: forall i. KnownNat i => ByteString -> MaxLenBS i
unsafeMaxLenBS :: forall (i :: Nat). KnownNat i => ByteString -> MaxLenBS i
unsafeMaxLenBS = ByteString -> MaxLenBS i
forall (i :: Nat). ByteString -> MaxLenBS i
MLBS
{-# INLINE unsafeMaxLenBS #-}

padMaxLenBS :: forall i. KnownNat i => MaxLenBS i -> MaxLenBS (i + 2)
padMaxLenBS :: forall (i :: Nat). KnownNat i => MaxLenBS i -> MaxLenBS (i + 2)
padMaxLenBS (MLBS ByteString
msg) = ByteString -> MaxLenBS (i + 2)
forall (i :: Nat). ByteString -> MaxLenBS i
MLBS (ByteString -> MaxLenBS (i + 2)) -> ByteString -> MaxLenBS (i + 2)
forall a b. (a -> b) -> a -> b
$ Word16 -> ByteString
encodeWord16 (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
msg ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> ByteString
B.replicate Int
padLen Char
'#'
  where
    len :: Int
len = ByteString -> Int
B.length ByteString
msg
    padLen :: Int
padLen = forall (i :: Nat). KnownNat i => Int
maxLength @i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len

appendMaxLenBS :: (KnownNat i, KnownNat j) => MaxLenBS i -> MaxLenBS j -> MaxLenBS (i + j)
appendMaxLenBS :: forall (i :: Nat) (j :: Nat).
(KnownNat i, KnownNat j) =>
MaxLenBS i -> MaxLenBS j -> MaxLenBS (i + j)
appendMaxLenBS (MLBS ByteString
s1) (MLBS ByteString
s2) = ByteString -> MaxLenBS (i + j)
forall (i :: Nat). ByteString -> MaxLenBS i
MLBS (ByteString -> MaxLenBS (i + j)) -> ByteString -> MaxLenBS (i + j)
forall a b. (a -> b) -> a -> b
$ ByteString
s1 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
s2

maxLength :: forall i. KnownNat i => Int
maxLength :: forall (i :: Nat). KnownNat i => Int
maxLength = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy i -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy i -> Integer) -> Proxy i -> Integer
forall a b. (a -> b) -> a -> b
$ forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @i)
{-# INLINE maxLength #-}

-- this function requires 16 bytes IV, it transforms IV in cryptonite_aes_gcm_init here:
-- https://github.com/haskell-crypto/cryptonite/blob/master/cbits/cryptonite_aes.c
-- This is used for double ratchet encryption, so to make it compatible with WebCrypto we will need to deprecate it and start using initAEADGCM
initAEAD :: forall c. AES.BlockCipher c => Key -> IV -> ExceptT CryptoError IO (AES.AEAD c)
initAEAD :: forall c.
BlockCipher c =>
Key -> IV -> ExceptT CryptoError IO (AEAD c)
initAEAD (Key ByteString
aesKey) (IV ByteString
ivBytes) = do
  IV c
iv <- forall c.
BlockCipher c =>
ByteString -> ExceptT CryptoError IO (IV c)
makeIV @c ByteString
ivBytes
  CryptoFailable (AEAD c) -> ExceptT CryptoError IO (AEAD c)
forall a. CryptoFailable a -> ExceptT CryptoError IO a
cryptoFailable (CryptoFailable (AEAD c) -> ExceptT CryptoError IO (AEAD c))
-> CryptoFailable (AEAD c) -> ExceptT CryptoError IO (AEAD c)
forall a b. (a -> b) -> a -> b
$ do
    c
cipher <- ByteString -> CryptoFailable c
forall key. ByteArray key => key -> CryptoFailable c
forall cipher key.
(Cipher cipher, ByteArray key) =>
key -> CryptoFailable cipher
AES.cipherInit ByteString
aesKey
    AEADMode -> c -> IV c -> CryptoFailable (AEAD c)
forall iv.
ByteArrayAccess iv =>
AEADMode -> c -> iv -> CryptoFailable (AEAD c)
forall cipher iv.
(BlockCipher cipher, ByteArrayAccess iv) =>
AEADMode -> cipher -> iv -> CryptoFailable (AEAD cipher)
AES.aeadInit AEADMode
AES.AEAD_GCM c
cipher IV c
iv

-- this function requires 12 bytes IV, it does not transforms IV.
initAEADGCM :: Key -> GCMIV -> ExceptT CryptoError IO (AES.AEAD AES256)
initAEADGCM :: Key -> GCMIV -> ExceptT CryptoError IO (AEAD AES256)
initAEADGCM (Key ByteString
aesKey) (GCMIV ByteString
ivBytes) = CryptoFailable (AEAD AES256)
-> ExceptT CryptoError IO (AEAD AES256)
forall a. CryptoFailable a -> ExceptT CryptoError IO a
cryptoFailable (CryptoFailable (AEAD AES256)
 -> ExceptT CryptoError IO (AEAD AES256))
-> CryptoFailable (AEAD AES256)
-> ExceptT CryptoError IO (AEAD AES256)
forall a b. (a -> b) -> a -> b
$ do
  AES256
cipher <- ByteString -> CryptoFailable AES256
forall key. ByteArray key => key -> CryptoFailable AES256
forall cipher key.
(Cipher cipher, ByteArray key) =>
key -> CryptoFailable cipher
AES.cipherInit ByteString
aesKey
  AEADMode -> AES256 -> ByteString -> CryptoFailable (AEAD AES256)
forall iv.
ByteArrayAccess iv =>
AEADMode -> AES256 -> iv -> CryptoFailable (AEAD AES256)
forall cipher iv.
(BlockCipher cipher, ByteArrayAccess iv) =>
AEADMode -> cipher -> iv -> CryptoFailable (AEAD cipher)
AES.aeadInit AEADMode
AES.AEAD_GCM AES256
cipher ByteString
ivBytes

-- | Random AES256 key.
randomAesKey :: TVar ChaChaDRG -> STM Key
randomAesKey :: TVar ChaChaDRG -> STM Key
randomAesKey = (ByteString -> Key) -> STM ByteString -> STM Key
forall a b. (a -> b) -> STM a -> STM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Key
Key (STM ByteString -> STM Key)
-> (TVar ChaChaDRG -> STM ByteString) -> TVar ChaChaDRG -> STM Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TVar ChaChaDRG -> STM ByteString
randomBytes Int
aesKeySize
{-# INLINE randomAesKey #-}

randomGCMIV :: TVar ChaChaDRG -> STM GCMIV
randomGCMIV :: TVar ChaChaDRG -> STM GCMIV
randomGCMIV = (ByteString -> GCMIV) -> STM ByteString -> STM GCMIV
forall a b. (a -> b) -> STM a -> STM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> GCMIV
GCMIV (STM ByteString -> STM GCMIV)
-> (TVar ChaChaDRG -> STM ByteString)
-> TVar ChaChaDRG
-> STM GCMIV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TVar ChaChaDRG -> STM ByteString
randomBytes Int
gcmIVSize
{-# INLINE randomGCMIV #-}

ivSize :: forall c. AES.BlockCipher c => Int
ivSize :: forall c. BlockCipher c => Int
ivSize = c -> Int
forall cipher. BlockCipher cipher => cipher -> Int
AES.blockSize (c
forall a. HasCallStack => a
undefined :: c)
{-# INLINE ivSize #-}

gcmIVSize :: Int
gcmIVSize :: Int
gcmIVSize = Int
12

makeIV :: AES.BlockCipher c => ByteString -> ExceptT CryptoError IO (AES.IV c)
makeIV :: forall c.
BlockCipher c =>
ByteString -> ExceptT CryptoError IO (IV c)
makeIV ByteString
bs = CryptoError -> Maybe (IV c) -> ExceptT CryptoError IO (IV c)
forall a. CryptoError -> Maybe a -> ExceptT CryptoError IO a
maybeError CryptoError
CryptoIVError (Maybe (IV c) -> ExceptT CryptoError IO (IV c))
-> Maybe (IV c) -> ExceptT CryptoError IO (IV c)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe (IV c)
forall b c. (ByteArrayAccess b, BlockCipher c) => b -> Maybe (IV c)
AES.makeIV ByteString
bs

maybeError :: CryptoError -> Maybe a -> ExceptT CryptoError IO a
maybeError :: forall a. CryptoError -> Maybe a -> ExceptT CryptoError IO a
maybeError CryptoError
e = ExceptT CryptoError IO a
-> (a -> ExceptT CryptoError IO a)
-> Maybe a
-> ExceptT CryptoError IO a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (CryptoError -> ExceptT CryptoError IO a
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE CryptoError
e) a -> ExceptT CryptoError IO a
forall a. a -> ExceptT CryptoError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
{-# INLINE maybeError #-}

cryptoFailable :: CE.CryptoFailable a -> ExceptT CryptoError IO a
cryptoFailable :: forall a. CryptoFailable a -> ExceptT CryptoError IO a
cryptoFailable = Either CryptoError a -> ExceptT CryptoError IO a
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either CryptoError a -> ExceptT CryptoError IO a)
-> (CryptoFailable a -> Either CryptoError a)
-> CryptoFailable a
-> ExceptT CryptoError IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CryptoError -> CryptoError)
-> Either CryptoError a -> Either CryptoError a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first CryptoError -> CryptoError
AESCipherError (Either CryptoError a -> Either CryptoError a)
-> (CryptoFailable a -> Either CryptoError a)
-> CryptoFailable a
-> Either CryptoError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoFailable a -> Either CryptoError a
forall a. CryptoFailable a -> Either CryptoError a
CE.eitherCryptoError

-- | Message signing.
--
-- Used by SMP clients to sign SMP commands and by SMP agents to sign messages.
sign' :: SignatureAlgorithm a => PrivateKey a -> ByteString -> Signature a
sign' :: forall (a :: Algorithm).
SignatureAlgorithm a =>
PrivateKey a -> ByteString -> Signature a
sign' (PrivateKeyEd25519 SecretKey
pk) ByteString
msg = Signature -> Signature 'Ed25519
SignatureEd25519 (Signature -> Signature 'Ed25519)
-> Signature -> Signature 'Ed25519
forall a b. (a -> b) -> a -> b
$ SecretKey -> PublicKey -> ByteString -> Signature
forall ba.
ByteArrayAccess ba =>
SecretKey -> PublicKey -> ba -> Signature
Ed25519.sign SecretKey
pk (SecretKey -> PublicKey
Ed25519.toPublic SecretKey
pk) ByteString
msg
sign' (PrivateKeyEd448 SecretKey
pk) ByteString
msg = Signature -> Signature 'Ed448
SignatureEd448 (Signature -> Signature 'Ed448) -> Signature -> Signature 'Ed448
forall a b. (a -> b) -> a -> b
$ SecretKey -> PublicKey -> ByteString -> Signature
forall ba.
ByteArrayAccess ba =>
SecretKey -> PublicKey -> ba -> Signature
Ed448.sign SecretKey
pk (SecretKey -> PublicKey
Ed448.toPublic SecretKey
pk) ByteString
msg
{-# INLINE sign' #-}

sign :: APrivateSignKey -> ByteString -> ASignature
sign :: APrivateSignKey -> ByteString -> ASignature
sign (APrivateSignKey SAlgorithm a
a PrivateKey a
k) = SAlgorithm a -> Signature a -> ASignature
forall (a :: Algorithm).
(AlgorithmI a, SignatureAlgorithm a) =>
SAlgorithm a -> Signature a -> ASignature
ASignature SAlgorithm a
a (Signature a -> ASignature)
-> (ByteString -> Signature a) -> ByteString -> ASignature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivateKey a -> ByteString -> Signature a
forall (a :: Algorithm).
SignatureAlgorithm a =>
PrivateKey a -> ByteString -> Signature a
sign' PrivateKey a
k
{-# INLINE sign #-}

signCertificate :: APrivateSignKey -> X.Certificate -> X.SignedCertificate
signCertificate :: APrivateSignKey -> Certificate -> SignedCertificate
signCertificate = APrivateSignKey -> Certificate -> SignedCertificate
forall o.
(ASN1Object o, Eq o, Show o) =>
APrivateSignKey -> o -> SignedExact o
signX509
{-# INLINE signCertificate #-}

signX509 :: (ASN1Object o, Eq o, Show o) => APrivateSignKey -> o -> X.SignedExact o
signX509 :: forall o.
(ASN1Object o, Eq o, Show o) =>
APrivateSignKey -> o -> SignedExact o
signX509 APrivateSignKey
key = (SignedExact o, ()) -> SignedExact o
forall a b. (a, b) -> a
fst ((SignedExact o, ()) -> SignedExact o)
-> (o -> (SignedExact o, ())) -> o -> SignedExact o
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> (ByteString, SignatureALG, ()))
-> o -> (SignedExact o, ())
forall a r.
(Show a, Eq a, ASN1Object a) =>
(ByteString -> (ByteString, SignatureALG, r))
-> a -> (SignedExact a, r)
X.objectToSignedExact ByteString -> (ByteString, SignatureALG, ())
f
  where
    f :: ByteString -> (ByteString, SignatureALG, ())
f ByteString
bytes =
      ( ASignature -> ByteString
forall s. CryptoSignature s => s -> ByteString
signatureBytes (ASignature -> ByteString) -> ASignature -> ByteString
forall a b. (a -> b) -> a -> b
$ APrivateSignKey -> ByteString -> ASignature
sign APrivateSignKey
key ByteString
bytes,
        APrivateSignKey -> SignatureALG
forall a. SignatureAlgorithmX509 a => a -> SignatureALG
signatureAlgorithmX509 APrivateSignKey
key,
        ()
      )
{-# INLINE signX509 #-}

verifyX509 :: (ASN1Object o, Eq o, Show o) => APublicVerifyKey -> X.SignedExact o -> Either String o
verifyX509 :: forall o.
(ASN1Object o, Eq o, Show o) =>
APublicVerifyKey -> SignedExact o -> Either String o
verifyX509 APublicVerifyKey
key SignedExact o
exact = do
  ASignature
signature <- case SignatureALG
signedAlg of
    X.SignatureALG_IntrinsicHash PubKeyALG
X.PubKeyALG_Ed25519 -> SAlgorithm 'Ed25519 -> Signature 'Ed25519 -> ASignature
forall (a :: Algorithm).
(AlgorithmI a, SignatureAlgorithm a) =>
SAlgorithm a -> Signature a -> ASignature
ASignature SAlgorithm 'Ed25519
SEd25519 (Signature 'Ed25519 -> ASignature)
-> Either String (Signature 'Ed25519) -> Either String ASignature
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either String (Signature 'Ed25519)
forall s. CryptoSignature s => ByteString -> Either String s
decodeSignature ByteString
signedSignature
    X.SignatureALG_IntrinsicHash PubKeyALG
X.PubKeyALG_Ed448 -> SAlgorithm 'Ed448 -> Signature 'Ed448 -> ASignature
forall (a :: Algorithm).
(AlgorithmI a, SignatureAlgorithm a) =>
SAlgorithm a -> Signature a -> ASignature
ASignature SAlgorithm 'Ed448
SEd448 (Signature 'Ed448 -> ASignature)
-> Either String (Signature 'Ed448) -> Either String ASignature
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either String (Signature 'Ed448)
forall s. CryptoSignature s => ByteString -> Either String s
decodeSignature ByteString
signedSignature
    SignatureALG
_ -> String -> Either String ASignature
forall a b. a -> Either a b
Left String
"unknown x509 signature algorithm"
  if APublicVerifyKey -> ASignature -> ByteString -> Bool
verify APublicVerifyKey
key ASignature
signature (ByteString -> Bool) -> ByteString -> Bool
forall a b. (a -> b) -> a -> b
$ SignedExact o -> ByteString
forall a.
(Show a, Eq a, ASN1Object a) =>
SignedExact a -> ByteString
X.getSignedData SignedExact o
exact then o -> Either String o
forall a b. b -> Either a b
Right o
signedObject else String -> Either String o
forall a b. a -> Either a b
Left String
"bad signature"
  where
    X.Signed {o
signedObject :: o
signedObject :: forall a. (Show a, Eq a, ASN1Object a) => Signed a -> a
signedObject, SignatureALG
signedAlg :: SignatureALG
signedAlg :: forall a. (Show a, Eq a, ASN1Object a) => Signed a -> SignatureALG
signedAlg, ByteString
signedSignature :: ByteString
signedSignature :: forall a. (Show a, Eq a, ASN1Object a) => Signed a -> ByteString
signedSignature} = SignedExact o -> Signed o
forall a. (Show a, Eq a, ASN1Object a) => SignedExact a -> Signed a
X.getSigned SignedExact o
exact
{-# INLINE verifyX509 #-}

certificateFingerprint :: X.SignedCertificate -> KeyHash
certificateFingerprint :: SignedCertificate -> KeyHash
certificateFingerprint = SignedCertificate -> KeyHash
forall o. (ASN1Object o, Eq o, Show o) => SignedExact o -> KeyHash
signedFingerprint
{-# INLINE certificateFingerprint #-}

signedFingerprint :: (ASN1Object o, Eq o, Show o) => X.SignedExact o -> KeyHash
signedFingerprint :: forall o. (ASN1Object o, Eq o, Show o) => SignedExact o -> KeyHash
signedFingerprint SignedExact o
o = ByteString -> KeyHash
KeyHash ByteString
fp
  where
    Fingerprint ByteString
fp = SignedExact o -> HashALG -> Fingerprint
forall a.
(Show a, Eq a, ASN1Object a) =>
SignedExact a -> HashALG -> Fingerprint
getFingerprint SignedExact o
o HashALG
X.HashSHA256

class SignatureAlgorithmX509 a where
  signatureAlgorithmX509 :: a -> X.SignatureALG

instance SignatureAlgorithm a => SignatureAlgorithmX509 (SAlgorithm a) where
  signatureAlgorithmX509 :: SAlgorithm a -> SignatureALG
signatureAlgorithmX509 = \case
    SAlgorithm a
SEd25519 -> PubKeyALG -> SignatureALG
X.SignatureALG_IntrinsicHash PubKeyALG
X.PubKeyALG_Ed25519
    SAlgorithm a
SEd448 -> PubKeyALG -> SignatureALG
X.SignatureALG_IntrinsicHash PubKeyALG
X.PubKeyALG_Ed448
  {-# INLINE signatureAlgorithmX509 #-}

instance SignatureAlgorithmX509 APrivateSignKey where
  signatureAlgorithmX509 :: APrivateSignKey -> SignatureALG
signatureAlgorithmX509 (APrivateSignKey SAlgorithm a
a PrivateKey a
_) = SAlgorithm a -> SignatureALG
forall a. SignatureAlgorithmX509 a => a -> SignatureALG
signatureAlgorithmX509 SAlgorithm a
a
  {-# INLINE signatureAlgorithmX509 #-}

instance SignatureAlgorithmX509 APublicVerifyKey where
  signatureAlgorithmX509 :: APublicVerifyKey -> SignatureALG
signatureAlgorithmX509 (APublicVerifyKey SAlgorithm a
a PublicKey a
_) = SAlgorithm a -> SignatureALG
forall a. SignatureAlgorithmX509 a => a -> SignatureALG
signatureAlgorithmX509 SAlgorithm a
a
  {-# INLINE signatureAlgorithmX509 #-}

-- | An instance for 'ASignatureKeyPair' / ('PublicKeyType' pk, pk), without touching its type family.
instance SignatureAlgorithmX509 pk => SignatureAlgorithmX509 (a, pk) where
  signatureAlgorithmX509 :: (a, pk) -> SignatureALG
signatureAlgorithmX509 = pk -> SignatureALG
forall a. SignatureAlgorithmX509 a => a -> SignatureALG
signatureAlgorithmX509 (pk -> SignatureALG) -> ((a, pk) -> pk) -> (a, pk) -> SignatureALG
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, pk) -> pk
forall a b. (a, b) -> b
snd
  {-# INLINE signatureAlgorithmX509 #-}

-- | A wrapper to marshall signed ASN1 objects, like certificates.
newtype SignedObject a = SignedObject {forall a. SignedObject a -> SignedExact a
getSignedExact :: X.SignedExact a}

instance (Typeable a, Eq a, Show a, ASN1Object a) => FromField (SignedObject a) where
#if defined(dbPostgres)
  fromField f dat = SignedObject <$> blobFieldDecoder X.decodeSignedObject f dat
#else
  fromField :: FieldParser (SignedObject a)
fromField = (SignedExact a -> SignedObject a)
-> Ok (SignedExact a) -> Ok (SignedObject a)
forall a b. (a -> b) -> Ok a -> Ok b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SignedExact a -> SignedObject a
forall a. SignedExact a -> SignedObject a
SignedObject (Ok (SignedExact a) -> Ok (SignedObject a))
-> (Field -> Ok (SignedExact a)) -> FieldParser (SignedObject a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Either String (SignedExact a))
-> Field -> Ok (SignedExact a)
forall k.
Typeable k =>
(ByteString -> Either String k) -> FieldParser k
blobFieldDecoder ByteString -> Either String (SignedExact a)
forall a.
(Show a, Eq a, ASN1Object a) =>
ByteString -> Either String (SignedExact a)
X.decodeSignedObject
#endif

instance (Eq a, Show a, ASN1Object a) => ToField (SignedObject a) where
  toField :: SignedObject a -> SQLData
toField (SignedObject SignedExact a
s) = Binary ByteString -> SQLData
forall a. ToField a => a -> SQLData
toField (Binary ByteString -> SQLData)
-> (ByteString -> Binary ByteString) -> ByteString -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Binary ByteString
forall a. a -> Binary a
Binary (ByteString -> SQLData) -> ByteString -> SQLData
forall a b. (a -> b) -> a -> b
$ SignedExact a -> ByteString
forall a.
(Show a, Eq a, ASN1Object a) =>
SignedExact a -> ByteString
X.encodeSignedObject SignedExact a
s

instance (Eq a, Show a, ASN1Object a) => Encoding (SignedObject a) where
  smpEncode :: SignedObject a -> ByteString
smpEncode (SignedObject SignedExact a
exact) = Large -> ByteString
forall a. Encoding a => a -> ByteString
smpEncode (Large -> ByteString)
-> (ByteString -> Large) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Large
Large (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ SignedExact a -> ByteString
forall a.
(Show a, Eq a, ASN1Object a) =>
SignedExact a -> ByteString
X.encodeSignedObject SignedExact a
exact
  smpP :: Parser (SignedObject a)
smpP = (SignedExact a -> SignedObject a)
-> Either String (SignedExact a) -> Either String (SignedObject a)
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SignedExact a -> SignedObject a
forall a. SignedExact a -> SignedObject a
SignedObject (Either String (SignedExact a) -> Either String (SignedObject a))
-> (Large -> Either String (SignedExact a))
-> Large
-> Either String (SignedObject a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String (SignedExact a)
forall a.
(Show a, Eq a, ASN1Object a) =>
ByteString -> Either String (SignedExact a)
X.decodeSignedObject (ByteString -> Either String (SignedExact a))
-> (Large -> ByteString) -> Large -> Either String (SignedExact a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Large -> ByteString
unLarge (Large -> Either String (SignedObject a))
-> Parser ByteString Large -> Parser (SignedObject a)
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> Parser ByteString Large
forall a. Encoding a => Parser a
smpP

encodeCertChain :: X.CertificateChain -> L.NonEmpty Large
encodeCertChain :: CertificateChain -> NonEmpty Large
encodeCertChain CertificateChain
cc = [Large] -> NonEmpty Large
forall a. HasCallStack => [a] -> NonEmpty a
L.fromList ([Large] -> NonEmpty Large) -> [Large] -> NonEmpty Large
forall a b. (a -> b) -> a -> b
$ (ByteString -> Large) -> [ByteString] -> [Large]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Large
Large [ByteString]
blobs
  where
    X.CertificateChainRaw [ByteString]
blobs = CertificateChain -> CertificateChainRaw
X.encodeCertificateChain CertificateChain
cc

certChainP :: A.Parser X.CertificateChain
certChainP :: Parser CertificateChain
certChainP = do
  CertificateChainRaw
rawChain <- [ByteString] -> CertificateChainRaw
X.CertificateChainRaw ([ByteString] -> CertificateChainRaw)
-> (NonEmpty Large -> [ByteString])
-> NonEmpty Large
-> CertificateChainRaw
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Large -> ByteString) -> [Large] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Large -> ByteString
unLarge ([Large] -> [ByteString])
-> (NonEmpty Large -> [Large]) -> NonEmpty Large -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Large -> [Large]
forall a. NonEmpty a -> [a]
L.toList (NonEmpty Large -> CertificateChainRaw)
-> Parser ByteString (NonEmpty Large)
-> Parser ByteString CertificateChainRaw
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString (NonEmpty Large)
forall a. Encoding a => Parser a
smpP
  ((Int, String) -> Parser CertificateChain)
-> (CertificateChain -> Parser CertificateChain)
-> Either (Int, String) CertificateChain
-> Parser CertificateChain
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser CertificateChain
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser CertificateChain)
-> ((Int, String) -> String)
-> (Int, String)
-> Parser CertificateChain
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, String) -> String
forall a. Show a => a -> String
show) CertificateChain -> Parser CertificateChain
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Int, String) CertificateChain -> Parser CertificateChain)
-> Either (Int, String) CertificateChain -> Parser CertificateChain
forall a b. (a -> b) -> a -> b
$ CertificateChainRaw -> Either (Int, String) CertificateChain
X.decodeCertificateChain CertificateChainRaw
rawChain

-- | Signature verification.
--
-- Used by SMP servers to authorize SMP commands and by SMP agents to verify messages.
verify' :: SignatureAlgorithm a => PublicKey a -> Signature a -> ByteString -> Bool
verify' :: forall (a :: Algorithm).
SignatureAlgorithm a =>
PublicKey a -> Signature a -> ByteString -> Bool
verify' (PublicKeyEd25519 PublicKey
k) (SignatureEd25519 Signature
sig) ByteString
msg = PublicKey -> ByteString -> Signature -> Bool
forall ba.
ByteArrayAccess ba =>
PublicKey -> ba -> Signature -> Bool
Ed25519.verify PublicKey
k ByteString
msg Signature
sig
verify' (PublicKeyEd448 PublicKey
k) (SignatureEd448 Signature
sig) ByteString
msg = PublicKey -> ByteString -> Signature -> Bool
forall ba.
ByteArrayAccess ba =>
PublicKey -> ba -> Signature -> Bool
Ed448.verify PublicKey
k ByteString
msg Signature
sig
{-# INLINE verify' #-}

verify :: APublicVerifyKey -> ASignature -> ByteString -> Bool
verify :: APublicVerifyKey -> ASignature -> ByteString -> Bool
verify (APublicVerifyKey SAlgorithm a
a PublicKey a
k) (ASignature SAlgorithm a
a' Signature a
sig) ByteString
msg = case SAlgorithm a -> SAlgorithm a -> Maybe (a :~: a)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: Algorithm) (b :: Algorithm).
SAlgorithm a -> SAlgorithm b -> Maybe (a :~: b)
testEquality SAlgorithm a
a SAlgorithm a
a' of
  Just a :~: a
Refl -> PublicKey a -> Signature a -> ByteString -> Bool
forall (a :: Algorithm).
SignatureAlgorithm a =>
PublicKey a -> Signature a -> ByteString -> Bool
verify' PublicKey a
k Signature a
Signature a
sig ByteString
msg
  Maybe (a :~: a)
_ -> Bool
False

dh' :: DhAlgorithm a => PublicKey a -> PrivateKey a -> DhSecret a
dh' :: forall (a :: Algorithm).
DhAlgorithm a =>
PublicKey a -> PrivateKey a -> DhSecret a
dh' (PublicKeyX25519 PublicKey
k) (PrivateKeyX25519 SecretKey
pk) = DhSecret -> DhSecret 'X25519
DhSecretX25519 (DhSecret -> DhSecret 'X25519) -> DhSecret -> DhSecret 'X25519
forall a b. (a -> b) -> a -> b
$ PublicKey -> SecretKey -> DhSecret
X25519.dh PublicKey
k SecretKey
pk
dh' (PublicKeyX448 PublicKey
k) (PrivateKeyX448 SecretKey
pk) = DhSecret -> DhSecret 'X448
DhSecretX448 (DhSecret -> DhSecret 'X448) -> DhSecret -> DhSecret 'X448
forall a b. (a -> b) -> a -> b
$ PublicKey -> SecretKey -> DhSecret
X448.dh PublicKey
k SecretKey
pk
{-# INLINE dh' #-}

-- | NaCl @crypto_box@ encrypt with padding with a shared DH secret and 192-bit nonce.
cbEncrypt :: DhSecret X25519 -> CbNonce -> ByteString -> Int -> Either CryptoError ByteString
cbEncrypt :: DhSecret 'X25519
-> CbNonce -> ByteString -> Int -> Either CryptoError ByteString
cbEncrypt (DhSecretX25519 DhSecret
secret) = DhSecret
-> CbNonce -> ByteString -> Int -> Either CryptoError ByteString
forall key.
ByteArrayAccess key =>
key
-> CbNonce -> ByteString -> Int -> Either CryptoError ByteString
sbEncrypt_ DhSecret
secret
{-# INLINE cbEncrypt #-}

-- | NaCl @crypto_box@ encrypt with a shared DH secret and 192-bit nonce (without padding).
cbEncryptNoPad :: DhSecret X25519 -> CbNonce -> ByteString -> ByteString
cbEncryptNoPad :: DhSecret 'X25519 -> CbNonce -> ByteString -> ByteString
cbEncryptNoPad (DhSecretX25519 DhSecret
secret) (CbNonce ByteString
nonce) = DhSecret -> ByteString -> ByteString -> ByteString
forall key.
ByteArrayAccess key =>
key -> ByteString -> ByteString -> ByteString
cryptoBox DhSecret
secret ByteString
nonce
{-# INLINE cbEncryptNoPad #-}

-- | NaCl @secret_box@ encrypt with a symmetric 256-bit key and 192-bit nonce.
sbEncrypt :: SbKey -> CbNonce -> ByteString -> Int -> Either CryptoError ByteString
sbEncrypt :: SbKey
-> CbNonce -> ByteString -> Int -> Either CryptoError ByteString
sbEncrypt (SbKey ByteString
key) = ByteString
-> CbNonce -> ByteString -> Int -> Either CryptoError ByteString
forall key.
ByteArrayAccess key =>
key
-> CbNonce -> ByteString -> Int -> Either CryptoError ByteString
sbEncrypt_ ByteString
key
{-# INLINE sbEncrypt #-}

sbEncrypt_ :: ByteArrayAccess key => key -> CbNonce -> ByteString -> Int -> Either CryptoError ByteString
sbEncrypt_ :: forall key.
ByteArrayAccess key =>
key
-> CbNonce -> ByteString -> Int -> Either CryptoError ByteString
sbEncrypt_ key
secret (CbNonce ByteString
nonce) ByteString
msg Int
paddedLen = key -> ByteString -> ByteString -> ByteString
forall key.
ByteArrayAccess key =>
key -> ByteString -> ByteString -> ByteString
cryptoBox key
secret ByteString
nonce (ByteString -> ByteString)
-> Either CryptoError ByteString -> Either CryptoError ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Int -> Either CryptoError ByteString
pad ByteString
msg Int
paddedLen
{-# INLINE sbEncrypt_ #-}

sbEncryptNoPad :: SbKey -> CbNonce -> ByteString -> ByteString
sbEncryptNoPad :: SbKey -> CbNonce -> ByteString -> ByteString
sbEncryptNoPad (SbKey ByteString
key) (CbNonce ByteString
nonce) = ByteString -> ByteString -> ByteString -> ByteString
forall key.
ByteArrayAccess key =>
key -> ByteString -> ByteString -> ByteString
cryptoBox ByteString
key ByteString
nonce
{-# INLINE sbEncryptNoPad #-}

-- | NaCl @crypto_box@ encrypt with a shared DH secret and 192-bit nonce.
cbEncryptMaxLenBS :: KnownNat i => DhSecret X25519 -> CbNonce -> MaxLenBS i -> ByteString
cbEncryptMaxLenBS :: forall (i :: Nat).
KnownNat i =>
DhSecret 'X25519 -> CbNonce -> MaxLenBS i -> ByteString
cbEncryptMaxLenBS (DhSecretX25519 DhSecret
secret) (CbNonce ByteString
nonce) = DhSecret -> ByteString -> ByteString -> ByteString
forall key.
ByteArrayAccess key =>
key -> ByteString -> ByteString -> ByteString
cryptoBox DhSecret
secret ByteString
nonce (ByteString -> ByteString)
-> (MaxLenBS i -> ByteString) -> MaxLenBS i -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaxLenBS (i + 2) -> ByteString
forall (i :: Nat). MaxLenBS i -> ByteString
unMaxLenBS (MaxLenBS (i + 2) -> ByteString)
-> (MaxLenBS i -> MaxLenBS (i + 2)) -> MaxLenBS i -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaxLenBS i -> MaxLenBS (i + 2)
forall (i :: Nat). KnownNat i => MaxLenBS i -> MaxLenBS (i + 2)
padMaxLenBS
{-# INLINE cbEncryptMaxLenBS #-}

cryptoBox :: ByteArrayAccess key => key -> ByteString -> ByteString -> ByteString
cryptoBox :: forall key.
ByteArrayAccess key =>
key -> ByteString -> ByteString -> ByteString
cryptoBox key
secret ByteString
nonce ByteString
s = Auth -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert Auth
tag ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
c
  where
    (ByteString
rs, ByteString
c) = key -> ByteString -> ByteString -> (ByteString, ByteString)
forall key.
ByteArrayAccess key =>
key -> ByteString -> ByteString -> (ByteString, ByteString)
xSalsa20 key
secret ByteString
nonce ByteString
s
    tag :: Auth
tag = ByteString -> ByteString -> Auth
forall key ba.
(ByteArrayAccess key, ByteArrayAccess ba) =>
key -> ba -> Auth
Poly1305.auth ByteString
rs ByteString
c

-- | NaCl @crypto_box@ decrypt with a shared DH secret and 192-bit nonce.
cbDecrypt :: DhSecret X25519 -> CbNonce -> ByteString -> Either CryptoError ByteString
cbDecrypt :: DhSecret 'X25519
-> CbNonce -> ByteString -> Either CryptoError ByteString
cbDecrypt (DhSecretX25519 DhSecret
secret) = DhSecret -> CbNonce -> ByteString -> Either CryptoError ByteString
forall key.
ByteArrayAccess key =>
key -> CbNonce -> ByteString -> Either CryptoError ByteString
sbDecrypt_ DhSecret
secret
{-# INLINE cbDecrypt #-}

-- | NaCl @crypto_box@ decrypt with a shared DH secret and 192-bit nonce (without unpadding).
cbDecryptNoPad :: DhSecret X25519 -> CbNonce -> ByteString -> Either CryptoError ByteString
cbDecryptNoPad :: DhSecret 'X25519
-> CbNonce -> ByteString -> Either CryptoError ByteString
cbDecryptNoPad (DhSecretX25519 DhSecret
secret) = DhSecret -> CbNonce -> ByteString -> Either CryptoError ByteString
forall key.
ByteArrayAccess key =>
key -> CbNonce -> ByteString -> Either CryptoError ByteString
sbDecryptNoPad_ DhSecret
secret
{-# INLINE cbDecryptNoPad #-}

-- | NaCl @secret_box@ decrypt with a symmetric 256-bit key and 192-bit nonce.
sbDecrypt :: SbKey -> CbNonce -> ByteString -> Either CryptoError ByteString
sbDecrypt :: SbKey -> CbNonce -> ByteString -> Either CryptoError ByteString
sbDecrypt (SbKey ByteString
key) = ByteString
-> CbNonce -> ByteString -> Either CryptoError ByteString
forall key.
ByteArrayAccess key =>
key -> CbNonce -> ByteString -> Either CryptoError ByteString
sbDecrypt_ ByteString
key
{-# INLINE sbDecrypt #-}

-- | NaCl @crypto_box@ decrypt with a shared DH secret and 192-bit nonce.
sbDecrypt_ :: ByteArrayAccess key => key -> CbNonce -> ByteString -> Either CryptoError ByteString
sbDecrypt_ :: forall key.
ByteArrayAccess key =>
key -> CbNonce -> ByteString -> Either CryptoError ByteString
sbDecrypt_ key
secret CbNonce
nonce = ByteString -> Either CryptoError ByteString
unPad (ByteString -> Either CryptoError ByteString)
-> (ByteString -> Either CryptoError ByteString)
-> ByteString
-> Either CryptoError ByteString
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< key -> CbNonce -> ByteString -> Either CryptoError ByteString
forall key.
ByteArrayAccess key =>
key -> CbNonce -> ByteString -> Either CryptoError ByteString
sbDecryptNoPad_ key
secret CbNonce
nonce
{-# INLINE sbDecrypt_ #-}

sbDecryptNoPad :: SbKey -> CbNonce -> ByteString -> Either CryptoError ByteString
sbDecryptNoPad :: SbKey -> CbNonce -> ByteString -> Either CryptoError ByteString
sbDecryptNoPad (SbKey ByteString
key) = ByteString
-> CbNonce -> ByteString -> Either CryptoError ByteString
forall key.
ByteArrayAccess key =>
key -> CbNonce -> ByteString -> Either CryptoError ByteString
sbDecryptNoPad_ ByteString
key
{-# INLINE sbDecryptNoPad #-}

-- | NaCl @crypto_box@ decrypt with a shared DH secret and 192-bit nonce (without unpadding).
sbDecryptNoPad_ :: ByteArrayAccess key => key -> CbNonce -> ByteString -> Either CryptoError ByteString
sbDecryptNoPad_ :: forall key.
ByteArrayAccess key =>
key -> CbNonce -> ByteString -> Either CryptoError ByteString
sbDecryptNoPad_ key
secret (CbNonce ByteString
nonce) ByteString
packet
  | ByteString -> Int
B.length ByteString
packet Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
16 = CryptoError -> Either CryptoError ByteString
forall a b. a -> Either a b
Left CryptoError
CBDecryptError
  | ByteString -> Auth -> Bool
forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
BA.constEq ByteString
tag' Auth
tag = ByteString -> Either CryptoError ByteString
forall a b. b -> Either a b
Right ByteString
msg
  | Bool
otherwise = CryptoError -> Either CryptoError ByteString
forall a b. a -> Either a b
Left CryptoError
CBDecryptError
  where
    (ByteString
tag', ByteString
c) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
16 ByteString
packet
    (ByteString
rs, ByteString
msg) = key -> ByteString -> ByteString -> (ByteString, ByteString)
forall key.
ByteArrayAccess key =>
key -> ByteString -> ByteString -> (ByteString, ByteString)
xSalsa20 key
secret ByteString
nonce ByteString
c
    tag :: Auth
tag = ByteString -> ByteString -> Auth
forall key ba.
(ByteArrayAccess key, ByteArrayAccess ba) =>
key -> ba -> Auth
Poly1305.auth ByteString
rs ByteString
c

-- type for authentication scheme using NaCl @crypto_box@ over the sha512 digest of the message.
newtype CbAuthenticator = CbAuthenticator ByteString deriving (CbAuthenticator -> CbAuthenticator -> Bool
(CbAuthenticator -> CbAuthenticator -> Bool)
-> (CbAuthenticator -> CbAuthenticator -> Bool)
-> Eq CbAuthenticator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CbAuthenticator -> CbAuthenticator -> Bool
== :: CbAuthenticator -> CbAuthenticator -> Bool
$c/= :: CbAuthenticator -> CbAuthenticator -> Bool
/= :: CbAuthenticator -> CbAuthenticator -> Bool
Eq, Int -> CbAuthenticator -> ShowS
[CbAuthenticator] -> ShowS
CbAuthenticator -> String
(Int -> CbAuthenticator -> ShowS)
-> (CbAuthenticator -> String)
-> ([CbAuthenticator] -> ShowS)
-> Show CbAuthenticator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CbAuthenticator -> ShowS
showsPrec :: Int -> CbAuthenticator -> ShowS
$cshow :: CbAuthenticator -> String
show :: CbAuthenticator -> String
$cshowList :: [CbAuthenticator] -> ShowS
showList :: [CbAuthenticator] -> ShowS
Show)

cbAuthenticatorSize :: Int
cbAuthenticatorSize :: Int
cbAuthenticatorSize = SHA512 -> Int
forall a. HashAlgorithm a => a -> Int
hashDigestSize SHA512
SHA512 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
authTagSize -- 64 + 16 = 80 bytes

-- create crypto_box authenticator for a message.
cbAuthenticate :: PublicKeyX25519 -> PrivateKeyX25519 -> CbNonce -> ByteString -> CbAuthenticator
cbAuthenticate :: PublicKey 'X25519
-> PrivateKey 'X25519 -> CbNonce -> ByteString -> CbAuthenticator
cbAuthenticate PublicKey 'X25519
k PrivateKey 'X25519
pk CbNonce
nonce ByteString
msg = ByteString -> CbAuthenticator
CbAuthenticator (ByteString -> CbAuthenticator) -> ByteString -> CbAuthenticator
forall a b. (a -> b) -> a -> b
$ DhSecret 'X25519 -> CbNonce -> ByteString -> ByteString
cbEncryptNoPad (PublicKey 'X25519 -> PrivateKey 'X25519 -> DhSecret 'X25519
forall (a :: Algorithm).
DhAlgorithm a =>
PublicKey a -> PrivateKey a -> DhSecret a
dh' PublicKey 'X25519
k PrivateKey 'X25519
pk) CbNonce
nonce (ByteString -> ByteString
sha512Hash ByteString
msg)

-- verify crypto_box authenticator for a message.
cbVerify :: PublicKeyX25519 -> PrivateKeyX25519 -> CbNonce -> CbAuthenticator -> ByteString -> Bool
cbVerify :: PublicKey 'X25519
-> PrivateKey 'X25519
-> CbNonce
-> CbAuthenticator
-> ByteString
-> Bool
cbVerify PublicKey 'X25519
k PrivateKey 'X25519
pk CbNonce
nonce (CbAuthenticator ByteString
s) ByteString
authorized = DhSecret 'X25519
-> CbNonce -> ByteString -> Either CryptoError ByteString
cbDecryptNoPad (PublicKey 'X25519 -> PrivateKey 'X25519 -> DhSecret 'X25519
forall (a :: Algorithm).
DhAlgorithm a =>
PublicKey a -> PrivateKey a -> DhSecret a
dh' PublicKey 'X25519
k PrivateKey 'X25519
pk) CbNonce
nonce ByteString
s Either CryptoError ByteString
-> Either CryptoError ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Either CryptoError ByteString
forall a b. b -> Either a b
Right (ByteString -> ByteString
sha512Hash ByteString
authorized)

newtype CbNonce = CryptoBoxNonce {CbNonce -> ByteString
unCbNonce :: ByteString}
  deriving (CbNonce -> CbNonce -> Bool
(CbNonce -> CbNonce -> Bool)
-> (CbNonce -> CbNonce -> Bool) -> Eq CbNonce
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CbNonce -> CbNonce -> Bool
== :: CbNonce -> CbNonce -> Bool
$c/= :: CbNonce -> CbNonce -> Bool
/= :: CbNonce -> CbNonce -> Bool
Eq, Int -> CbNonce -> ShowS
[CbNonce] -> ShowS
CbNonce -> String
(Int -> CbNonce -> ShowS)
-> (CbNonce -> String) -> ([CbNonce] -> ShowS) -> Show CbNonce
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CbNonce -> ShowS
showsPrec :: Int -> CbNonce -> ShowS
$cshow :: CbNonce -> String
show :: CbNonce -> String
$cshowList :: [CbNonce] -> ShowS
showList :: [CbNonce] -> ShowS
Show)
  deriving newtype (FieldParser CbNonce
FieldParser CbNonce -> FromField CbNonce
forall a. FieldParser a -> FromField a
$cfromField :: FieldParser CbNonce
fromField :: FieldParser CbNonce
FromField)

instance ToField CbNonce where toField :: CbNonce -> SQLData
toField (CryptoBoxNonce ByteString
s) = Binary ByteString -> SQLData
forall a. ToField a => a -> SQLData
toField (Binary ByteString -> SQLData) -> Binary ByteString -> SQLData
forall a b. (a -> b) -> a -> b
$ ByteString -> Binary ByteString
forall a. a -> Binary a
Binary ByteString
s

pattern CbNonce :: ByteString -> CbNonce
pattern $mCbNonce :: forall {r}. CbNonce -> (ByteString -> r) -> ((# #) -> r) -> r
CbNonce s <- CryptoBoxNonce s

{-# COMPLETE CbNonce #-}

instance StrEncoding CbNonce where
  strEncode :: CbNonce -> ByteString
strEncode (CbNonce ByteString
s) = ByteString -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode ByteString
s
  strP :: Parser CbNonce
strP = ByteString -> CbNonce
cbNonce (ByteString -> CbNonce)
-> Parser ByteString ByteString -> Parser CbNonce
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
forall a. StrEncoding a => Parser a
strP

instance ToJSON CbNonce where
  toJSON :: CbNonce -> Value
toJSON = CbNonce -> Value
forall a. StrEncoding a => a -> Value
strToJSON
  toEncoding :: CbNonce -> Encoding
toEncoding = CbNonce -> Encoding
forall a. StrEncoding a => a -> Encoding
strToJEncoding

instance FromJSON CbNonce where
  parseJSON :: Value -> Parser CbNonce
parseJSON = String -> Value -> Parser CbNonce
forall a. StrEncoding a => String -> Value -> Parser a
strParseJSON String
"CbNonce"

cbNonce :: ByteString -> CbNonce
cbNonce :: ByteString -> CbNonce
cbNonce ByteString
s
  | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
24 = ByteString -> CbNonce
CryptoBoxNonce ByteString
s
  | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
24 = ByteString -> CbNonce
CryptoBoxNonce (ByteString -> CbNonce)
-> ((ByteString, ByteString) -> ByteString)
-> (ByteString, ByteString)
-> CbNonce
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, ByteString) -> CbNonce)
-> (ByteString, ByteString) -> CbNonce
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
24 ByteString
s
  | Bool
otherwise = ByteString -> CbNonce
CryptoBoxNonce (ByteString -> CbNonce) -> ByteString -> CbNonce
forall a b. (a -> b) -> a -> b
$ ByteString
s ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> ByteString
B.replicate (Int
24 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len) (Int -> Char
forall a. Enum a => Int -> a
toEnum Int
0)
  where
    len :: Int
len = ByteString -> Int
B.length ByteString
s

randomCbNonce :: TVar ChaChaDRG -> STM CbNonce
randomCbNonce :: TVar ChaChaDRG -> STM CbNonce
randomCbNonce = (ByteString -> CbNonce) -> STM ByteString -> STM CbNonce
forall a b. (a -> b) -> STM a -> STM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> CbNonce
CryptoBoxNonce (STM ByteString -> STM CbNonce)
-> (TVar ChaChaDRG -> STM ByteString)
-> TVar ChaChaDRG
-> STM CbNonce
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TVar ChaChaDRG -> STM ByteString
randomBytes Int
24

randomBytes :: Int -> TVar ChaChaDRG -> STM ByteString
randomBytes :: Int -> TVar ChaChaDRG -> STM ByteString
randomBytes Int
n TVar ChaChaDRG
gVar = TVar ChaChaDRG
-> (ChaChaDRG -> (ByteString, ChaChaDRG)) -> STM ByteString
forall s a. TVar s -> (s -> (a, s)) -> STM a
stateTVar TVar ChaChaDRG
gVar ((ChaChaDRG -> (ByteString, ChaChaDRG)) -> STM ByteString)
-> (ChaChaDRG -> (ByteString, ChaChaDRG)) -> STM ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ChaChaDRG -> (ByteString, ChaChaDRG)
forall byteArray.
ByteArray byteArray =>
Int -> ChaChaDRG -> (byteArray, ChaChaDRG)
forall gen byteArray.
(DRG gen, ByteArray byteArray) =>
Int -> gen -> (byteArray, gen)
randomBytesGenerate Int
n

reverseNonce :: CbNonce -> CbNonce
reverseNonce :: CbNonce -> CbNonce
reverseNonce (CryptoBoxNonce ByteString
s) = ByteString -> CbNonce
CryptoBoxNonce (ByteString -> ByteString
B.reverse ByteString
s)

instance Encoding CbNonce where
  smpEncode :: CbNonce -> ByteString
smpEncode = CbNonce -> ByteString
unCbNonce
  smpP :: Parser CbNonce
smpP = ByteString -> CbNonce
CryptoBoxNonce (ByteString -> CbNonce)
-> Parser ByteString ByteString -> Parser CbNonce
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser ByteString ByteString
A.take Int
24

newtype SbKey = SecretBoxKey {SbKey -> ByteString
unSbKey :: ByteString}
  deriving (SbKey -> SbKey -> Bool
(SbKey -> SbKey -> Bool) -> (SbKey -> SbKey -> Bool) -> Eq SbKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SbKey -> SbKey -> Bool
== :: SbKey -> SbKey -> Bool
$c/= :: SbKey -> SbKey -> Bool
/= :: SbKey -> SbKey -> Bool
Eq, Int -> SbKey -> ShowS
[SbKey] -> ShowS
SbKey -> String
(Int -> SbKey -> ShowS)
-> (SbKey -> String) -> ([SbKey] -> ShowS) -> Show SbKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SbKey -> ShowS
showsPrec :: Int -> SbKey -> ShowS
$cshow :: SbKey -> String
show :: SbKey -> String
$cshowList :: [SbKey] -> ShowS
showList :: [SbKey] -> ShowS
Show)
  deriving newtype (FieldParser SbKey
FieldParser SbKey -> FromField SbKey
forall a. FieldParser a -> FromField a
$cfromField :: FieldParser SbKey
fromField :: FieldParser SbKey
FromField)

instance ToField SbKey where toField :: SbKey -> SQLData
toField (SecretBoxKey ByteString
s) = Binary ByteString -> SQLData
forall a. ToField a => a -> SQLData
toField (Binary ByteString -> SQLData) -> Binary ByteString -> SQLData
forall a b. (a -> b) -> a -> b
$ ByteString -> Binary ByteString
forall a. a -> Binary a
Binary ByteString
s

pattern SbKey :: ByteString -> SbKey
pattern $mSbKey :: forall {r}. SbKey -> (ByteString -> r) -> ((# #) -> r) -> r
SbKey s <- SecretBoxKey s

{-# COMPLETE SbKey #-}

instance StrEncoding SbKey where
  strEncode :: SbKey -> ByteString
strEncode (SbKey ByteString
s) = ByteString -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode ByteString
s
  strP :: Parser SbKey
strP = ByteString -> Either String SbKey
sbKey (ByteString -> Either String SbKey)
-> Parser ByteString ByteString -> Parser SbKey
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> Parser ByteString ByteString
forall a. StrEncoding a => Parser a
strP

instance ToJSON SbKey where
  toJSON :: SbKey -> Value
toJSON = SbKey -> Value
forall a. StrEncoding a => a -> Value
strToJSON
  toEncoding :: SbKey -> Encoding
toEncoding = SbKey -> Encoding
forall a. StrEncoding a => a -> Encoding
strToJEncoding

instance FromJSON SbKey where
  parseJSON :: Value -> Parser SbKey
parseJSON = String -> Value -> Parser SbKey
forall a. StrEncoding a => String -> Value -> Parser a
strParseJSON String
"SbKey"

sbKey :: ByteString -> Either String SbKey
sbKey :: ByteString -> Either String SbKey
sbKey ByteString
s
  | ByteString -> Int
B.length ByteString
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
32 = SbKey -> Either String SbKey
forall a b. b -> Either a b
Right (SbKey -> Either String SbKey) -> SbKey -> Either String SbKey
forall a b. (a -> b) -> a -> b
$ ByteString -> SbKey
SecretBoxKey ByteString
s
  | Bool
otherwise = String -> Either String SbKey
forall a b. a -> Either a b
Left String
"SbKey: invalid length"

unsafeSbKey :: ByteString -> SbKey
unsafeSbKey :: ByteString -> SbKey
unsafeSbKey ByteString
s = (String -> SbKey)
-> (SbKey -> SbKey) -> Either String SbKey -> SbKey
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> SbKey
forall a. HasCallStack => String -> a
error SbKey -> SbKey
forall a. a -> a
id (Either String SbKey -> SbKey) -> Either String SbKey -> SbKey
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String SbKey
sbKey ByteString
s

randomSbKey :: TVar ChaChaDRG -> STM SbKey
randomSbKey :: TVar ChaChaDRG -> STM SbKey
randomSbKey TVar ChaChaDRG
gVar = ByteString -> SbKey
SecretBoxKey (ByteString -> SbKey) -> STM ByteString -> STM SbKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> TVar ChaChaDRG -> STM ByteString
randomBytes Int
32 TVar ChaChaDRG
gVar

newtype SbChainKey = SecretBoxChainKey {SbChainKey -> ByteString
unSbChainKey :: ByteString}
  deriving (SbChainKey -> SbChainKey -> Bool
(SbChainKey -> SbChainKey -> Bool)
-> (SbChainKey -> SbChainKey -> Bool) -> Eq SbChainKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SbChainKey -> SbChainKey -> Bool
== :: SbChainKey -> SbChainKey -> Bool
$c/= :: SbChainKey -> SbChainKey -> Bool
/= :: SbChainKey -> SbChainKey -> Bool
Eq, Int -> SbChainKey -> ShowS
[SbChainKey] -> ShowS
SbChainKey -> String
(Int -> SbChainKey -> ShowS)
-> (SbChainKey -> String)
-> ([SbChainKey] -> ShowS)
-> Show SbChainKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SbChainKey -> ShowS
showsPrec :: Int -> SbChainKey -> ShowS
$cshow :: SbChainKey -> String
show :: SbChainKey -> String
$cshowList :: [SbChainKey] -> ShowS
showList :: [SbChainKey] -> ShowS
Show)

sbcInit :: ByteArrayAccess secret => ByteString -> secret -> (SbChainKey, SbChainKey)
sbcInit :: forall secret.
ByteArrayAccess secret =>
ByteString -> secret -> (SbChainKey, SbChainKey)
sbcInit ByteString
salt secret
secret = (ByteString -> SbChainKey
SecretBoxChainKey ByteString
ck1, ByteString -> SbChainKey
SecretBoxChainKey ByteString
ck2)
  where
    (ByteString
ck1, ByteString
ck2) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
32 (ByteString -> (ByteString, ByteString))
-> ByteString -> (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> secret -> ByteString -> Int -> ByteString
forall secret.
ByteArrayAccess secret =>
ByteString -> secret -> ByteString -> Int -> ByteString
hkdf ByteString
salt secret
secret ByteString
"SimpleXSbChainInit" Int
64

type SbKeyNonce = (SbKey, CbNonce)

sbcHkdf :: SbChainKey -> (SbKeyNonce, SbChainKey)
sbcHkdf :: SbChainKey -> (SbKeyNonce, SbChainKey)
sbcHkdf (SecretBoxChainKey ByteString
ck) = ((ByteString -> SbKey
SecretBoxKey ByteString
sk, ByteString -> CbNonce
CryptoBoxNonce ByteString
nonce), ByteString -> SbChainKey
SecretBoxChainKey ByteString
ck')
  where
    out :: ByteString
out = ByteString -> ByteString -> ByteString -> Int -> ByteString
forall secret.
ByteArrayAccess secret =>
ByteString -> secret -> ByteString -> Int -> ByteString
hkdf ByteString
"" ByteString
ck ByteString
"SimpleXSbChain" Int
88 -- = 32 (new chain key) + 32 (secret_box key) + 24 (nonce)
    (ByteString
ck', ByteString
rest) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
32 ByteString
out
    (ByteString
sk, ByteString
nonce) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
32 ByteString
rest

hkdf :: ByteArrayAccess secret => ByteString -> secret -> ByteString -> Int -> ByteString
hkdf :: forall secret.
ByteArrayAccess secret =>
ByteString -> secret -> ByteString -> Int -> ByteString
hkdf ByteString
salt secret
ikm ByteString
info Int
n =
  let prk :: PRK SHA512
prk = ByteString -> secret -> PRK SHA512
forall a salt ikm.
(HashAlgorithm a, ByteArrayAccess salt, ByteArrayAccess ikm) =>
salt -> ikm -> PRK a
H.extract ByteString
salt secret
ikm :: H.PRK SHA512
   in PRK SHA512 -> ByteString -> Int -> ByteString
forall a info out.
(HashAlgorithm a, ByteArrayAccess info, ByteArray out) =>
PRK a -> info -> Int -> out
H.expand PRK SHA512
prk ByteString
info Int
n
{-# INLINE hkdf #-}

xSalsa20 :: ByteArrayAccess key => key -> ByteString -> ByteString -> (ByteString, ByteString)
xSalsa20 :: forall key.
ByteArrayAccess key =>
key -> ByteString -> ByteString -> (ByteString, ByteString)
xSalsa20 key
secret ByteString
nonce ByteString
msg = (ByteString
rs, ByteString
msg')
  where
    zero :: ByteString
zero = Int -> Char -> ByteString
B.replicate Int
16 (Char -> ByteString) -> Char -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Char
forall a. Enum a => Int -> a
toEnum Int
0
    (ByteString
iv0, ByteString
iv1) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
8 ByteString
nonce
    state0 :: State
state0 = Int -> key -> ByteString -> State
forall key nonce.
(ByteArrayAccess key, ByteArrayAccess nonce) =>
Int -> key -> nonce -> State
XSalsa.initialize Int
20 key
secret (ByteString
zero ByteString -> ByteString -> ByteString
`B.append` ByteString
iv0)
    state1 :: State
state1 = State -> ByteString -> State
forall nonce. ByteArrayAccess nonce => State -> nonce -> State
XSalsa.derive State
state0 ByteString
iv1
    (ByteString
rs, State
state2) = State -> Int -> (ByteString, State)
forall ba. ByteArray ba => State -> Int -> (ba, State)
XSalsa.generate State
state1 Int
32
    (ByteString
msg', State
_) = State -> ByteString -> (ByteString, State)
forall ba. ByteArray ba => State -> ba -> (ba, State)
XSalsa.combine State
state2 ByteString
msg

publicToX509 :: PublicKey a -> X.PubKey
publicToX509 :: forall (a :: Algorithm). PublicKey a -> PubKey
publicToX509 = \case
  PublicKeyEd25519 PublicKey
k -> PublicKey -> PubKey
X.PubKeyEd25519 PublicKey
k
  PublicKeyEd448 PublicKey
k -> PublicKey -> PubKey
X.PubKeyEd448 PublicKey
k
  PublicKeyX25519 PublicKey
k -> PublicKey -> PubKey
X.PubKeyX25519 PublicKey
k
  PublicKeyX448 PublicKey
k -> PublicKey -> PubKey
X.PubKeyX448 PublicKey
k

privateToX509 :: PrivateKey a -> X.PrivKey
privateToX509 :: forall (a :: Algorithm). PrivateKey a -> PrivKey
privateToX509 = \case
  PrivateKeyEd25519 SecretKey
k -> SecretKey -> PrivKey
X.PrivKeyEd25519 SecretKey
k
  PrivateKeyEd448 SecretKey
k -> SecretKey -> PrivKey
X.PrivKeyEd448 SecretKey
k
  PrivateKeyX25519 SecretKey
k -> SecretKey -> PrivKey
X.PrivKeyX25519 SecretKey
k
  PrivateKeyX448 SecretKey
k -> SecretKey -> PrivKey
X.PrivKeyX448 SecretKey
k

encodeASNObj :: ASN1Object a => a -> ByteString
encodeASNObj :: forall a. ASN1Object a => a -> ByteString
encodeASNObj a
k = ByteString -> ByteString
toStrict (ByteString -> ByteString)
-> ([ASN1] -> ByteString) -> [ASN1] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DER -> [ASN1] -> ByteString
forall a. ASN1Encoding a => a -> [ASN1] -> ByteString
encodeASN1 DER
DER ([ASN1] -> ByteString) -> [ASN1] -> ByteString
forall a b. (a -> b) -> a -> b
$ a -> ASN1S
forall a. ASN1Object a => a -> ASN1S
toASN1 a
k []

-- Decoding of binary X509 'CryptoPublicKey'.
decodePubKey :: CryptoPublicKey k => ByteString -> Either String k
decodePubKey :: forall k. CryptoPublicKey k => ByteString -> Either String k
decodePubKey = ByteString -> Either String (PubKey, [ASN1])
forall a. ASN1Object a => ByteString -> Either String (a, [ASN1])
decodeKey (ByteString -> Either String (PubKey, [ASN1]))
-> ((PubKey, [ASN1]) -> Either String k)
-> ByteString
-> Either String k
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (PubKey, [ASN1]) -> Either String APublicKey
x509ToPublic ((PubKey, [ASN1]) -> Either String APublicKey)
-> (APublicKey -> Either String k)
-> (PubKey, [ASN1])
-> Either String k
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> APublicKey -> Either String k
forall k. CryptoPublicKey k => APublicKey -> Either String k
pubKey

-- Decoding of binary PKCS8 'PrivateKey'.
decodePrivKey :: CryptoPrivateKey k => ByteString -> Either String k
decodePrivKey :: forall k. CryptoPrivateKey k => ByteString -> Either String k
decodePrivKey = ByteString -> Either String (PrivKey, [ASN1])
forall a. ASN1Object a => ByteString -> Either String (a, [ASN1])
decodeKey (ByteString -> Either String (PrivKey, [ASN1]))
-> ((PrivKey, [ASN1]) -> Either String k)
-> ByteString
-> Either String k
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (PrivKey, [ASN1]) -> Either String APrivateKey
x509ToPrivate ((PrivKey, [ASN1]) -> Either String APrivateKey)
-> (APrivateKey -> Either String k)
-> (PrivKey, [ASN1])
-> Either String k
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> APrivateKey -> Either String k
forall pk. CryptoPrivateKey pk => APrivateKey -> Either String pk
privKey

x509ToPublic :: (X.PubKey, [ASN1]) -> Either String APublicKey
x509ToPublic :: (PubKey, [ASN1]) -> Either String APublicKey
x509ToPublic = \case
  (X.PubKeyEd25519 PublicKey
k, []) -> APublicKey -> Either String APublicKey
forall a b. b -> Either a b
Right (APublicKey -> Either String APublicKey)
-> (PublicKey 'Ed25519 -> APublicKey)
-> PublicKey 'Ed25519
-> Either String APublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SAlgorithm 'Ed25519 -> PublicKey 'Ed25519 -> APublicKey
forall (a :: Algorithm).
AlgorithmI a =>
SAlgorithm a -> PublicKey a -> APublicKey
APublicKey SAlgorithm 'Ed25519
SEd25519 (PublicKey 'Ed25519 -> Either String APublicKey)
-> PublicKey 'Ed25519 -> Either String APublicKey
forall a b. (a -> b) -> a -> b
$ PublicKey -> PublicKey 'Ed25519
PublicKeyEd25519 PublicKey
k
  (X.PubKeyEd448 PublicKey
k, []) -> APublicKey -> Either String APublicKey
forall a b. b -> Either a b
Right (APublicKey -> Either String APublicKey)
-> (PublicKey 'Ed448 -> APublicKey)
-> PublicKey 'Ed448
-> Either String APublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SAlgorithm 'Ed448 -> PublicKey 'Ed448 -> APublicKey
forall (a :: Algorithm).
AlgorithmI a =>
SAlgorithm a -> PublicKey a -> APublicKey
APublicKey SAlgorithm 'Ed448
SEd448 (PublicKey 'Ed448 -> Either String APublicKey)
-> PublicKey 'Ed448 -> Either String APublicKey
forall a b. (a -> b) -> a -> b
$ PublicKey -> PublicKey 'Ed448
PublicKeyEd448 PublicKey
k
  (X.PubKeyX25519 PublicKey
k, []) -> APublicKey -> Either String APublicKey
forall a b. b -> Either a b
Right (APublicKey -> Either String APublicKey)
-> (PublicKey 'X25519 -> APublicKey)
-> PublicKey 'X25519
-> Either String APublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SAlgorithm 'X25519 -> PublicKey 'X25519 -> APublicKey
forall (a :: Algorithm).
AlgorithmI a =>
SAlgorithm a -> PublicKey a -> APublicKey
APublicKey SAlgorithm 'X25519
SX25519 (PublicKey 'X25519 -> Either String APublicKey)
-> PublicKey 'X25519 -> Either String APublicKey
forall a b. (a -> b) -> a -> b
$ PublicKey -> PublicKey 'X25519
PublicKeyX25519 PublicKey
k
  (X.PubKeyX448 PublicKey
k, []) -> APublicKey -> Either String APublicKey
forall a b. b -> Either a b
Right (APublicKey -> Either String APublicKey)
-> (PublicKey 'X448 -> APublicKey)
-> PublicKey 'X448
-> Either String APublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SAlgorithm 'X448 -> PublicKey 'X448 -> APublicKey
forall (a :: Algorithm).
AlgorithmI a =>
SAlgorithm a -> PublicKey a -> APublicKey
APublicKey SAlgorithm 'X448
SX448 (PublicKey 'X448 -> Either String APublicKey)
-> PublicKey 'X448 -> Either String APublicKey
forall a b. (a -> b) -> a -> b
$ PublicKey -> PublicKey 'X448
PublicKeyX448 PublicKey
k
  (PubKey, [ASN1])
r -> (PubKey, [ASN1]) -> Either String APublicKey
forall a b. (a, [ASN1]) -> Either String b
keyError (PubKey, [ASN1])
r

x509ToPublic' :: CryptoPublicKey k => X.PubKey -> Either String k
x509ToPublic' :: forall k. CryptoPublicKey k => PubKey -> Either String k
x509ToPublic' PubKey
k = (PubKey, [ASN1]) -> Either String APublicKey
x509ToPublic (PubKey
k, []) Either String APublicKey
-> (APublicKey -> Either String k) -> Either String k
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= APublicKey -> Either String k
forall k. CryptoPublicKey k => APublicKey -> Either String k
pubKey
{-# INLINE x509ToPublic' #-}

x509ToPrivate :: (X.PrivKey, [ASN1]) -> Either String APrivateKey
x509ToPrivate :: (PrivKey, [ASN1]) -> Either String APrivateKey
x509ToPrivate = \case
  (X.PrivKeyEd25519 SecretKey
k, []) -> APrivateKey -> Either String APrivateKey
forall a b. b -> Either a b
Right (APrivateKey -> Either String APrivateKey)
-> APrivateKey -> Either String APrivateKey
forall a b. (a -> b) -> a -> b
$ SAlgorithm 'Ed25519 -> PrivateKey 'Ed25519 -> APrivateKey
forall (a :: Algorithm).
AlgorithmI a =>
SAlgorithm a -> PrivateKey a -> APrivateKey
APrivateKey SAlgorithm 'Ed25519
SEd25519 (PrivateKey 'Ed25519 -> APrivateKey)
-> PrivateKey 'Ed25519 -> APrivateKey
forall a b. (a -> b) -> a -> b
$ SecretKey -> PrivateKey 'Ed25519
PrivateKeyEd25519 SecretKey
k
  (X.PrivKeyEd448 SecretKey
k, []) -> APrivateKey -> Either String APrivateKey
forall a b. b -> Either a b
Right (APrivateKey -> Either String APrivateKey)
-> APrivateKey -> Either String APrivateKey
forall a b. (a -> b) -> a -> b
$ SAlgorithm 'Ed448 -> PrivateKey 'Ed448 -> APrivateKey
forall (a :: Algorithm).
AlgorithmI a =>
SAlgorithm a -> PrivateKey a -> APrivateKey
APrivateKey SAlgorithm 'Ed448
SEd448 (PrivateKey 'Ed448 -> APrivateKey)
-> PrivateKey 'Ed448 -> APrivateKey
forall a b. (a -> b) -> a -> b
$ SecretKey -> PrivateKey 'Ed448
PrivateKeyEd448 SecretKey
k
  (X.PrivKeyX25519 SecretKey
k, []) -> APrivateKey -> Either String APrivateKey
forall a b. b -> Either a b
Right (APrivateKey -> Either String APrivateKey)
-> APrivateKey -> Either String APrivateKey
forall a b. (a -> b) -> a -> b
$ SAlgorithm 'X25519 -> PrivateKey 'X25519 -> APrivateKey
forall (a :: Algorithm).
AlgorithmI a =>
SAlgorithm a -> PrivateKey a -> APrivateKey
APrivateKey SAlgorithm 'X25519
SX25519 (PrivateKey 'X25519 -> APrivateKey)
-> PrivateKey 'X25519 -> APrivateKey
forall a b. (a -> b) -> a -> b
$ SecretKey -> PrivateKey 'X25519
PrivateKeyX25519 SecretKey
k
  (X.PrivKeyX448 SecretKey
k, []) -> APrivateKey -> Either String APrivateKey
forall a b. b -> Either a b
Right (APrivateKey -> Either String APrivateKey)
-> APrivateKey -> Either String APrivateKey
forall a b. (a -> b) -> a -> b
$ SAlgorithm 'X448 -> PrivateKey 'X448 -> APrivateKey
forall (a :: Algorithm).
AlgorithmI a =>
SAlgorithm a -> PrivateKey a -> APrivateKey
APrivateKey SAlgorithm 'X448
SX448 (PrivateKey 'X448 -> APrivateKey)
-> PrivateKey 'X448 -> APrivateKey
forall a b. (a -> b) -> a -> b
$ SecretKey -> PrivateKey 'X448
PrivateKeyX448 SecretKey
k
  (PrivKey, [ASN1])
r -> (PrivKey, [ASN1]) -> Either String APrivateKey
forall a b. (a, [ASN1]) -> Either String b
keyError (PrivKey, [ASN1])
r

x509ToPrivate' :: CryptoPrivateKey k => X.PrivKey -> Either String k
x509ToPrivate' :: forall k. CryptoPrivateKey k => PrivKey -> Either String k
x509ToPrivate' PrivKey
pk = (PrivKey, [ASN1]) -> Either String APrivateKey
x509ToPrivate (PrivKey
pk, []) Either String APrivateKey
-> (APrivateKey -> Either String k) -> Either String k
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= APrivateKey -> Either String k
forall pk. CryptoPrivateKey pk => APrivateKey -> Either String pk
privKey
{-# INLINE x509ToPrivate' #-}

decodeKey :: ASN1Object a => ByteString -> Either String (a, [ASN1])
decodeKey :: forall a. ASN1Object a => ByteString -> Either String (a, [ASN1])
decodeKey = [ASN1] -> Either String (a, [ASN1])
forall a. ASN1Object a => [ASN1] -> Either String (a, [ASN1])
fromASN1 ([ASN1] -> Either String (a, [ASN1]))
-> (ByteString -> Either String [ASN1])
-> ByteString
-> Either String (a, [ASN1])
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (ASN1Error -> String)
-> Either ASN1Error [ASN1] -> Either String [ASN1]
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ASN1Error -> String
forall a. Show a => a -> String
show (Either ASN1Error [ASN1] -> Either String [ASN1])
-> (ByteString -> Either ASN1Error [ASN1])
-> ByteString
-> Either String [ASN1]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DER -> ByteString -> Either ASN1Error [ASN1]
forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
decodeASN1 DER
DER (ByteString -> Either ASN1Error [ASN1])
-> (ByteString -> ByteString)
-> ByteString
-> Either ASN1Error [ASN1]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
fromStrict

keyError :: (a, [ASN1]) -> Either String b
keyError :: forall a b. (a, [ASN1]) -> Either String b
keyError = \case
  (a
_, []) -> String -> Either String b
forall a b. a -> Either a b
Left String
"unknown key algorithm"
  (a, [ASN1])
_ -> String -> Either String b
forall a b. a -> Either a b
Left String
"more than one key"