Uses type families, GADTs, and Singletons to abstract over Scheme Options

schemes.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}

import Data.Kind
import qualified Crypto.Ed25519.Pure as Ed25519

data SchemeOptions = ED2551' | ETH'

data PPKScheme' :: SchemeOptions -> Type where
  ED2551 :: PPKScheme' ED2551'
  ETH :: PPKScheme' ETH'

instance Scheme (PPKScheme' ED2551') where
  type SchemePubKey (PPKScheme' ED2551') = Ed25519.PublicKey
  type SchemePrivKey (PPKScheme' ED2551') = Ed25519.PrivateKey
  formatPubKey _ p = Ed25519.exportPublic p 

class Scheme a where
  type SchemePubKey a
  type SchemePrivKey a
  formatPubKey :: a -> SchemePubKey a -> ByteString

testScheme :: IO (ByteString)
testScheme = do
  (s,p) <- genKeyPairEd
  let scheme = ED2551
  return $ formatPubKey scheme p

genKeyPairEd :: IO (Ed25519.PrivateKey, Ed25519.PublicKey)
genKeyPairEd  = do
  g :: SystemRandom <- newGenIO
  case Ed25519.generateKeyPair g of
    Left _ -> error "Something went wrong in genKeyPairs"
    Right (s,p,_) -> return (s,p)