-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

-- | Handling of MLS private keys used for signing external proposals.
module Galley.Keys
  ( MLSPrivateKeyPaths,
    loadAllMLSKeys,
  )
where

import Control.Error.Util
import Control.Exception
import Crypto.ECC hiding (KeyPair)
import Crypto.Error
import Crypto.PubKey.ECDSA qualified as ECDSA
import Crypto.PubKey.Ed25519 qualified as Ed25519
import Data.ASN1.BinaryEncoding
import Data.ASN1.BitArray
import Data.ASN1.Encoding
import Data.ASN1.Types
import Data.Bifunctor
import Data.ByteString.Lazy qualified as LBS
import Data.PEM
import Data.Proxy
import Data.X509
import Imports
import Wire.API.MLS.CipherSuite
import Wire.API.MLS.Keys

type MLSPrivateKeyPaths = MLSKeysByPurpose (MLSKeys FilePath)

data MLSPrivateKeyException = MLSPrivateKeyException
  { MLSPrivateKeyException -> String
mpkePath :: FilePath,
    MLSPrivateKeyException -> String
mpkeMsg :: String
  }
  deriving (MLSPrivateKeyException -> MLSPrivateKeyException -> Bool
(MLSPrivateKeyException -> MLSPrivateKeyException -> Bool)
-> (MLSPrivateKeyException -> MLSPrivateKeyException -> Bool)
-> Eq MLSPrivateKeyException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MLSPrivateKeyException -> MLSPrivateKeyException -> Bool
== :: MLSPrivateKeyException -> MLSPrivateKeyException -> Bool
$c/= :: MLSPrivateKeyException -> MLSPrivateKeyException -> Bool
/= :: MLSPrivateKeyException -> MLSPrivateKeyException -> Bool
Eq, Int -> MLSPrivateKeyException -> ShowS
[MLSPrivateKeyException] -> ShowS
MLSPrivateKeyException -> String
(Int -> MLSPrivateKeyException -> ShowS)
-> (MLSPrivateKeyException -> String)
-> ([MLSPrivateKeyException] -> ShowS)
-> Show MLSPrivateKeyException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MLSPrivateKeyException -> ShowS
showsPrec :: Int -> MLSPrivateKeyException -> ShowS
$cshow :: MLSPrivateKeyException -> String
show :: MLSPrivateKeyException -> String
$cshowList :: [MLSPrivateKeyException] -> ShowS
showList :: [MLSPrivateKeyException] -> ShowS
Show, Typeable)

instance Exception MLSPrivateKeyException where
  displayException :: MLSPrivateKeyException -> String
displayException MLSPrivateKeyException
e = MLSPrivateKeyException -> String
mpkePath MLSPrivateKeyException
e String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> MLSPrivateKeyException -> String
mpkeMsg MLSPrivateKeyException
e

loadAllMLSKeys :: MLSPrivateKeyPaths -> IO (MLSKeysByPurpose MLSPrivateKeys)
loadAllMLSKeys :: MLSPrivateKeyPaths -> IO (MLSKeysByPurpose MLSPrivateKeys)
loadAllMLSKeys = (MLSKeys String -> IO MLSPrivateKeys)
-> MLSPrivateKeyPaths -> IO (MLSKeysByPurpose MLSPrivateKeys)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MLSKeysByPurpose a -> f (MLSKeysByPurpose b)
traverse MLSKeys String -> IO MLSPrivateKeys
loadMLSKeys

loadMLSKeys :: MLSKeys FilePath -> IO MLSPrivateKeys
loadMLSKeys :: MLSKeys String -> IO MLSPrivateKeys
loadMLSKeys MLSKeys String
paths =
  (SecretKey, PublicKey)
-> (Scalar, Point)
-> (Scalar SEC_p384r1, Point SEC_p384r1)
-> (Scalar SEC_p521r1, Point SEC_p521r1)
-> MLSPrivateKeys
KeyPair 'Ed25519
-> KeyPair 'Ecdsa_secp256r1_sha256
-> KeyPair 'Ecdsa_secp384r1_sha384
-> KeyPair 'Ecdsa_secp521r1_sha512
-> MLSPrivateKeys
MLSPrivateKeys
    ((SecretKey, PublicKey)
 -> (Scalar, Point)
 -> (Scalar SEC_p384r1, Point SEC_p384r1)
 -> (Scalar SEC_p521r1, Point SEC_p521r1)
 -> MLSPrivateKeys)
-> IO (SecretKey, PublicKey)
-> IO
     ((Scalar, Point)
      -> (Scalar SEC_p384r1, Point SEC_p384r1)
      -> (Scalar SEC_p521r1, Point SEC_p521r1)
      -> MLSPrivateKeys)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (ss :: SignatureSchemeTag).
LoadKeyPair ss =>
String -> IO (KeyPair ss)
loadKeyPair @Ed25519 MLSKeys String
paths.ed25519
    IO
  ((Scalar, Point)
   -> (Scalar SEC_p384r1, Point SEC_p384r1)
   -> (Scalar SEC_p521r1, Point SEC_p521r1)
   -> MLSPrivateKeys)
-> IO (Scalar, Point)
-> IO
     ((Scalar SEC_p384r1, Point SEC_p384r1)
      -> (Scalar SEC_p521r1, Point SEC_p521r1) -> MLSPrivateKeys)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (ss :: SignatureSchemeTag).
LoadKeyPair ss =>
String -> IO (KeyPair ss)
loadKeyPair @Ecdsa_secp256r1_sha256 MLSKeys String
paths.ecdsa_secp256r1_sha256
    IO
  ((Scalar SEC_p384r1, Point SEC_p384r1)
   -> (Scalar SEC_p521r1, Point SEC_p521r1) -> MLSPrivateKeys)
-> IO (Scalar SEC_p384r1, Point SEC_p384r1)
-> IO ((Scalar SEC_p521r1, Point SEC_p521r1) -> MLSPrivateKeys)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (ss :: SignatureSchemeTag).
LoadKeyPair ss =>
String -> IO (KeyPair ss)
loadKeyPair @Ecdsa_secp384r1_sha384 MLSKeys String
paths.ecdsa_secp384r1_sha384
    IO ((Scalar SEC_p521r1, Point SEC_p521r1) -> MLSPrivateKeys)
-> IO (Scalar SEC_p521r1, Point SEC_p521r1) -> IO MLSPrivateKeys
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (ss :: SignatureSchemeTag).
LoadKeyPair ss =>
String -> IO (KeyPair ss)
loadKeyPair @Ecdsa_secp521r1_sha512 MLSKeys String
paths.ecdsa_secp521r1_sha512

class LoadKeyPair (ss :: SignatureSchemeTag) where
  loadKeyPair :: FilePath -> IO (KeyPair ss)

instance LoadKeyPair Ed25519 where
  loadKeyPair :: String -> IO (KeyPair 'Ed25519)
loadKeyPair = String -> IO (SecretKey, PublicKey)
String -> IO (KeyPair 'Ed25519)
loadEd25519KeyPair

instance LoadKeyPair Ecdsa_secp256r1_sha256 where
  loadKeyPair :: String -> IO (KeyPair 'Ecdsa_secp256r1_sha256)
loadKeyPair = forall c.
(EllipticCurveECDSA c, CurveOID c) =>
String -> IO (PrivateKey c, PublicKey c)
loadECDSAKeyPair @Curve_P256R1

instance LoadKeyPair Ecdsa_secp384r1_sha384 where
  loadKeyPair :: String -> IO (KeyPair 'Ecdsa_secp384r1_sha384)
loadKeyPair = forall c.
(EllipticCurveECDSA c, CurveOID c) =>
String -> IO (PrivateKey c, PublicKey c)
loadECDSAKeyPair @Curve_P384R1

instance LoadKeyPair Ecdsa_secp521r1_sha512 where
  loadKeyPair :: String -> IO (KeyPair 'Ecdsa_secp521r1_sha512)
loadKeyPair = forall c.
(EllipticCurveECDSA c, CurveOID c) =>
String -> IO (PrivateKey c, PublicKey c)
loadECDSAKeyPair @Curve_P521R1

class CurveOID c where
  curveOID :: [Integer]

instance CurveOID Curve_P256R1 where
  curveOID :: [Integer]
curveOID = [Integer
1, Integer
2, Integer
840, Integer
10045, Integer
3, Integer
1, Integer
7]

instance CurveOID Curve_P384R1 where
  curveOID :: [Integer]
curveOID = [Integer
1, Integer
3, Integer
132, Integer
0, Integer
34]

instance CurveOID Curve_P521R1 where
  curveOID :: [Integer]
curveOID = [Integer
1, Integer
3, Integer
132, Integer
0, Integer
35]

loadECDSAKeyPair ::
  forall c.
  (ECDSA.EllipticCurveECDSA c, CurveOID c) =>
  FilePath ->
  IO (ECDSA.PrivateKey c, ECDSA.PublicKey c)
loadECDSAKeyPair :: forall c.
(EllipticCurveECDSA c, CurveOID c) =>
String -> IO (PrivateKey c, PublicKey c)
loadECDSAKeyPair String
path = do
  ByteString
bytes <- String -> IO ByteString
LBS.readFile String
path
  (String -> IO (PrivateKey c, PublicKey c))
-> ((PrivateKey c, PublicKey c) -> IO (PrivateKey c, PublicKey c))
-> Either String (PrivateKey c, PublicKey c)
-> IO (PrivateKey c, PublicKey c)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (MLSPrivateKeyException -> IO (PrivateKey c, PublicKey c)
forall e a. Exception e => e -> IO a
throwIO (MLSPrivateKeyException -> IO (PrivateKey c, PublicKey c))
-> (String -> MLSPrivateKeyException)
-> String
-> IO (PrivateKey c, PublicKey c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> MLSPrivateKeyException
MLSPrivateKeyException String
path) (PrivateKey c, PublicKey c) -> IO (PrivateKey c, PublicKey c)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (PrivateKey c, PublicKey c)
 -> IO (PrivateKey c, PublicKey c))
-> Either String (PrivateKey c, PublicKey c)
-> IO (PrivateKey c, PublicKey c)
forall a b. (a -> b) -> a -> b
$
    forall c.
(EllipticCurveECDSA c, CurveOID c) =>
ByteString -> Either String (PrivateKey c, PublicKey c)
decodeEcdsaKeyPair @c ByteString
bytes

loadEd25519KeyPair :: FilePath -> IO (Ed25519.SecretKey, Ed25519.PublicKey)
loadEd25519KeyPair :: String -> IO (SecretKey, PublicKey)
loadEd25519KeyPair String
path = do
  ByteString
bytes <- String -> IO ByteString
LBS.readFile String
path
  SecretKey
priv <-
    (String -> IO SecretKey)
-> (SecretKey -> IO SecretKey)
-> Either String SecretKey
-> IO SecretKey
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (MLSPrivateKeyException -> IO SecretKey
forall e a. Exception e => e -> IO a
throwIO (MLSPrivateKeyException -> IO SecretKey)
-> (String -> MLSPrivateKeyException) -> String -> IO SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> MLSPrivateKeyException
MLSPrivateKeyException String
path) SecretKey -> IO SecretKey
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String SecretKey -> IO SecretKey)
-> Either String SecretKey -> IO SecretKey
forall a b. (a -> b) -> a -> b
$
      ByteString -> Either String SecretKey
decodeEd25519PrivateKey ByteString
bytes
  (SecretKey, PublicKey) -> IO (SecretKey, PublicKey)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SecretKey
priv, SecretKey -> PublicKey
Ed25519.toPublic SecretKey
priv)

decodeEcdsaKeyPair ::
  forall c.
  (ECDSA.EllipticCurveECDSA c, CurveOID c) =>
  LByteString ->
  Either String (ECDSA.PrivateKey c, ECDSA.PublicKey c)
decodeEcdsaKeyPair :: forall c.
(EllipticCurveECDSA c, CurveOID c) =>
ByteString -> Either String (PrivateKey c, PublicKey c)
decodeEcdsaKeyPair ByteString
bytes = do
  let curve :: Proxy c
curve = forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c
  [PEM]
pems <- ByteString -> Either String [PEM]
pemParseLBS ByteString
bytes
  PEM
pem <- String -> [PEM] -> Either String PEM
forall a. String -> [a] -> Either String a
expectOne String
"private key" [PEM]
pems
  let content :: ByteString
content = PEM -> ByteString
pemContent PEM
pem
  -- parse outer pkcs8 container as BER
  [ASN1]
asn1 <- (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 e. Exception e => e -> String
displayException (BER -> ByteString -> Either ASN1Error [ASN1]
forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
decodeASN1' BER
BER ByteString
content)
  ([Integer]
oid, ByteString
key) <- case [ASN1]
asn1 of
    [ Start ASN1ConstructionType
Sequence,
      IntVal Integer
_version,
      Start ASN1ConstructionType
Sequence,
      OID [Integer
1, Integer
2, Integer
840, Integer
10045, Integer
2, Integer
1], -- ecdsa
      OID [Integer]
oid,
      End ASN1ConstructionType
Sequence,
      OctetString ByteString
key,
      End ASN1ConstructionType
Sequence
      ] -> ([Integer], ByteString) -> Either String ([Integer], ByteString)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Integer]
oid, ByteString
key)
    [ASN1]
_ -> String -> Either String ([Integer], ByteString)
forall a b. a -> Either a b
Left String
"invalid ECDSA key format: expected pkcs8"
  String -> Maybe () -> Either String ()
forall a b. a -> Maybe b -> Either a b
note
    ( String
"private key curve mismatch, expected "
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Integer] -> String
forall a. Show a => a -> String
show (forall c. CurveOID c => [Integer]
forall {k} (c :: k). CurveOID c => [Integer]
curveOID @c)
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", found "
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Integer] -> String
forall a. Show a => a -> String
show [Integer]
oid
    )
    (Maybe () -> Either String ()) -> Maybe () -> Either String ()
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ([Integer]
oid [Integer] -> [Integer] -> Bool
forall a. Eq a => a -> a -> Bool
== forall c. CurveOID c => [Integer]
forall {k} (c :: k). CurveOID c => [Integer]
curveOID @c)
  -- parse key bytestring as BER again, this should be in the format of rfc5915
  [ASN1]
asn1' <- (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 e. Exception e => e -> String
displayException (BER -> ByteString -> Either ASN1Error [ASN1]
forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
decodeASN1' BER
BER ByteString
key)
  (ByteString
privBS, ByteString
pubBS) <- case [ASN1]
asn1' of
    [ Start ASN1ConstructionType
Sequence,
      IntVal Integer
_version,
      OctetString ByteString
priv,
      Start (Container ASN1Class
Context Int
_),
      BitString (BitArray Word64
_ ByteString
pub),
      End (Container ASN1Class
Context Int
_),
      End ASN1ConstructionType
Sequence
      ] -> (ByteString, ByteString) -> Either String (ByteString, ByteString)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString
priv, ByteString
pub)
    [ASN1]
_ -> String -> Either String (ByteString, ByteString)
forall a b. a -> Either a b
Left String
"invalid ECDSA key format: expected rfc5915 private key format"
  PrivateKey c
priv <-
    (CryptoError -> String)
-> Either CryptoError (PrivateKey c)
-> Either String (PrivateKey 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 e. Exception e => e -> String
displayException (Either CryptoError (PrivateKey c) -> Either String (PrivateKey c))
-> (CryptoFailable (PrivateKey c)
    -> Either CryptoError (PrivateKey c))
-> CryptoFailable (PrivateKey c)
-> Either String (PrivateKey c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoFailable (PrivateKey c) -> Either CryptoError (PrivateKey c)
forall a. CryptoFailable a -> Either CryptoError a
eitherCryptoError (CryptoFailable (PrivateKey c) -> Either String (PrivateKey c))
-> CryptoFailable (PrivateKey c) -> Either String (PrivateKey c)
forall a b. (a -> b) -> a -> b
$
      Proxy c -> ByteString -> CryptoFailable (PrivateKey c)
forall curve bs (proxy :: * -> *).
(EllipticCurveECDSA curve, ByteArray bs) =>
proxy curve -> bs -> CryptoFailable (PrivateKey curve)
ECDSA.decodePrivate Proxy c
curve ByteString
privBS
  PublicKey c
pub <-
    (CryptoError -> String)
-> Either CryptoError (PublicKey c) -> Either String (PublicKey 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 e. Exception e => e -> String
displayException (Either CryptoError (PublicKey c) -> Either String (PublicKey c))
-> (CryptoFailable (PublicKey c)
    -> Either CryptoError (PublicKey c))
-> CryptoFailable (PublicKey c)
-> Either String (PublicKey c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoFailable (PublicKey c) -> Either CryptoError (PublicKey c)
forall a. CryptoFailable a -> Either CryptoError a
eitherCryptoError (CryptoFailable (PublicKey c) -> Either String (PublicKey c))
-> CryptoFailable (PublicKey c) -> Either String (PublicKey c)
forall a b. (a -> b) -> a -> b
$
      Proxy c -> ByteString -> CryptoFailable (PublicKey c)
forall curve bs (proxy :: * -> *).
(EllipticCurve curve, ByteArray bs) =>
proxy curve -> bs -> CryptoFailable (PublicKey curve)
ECDSA.decodePublic Proxy c
curve ByteString
pubBS
  (PrivateKey c, PublicKey c)
-> Either String (PrivateKey c, PublicKey c)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrivateKey c
priv, PublicKey c
pub)

decodeEd25519PrivateKey ::
  LByteString ->
  Either String Ed25519.SecretKey
decodeEd25519PrivateKey :: ByteString -> Either String SecretKey
decodeEd25519PrivateKey ByteString
bytes = do
  [PEM]
pems <- ByteString -> Either String [PEM]
pemParseLBS ByteString
bytes
  PEM
pem <- String -> [PEM] -> Either String PEM
forall a. String -> [a] -> Either String a
expectOne String
"private key" [PEM]
pems
  let content :: ByteString
content = PEM -> ByteString
pemContent PEM
pem
  [ASN1]
asn1 <- (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 e. Exception e => e -> String
displayException (BER -> ByteString -> Either ASN1Error [ASN1]
forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
decodeASN1' BER
BER ByteString
content)
  (PrivKey
priv, [ASN1]
remainder) <- [ASN1] -> Either String (PrivKey, [ASN1])
forall a. ASN1Object a => [ASN1] -> Either String (a, [ASN1])
fromASN1 [ASN1]
asn1
  [ASN1] -> Either String ()
forall a. [a] -> Either String ()
expectEmpty [ASN1]
remainder
  case PrivKey
priv of
    PrivKeyEd25519 SecretKey
sec -> SecretKey -> Either String SecretKey
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SecretKey
sec
    PrivKey
_ -> String -> Either String SecretKey
forall a b. a -> Either a b
Left (String -> Either String SecretKey)
-> String -> Either String SecretKey
forall a b. (a -> b) -> a -> b
$ String
"invalid signature scheme (expected ed25519)"
  where
    expectEmpty :: [a] -> Either String ()
    expectEmpty :: forall a. [a] -> Either String ()
expectEmpty [] = () -> Either String ()
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    expectEmpty [a]
_ = String -> Either String ()
forall a b. a -> Either a b
Left String
"extraneous ASN.1 data"

expectOne :: String -> [a] -> Either String a
expectOne :: forall a. String -> [a] -> Either String a
expectOne String
label [] = String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"no " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
label String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" found"
expectOne String
_ [a
x] = a -> Either String a
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
expectOne String
label [a]
_ = String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"found multiple " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
label String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"s"