{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Abstract key evolving signatures.
module Cardano.Crypto.KES.Class
  (
    -- * KES algorithm class
    KESAlgorithm (..)
  , Period

  , OptimizedKESAlgorithm (..)
  , verifyOptimizedKES

    -- * 'SignedKES' wrapper
  , SignedKES (..)
  , signedKES
  , verifySignedKES

    -- * CBOR encoding and decoding
  , encodeVerKeyKES
  , decodeVerKeyKES
  , encodeSignKeyKES
  , decodeSignKeyKES
  , encodeSigKES
  , decodeSigKES
  , encodeSignedKES
  , decodeSignedKES

    -- * Encoded 'Size' expressions
  , encodedVerKeyKESSizeExpr
  , encodedSignKeyKESSizeExpr
  , encodedSigKESSizeExpr

    -- * Utility functions
    -- These are used between multiple KES implementations. User code will
    -- most likely not need these, but they are required for recursive
    -- definitions of the SumKES algorithms, and can be expressed entirely in
    -- terms of the KES, DSIGN and Hash typeclasses, so we keep them here for
    -- convenience.
  , hashPairOfVKeys
  , zeroSeed
  , mungeName
  )
where

import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Word (Word8)
import Data.Kind (Type)
import Data.Proxy (Proxy(..))
import Data.Typeable (Typeable)
import GHC.Exts (Constraint)
import GHC.Generics (Generic)
import GHC.Stack
import GHC.TypeLits (Nat, KnownNat, natVal, TypeError, ErrorMessage (..))
import NoThunks.Class (NoThunks)

import Cardano.Binary (Decoder, decodeBytes, Encoding, encodeBytes, Size, withWordSize)

import Cardano.Crypto.Seed
import Cardano.Crypto.Util (Empty)
import Cardano.Crypto.Hash.Class (HashAlgorithm, Hash, hashWith)


class ( Typeable v
      , Show (VerKeyKES v)
      , Eq (VerKeyKES v)
      , Show (SignKeyKES v)
      , Show (SigKES v)
      , Eq (SigKES v)
      , NoThunks (SigKES v)
      , NoThunks (SignKeyKES v)
      , NoThunks (VerKeyKES v)
      , KnownNat (SeedSizeKES v)
      )
      => KESAlgorithm v where

  type SeedSizeKES v :: Nat

  --
  -- Key and signature types
  --

  data VerKeyKES  v :: Type
  data SignKeyKES v :: Type
  data SigKES     v :: Type


  --
  -- Metadata and basic key operations
  --

  algorithmNameKES :: proxy v -> String

  deriveVerKeyKES :: SignKeyKES v -> VerKeyKES v

  hashVerKeyKES :: HashAlgorithm h => VerKeyKES v -> Hash h (VerKeyKES v)
  hashVerKeyKES = forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
hashWith forall v. KESAlgorithm v => VerKeyKES v -> ByteString
rawSerialiseVerKeyKES


  --
  -- Core algorithm operations
  --

  -- | Context required to run the KES algorithm
  --
  -- Unit by default (no context required)
  type ContextKES v :: Type
  type ContextKES v = ()

  type Signable v :: Type -> Constraint
  type Signable v = Empty

  signKES
    :: (Signable v a, HasCallStack)
    => ContextKES v
    -> Period  -- ^ The /current/ period for the key
    -> a
    -> SignKeyKES v
    -> SigKES v

  -- | Full KES verification. This method checks that the signature itself
  -- checks out (as per 'verifySigKES'), and also makes sure that it matches
  -- the provided VerKey.
  verifyKES
    :: (Signable v a, HasCallStack)
    => ContextKES v
    -> VerKeyKES v
    -> Period  -- ^ The /current/ period for the key
    -> a
    -> SigKES v
    -> Either String ()

  -- | Update the KES signature key to the /next/ period, given the /current/
  -- period.
  --
  -- It returns 'Nothing' if the cannot be evolved any further.
  --
  -- The precondition (to get a 'Just' result) is that the current KES period
  -- of the input key is not the last period. The given period must be the
  -- current KES period of the input key (not the next or target).
  --
  -- The postcondition is that in case a key is returned, its current KES
  -- period is incremented by one compared to before.
  --
  -- Note that you must track the current period separately, and to skip to a
  -- later period requires repeated use of this function, since it only
  -- increments one period at once.
  --
  updateKES
    :: HasCallStack
    => ContextKES v
    -> SignKeyKES v
    -> Period  -- ^ The /current/ period for the key, not the target period.
    -> Maybe (SignKeyKES v)

  -- | Return the total number of KES periods supported by this algorithm. The
  -- KES algorithm is assumed to support a fixed maximum number of periods, not
  -- a variable number.
  --
  -- Do note that this is the total number of /periods/ not the total number of
  -- evolutions. The difference is off-by-one. For example if there are 2
  -- periods (period 0 and 1) then there is only one evolution.
  --
  totalPeriodsKES
    :: proxy v -> Word


  --
  -- Key generation
  --

  genKeyKES :: Seed -> SignKeyKES v

  -- | The upper bound on the 'Seed' size needed by 'genKeyKES'
  seedSizeKES :: proxy v -> Word
  seedSizeKES proxy v
_ = forall a. Num a => Integer -> a
fromInteger (forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
Proxy @(SeedSizeKES v)))

  --
  -- Secure forgetting
  --

  -- | Forget a signing key synchronously, rather than waiting for GC. In some
  -- non-mock instances this provides a guarantee that the signing key is no
  -- longer in memory.
  --
  -- The precondition is that this key value will not be used again.
  --
  forgetSignKeyKES :: SignKeyKES v -> IO ()
  forgetSignKeyKES = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()

  --
  -- Serialisation/(de)serialisation in fixed-size raw format
  --

  sizeVerKeyKES  :: proxy v -> Word
  sizeSignKeyKES :: proxy v -> Word
  sizeSigKES     :: proxy v -> Word

  rawSerialiseVerKeyKES    :: VerKeyKES  v -> ByteString
  rawSerialiseSignKeyKES   :: SignKeyKES v -> ByteString
  rawSerialiseSigKES       :: SigKES     v -> ByteString

  rawDeserialiseVerKeyKES  :: ByteString -> Maybe (VerKeyKES v)
  rawDeserialiseSignKeyKES :: ByteString -> Maybe (SignKeyKES v)
  rawDeserialiseSigKES     :: ByteString -> Maybe (SigKES v)

-- | Subclass for KES algorithms that embed a copy of the VerKey into the
-- signature itself, rather than relying on the externally supplied VerKey
-- alone. Some optimizations made in the 'Cardano.Crypto.KES.CompactSingleKES'
-- and 'Cardano.Crypto.KES.CompactSumKES' implementations require this
-- additional interface in order to avoid redundant computations.
class KESAlgorithm v => OptimizedKESAlgorithm v where
  -- | Partial verification: this method only verifies the signature itself,
  -- but it does not check it against any externally-provided VerKey. Use
  -- 'verifyKES' for full KES verification.
  verifySigKES
    :: (Signable v a, HasCallStack)
    => ContextKES v
    -> Period  -- ^ The /current/ period for the key
    -> a
    -> SigKES v
    -> Either String ()

  -- | Extract a VerKey from a SigKES. Note that a VerKey embedded in or
  -- derived from a SigKES is effectively user-supplied, so it is not enough
  -- to validate a SigKES against this VerKey (like 'verifySigKES' does); you
  -- must also compare the VerKey against an externally-provided key that you
  -- want to verify against (see 'verifyKES').
  verKeyFromSigKES
    :: ContextKES v
    -> Period
    -> SigKES v
    -> VerKeyKES v

verifyOptimizedKES :: (OptimizedKESAlgorithm v, Signable v a, HasCallStack)
                   => ContextKES v
                   -> VerKeyKES v
                   -> Period
                   -> a
                   -> SigKES v
                   -> Either String ()
verifyOptimizedKES :: forall v a.
(OptimizedKESAlgorithm v, Signable v a, HasCallStack) =>
ContextKES v
-> VerKeyKES v -> Word -> a -> SigKES v -> Either String ()
verifyOptimizedKES ContextKES v
ctx VerKeyKES v
vk Word
t a
a SigKES v
sig = do
  forall v a.
(OptimizedKESAlgorithm v, Signable v a, HasCallStack) =>
ContextKES v -> Word -> a -> SigKES v -> Either String ()
verifySigKES ContextKES v
ctx Word
t a
a SigKES v
sig
  let vk' :: VerKeyKES v
vk' = forall v.
OptimizedKESAlgorithm v =>
ContextKES v -> Word -> SigKES v -> VerKeyKES v
verKeyFromSigKES ContextKES v
ctx Word
t SigKES v
sig
  if VerKeyKES v
vk' forall a. Eq a => a -> a -> Bool
==  VerKeyKES v
vk then
    forall (m :: * -> *) a. Monad m => a -> m a
return ()
  else
    forall a b. a -> Either a b
Left String
"KES verification failed"
--
-- Do not provide Ord instances for keys, see #38
--

instance ( TypeError ('Text "Ord not supported for signing keys, use the hash instead")
         , Eq (SignKeyKES v)
         )
      => Ord (SignKeyKES v) where
    compare :: SignKeyKES v -> SignKeyKES v -> Ordering
compare = forall a. HasCallStack => String -> a
error String
"unsupported"

instance ( TypeError ('Text "Ord not supported for verification keys, use the hash instead")
         , KESAlgorithm v
         )
      => Ord (VerKeyKES v) where
    compare :: VerKeyKES v -> VerKeyKES v -> Ordering
compare = forall a. HasCallStack => String -> a
error String
"unsupported"

--
-- Convenient CBOR encoding/decoding
--
-- Implementations in terms of the raw (de)serialise
--

encodeVerKeyKES :: KESAlgorithm v => VerKeyKES v -> Encoding
encodeVerKeyKES :: forall v. KESAlgorithm v => VerKeyKES v -> Encoding
encodeVerKeyKES = ByteString -> Encoding
encodeBytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. KESAlgorithm v => VerKeyKES v -> ByteString
rawSerialiseVerKeyKES

encodeSignKeyKES :: KESAlgorithm v => SignKeyKES v -> Encoding
encodeSignKeyKES :: forall v. KESAlgorithm v => SignKeyKES v -> Encoding
encodeSignKeyKES = ByteString -> Encoding
encodeBytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. KESAlgorithm v => SignKeyKES v -> ByteString
rawSerialiseSignKeyKES

encodeSigKES :: KESAlgorithm v => SigKES v -> Encoding
encodeSigKES :: forall v. KESAlgorithm v => SigKES v -> Encoding
encodeSigKES = ByteString -> Encoding
encodeBytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. KESAlgorithm v => SigKES v -> ByteString
rawSerialiseSigKES

decodeVerKeyKES :: forall v s. KESAlgorithm v => Decoder s (VerKeyKES v)
decodeVerKeyKES :: forall v s. KESAlgorithm v => Decoder s (VerKeyKES v)
decodeVerKeyKES = do
    ByteString
bs <- forall s. Decoder s ByteString
decodeBytes
    case forall v. KESAlgorithm v => ByteString -> Maybe (VerKeyKES v)
rawDeserialiseVerKeyKES ByteString
bs of
      Just VerKeyKES v
vk -> forall (m :: * -> *) a. Monad m => a -> m a
return VerKeyKES v
vk
      Maybe (VerKeyKES v)
Nothing
        | Int
actual forall a. Eq a => a -> a -> Bool
/= Int
expected
                    -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"decodeVerKeyKES: wrong length, expected " forall a. [a] -> [a] -> [a]
++
                             forall a. Show a => a -> String
show Int
expected forall a. [a] -> [a] -> [a]
++ String
" bytes but got " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
actual)
        | Bool
otherwise -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"decodeVerKeyKES: cannot decode key"
        where
          expected :: Int
expected = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Word
sizeVerKeyKES (forall {k} (t :: k). Proxy t
Proxy :: Proxy v))
          actual :: Int
actual   = ByteString -> Int
BS.length ByteString
bs

decodeSignKeyKES :: forall v s. KESAlgorithm v => Decoder s (SignKeyKES v)
decodeSignKeyKES :: forall v s. KESAlgorithm v => Decoder s (SignKeyKES v)
decodeSignKeyKES = do
    ByteString
bs <- forall s. Decoder s ByteString
decodeBytes
    case forall v. KESAlgorithm v => ByteString -> Maybe (SignKeyKES v)
rawDeserialiseSignKeyKES ByteString
bs of
      Just SignKeyKES v
sk -> forall (m :: * -> *) a. Monad m => a -> m a
return SignKeyKES v
sk
      Maybe (SignKeyKES v)
Nothing
        | Int
actual forall a. Eq a => a -> a -> Bool
/= Int
expected
                    -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"decodeSignKeyKES: wrong length, expected " forall a. [a] -> [a] -> [a]
++
                             forall a. Show a => a -> String
show Int
expected forall a. [a] -> [a] -> [a]
++ String
" bytes but got " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
actual)
        | Bool
otherwise -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"decodeSignKeyKES: cannot decode key"
        where
          expected :: Int
expected = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Word
sizeSignKeyKES (forall {k} (t :: k). Proxy t
Proxy :: Proxy v))
          actual :: Int
actual   = ByteString -> Int
BS.length ByteString
bs

decodeSigKES :: forall v s. KESAlgorithm v => Decoder s (SigKES v)
decodeSigKES :: forall v s. KESAlgorithm v => Decoder s (SigKES v)
decodeSigKES = do
    ByteString
bs <- forall s. Decoder s ByteString
decodeBytes
    case forall v. KESAlgorithm v => ByteString -> Maybe (SigKES v)
rawDeserialiseSigKES ByteString
bs of
      Just SigKES v
sig -> forall (m :: * -> *) a. Monad m => a -> m a
return SigKES v
sig
      Maybe (SigKES v)
Nothing
        | Int
actual forall a. Eq a => a -> a -> Bool
/= Int
expected
                    -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"decodeSigKES: wrong length, expected " forall a. [a] -> [a] -> [a]
++
                             forall a. Show a => a -> String
show Int
expected forall a. [a] -> [a] -> [a]
++ String
" bytes but got " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
actual)
        | Bool
otherwise -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"decodeSigKES: cannot decode key"
        where
          expected :: Int
expected = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Word
sizeSigKES (forall {k} (t :: k). Proxy t
Proxy :: Proxy v))
          actual :: Int
actual   = ByteString -> Int
BS.length ByteString
bs


-- | The KES period. Periods are enumerated from zero.
--
-- Be careful of fencepost errors: if there are 2 periods (period 0 and 1)
-- then there is only one key evolution.
--
type Period = Word

newtype SignedKES v a = SignedKES {forall v a. SignedKES v a -> SigKES v
getSig :: SigKES v}
  deriving forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v a x. Rep (SignedKES v a) x -> SignedKES v a
forall v a x. SignedKES v a -> Rep (SignedKES v a) x
$cto :: forall v a x. Rep (SignedKES v a) x -> SignedKES v a
$cfrom :: forall v a x. SignedKES v a -> Rep (SignedKES v a) x
Generic

deriving instance KESAlgorithm v => Show (SignedKES v a)
deriving instance KESAlgorithm v => Eq   (SignedKES v a)

instance KESAlgorithm v => NoThunks (SignedKES v a)
  -- use generic instance

signedKES
  :: (KESAlgorithm v, Signable v a)
  => ContextKES v
  -> Period
  -> a
  -> SignKeyKES v
  -> SignedKES v a
signedKES :: forall v a.
(KESAlgorithm v, Signable v a) =>
ContextKES v -> Word -> a -> SignKeyKES v -> SignedKES v a
signedKES ContextKES v
ctxt Word
time a
a SignKeyKES v
key = forall v a. SigKES v -> SignedKES v a
SignedKES (forall v a.
(KESAlgorithm v, Signable v a, HasCallStack) =>
ContextKES v -> Word -> a -> SignKeyKES v -> SigKES v
signKES ContextKES v
ctxt Word
time a
a SignKeyKES v
key)

verifySignedKES
  :: (KESAlgorithm v, Signable v a)
  => ContextKES v
  -> VerKeyKES v
  -> Period
  -> a
  -> SignedKES v a
  -> Either String ()
verifySignedKES :: forall v a.
(KESAlgorithm v, Signable v a) =>
ContextKES v
-> VerKeyKES v -> Word -> a -> SignedKES v a -> Either String ()
verifySignedKES ContextKES v
ctxt VerKeyKES v
vk Word
j a
a (SignedKES SigKES v
sig) = forall v a.
(KESAlgorithm v, Signable v a, HasCallStack) =>
ContextKES v
-> VerKeyKES v -> Word -> a -> SigKES v -> Either String ()
verifyKES ContextKES v
ctxt VerKeyKES v
vk Word
j a
a SigKES v
sig

encodeSignedKES :: KESAlgorithm v => SignedKES v a -> Encoding
encodeSignedKES :: forall v a. KESAlgorithm v => SignedKES v a -> Encoding
encodeSignedKES (SignedKES SigKES v
s) = forall v. KESAlgorithm v => SigKES v -> Encoding
encodeSigKES SigKES v
s

decodeSignedKES :: KESAlgorithm v => Decoder s (SignedKES v a)
decodeSignedKES :: forall v s a. KESAlgorithm v => Decoder s (SignedKES v a)
decodeSignedKES = forall v a. SigKES v -> SignedKES v a
SignedKES forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v s. KESAlgorithm v => Decoder s (SigKES v)
decodeSigKES

--
-- 'Size' expressions for 'ToCBOR' instances.
--

-- | 'Size' expression for 'VerKeyKES' which is using 'sizeVerKeyKES' encoded
-- as 'Size'.
--
encodedVerKeyKESSizeExpr :: forall v. KESAlgorithm v => Proxy (VerKeyKES v) -> Size
encodedVerKeyKESSizeExpr :: forall v. KESAlgorithm v => Proxy (VerKeyKES v) -> Size
encodedVerKeyKESSizeExpr Proxy (VerKeyKES v)
_proxy =
      -- 'encodeBytes' envelope
      forall a b. (Integral a, Num b) => a -> b
fromIntegral ((forall s a. (Integral s, Integral a) => s -> a
withWordSize :: Word -> Integer) (forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Word
sizeVerKeyKES (forall {k} (t :: k). Proxy t
Proxy :: Proxy v)))
      -- payload
    forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Word
sizeVerKeyKES (forall {k} (t :: k). Proxy t
Proxy :: Proxy v))

-- | 'Size' expression for 'SignKeyKES' which is using 'sizeSignKeyKES' encoded
-- as 'Size'.
--
encodedSignKeyKESSizeExpr :: forall v. KESAlgorithm v => Proxy (SignKeyKES v) -> Size
encodedSignKeyKESSizeExpr :: forall v. KESAlgorithm v => Proxy (SignKeyKES v) -> Size
encodedSignKeyKESSizeExpr Proxy (SignKeyKES v)
_proxy =
      -- 'encodeBytes' envelope
      forall a b. (Integral a, Num b) => a -> b
fromIntegral ((forall s a. (Integral s, Integral a) => s -> a
withWordSize :: Word -> Integer) (forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Word
sizeSignKeyKES (forall {k} (t :: k). Proxy t
Proxy :: Proxy v)))
      -- payload
    forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Word
sizeSignKeyKES (forall {k} (t :: k). Proxy t
Proxy :: Proxy v))

-- | 'Size' expression for 'SigKES' which is using 'sizeSigKES' encoded as
-- 'Size'.
--
encodedSigKESSizeExpr :: forall v. KESAlgorithm v => Proxy (SigKES v) -> Size
encodedSigKESSizeExpr :: forall v. KESAlgorithm v => Proxy (SigKES v) -> Size
encodedSigKESSizeExpr Proxy (SigKES v)
_proxy =
      -- 'encodeBytes' envelope
      forall a b. (Integral a, Num b) => a -> b
fromIntegral ((forall s a. (Integral s, Integral a) => s -> a
withWordSize :: Word -> Integer) (forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Word
sizeSigKES (forall {k} (t :: k). Proxy t
Proxy :: Proxy v)))
      -- payload
    forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Word
sizeSigKES (forall {k} (t :: k). Proxy t
Proxy :: Proxy v))

hashPairOfVKeys :: (KESAlgorithm d, HashAlgorithm h)
                => (VerKeyKES d, VerKeyKES d)
                -> Hash h (VerKeyKES d, VerKeyKES d)
hashPairOfVKeys :: forall d h.
(KESAlgorithm d, HashAlgorithm h) =>
(VerKeyKES d, VerKeyKES d) -> Hash h (VerKeyKES d, VerKeyKES d)
hashPairOfVKeys =
    forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
hashWith forall a b. (a -> b) -> a -> b
$ \(VerKeyKES d
a,VerKeyKES d
b) ->
      forall v. KESAlgorithm v => VerKeyKES v -> ByteString
rawSerialiseVerKeyKES VerKeyKES d
a forall a. Semigroup a => a -> a -> a
<> forall v. KESAlgorithm v => VerKeyKES v -> ByteString
rawSerialiseVerKeyKES VerKeyKES d
b

zeroSeed :: KESAlgorithm d => Proxy d -> Seed
zeroSeed :: forall d. KESAlgorithm d => Proxy d -> Seed
zeroSeed Proxy d
p = ByteString -> Seed
mkSeedFromBytes (Int -> Word8 -> ByteString
BS.replicate Int
seedSize (Word8
0 :: Word8))
  where
    seedSize :: Int
    seedSize :: Int
seedSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Word
seedSizeKES Proxy d
p)

mungeName :: String -> String
mungeName :: ShowS
mungeName String
basename
  | (String
name, Char
'^':String
nstr) <- forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => a -> a -> Bool
/= Char
'^') String
basename
  , [(Word
n, String
"")] <- forall a. Read a => ReadS a
reads String
nstr
  = String
name forall a. [a] -> [a] -> [a]
++ Char
'^' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show (Word
nforall a. Num a => a -> a -> a
+Word
1 :: Word)

  | Bool
otherwise
  = String
basename forall a. [a] -> [a] -> [a]
++ String
"_2^1"