-- GENERATED by C->Haskell Compiler, version 0.28.1 Switcheroo, 1 April 2016 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "./System/Crypto/Pkcs11.chs" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module System.Crypto.Pkcs11 (
    -- * Library
    Library,
    loadLibrary,
    releaseLibrary,

    -- ** Reading library information
    Info,
    getInfo,
    infoCryptokiVersion,
    infoManufacturerId,
    infoFlags,
    infoLibraryDescription,
    infoLibraryVersion,

    -- * Slots
    SlotId,
    getSlotList,

    -- ** Reading slot information
    SlotInfo,
    getSlotInfo,
    slotInfoDescription,
    slotInfoManufacturerId,
    slotInfoFlags,
    slotInfoHardwareVersion,
    slotInfoFirmwareVersion,

    -- ** Reading token information
    TokenInfo,
    getTokenInfo,
    tokenInfoLabel,
    tokenInfoManufacturerId,
    tokenInfoModel,
    tokenInfoSerialNumber,
    tokenInfoFlags,

    -- * Mechanisms
    MechType(RsaPkcsKeyPairGen,RsaPkcs,AesEcb,AesCbc,AesMac,AesMacGeneral,AesCbcPad,AesCtr),
    MechInfo,
    getMechanismList,
    getMechanismInfo,
    mechInfoMinKeySize,
    mechInfoMaxKeySize,
    mechInfoFlags,

    -- * Session management
    Session,
    UserType(User,SecurityOfficer,ContextSpecific),
    withSession,
    login,
    logout,

    -- * Object attributes
    ObjectHandle,
    Attribute(Class,Label,KeyType,Modulus,ModulusBits,PublicExponent,Token,Decrypt),
    ClassType(PrivateKey,SecretKey),
    KeyTypeValue(RSA,DSA,DH,ECDSA,EC,AES),
    -- ** Searching objects
    findObjects,
    -- ** Reading object attributes
    getTokenFlag,
    getPrivateFlag,
    getSensitiveFlag,
    getEncryptFlag,
    getDecryptFlag,
    getWrapFlag,
    getUnwrapFlag,
    getSignFlag,
    getModulus,
    getPublicExponent,

    -- * Key generation
    generateKeyPair,

    -- * Key wrapping/unwrapping
    unwrapKey,

    -- * Encryption/decryption
    decrypt,
    encrypt,

    -- * Misc
    Version,
    versionMajor,
    versionMinor,
) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified Foreign.Storable as C2HSImp


import Foreign
import Foreign.Marshal.Utils
import Foreign.Marshal.Alloc
import Foreign.C
import Foreign.Ptr
import System.Posix.DynamicLinker
import Control.Monad
import Control.Exception
import qualified Data.ByteString.UTF8 as BU8
import qualified Data.ByteString as BS
import Data.ByteString.Unsafe



{-
 Currently cannot use c2hs structure alignment and offset detector since it does not support pragma pack
 which is required by PKCS11, which is using 1 byte packing
 https://github.com/haskell/c2hs/issues/172
-}

_serialSession = 0x4 :: Int
_rwSession = 0x2 :: Int

rsaPkcsKeyPairGen = 0x0 :: Int

type ObjectHandle = (C2HSImp.CULong)
{-# LINE 114 "./System/Crypto/Pkcs11.chs" #-}

type SlotId = Int
type Rv = (C2HSImp.CULong)
{-# LINE 116 "./System/Crypto/Pkcs11.chs" #-}

type CK_BBOOL = (C2HSImp.CUChar)
{-# LINE 117 "./System/Crypto/Pkcs11.chs" #-}

type CK_BYTE = (C2HSImp.CUChar)
{-# LINE 118 "./System/Crypto/Pkcs11.chs" #-}

type CK_FLAGS = (C2HSImp.CULong)
{-# LINE 119 "./System/Crypto/Pkcs11.chs" #-}

type GetFunctionListFunPtr = ((C2HSImp.FunPtr ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (IO C2HSImp.CULong))))
{-# LINE 120 "./System/Crypto/Pkcs11.chs" #-}

type GetSlotListFunPtr = ((C2HSImp.FunPtr (C2HSImp.CUChar -> ((C2HSImp.Ptr C2HSImp.CULong) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CULong))))))
{-# LINE 121 "./System/Crypto/Pkcs11.chs" #-}

type NotifyFunPtr = ((C2HSImp.FunPtr (C2HSImp.CULong -> (C2HSImp.CULong -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CULong))))))
{-# LINE 122 "./System/Crypto/Pkcs11.chs" #-}

type SessionHandle = (C2HSImp.CULong)
{-# LINE 123 "./System/Crypto/Pkcs11.chs" #-}


type FunctionListPtr = C2HSImp.Ptr (())
{-# LINE 125 "./System/Crypto/Pkcs11.chs" #-}

type InfoPtr = C2HSImp.Ptr (Info)
{-# LINE 126 "./System/Crypto/Pkcs11.chs" #-}

type SlotInfoPtr = C2HSImp.Ptr (SlotInfo)
{-# LINE 127 "./System/Crypto/Pkcs11.chs" #-}

type TokenInfoPtr = C2HSImp.Ptr (TokenInfo)
{-# LINE 128 "./System/Crypto/Pkcs11.chs" #-}

type LlAttributePtr = C2HSImp.Ptr (LlAttribute)
{-# LINE 129 "./System/Crypto/Pkcs11.chs" #-}

type MechInfoPtr = C2HSImp.Ptr (MechInfo)
{-# LINE 130 "./System/Crypto/Pkcs11.chs" #-}

type MechPtr = C2HSImp.Ptr (Mech)
{-# LINE 131 "./System/Crypto/Pkcs11.chs" #-}


-- defined this one manually because I don't know how to make c2hs to define it yet
type GetFunctionListFun = (C2HSImp.Ptr (FunctionListPtr)) -> (IO C2HSImp.CULong)

foreign import ccall unsafe "dynamic"
  getFunctionList'_ :: GetFunctionListFunPtr -> GetFunctionListFun

data Version = Version {
    versionMajor :: Int,
    versionMinor :: Int
} deriving (Show)

instance Storable Version where
  sizeOf _ = 4
{-# LINE 145 "./System/Crypto/Pkcs11.chs" #-}

  alignment _ = 1
{-# LINE 146 "./System/Crypto/Pkcs11.chs" #-}

  peek p = Version
    <$> liftM fromIntegral ((\ptr -> do {C2HSImp.peekByteOff ptr 0 :: IO C2HSImp.CUChar}) p)
    <*> liftM fromIntegral ((\ptr -> do {C2HSImp.peekByteOff ptr 1 :: IO C2HSImp.CUChar}) p)
  poke p x = do
    (\ptr val -> do {C2HSImp.pokeByteOff ptr 0 (val :: C2HSImp.CUChar)}) p (fromIntegral $ versionMajor x)
    (\ptr val -> do {C2HSImp.pokeByteOff ptr 1 (val :: C2HSImp.CUChar)}) p (fromIntegral $ versionMinor x)

data Info = Info {
    -- | Cryptoki interface version number, for compatibility with future revisions of this interface
    infoCryptokiVersion :: Version,
    -- | ID of the Cryptoki library manufacturer
    infoManufacturerId :: String,
    -- | bit flags reserved for future versions. Must be zero for this version
    infoFlags :: Int,
    infoLibraryDescription :: String,
    -- | Cryptoki library version number
    infoLibraryVersion :: Version
} deriving (Show)

instance Storable Info where
  sizeOf _ = (2+32+4+32+10+2)
  alignment _ = 1
  peek p = do
    ver <- peek (p `plusPtr` (0)) :: IO Version
    manufacturerId <- peekCStringLen ((p `plusPtr` 2), 32)
    flags <- (\ptr -> do {C2HSImp.peekByteOff ptr (2+32) :: IO C2HSImp.CULong}) p
    --flags <- {#get CK_INFO->flags#} p
    libraryDescription <- peekCStringLen ((p `plusPtr` (2+32+4+10)), 32)
    --libraryDescription <- {# get CK_INFO->libraryDescription #} p
    libVer <- peek (p `plusPtr` (2+32+4+32+10)) :: IO Version
    return Info {infoCryptokiVersion=ver,
                 infoManufacturerId=manufacturerId,
                 infoFlags=fromIntegral flags,
                 infoLibraryDescription=libraryDescription,
                 infoLibraryVersion=libVer
                 }
  poke p v = do
    error "not implemented"


peekInfo :: Ptr Info -> IO Info
peekInfo ptr = peek ptr


data SlotInfo = SlotInfo {
    slotInfoDescription :: String,
    slotInfoManufacturerId :: String,
    -- | bit flags indicating capabilities and status of the slot as defined in https://www.cryptsoft.com/pkcs11doc/v220/pkcs11__all_8h.html#aCK_SLOT_INFO
    slotInfoFlags :: Int,
    slotInfoHardwareVersion :: Version,
    slotInfoFirmwareVersion :: Version
} deriving (Show)

instance Storable SlotInfo where
  sizeOf _ = (64+32+4+2+2)
  alignment _ = 1
  peek p = do
    description <- peekCStringLen ((p `plusPtr` 0), 64)
    manufacturerId <- peekCStringLen ((p `plusPtr` 64), 32)
    flags <- C2HSImp.peekByteOff p (64+32) :: IO C2HSImp.CULong
    hwVer <- peek (p `plusPtr` (64+32+4)) :: IO Version
    fwVer <- peek (p `plusPtr` (64+32+4+2)) :: IO Version
    return SlotInfo {slotInfoDescription=description,
                     slotInfoManufacturerId=manufacturerId,
                     slotInfoFlags=fromIntegral flags,
                     slotInfoHardwareVersion=hwVer,
                     slotInfoFirmwareVersion=fwVer
                     }
  poke p v = do
    error "not implemented"


data TokenInfo = TokenInfo {
    tokenInfoLabel :: String,
    tokenInfoManufacturerId :: String,
    tokenInfoModel :: String,
    tokenInfoSerialNumber :: String,
    -- | bit flags indicating capabilities and status of the device as defined in https://www.cryptsoft.com/pkcs11doc/v220/pkcs11__all_8h.html#aCK_TOKEN_INFO
    tokenInfoFlags :: Int--,
    --tokenInfoHardwareVersion :: Version,
    --tokenInfoFirmwareVersion :: Version
} deriving (Show)

instance Storable TokenInfo where
    sizeOf _ = (64+32+4+2+2)
    alignment _ = 1
    peek p = do
        label <- peekCStringLen ((p `plusPtr` 0), 32)
        manufacturerId <- peekCStringLen ((p `plusPtr` 32), 32)
        model <- peekCStringLen ((p `plusPtr` (32+32)), 16)
        serialNumber <- peekCStringLen ((p `plusPtr` (32+32+16)), 16)
        flags <- C2HSImp.peekByteOff p (32+32+16+16) :: IO C2HSImp.CULong
        --hwVer <- peek (p `plusPtr` (64+32+4)) :: IO Version
        --fwVer <- peek (p `plusPtr` (64+32+4+2)) :: IO Version
        return TokenInfo {tokenInfoLabel=label,
                          tokenInfoManufacturerId=manufacturerId,
                          tokenInfoModel=model,
                          tokenInfoSerialNumber=serialNumber,
                          tokenInfoFlags=fromIntegral flags--,
                          --tokenInfoHardwareVersion=hwVer,
                          --tokenInfoFirmwareVersion=fwVer
                          }

    poke p v = do
        error "not implemented"


data MechInfo = MechInfo {
    mechInfoMinKeySize :: Int,
    mechInfoMaxKeySize :: Int,
    mechInfoFlags :: Int
} deriving (Show)

instance Storable MechInfo where
  sizeOf _ = 24
{-# LINE 261 "./System/Crypto/Pkcs11.chs" #-}

  alignment _ = 1
  peek p = MechInfo
    <$> liftM fromIntegral ((\ptr -> do {C2HSImp.peekByteOff ptr 0 :: IO C2HSImp.CULong}) p)
    <*> liftM fromIntegral ((\ptr -> do {C2HSImp.peekByteOff ptr 8 :: IO C2HSImp.CULong}) p)
    <*> liftM fromIntegral ((\ptr -> do {C2HSImp.peekByteOff ptr 16 :: IO C2HSImp.CULong}) p)
  poke p x = do
    (\ptr val -> do {C2HSImp.pokeByteOff ptr 0 (val :: C2HSImp.CULong)}) p (fromIntegral $ mechInfoMinKeySize x)
    (\ptr val -> do {C2HSImp.pokeByteOff ptr 8 (val :: C2HSImp.CULong)}) p (fromIntegral $ mechInfoMaxKeySize x)
    (\ptr val -> do {C2HSImp.pokeByteOff ptr 16 (val :: C2HSImp.CULong)}) p (fromIntegral $ mechInfoFlags x)


data Mech = Mech {
    mechType :: MechType,
    mechParamPtr :: Ptr (),
    mechParamSize :: Int
}

instance Storable Mech where
    sizeOf _ = 8 + 8 + 8
{-# LINE 280 "./System/Crypto/Pkcs11.chs" #-}

    alignment _ = 1
    peek p = do
        error "not implemented"
    poke p x = do
        poke (p `plusPtr` 0) (fromEnum $ mechType x)
        poke (p `plusPtr` 8) (mechParamPtr x :: ((C2HSImp.Ptr ())))
        poke (p `plusPtr` (8 + 8)) (mechParamSize x)



initialize :: (FunctionListPtr) -> IO ((Rv))
initialize a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  (\ptr -> do {C2HSImp.peekByteOff ptr 8 :: IO (C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> (IO C2HSImp.CULong)))})  a1' >>= \b1' ->
  initialize'_ b1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 293 "./System/Crypto/Pkcs11.chs" #-}


getInfo' :: (FunctionListPtr) -> IO ((Rv), (Info))
getInfo' a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  (\ptr -> do {C2HSImp.peekByteOff ptr 24 :: IO (C2HSImp.FunPtr ((InfoPtr) -> (IO C2HSImp.CULong)))})  a1' >>= \b1' ->
  getInfo''_ b1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  peekInfo  a2'>>= \a2'' -> 
  return (res', a2'')

{-# LINE 297 "./System/Crypto/Pkcs11.chs" #-}



getSlotList' functionListPtr active num = do
  alloca $ \arrayLenPtr -> do
    poke arrayLenPtr (fromIntegral num)
    allocaArray num $ \array -> do
      res <- (\o x1 x2 x3 -> (\ptr -> do {C2HSImp.peekByteOff ptr 40 :: IO (C2HSImp.FunPtr (C2HSImp.CUChar -> ((C2HSImp.Ptr C2HSImp.CULong) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CULong)))))}) o >>= \f -> cK_FUNCTION_LISTc_GetSlotList f x1 x2 x3) functionListPtr (fromBool active) array arrayLenPtr
      arrayLen <- peek arrayLenPtr
      slots <- peekArray (fromIntegral arrayLen) array
      return (fromIntegral res, slots)


getSlotInfo' :: (FunctionListPtr) -> (Int) -> IO ((Rv), (SlotInfo))
getSlotInfo' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  alloca $ \a3' -> 
  (\ptr -> do {C2HSImp.peekByteOff ptr 48 :: IO (C2HSImp.FunPtr (C2HSImp.CULong -> ((SlotInfoPtr) -> (IO C2HSImp.CULong))))})  a1' >>= \b1' ->
  getSlotInfo''_ b1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a3'>>= \a3'' -> 
  return (res', a3'')

{-# LINE 314 "./System/Crypto/Pkcs11.chs" #-}



getTokenInfo' :: (FunctionListPtr) -> (Int) -> IO ((Rv), (TokenInfo))
getTokenInfo' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  alloca $ \a3' -> 
  (\ptr -> do {C2HSImp.peekByteOff ptr 56 :: IO (C2HSImp.FunPtr (C2HSImp.CULong -> ((TokenInfoPtr) -> (IO C2HSImp.CULong))))})  a1' >>= \b1' ->
  getTokenInfo''_ b1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a3'>>= \a3'' -> 
  return (res', a3'')

{-# LINE 321 "./System/Crypto/Pkcs11.chs" #-}



openSession' functionListPtr slotId flags =
  alloca $ \slotIdPtr -> do
    res <- (\o x1 x2 x3 x4 x5 -> (\ptr -> do {C2HSImp.peekByteOff ptr 104 :: IO (C2HSImp.FunPtr (C2HSImp.CULong -> (C2HSImp.CULong -> ((C2HSImp.Ptr ()) -> ((C2HSImp.FunPtr (C2HSImp.CULong -> (C2HSImp.CULong -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CULong))))) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CULong)))))))}) o >>= \f -> cK_FUNCTION_LISTc_OpenSession f x1 x2 x3 x4 x5) functionListPtr (fromIntegral slotId) (fromIntegral flags) nullPtr nullFunPtr slotIdPtr
    slotId <- peek slotIdPtr
    return (fromIntegral res, fromIntegral slotId)


closeSession' :: (FunctionListPtr) -> (CULong) -> IO ((Rv))
closeSession' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  (\ptr -> do {C2HSImp.peekByteOff ptr 112 :: IO (C2HSImp.FunPtr (C2HSImp.CULong -> (IO C2HSImp.CULong)))})  a1' >>= \b1' ->
  closeSession''_ b1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 333 "./System/Crypto/Pkcs11.chs" #-}



finalize :: (FunctionListPtr) -> IO ((Rv))
finalize a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  (\ptr -> do {C2HSImp.peekByteOff ptr 16 :: IO (C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> (IO C2HSImp.CULong)))})  a1' >>= \b1' ->
  finalize'_ b1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 338 "./System/Crypto/Pkcs11.chs" #-}



getFunctionList :: GetFunctionListFunPtr -> IO ((Rv), (FunctionListPtr))
getFunctionList getFunctionListPtr =
  alloca $ \funcListPtrPtr -> do
    res <- (getFunctionList'_ getFunctionListPtr) funcListPtrPtr
    funcListPtr <- peek funcListPtrPtr
    return (fromIntegral res, funcListPtr)


findObjectsInit' functionListPtr session attribs = do
    _withAttribs attribs $ \attribsPtr -> do
        res <- (\o x1 x2 x3 -> (\ptr -> do {C2HSImp.peekByteOff ptr 216 :: IO (C2HSImp.FunPtr (C2HSImp.CULong -> ((LlAttributePtr) -> (C2HSImp.CULong -> (IO C2HSImp.CULong)))))}) o >>= \f -> cK_FUNCTION_LISTc_FindObjectsInit f x1 x2 x3) functionListPtr session attribsPtr (fromIntegral $ length attribs)
        return (fromIntegral res)


findObjects' functionListPtr session maxObjects = do
  alloca $ \arrayLenPtr -> do
    poke arrayLenPtr (fromIntegral 0)
    allocaArray maxObjects $ \array -> do
      res <- (\o x1 x2 x3 x4 -> (\ptr -> do {C2HSImp.peekByteOff ptr 224 :: IO (C2HSImp.FunPtr (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CULong) -> (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CULong))))))}) o >>= \f -> cK_FUNCTION_LISTc_FindObjects f x1 x2 x3 x4) functionListPtr session array (fromIntegral maxObjects) arrayLenPtr
      arrayLen <- peek arrayLenPtr
      objectHandles <- peekArray (fromIntegral arrayLen) array
      return (fromIntegral res, objectHandles)


findObjectsFinal' :: (FunctionListPtr) -> (CULong) -> IO ((Rv))
findObjectsFinal' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  (\ptr -> do {C2HSImp.peekByteOff ptr 232 :: IO (C2HSImp.FunPtr (C2HSImp.CULong -> (IO C2HSImp.CULong)))})  a1' >>= \b1' ->
  findObjectsFinal''_ b1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 367 "./System/Crypto/Pkcs11.chs" #-}



data UserType = SecurityOfficer
              | User
              | ContextSpecific
  deriving (Eq)
instance Enum UserType where
  succ SecurityOfficer = User
  succ User = ContextSpecific
  succ ContextSpecific = error "UserType.succ: ContextSpecific has no successor"

  pred User = SecurityOfficer
  pred ContextSpecific = User
  pred SecurityOfficer = error "UserType.pred: SecurityOfficer has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from ContextSpecific

  fromEnum SecurityOfficer = 0
  fromEnum User = 1
  fromEnum ContextSpecific = 2

  toEnum 0 = SecurityOfficer
  toEnum 1 = User
  toEnum 2 = ContextSpecific
  toEnum unmatched = error ("UserType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 370 "./System/Crypto/Pkcs11.chs" #-}



_login :: FunctionListPtr -> SessionHandle -> UserType -> BU8.ByteString -> IO (Rv)
_login functionListPtr session userType pin = do
    unsafeUseAsCStringLen pin $ \(pinPtr, pinLen) -> do
        res <- (\o x1 x2 x3 x4 -> (\ptr -> do {C2HSImp.peekByteOff ptr 152 :: IO (C2HSImp.FunPtr (C2HSImp.CULong -> (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CUChar) -> (C2HSImp.CULong -> (IO C2HSImp.CULong))))))}) o >>= \f -> cK_FUNCTION_LISTc_Login f x1 x2 x3 x4) functionListPtr session (fromIntegral $ fromEnum userType) (castPtr pinPtr) (fromIntegral pinLen)
        return (fromIntegral res)


_generateKeyPair :: FunctionListPtr -> SessionHandle -> MechType -> [Attribute] -> [Attribute] -> IO (Rv, ObjectHandle, ObjectHandle)
_generateKeyPair functionListPtr session mechType pubAttrs privAttrs = do
    alloca $ \pubKeyHandlePtr -> do
        alloca $ \privKeyHandlePtr -> do
            alloca $ \mechPtr -> do
                poke mechPtr (Mech {mechType = mechType, mechParamPtr = nullPtr, mechParamSize = 0})
                _withAttribs pubAttrs $ \pubAttrsPtr -> do
                    _withAttribs privAttrs $ \privAttrsPtr -> do
                        res <- (\o x1 x2 x3 x4 x5 x6 x7 x8 -> (\ptr -> do {C2HSImp.peekByteOff ptr 480 :: IO (C2HSImp.FunPtr (C2HSImp.CULong -> ((MechPtr) -> ((LlAttributePtr) -> (C2HSImp.CULong -> ((LlAttributePtr) -> (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CULong) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CULong))))))))))}) o >>= \f -> cK_FUNCTION_LISTc_GenerateKeyPair f x1 x2 x3 x4 x5 x6 x7 x8) functionListPtr session mechPtr pubAttrsPtr (fromIntegral $ length pubAttrs) privAttrsPtr (fromIntegral $ length privAttrs) pubKeyHandlePtr privKeyHandlePtr
                        pubKeyHandle <- peek pubKeyHandlePtr
                        privKeyHandle <- peek privKeyHandlePtr
                        return (fromIntegral res, fromIntegral pubKeyHandle, fromIntegral privKeyHandle)



_getMechanismList :: FunctionListPtr -> Int -> Int -> IO (Rv, [Int])
_getMechanismList functionListPtr slotId maxMechanisms = do
    alloca $ \arrayLenPtr -> do
        poke arrayLenPtr (fromIntegral maxMechanisms)
        allocaArray maxMechanisms $ \array -> do
            res <- (\o x1 x2 x3 -> (\ptr -> do {C2HSImp.peekByteOff ptr 64 :: IO (C2HSImp.FunPtr (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CULong) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CULong)))))}) o >>= \f -> cK_FUNCTION_LISTc_GetMechanismList f x1 x2 x3) functionListPtr (fromIntegral slotId) array arrayLenPtr
            arrayLen <- peek arrayLenPtr
            objectHandles <- peekArray (fromIntegral arrayLen) array
            return (fromIntegral res, map (fromIntegral) objectHandles)


_getMechanismInfo :: (FunctionListPtr) -> (Int) -> (Int) -> IO ((Rv), (MechInfo))
_getMechanismInfo a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  alloca $ \a4' -> 
  (\ptr -> do {C2HSImp.peekByteOff ptr 72 :: IO (C2HSImp.FunPtr (C2HSImp.CULong -> (C2HSImp.CULong -> ((MechInfoPtr) -> (IO C2HSImp.CULong)))))})  a1' >>= \b1' ->
  _getMechanismInfo'_ b1' a2' a3' a4' >>= \res ->
  let {res' = fromIntegral res} in
  peek  a4'>>= \a4'' -> 
  return (res', a4'')

{-# LINE 411 "./System/Crypto/Pkcs11.chs" #-}



rvToStr :: Rv -> String
rvToStr 0x0 = "ok"
rvToStr 0x7 = "bad arguments"
rvToStr 0x10 = "attribute is read-only"
rvToStr 0x12 = "invalid attribute type specified in template"
rvToStr 0x13 = "invalid attribute value specified in template"
rvToStr 0x150 = "buffer too small"
rvToStr 0x190 = "cryptoki not initialized"
rvToStr 0x20 = "data invalid"
rvToStr 0x30 = "device error"
rvToStr 0x31 = "device memory"
rvToStr 0x32 = "device removed"
rvToStr 0x130 = "invalid domain parameters"
rvToStr 0x40 = "encrypted data is invalid"
rvToStr 0x41 = "encrypted data length not in range"
rvToStr 0x50 = "function canceled"
rvToStr 0x6 = "function failed"
rvToStr 0x5 = "general error"
rvToStr 0x2 = "host memory"
rvToStr 0x68 = "key function not permitted"
rvToStr 0x60 = "key handle invalid"
rvToStr 0x62 = "key size range"
rvToStr 0x63 = "key type inconsistent"
rvToStr 0x70 = "invalid mechanism"
rvToStr 0x71 = "invalid mechanism parameter"
rvToStr 0x90 = "there is already an active operation in-progress"
rvToStr 0x91 = "operation was not initialized"
rvToStr 0xa3 = "PIN is expired, you need to setup a new PIN"
rvToStr 0xa0 = "PIN is incorrect, authentication failed"
rvToStr 0xa4 = "PIN is locked, authentication failed"
rvToStr 0xb0 = "session was closed in a middle of operation"
rvToStr 0xb1 = "session count"
rvToStr 0xb3 = "session handle is invalid"
rvToStr 0xb4 = "parallel session not supported"
rvToStr 0xb5 = "session is read-only"
rvToStr 0xb7 = "read-only session exists, SO cannot login"
rvToStr 0xb8 = "read-write SO session exists"
rvToStr 0x3 = "slot id invalid"
rvToStr 0xd0 = "provided template is incomplete"
rvToStr 0xd1 = "provided template is inconsistent"
rvToStr 0xe0 = "token not present"
rvToStr 0xe1 = "token not recognized"
rvToStr 0xe2 = "token is write protected"
rvToStr 0xf0 = "unwrapping key handle invalid"
rvToStr 0xf1 = "unwrapping key size not in range"
rvToStr 0xf2 = "unwrapping key type inconsistent"
rvToStr 0x101 = "user needs to be logged in to perform this operation"
rvToStr 0x100 = "user already logged in"
rvToStr 0x104 = "another user already logged in, first another user should be logged out"
rvToStr 0x102 = "user PIN not initialized, need to setup PIN first"
rvToStr 0x105 = "cannot login user, somebody should logout first"
rvToStr 0x103 = "invalid value for user type"
rvToStr 0x110 = "wrapped key invalid"
rvToStr 0x112 = "wrapped key length not in range"
rvToStr rv = "unknown value for error " ++ (show rv)


-- Attributes

data ClassType = Data
               | Certificate
               | PublicKey
               | PrivateKey
               | SecretKey
               | HWFeature
               | DomainParameters
               | Mechanism
  deriving (Show,Eq)
instance Enum ClassType where
  succ Data = Certificate
  succ Certificate = PublicKey
  succ PublicKey = PrivateKey
  succ PrivateKey = SecretKey
  succ SecretKey = HWFeature
  succ HWFeature = DomainParameters
  succ DomainParameters = Mechanism
  succ Mechanism = error "ClassType.succ: Mechanism has no successor"

  pred Certificate = Data
  pred PublicKey = Certificate
  pred PrivateKey = PublicKey
  pred SecretKey = PrivateKey
  pred HWFeature = SecretKey
  pred DomainParameters = HWFeature
  pred Mechanism = DomainParameters
  pred Data = error "ClassType.pred: Data has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from Mechanism

  fromEnum Data = 0
  fromEnum Certificate = 1
  fromEnum PublicKey = 2
  fromEnum PrivateKey = 3
  fromEnum SecretKey = 4
  fromEnum HWFeature = 5
  fromEnum DomainParameters = 6
  fromEnum Mechanism = 7

  toEnum 0 = Data
  toEnum 1 = Certificate
  toEnum 2 = PublicKey
  toEnum 3 = PrivateKey
  toEnum 4 = SecretKey
  toEnum 5 = HWFeature
  toEnum 6 = DomainParameters
  toEnum 7 = Mechanism
  toEnum unmatched = error ("ClassType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 483 "./System/Crypto/Pkcs11.chs" #-}


data KeyTypeValue = RSA
                  | DSA
                  | DH
                  | ECDSA
                  | EC
                  | AES
  deriving (Show,Eq)
instance Enum KeyTypeValue where
  succ RSA = DSA
  succ DSA = DH
  succ DH = ECDSA
  succ ECDSA = AES
  succ EC = AES
  succ AES = error "KeyTypeValue.succ: AES has no successor"

  pred DSA = RSA
  pred DH = DSA
  pred ECDSA = DH
  pred EC = DH
  pred AES = ECDSA
  pred RSA = error "KeyTypeValue.pred: RSA has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from AES

  fromEnum RSA = 0
  fromEnum DSA = 1
  fromEnum DH = 2
  fromEnum ECDSA = 3
  fromEnum EC = 3
  fromEnum AES = 31

  toEnum 0 = RSA
  toEnum 1 = DSA
  toEnum 2 = DH
  toEnum 3 = ECDSA
  toEnum 31 = AES
  toEnum unmatched = error ("KeyTypeValue.toEnum: Cannot match " ++ show unmatched)

{-# LINE 492 "./System/Crypto/Pkcs11.chs" #-}


data AttributeType = ClassType
                   | TokenType
                   | PrivateType
                   | LabelType
                   | ApplicationType
                   | ValueType
                   | ObjectType
                   | CertificateType
                   | IssuerType
                   | SerialNumberType
                   | AcIssuerType
                   | OwnerType
                   | AttrTypesType
                   | TrustedType
                   | CertificateCategoryType
                   | JavaMidpSecurityDomainType
                   | UrlType
                   | HashOfSubjectPublicKeyType
                   | HashOfIssuerPublicKeyType
                   | CheckValueType
                   | KeyTypeType
                   | SubjectType
                   | IdType
                   | SensitiveType
                   | EncryptType
                   | DecryptType
                   | WrapType
                   | UnwrapType
                   | SignType
                   | SignRecoverType
                   | VerifyType
                   | VerifyRecoverType
                   | DeriveType
                   | StartDateType
                   | EndDataType
                   | ModulusType
                   | ModulusBitsType
                   | PublicExponentType
                   | PrivateExponentType
                   | Prime1Type
                   | Prime2Type
                   | Exponent1Type
                   | Exponent2Type
                   | CoefficientType
                   | PrimeBitsType
                   | SubPrimeBitsType
                   | ValueBitsType
                   | ValueLenType
                   | ExtractableType
                   | LocalType
                   | NeverExtractableType
                   | AlwaysSensitiveType
                   | KeyGenMechanismType
                   | ModifiableType
                   | EcdsaParamsType
                   | EcParamsType
                   | EcPointType
                   | SecondaryAuthType
                   | AuthPinFlagsType
                   | AlwaysAuthenticateType
                   | WrapWithTrustedType
                   | OtpFormatType
                   | OtpLengthType
                   | OtpTimeIntervalType
                   | OtpUserFriendlyModeType
                   | OtpChallengeRequirementType
                   | OtpTimeRequirementType
                   | OtpCounterRequirementType
                   | OtpPinRequirementType
                   | OtpUserIdentifierType
                   | OtpServiceIdentifierType
                   | OtpServiceLogoType
                   | OtpServiceLogoTypeType
                   | OtpCounterType
                   | OtpTimeType
                   | GostR3410ParamsType
                   | GostR3411ParamsType
                   | Gost28147ParamsType
                   | HwFeatureTypeType
                   | ResetOnInitType
                   | HasResetType
                   | PixelXType
                   | PixelYType
                   | ResolutionType
                   | CharRowsType
                   | CharColumnsType
                   | ColorType
                   | BitPerPixelType
                   | CharSetsType
                   | EncodingMethodsType
                   | MimeTypesType
                   | MechanismTypeType
                   | RequiredCmsAttributesType
                   | DefaultCmsAttributesType
                   | SupportedCmsAttributesType
                   | WrapTemplateType
                   | UnwrapTemplateType
                   | DeriveTemplateType
                   | AllowedMechanismsType
                   | VendorDefinedType
  deriving (Show,Eq)
instance Enum AttributeType where
  succ ClassType = TokenType
  succ TokenType = PrivateType
  succ PrivateType = LabelType
  succ LabelType = ApplicationType
  succ ApplicationType = ValueType
  succ ValueType = ObjectType
  succ ObjectType = CertificateType
  succ CertificateType = IssuerType
  succ IssuerType = SerialNumberType
  succ SerialNumberType = AcIssuerType
  succ AcIssuerType = OwnerType
  succ OwnerType = AttrTypesType
  succ AttrTypesType = TrustedType
  succ TrustedType = CertificateCategoryType
  succ CertificateCategoryType = JavaMidpSecurityDomainType
  succ JavaMidpSecurityDomainType = UrlType
  succ UrlType = HashOfSubjectPublicKeyType
  succ HashOfSubjectPublicKeyType = HashOfIssuerPublicKeyType
  succ HashOfIssuerPublicKeyType = CheckValueType
  succ CheckValueType = KeyTypeType
  succ KeyTypeType = SubjectType
  succ SubjectType = IdType
  succ IdType = SensitiveType
  succ SensitiveType = EncryptType
  succ EncryptType = DecryptType
  succ DecryptType = WrapType
  succ WrapType = UnwrapType
  succ UnwrapType = SignType
  succ SignType = SignRecoverType
  succ SignRecoverType = VerifyType
  succ VerifyType = VerifyRecoverType
  succ VerifyRecoverType = DeriveType
  succ DeriveType = StartDateType
  succ StartDateType = EndDataType
  succ EndDataType = ModulusType
  succ ModulusType = ModulusBitsType
  succ ModulusBitsType = PublicExponentType
  succ PublicExponentType = PrivateExponentType
  succ PrivateExponentType = Prime1Type
  succ Prime1Type = Prime2Type
  succ Prime2Type = Exponent1Type
  succ Exponent1Type = Exponent2Type
  succ Exponent2Type = CoefficientType
  succ CoefficientType = PrimeBitsType
  succ PrimeBitsType = SubPrimeBitsType
  succ SubPrimeBitsType = ValueBitsType
  succ ValueBitsType = ValueLenType
  succ ValueLenType = ExtractableType
  succ ExtractableType = LocalType
  succ LocalType = NeverExtractableType
  succ NeverExtractableType = AlwaysSensitiveType
  succ AlwaysSensitiveType = KeyGenMechanismType
  succ KeyGenMechanismType = ModifiableType
  succ ModifiableType = EcdsaParamsType
  succ EcdsaParamsType = EcPointType
  succ EcParamsType = EcPointType
  succ EcPointType = SecondaryAuthType
  succ SecondaryAuthType = AuthPinFlagsType
  succ AuthPinFlagsType = AlwaysAuthenticateType
  succ AlwaysAuthenticateType = WrapWithTrustedType
  succ WrapWithTrustedType = OtpFormatType
  succ OtpFormatType = OtpLengthType
  succ OtpLengthType = OtpTimeIntervalType
  succ OtpTimeIntervalType = OtpUserFriendlyModeType
  succ OtpUserFriendlyModeType = OtpChallengeRequirementType
  succ OtpChallengeRequirementType = OtpTimeRequirementType
  succ OtpTimeRequirementType = OtpCounterRequirementType
  succ OtpCounterRequirementType = OtpPinRequirementType
  succ OtpPinRequirementType = OtpUserIdentifierType
  succ OtpUserIdentifierType = OtpServiceIdentifierType
  succ OtpServiceIdentifierType = OtpServiceLogoType
  succ OtpServiceLogoType = OtpServiceLogoTypeType
  succ OtpServiceLogoTypeType = OtpCounterType
  succ OtpCounterType = OtpTimeType
  succ OtpTimeType = GostR3410ParamsType
  succ GostR3410ParamsType = GostR3411ParamsType
  succ GostR3411ParamsType = Gost28147ParamsType
  succ Gost28147ParamsType = HwFeatureTypeType
  succ HwFeatureTypeType = ResetOnInitType
  succ ResetOnInitType = HasResetType
  succ HasResetType = PixelXType
  succ PixelXType = PixelYType
  succ PixelYType = ResolutionType
  succ ResolutionType = CharRowsType
  succ CharRowsType = CharColumnsType
  succ CharColumnsType = ColorType
  succ ColorType = BitPerPixelType
  succ BitPerPixelType = CharSetsType
  succ CharSetsType = EncodingMethodsType
  succ EncodingMethodsType = MimeTypesType
  succ MimeTypesType = MechanismTypeType
  succ MechanismTypeType = RequiredCmsAttributesType
  succ RequiredCmsAttributesType = DefaultCmsAttributesType
  succ DefaultCmsAttributesType = SupportedCmsAttributesType
  succ SupportedCmsAttributesType = WrapTemplateType
  succ WrapTemplateType = UnwrapTemplateType
  succ UnwrapTemplateType = DeriveTemplateType
  succ DeriveTemplateType = AllowedMechanismsType
  succ AllowedMechanismsType = VendorDefinedType
  succ VendorDefinedType = error "AttributeType.succ: VendorDefinedType has no successor"

  pred TokenType = ClassType
  pred PrivateType = TokenType
  pred LabelType = PrivateType
  pred ApplicationType = LabelType
  pred ValueType = ApplicationType
  pred ObjectType = ValueType
  pred CertificateType = ObjectType
  pred IssuerType = CertificateType
  pred SerialNumberType = IssuerType
  pred AcIssuerType = SerialNumberType
  pred OwnerType = AcIssuerType
  pred AttrTypesType = OwnerType
  pred TrustedType = AttrTypesType
  pred CertificateCategoryType = TrustedType
  pred JavaMidpSecurityDomainType = CertificateCategoryType
  pred UrlType = JavaMidpSecurityDomainType
  pred HashOfSubjectPublicKeyType = UrlType
  pred HashOfIssuerPublicKeyType = HashOfSubjectPublicKeyType
  pred CheckValueType = HashOfIssuerPublicKeyType
  pred KeyTypeType = CheckValueType
  pred SubjectType = KeyTypeType
  pred IdType = SubjectType
  pred SensitiveType = IdType
  pred EncryptType = SensitiveType
  pred DecryptType = EncryptType
  pred WrapType = DecryptType
  pred UnwrapType = WrapType
  pred SignType = UnwrapType
  pred SignRecoverType = SignType
  pred VerifyType = SignRecoverType
  pred VerifyRecoverType = VerifyType
  pred DeriveType = VerifyRecoverType
  pred StartDateType = DeriveType
  pred EndDataType = StartDateType
  pred ModulusType = EndDataType
  pred ModulusBitsType = ModulusType
  pred PublicExponentType = ModulusBitsType
  pred PrivateExponentType = PublicExponentType
  pred Prime1Type = PrivateExponentType
  pred Prime2Type = Prime1Type
  pred Exponent1Type = Prime2Type
  pred Exponent2Type = Exponent1Type
  pred CoefficientType = Exponent2Type
  pred PrimeBitsType = CoefficientType
  pred SubPrimeBitsType = PrimeBitsType
  pred ValueBitsType = SubPrimeBitsType
  pred ValueLenType = ValueBitsType
  pred ExtractableType = ValueLenType
  pred LocalType = ExtractableType
  pred NeverExtractableType = LocalType
  pred AlwaysSensitiveType = NeverExtractableType
  pred KeyGenMechanismType = AlwaysSensitiveType
  pred ModifiableType = KeyGenMechanismType
  pred EcdsaParamsType = ModifiableType
  pred EcParamsType = ModifiableType
  pred EcPointType = EcdsaParamsType
  pred SecondaryAuthType = EcPointType
  pred AuthPinFlagsType = SecondaryAuthType
  pred AlwaysAuthenticateType = AuthPinFlagsType
  pred WrapWithTrustedType = AlwaysAuthenticateType
  pred OtpFormatType = WrapWithTrustedType
  pred OtpLengthType = OtpFormatType
  pred OtpTimeIntervalType = OtpLengthType
  pred OtpUserFriendlyModeType = OtpTimeIntervalType
  pred OtpChallengeRequirementType = OtpUserFriendlyModeType
  pred OtpTimeRequirementType = OtpChallengeRequirementType
  pred OtpCounterRequirementType = OtpTimeRequirementType
  pred OtpPinRequirementType = OtpCounterRequirementType
  pred OtpUserIdentifierType = OtpPinRequirementType
  pred OtpServiceIdentifierType = OtpUserIdentifierType
  pred OtpServiceLogoType = OtpServiceIdentifierType
  pred OtpServiceLogoTypeType = OtpServiceLogoType
  pred OtpCounterType = OtpServiceLogoTypeType
  pred OtpTimeType = OtpCounterType
  pred GostR3410ParamsType = OtpTimeType
  pred GostR3411ParamsType = GostR3410ParamsType
  pred Gost28147ParamsType = GostR3411ParamsType
  pred HwFeatureTypeType = Gost28147ParamsType
  pred ResetOnInitType = HwFeatureTypeType
  pred HasResetType = ResetOnInitType
  pred PixelXType = HasResetType
  pred PixelYType = PixelXType
  pred ResolutionType = PixelYType
  pred CharRowsType = ResolutionType
  pred CharColumnsType = CharRowsType
  pred ColorType = CharColumnsType
  pred BitPerPixelType = ColorType
  pred CharSetsType = BitPerPixelType
  pred EncodingMethodsType = CharSetsType
  pred MimeTypesType = EncodingMethodsType
  pred MechanismTypeType = MimeTypesType
  pred RequiredCmsAttributesType = MechanismTypeType
  pred DefaultCmsAttributesType = RequiredCmsAttributesType
  pred SupportedCmsAttributesType = DefaultCmsAttributesType
  pred WrapTemplateType = SupportedCmsAttributesType
  pred UnwrapTemplateType = WrapTemplateType
  pred DeriveTemplateType = UnwrapTemplateType
  pred AllowedMechanismsType = DeriveTemplateType
  pred VendorDefinedType = AllowedMechanismsType
  pred ClassType = error "AttributeType.pred: ClassType has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from VendorDefinedType

  fromEnum ClassType = 0
  fromEnum TokenType = 1
  fromEnum PrivateType = 2
  fromEnum LabelType = 3
  fromEnum ApplicationType = 16
  fromEnum ValueType = 17
  fromEnum ObjectType = 18
  fromEnum CertificateType = 128
  fromEnum IssuerType = 129
  fromEnum SerialNumberType = 130
  fromEnum AcIssuerType = 131
  fromEnum OwnerType = 132
  fromEnum AttrTypesType = 133
  fromEnum TrustedType = 134
  fromEnum CertificateCategoryType = 135
  fromEnum JavaMidpSecurityDomainType = 136
  fromEnum UrlType = 137
  fromEnum HashOfSubjectPublicKeyType = 138
  fromEnum HashOfIssuerPublicKeyType = 139
  fromEnum CheckValueType = 144
  fromEnum KeyTypeType = 256
  fromEnum SubjectType = 257
  fromEnum IdType = 258
  fromEnum SensitiveType = 259
  fromEnum EncryptType = 260
  fromEnum DecryptType = 261
  fromEnum WrapType = 262
  fromEnum UnwrapType = 263
  fromEnum SignType = 264
  fromEnum SignRecoverType = 265
  fromEnum VerifyType = 266
  fromEnum VerifyRecoverType = 267
  fromEnum DeriveType = 268
  fromEnum StartDateType = 272
  fromEnum EndDataType = 273
  fromEnum ModulusType = 288
  fromEnum ModulusBitsType = 289
  fromEnum PublicExponentType = 290
  fromEnum PrivateExponentType = 291
  fromEnum Prime1Type = 292
  fromEnum Prime2Type = 293
  fromEnum Exponent1Type = 294
  fromEnum Exponent2Type = 295
  fromEnum CoefficientType = 296
  fromEnum PrimeBitsType = 307
  fromEnum SubPrimeBitsType = 308
  fromEnum ValueBitsType = 352
  fromEnum ValueLenType = 353
  fromEnum ExtractableType = 354
  fromEnum LocalType = 355
  fromEnum NeverExtractableType = 356
  fromEnum AlwaysSensitiveType = 357
  fromEnum KeyGenMechanismType = 358
  fromEnum ModifiableType = 368
  fromEnum EcdsaParamsType = 384
  fromEnum EcParamsType = 384
  fromEnum EcPointType = 385
  fromEnum SecondaryAuthType = 512
  fromEnum AuthPinFlagsType = 513
  fromEnum AlwaysAuthenticateType = 514
  fromEnum WrapWithTrustedType = 528
  fromEnum OtpFormatType = 544
  fromEnum OtpLengthType = 545
  fromEnum OtpTimeIntervalType = 546
  fromEnum OtpUserFriendlyModeType = 547
  fromEnum OtpChallengeRequirementType = 548
  fromEnum OtpTimeRequirementType = 549
  fromEnum OtpCounterRequirementType = 550
  fromEnum OtpPinRequirementType = 551
  fromEnum OtpUserIdentifierType = 554
  fromEnum OtpServiceIdentifierType = 555
  fromEnum OtpServiceLogoType = 556
  fromEnum OtpServiceLogoTypeType = 557
  fromEnum OtpCounterType = 558
  fromEnum OtpTimeType = 559
  fromEnum GostR3410ParamsType = 592
  fromEnum GostR3411ParamsType = 593
  fromEnum Gost28147ParamsType = 594
  fromEnum HwFeatureTypeType = 768
  fromEnum ResetOnInitType = 769
  fromEnum HasResetType = 770
  fromEnum PixelXType = 1024
  fromEnum PixelYType = 1025
  fromEnum ResolutionType = 1026
  fromEnum CharRowsType = 1027
  fromEnum CharColumnsType = 1028
  fromEnum ColorType = 1029
  fromEnum BitPerPixelType = 1030
  fromEnum CharSetsType = 1152
  fromEnum EncodingMethodsType = 1153
  fromEnum MimeTypesType = 1154
  fromEnum MechanismTypeType = 1280
  fromEnum RequiredCmsAttributesType = 1281
  fromEnum DefaultCmsAttributesType = 1282
  fromEnum SupportedCmsAttributesType = 1283
  fromEnum WrapTemplateType = 1073742353
  fromEnum UnwrapTemplateType = 1073742354
  fromEnum DeriveTemplateType = 1073742355
  fromEnum AllowedMechanismsType = 1073743360
  fromEnum VendorDefinedType = 2147483648

  toEnum 0 = ClassType
  toEnum 1 = TokenType
  toEnum 2 = PrivateType
  toEnum 3 = LabelType
  toEnum 16 = ApplicationType
  toEnum 17 = ValueType
  toEnum 18 = ObjectType
  toEnum 128 = CertificateType
  toEnum 129 = IssuerType
  toEnum 130 = SerialNumberType
  toEnum 131 = AcIssuerType
  toEnum 132 = OwnerType
  toEnum 133 = AttrTypesType
  toEnum 134 = TrustedType
  toEnum 135 = CertificateCategoryType
  toEnum 136 = JavaMidpSecurityDomainType
  toEnum 137 = UrlType
  toEnum 138 = HashOfSubjectPublicKeyType
  toEnum 139 = HashOfIssuerPublicKeyType
  toEnum 144 = CheckValueType
  toEnum 256 = KeyTypeType
  toEnum 257 = SubjectType
  toEnum 258 = IdType
  toEnum 259 = SensitiveType
  toEnum 260 = EncryptType
  toEnum 261 = DecryptType
  toEnum 262 = WrapType
  toEnum 263 = UnwrapType
  toEnum 264 = SignType
  toEnum 265 = SignRecoverType
  toEnum 266 = VerifyType
  toEnum 267 = VerifyRecoverType
  toEnum 268 = DeriveType
  toEnum 272 = StartDateType
  toEnum 273 = EndDataType
  toEnum 288 = ModulusType
  toEnum 289 = ModulusBitsType
  toEnum 290 = PublicExponentType
  toEnum 291 = PrivateExponentType
  toEnum 292 = Prime1Type
  toEnum 293 = Prime2Type
  toEnum 294 = Exponent1Type
  toEnum 295 = Exponent2Type
  toEnum 296 = CoefficientType
  toEnum 307 = PrimeBitsType
  toEnum 308 = SubPrimeBitsType
  toEnum 352 = ValueBitsType
  toEnum 353 = ValueLenType
  toEnum 354 = ExtractableType
  toEnum 355 = LocalType
  toEnum 356 = NeverExtractableType
  toEnum 357 = AlwaysSensitiveType
  toEnum 358 = KeyGenMechanismType
  toEnum 368 = ModifiableType
  toEnum 384 = EcdsaParamsType
  toEnum 385 = EcPointType
  toEnum 512 = SecondaryAuthType
  toEnum 513 = AuthPinFlagsType
  toEnum 514 = AlwaysAuthenticateType
  toEnum 528 = WrapWithTrustedType
  toEnum 544 = OtpFormatType
  toEnum 545 = OtpLengthType
  toEnum 546 = OtpTimeIntervalType
  toEnum 547 = OtpUserFriendlyModeType
  toEnum 548 = OtpChallengeRequirementType
  toEnum 549 = OtpTimeRequirementType
  toEnum 550 = OtpCounterRequirementType
  toEnum 551 = OtpPinRequirementType
  toEnum 554 = OtpUserIdentifierType
  toEnum 555 = OtpServiceIdentifierType
  toEnum 556 = OtpServiceLogoType
  toEnum 557 = OtpServiceLogoTypeType
  toEnum 558 = OtpCounterType
  toEnum 559 = OtpTimeType
  toEnum 592 = GostR3410ParamsType
  toEnum 593 = GostR3411ParamsType
  toEnum 594 = Gost28147ParamsType
  toEnum 768 = HwFeatureTypeType
  toEnum 769 = ResetOnInitType
  toEnum 770 = HasResetType
  toEnum 1024 = PixelXType
  toEnum 1025 = PixelYType
  toEnum 1026 = ResolutionType
  toEnum 1027 = CharRowsType
  toEnum 1028 = CharColumnsType
  toEnum 1029 = ColorType
  toEnum 1030 = BitPerPixelType
  toEnum 1152 = CharSetsType
  toEnum 1153 = EncodingMethodsType
  toEnum 1154 = MimeTypesType
  toEnum 1280 = MechanismTypeType
  toEnum 1281 = RequiredCmsAttributesType
  toEnum 1282 = DefaultCmsAttributesType
  toEnum 1283 = SupportedCmsAttributesType
  toEnum 1073742353 = WrapTemplateType
  toEnum 1073742354 = UnwrapTemplateType
  toEnum 1073742355 = DeriveTemplateType
  toEnum 1073743360 = AllowedMechanismsType
  toEnum 2147483648 = VendorDefinedType
  toEnum unmatched = error ("AttributeType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 613 "./System/Crypto/Pkcs11.chs" #-}


data Attribute = Class ClassType
    | KeyType KeyTypeValue
    | Label String
    | ModulusBits Int
    | Token Bool
    | Decrypt Bool
    | Sign Bool
    | Modulus Integer
    | PublicExponent Integer
    deriving (Show)

data LlAttribute = LlAttribute {
    attributeType :: AttributeType,
    attributeValuePtr :: Ptr (),
    attributeSize :: (C2HSImp.CULong)
{-# LINE 629 "./System/Crypto/Pkcs11.chs" #-}

}

instance Storable LlAttribute where
    sizeOf _ = 8 + 8 + 8
{-# LINE 633 "./System/Crypto/Pkcs11.chs" #-}

    alignment _ = 1
    poke p x = do
        poke (p `plusPtr` 0) (fromEnum $ attributeType x)
        poke (p `plusPtr` 8) (attributeValuePtr x :: ((C2HSImp.Ptr ())))
        poke (p `plusPtr` (8 + 8)) (attributeSize x)
    peek p = do
        attrType <- peek (p `plusPtr` 0) :: IO (C2HSImp.CULong)
{-# LINE 640 "./System/Crypto/Pkcs11.chs" #-}

        valPtr <- peek (p `plusPtr` 8)
        valSize <- peek (p `plusPtr` (8 + 8))
        return $ LlAttribute (toEnum $ fromIntegral attrType) valPtr valSize


_attrType :: Attribute -> AttributeType
_attrType (Class _) = ClassType
_attrType (KeyType _) = KeyTypeType
_attrType (Label _) = LabelType
_attrType (ModulusBits _) = ModulusBitsType
_attrType (Token _) = TokenType


_valueSize :: Attribute -> Int
_valueSize (Class _) = 8
{-# LINE 655 "./System/Crypto/Pkcs11.chs" #-}

_valueSize (KeyType _) = 8
{-# LINE 656 "./System/Crypto/Pkcs11.chs" #-}

_valueSize (Label l) = BU8.length $ BU8.fromString l
_valueSize (ModulusBits _) = 8
{-# LINE 658 "./System/Crypto/Pkcs11.chs" #-}

_valueSize (Token _) = 1
{-# LINE 659 "./System/Crypto/Pkcs11.chs" #-}



_pokeValue :: Attribute -> Ptr () -> IO ()
_pokeValue (Class c) ptr = poke (castPtr ptr :: Ptr (C2HSImp.CULong)) (fromIntegral $ fromEnum c)
_pokeValue (KeyType k) ptr = poke (castPtr ptr :: Ptr (C2HSImp.CULong)) (fromIntegral $ fromEnum k)
_pokeValue (Label l) ptr = unsafeUseAsCStringLen (BU8.fromString l) $ \(src, len) -> copyBytes ptr (castPtr src :: Ptr ()) len
_pokeValue (ModulusBits l) ptr = poke (castPtr ptr :: Ptr (C2HSImp.CULong)) (fromIntegral l :: (C2HSImp.CULong))
_pokeValue (Token b) ptr = poke (castPtr ptr :: Ptr (C2HSImp.CUChar)) (fromBool b :: (C2HSImp.CUChar))


_pokeValues :: [Attribute] -> Ptr () -> IO ()
_pokeValues [] p = return ()
_pokeValues (a:rem) p = do
    _pokeValue a p
    _pokeValues rem (p `plusPtr` (_valueSize a))


_valuesSize :: [Attribute] -> Int
_valuesSize attribs = foldr (+) 0 (map (_valueSize) attribs)


_makeLowLevelAttrs :: [Attribute] -> Ptr () -> [LlAttribute]
_makeLowLevelAttrs [] valuePtr = []
_makeLowLevelAttrs (a:rem) valuePtr =
    let valuePtr' = valuePtr `plusPtr` (_valueSize a)
        llAttr = LlAttribute {attributeType=_attrType a, attributeValuePtr=valuePtr, attributeSize=(fromIntegral $ _valueSize a)}
    in
        llAttr:(_makeLowLevelAttrs rem valuePtr')


_withAttribs :: [Attribute] -> (Ptr LlAttribute -> IO a) -> IO a
_withAttribs attribs f = do
    allocaBytes (_valuesSize attribs) $ \valuesPtr -> do
        _pokeValues attribs valuesPtr
        allocaArray (length attribs) $ \attrsPtr -> do
            pokeArray attrsPtr (_makeLowLevelAttrs attribs valuesPtr)
            f attrsPtr


_peekBigInt :: Ptr () -> CULong -> IO Integer
_peekBigInt ptr len = do
    arr <- peekArray (fromIntegral len) (castPtr ptr :: Ptr Word8)
    return $ foldl (\acc v -> (fromIntegral v) + (acc * 256)) 0 arr


_llAttrToAttr :: LlAttribute -> IO Attribute
_llAttrToAttr (LlAttribute ClassType ptr len) = do
    val <- peek (castPtr ptr :: Ptr (C2HSImp.CULong))
    return (Class $ toEnum $ fromIntegral val)
_llAttrToAttr (LlAttribute ModulusType ptr len) = do
    val <- _peekBigInt ptr len
    return (Modulus val)
_llAttrToAttr (LlAttribute PublicExponentType ptr len) = do
    val <- _peekBigInt ptr len
    return (PublicExponent val)
_llAttrToAttr (LlAttribute DecryptType ptr len) = do
    val <- peek (castPtr ptr :: Ptr (C2HSImp.CUChar))
    return $ Decrypt(val /= 0)
_llAttrToAttr (LlAttribute SignType ptr len) = do
    val <- peek (castPtr ptr :: Ptr (C2HSImp.CUChar))
    return $ Sign(val /= 0)


-- High level API starts here


data Library = Library {
    libraryHandle :: DL,
    functionListPtr :: FunctionListPtr
}


data Session = Session SessionHandle FunctionListPtr


-- | Load PKCS#11 dynamically linked library
--
-- > lib <- loadLibrary "/path/to/dll.so"
loadLibrary :: String -> IO Library
loadLibrary libraryPath = do
    lib <- dlopen libraryPath []
    getFunctionListFunPtr <- dlsym lib "C_GetFunctionList"
    (rv, functionListPtr) <- getFunctionList getFunctionListFunPtr
    if rv /= 0
        then fail $ "failed to get list of functions " ++ (rvToStr rv)
        else do
            rv <- initialize functionListPtr
            if rv /= 0
                then fail $ "failed to initialize library " ++ (rvToStr rv)
                else return Library { libraryHandle = lib, functionListPtr = functionListPtr }


releaseLibrary lib = do
    rv <- finalize $ functionListPtr lib
    dlclose $ libraryHandle lib


-- | Returns general information about Cryptoki
getInfo :: Library -> IO Info
getInfo (Library _ functionListPtr) = do
    (rv, info) <- getInfo' functionListPtr
    if rv /= 0
        then fail $ "failed to get library information " ++ (rvToStr rv)
        else return info


-- | Allows to obtain a list of slots in the system
--
-- > slotsIds <- getSlotList lib True 10
--
-- In this example retrieves list of, at most 10 (third parameter) slot identifiers with tokens present (second parameter is set to True)
getSlotList :: Library -> Bool -> Int -> IO [SlotId]
getSlotList (Library _ functionListPtr) active num = do
    (rv, slots) <- getSlotList' functionListPtr active num
    if rv /= 0
        then fail $ "failed to get list of slots " ++ (rvToStr rv)
        else return $ map (fromIntegral) slots


-- | Obtains information about a particular slot in the system
--
-- > slotInfo <- getSlotInfo lib slotId
getSlotInfo :: Library -> SlotId -> IO SlotInfo
getSlotInfo (Library _ functionListPtr) slotId = do
    (rv, slotInfo) <- getSlotInfo' functionListPtr slotId
    if rv /= 0
        then fail $ "failed to get slot information " ++ (rvToStr rv)
        else return slotInfo


-- | Obtains information about a particular token in the system
--
-- > tokenInfo <- getTokenInfo lib slotId
getTokenInfo :: Library -> SlotId -> IO TokenInfo
getTokenInfo (Library _ functionListPtr) slotId = do
    (rv, slotInfo) <- getTokenInfo' functionListPtr slotId
    if rv /= 0
        then fail $ "failed to get token information " ++ (rvToStr rv)
        else return slotInfo


_openSessionEx :: Library -> SlotId -> Int -> IO Session
_openSessionEx (Library _ functionListPtr) slotId flags = do
    (rv, sessionHandle) <- openSession' functionListPtr slotId flags
    if rv /= 0
        then fail $ "failed to open slot: " ++ (rvToStr rv)
        else return $ Session sessionHandle functionListPtr


_closeSessionEx :: Session -> IO ()
_closeSessionEx (Session sessionHandle functionListPtr) = do
    rv <- closeSession' functionListPtr sessionHandle
    if rv /= 0
        then fail $ "failed to close slot: " ++ (rvToStr rv)
        else return ()


withSession :: Library -> SlotId -> Bool -> (Session -> IO a) -> IO a
withSession lib slotId writable f = do
    let flags = if writable then _rwSession else 0
    bracket
        (_openSessionEx lib slotId (flags .|. _serialSession))
        (_closeSessionEx)
        (f)



_findObjectsInitEx :: Session -> [Attribute] -> IO ()
_findObjectsInitEx (Session sessionHandle functionListPtr) attribs = do
    rv <- findObjectsInit' functionListPtr sessionHandle attribs
    if rv /= 0
        then fail $ "failed to initialize search: " ++ (rvToStr rv)
        else return ()


_findObjectsEx :: Session -> IO [ObjectHandle]
_findObjectsEx (Session sessionHandle functionListPtr) = do
    (rv, objectsHandles) <- findObjects' functionListPtr sessionHandle 10
    if rv /= 0
        then fail $ "failed to execute search: " ++ (rvToStr rv)
        else return objectsHandles


_findObjectsFinalEx :: Session -> IO ()
_findObjectsFinalEx (Session sessionHandle functionListPtr) = do
    rv <- findObjectsFinal' functionListPtr sessionHandle
    if rv /= 0
        then fail $ "failed to finalize search: " ++ (rvToStr rv)
        else return ()


findObjects :: Session -> [Attribute] -> IO [ObjectHandle]
findObjects session attribs = do
    _findObjectsInitEx session attribs
    finally (_findObjectsEx session) (_findObjectsFinalEx session)


generateKeyPair :: Session -> MechType -> [Attribute] -> [Attribute] -> IO (ObjectHandle, ObjectHandle)
generateKeyPair (Session sessionHandle functionListPtr) mechType pubKeyAttrs privKeyAttrs = do
    (rv, pubKeyHandle, privKeyHandle) <- _generateKeyPair functionListPtr sessionHandle mechType pubKeyAttrs privKeyAttrs
    if rv /= 0
        then fail $ "failed to generate key pair: " ++ (rvToStr rv)
        else return (pubKeyHandle, privKeyHandle)


_getAttr :: Session -> ObjectHandle -> AttributeType -> Ptr x -> IO ()
_getAttr (Session sessionHandle functionListPtr) objHandle attrType valPtr = do
    alloca $ \attrPtr -> do
        poke attrPtr (LlAttribute attrType (castPtr valPtr) (fromIntegral $ sizeOf valPtr))
        rv <- (\o x1 x2 x3 x4 -> (\ptr -> do {C2HSImp.peekByteOff ptr 200 :: IO (C2HSImp.FunPtr (C2HSImp.CULong -> (C2HSImp.CULong -> ((LlAttributePtr) -> (C2HSImp.CULong -> (IO C2HSImp.CULong))))))}) o >>= \f -> cK_FUNCTION_LISTc_GetAttributeValue f x1 x2 x3 x4) functionListPtr sessionHandle objHandle attrPtr 1
        if rv /= 0
            then fail $ "failed to get attribute: " ++ (rvToStr rv)
            else return ()


getBoolAttr :: Session -> ObjectHandle -> AttributeType -> IO Bool
getBoolAttr sess objHandle attrType = do
    alloca $ \valuePtr -> do
        _getAttr sess objHandle attrType (valuePtr :: Ptr CK_BBOOL)
        val <- peek valuePtr
        return $ toBool val


getObjectAttr :: Session -> ObjectHandle -> AttributeType -> IO Attribute
getObjectAttr (Session sessionHandle functionListPtr) objHandle attrType = do
    alloca $ \attrPtr -> do
        poke attrPtr (LlAttribute attrType nullPtr 0)
        rv <- (\o x1 x2 x3 x4 -> (\ptr -> do {C2HSImp.peekByteOff ptr 200 :: IO (C2HSImp.FunPtr (C2HSImp.CULong -> (C2HSImp.CULong -> ((LlAttributePtr) -> (C2HSImp.CULong -> (IO C2HSImp.CULong))))))}) o >>= \f -> cK_FUNCTION_LISTc_GetAttributeValue f x1 x2 x3 x4) functionListPtr sessionHandle objHandle attrPtr 1
        attrWithLen <- peek attrPtr
        allocaBytes (fromIntegral $ attributeSize attrWithLen) $ \attrVal -> do
            poke attrPtr (LlAttribute attrType attrVal (attributeSize attrWithLen))
            rv <- (\o x1 x2 x3 x4 -> (\ptr -> do {C2HSImp.peekByteOff ptr 200 :: IO (C2HSImp.FunPtr (C2HSImp.CULong -> (C2HSImp.CULong -> ((LlAttributePtr) -> (C2HSImp.CULong -> (IO C2HSImp.CULong))))))}) o >>= \f -> cK_FUNCTION_LISTc_GetAttributeValue f x1 x2 x3 x4) functionListPtr sessionHandle objHandle attrPtr 1
            if rv /= 0
                then fail $ "failed to get attribute: " ++ (rvToStr rv)
                else do
                    llAttr <- peek attrPtr
                    _llAttrToAttr llAttr


getTokenFlag sess objHandle = getBoolAttr sess objHandle TokenType
getPrivateFlag sess objHandle = getBoolAttr sess objHandle PrivateType
getSensitiveFlag sess objHandle = getBoolAttr sess objHandle SensitiveType
getEncryptFlag sess objHandle = getBoolAttr sess objHandle EncryptType
getDecryptFlag sess objHandle = getBoolAttr sess objHandle DecryptType
getWrapFlag sess objHandle = getBoolAttr sess objHandle WrapType
getUnwrapFlag sess objHandle = getBoolAttr sess objHandle UnwrapType
getSignFlag sess objHandle = getBoolAttr sess objHandle SignType

getModulus :: Session -> ObjectHandle -> IO Integer
getModulus sess objHandle = do
    (Modulus m) <- getObjectAttr sess objHandle ModulusType
    return m

getPublicExponent :: Session -> ObjectHandle -> IO Integer
getPublicExponent sess objHandle = do
    (PublicExponent v) <- getObjectAttr sess objHandle PublicExponentType
    return v


login :: Session -> UserType -> BU8.ByteString -> IO ()
login (Session sessionHandle functionListPtr) userType pin = do
    rv <- _login functionListPtr sessionHandle userType pin
    if rv /= 0
        then fail $ "login failed: " ++ (rvToStr rv)
        else return ()


logout :: Session -> IO ()
logout (Session sessionHandle functionListPtr) = do
    rv <- (\o x1 -> (\ptr -> do {C2HSImp.peekByteOff ptr 160 :: IO (C2HSImp.FunPtr (C2HSImp.CULong -> (IO C2HSImp.CULong)))}) o >>= \f -> cK_FUNCTION_LISTc_Logout f x1) functionListPtr sessionHandle
    if rv /= 0
        then fail $ "logout failed: " ++ (rvToStr rv)
        else return ()


data MechType = RsaPkcsKeyPairGen
              | RsaPkcs
              | Rsa9796
              | RsaX509
              | Md2RsaPkcs
              | Md5RsaPkcs
              | Sha1RsaPkcs
              | RipeMd128RsaPkcs
              | RipeMd160RsaPkcs
              | RsaPkcsOaep
              | RsaX931KeyPairGen
              | RsaX931
              | Sha1RsaX931
              | RsaPkcsPss
              | Sha1RsaPkcsPss
              | DsaKeyPairGen
              | Dsa
              | DsaSha1
              | DhPkcsKeyPairGen
              | DhPkcsDerive
              | X942DhKeyPairGen
              | X942DhDerive
              | X942DhHybridDerive
              | X942MqvDerive
              | Sha256RsaPkcs
              | Sha384RsaPkcs
              | Sha512RsaPkcs
              | Sha256RsaPkcsPss
              | Sha384RsaPkcsPss
              | Sha512RsaPkcsPss
              | Sha224RsaPkcs
              | Sha224RsaPkcsPss
              | Rc2KeyGen
              | Rc2Ecb
              | Rc2Cbc
              | Rc2Mac
              | Rc2MacGeneral
              | Rc2CbcPad
              | Rc4KeyGen
              | Rc4
              | DesKeyGen
              | DesEcb
              | DesCbc
              | DesMac
              | DesMacGeneral
              | DesCbcPad
              | Des2KeyGen
              | Des3KeyGen
              | Des3Ecb
              | Des3Cbc
              | Des3Mac
              | Des3MacGeneral
              | Des3CbcPad
              | CdmfKeyGen
              | CdmfEcb
              | CdmfCbc
              | CdmfMac
              | CdmfMacGeneral
              | CdmfCbcPad
              | DesOfb64
              | DesOfb8
              | DesCfb64
              | DesCfb8
              | Md2
              | Md2Hmac
              | Md2HmacGeneral
              | Md5
              | Md5Hmac
              | Md5HmacGeneral
              | Sha1
              | Sha1Hmac
              | Sha1HmacGeneral
              | RipeMd128
              | RipeMd128Hmac
              | RipeMd128HmacGeneral
              | Ripe160
              | Ripe160Hmac
              | Ripe160HmacGeneral
              | Sha256
              | Sha256Hmac
              | Sha256HmacGeneral
              | Sha224
              | Sha224Hmac
              | Sha224HmacGeneral
              | Sha384
              | Sha384Hmac
              | Sha384HmacGeneral
              | Sha512
              | Sha512Hmac
              | Sha512HmacGeneral
              | CastKeyGen
              | CastEcb
              | CastCbc
              | CastMac
              | CastMacGeneral
              | CastCbcPad
              | Cast3KeyGen
              | Cast3Ecb
              | Cast3Cbc
              | Cast3Mac
              | Cast3MacGeneral
              | Cast3CbcPad
              | Cast5KeyGen
              | Cast128KeyGen
              | Cast5Ecb
              | Cast128Ecb
              | Cast5Cbc
              | Cast128Cbc
              | Cast5Mac
              | Cast128Mac
              | Cast5MacGeneral
              | Cast128MacGeneral
              | Cast5CbcPad
              | Cast128CbcPad
              | Rc5KeyGen
              | Rc5Ecb
              | Rc5Cbc
              | Rc5Mac
              | Rc5MacGeneral
              | Rc5CbcPad
              | IdeaKeyGen
              | IdeaEcb
              | IdeaCbc
              | IdeaMac
              | IdeaMacGeneral
              | IdeaCbcPad
              | GeneralSecretKeyGen
              | ConcatenateBaseAndKey
              | ConcatenateBaseAndData
              | ConcatenateDataAndBase
              | XorBaseAndData
              | ExtractKeyFromKey
              | Ssl3PreMasterKeyGen
              | Ssl3MasterKeyDerive
              | Ssl3KeyAndMacDerive
              | Sha224KeyDerivation
              | PbeMd2DesCbc
              | PbeMd5DesCbc
              | PbeMd5CastCbc
              | PbeMd5Cast3Cbc
              | PbeMd5Cast5Cbc
              | PbeMd5Cast128Cbc
              | PbeSha1Cast5Cbc
              | PbeSha1Cast128Cbc
              | PbeSha1Rc4128
              | PbeSha1Rc440
              | PbeSha1Des3EdeCbc
              | PbeSha1Des2EdeCbc
              | PbeSha1Rc2128Cbc
              | PbeSha1Rc240Cbc
              | Pkcs5Pbkd2
              | PbaSha1WithSha1Hmac
              | EcdsaKeyPairGen
              | EcKeyPairGen
              | Ecdsa
              | EcdsaSha1
              | Ecdh1Derive
              | Ecdh1CofactorDerive
              | DcmqvDerive
              | JuniperKeyGen
              | JuniperEcb128
              | JuniperCbc128
              | JuniperCounter
              | JuniperShuffle
              | JuniperWrap
              | FastHash
              | AesKeyGen
              | AesEcb
              | AesCbc
              | AesMac
              | AesMacGeneral
              | AesCbcPad
              | AesCtr
              | AesGcm
              | AesCcm
              | AesKeyWrap
              | BlowfishKeyGen
              | AesKeyWrapPad
              | BlowfishCbc
              | TwoFishKeyGen
              | TwoFishCbc
              | DesEcbEncryptData
              | DesCbcEncryptData
              | Des3EcbEncryptData
              | Des3CbcEncryptData
              | AesEcbEncryptData
              | AesCbcEncryptData
              | DsaParameterGen
              | DhPkcsParameterGen
              | X9_42DhParameterGen
              | VendorDefined
  deriving (Eq,Show)
instance Enum MechType where
  succ RsaPkcsKeyPairGen = RsaPkcs
  succ RsaPkcs = Rsa9796
  succ Rsa9796 = RsaX509
  succ RsaX509 = Md2RsaPkcs
  succ Md2RsaPkcs = Md5RsaPkcs
  succ Md5RsaPkcs = Sha1RsaPkcs
  succ Sha1RsaPkcs = RipeMd128RsaPkcs
  succ RipeMd128RsaPkcs = RipeMd160RsaPkcs
  succ RipeMd160RsaPkcs = RsaPkcsOaep
  succ RsaPkcsOaep = RsaX931KeyPairGen
  succ RsaX931KeyPairGen = RsaX931
  succ RsaX931 = Sha1RsaX931
  succ Sha1RsaX931 = RsaPkcsPss
  succ RsaPkcsPss = Sha1RsaPkcsPss
  succ Sha1RsaPkcsPss = DsaKeyPairGen
  succ DsaKeyPairGen = Dsa
  succ Dsa = DsaSha1
  succ DsaSha1 = DhPkcsKeyPairGen
  succ DhPkcsKeyPairGen = DhPkcsDerive
  succ DhPkcsDerive = X942DhKeyPairGen
  succ X942DhKeyPairGen = X942DhDerive
  succ X942DhDerive = X942DhHybridDerive
  succ X942DhHybridDerive = X942MqvDerive
  succ X942MqvDerive = Sha256RsaPkcs
  succ Sha256RsaPkcs = Sha384RsaPkcs
  succ Sha384RsaPkcs = Sha512RsaPkcs
  succ Sha512RsaPkcs = Sha256RsaPkcsPss
  succ Sha256RsaPkcsPss = Sha384RsaPkcsPss
  succ Sha384RsaPkcsPss = Sha512RsaPkcsPss
  succ Sha512RsaPkcsPss = Sha224RsaPkcs
  succ Sha224RsaPkcs = Sha224RsaPkcsPss
  succ Sha224RsaPkcsPss = Rc2KeyGen
  succ Rc2KeyGen = Rc2Ecb
  succ Rc2Ecb = Rc2Cbc
  succ Rc2Cbc = Rc2Mac
  succ Rc2Mac = Rc2MacGeneral
  succ Rc2MacGeneral = Rc2CbcPad
  succ Rc2CbcPad = Rc4KeyGen
  succ Rc4KeyGen = Rc4
  succ Rc4 = DesKeyGen
  succ DesKeyGen = DesEcb
  succ DesEcb = DesCbc
  succ DesCbc = DesMac
  succ DesMac = DesMacGeneral
  succ DesMacGeneral = DesCbcPad
  succ DesCbcPad = Des2KeyGen
  succ Des2KeyGen = Des3KeyGen
  succ Des3KeyGen = Des3Ecb
  succ Des3Ecb = Des3Cbc
  succ Des3Cbc = Des3Mac
  succ Des3Mac = Des3MacGeneral
  succ Des3MacGeneral = Des3CbcPad
  succ Des3CbcPad = CdmfKeyGen
  succ CdmfKeyGen = CdmfEcb
  succ CdmfEcb = CdmfCbc
  succ CdmfCbc = CdmfMac
  succ CdmfMac = CdmfMacGeneral
  succ CdmfMacGeneral = CdmfCbcPad
  succ CdmfCbcPad = DesOfb64
  succ DesOfb64 = DesOfb8
  succ DesOfb8 = DesCfb64
  succ DesCfb64 = DesCfb8
  succ DesCfb8 = Md2
  succ Md2 = Md2Hmac
  succ Md2Hmac = Md2HmacGeneral
  succ Md2HmacGeneral = Md5
  succ Md5 = Md5Hmac
  succ Md5Hmac = Md5HmacGeneral
  succ Md5HmacGeneral = Sha1
  succ Sha1 = Sha1Hmac
  succ Sha1Hmac = Sha1HmacGeneral
  succ Sha1HmacGeneral = RipeMd128
  succ RipeMd128 = RipeMd128Hmac
  succ RipeMd128Hmac = RipeMd128HmacGeneral
  succ RipeMd128HmacGeneral = Ripe160
  succ Ripe160 = Ripe160Hmac
  succ Ripe160Hmac = Ripe160HmacGeneral
  succ Ripe160HmacGeneral = Sha256
  succ Sha256 = Sha256Hmac
  succ Sha256Hmac = Sha256HmacGeneral
  succ Sha256HmacGeneral = Sha224
  succ Sha224 = Sha224Hmac
  succ Sha224Hmac = Sha224HmacGeneral
  succ Sha224HmacGeneral = Sha384
  succ Sha384 = Sha384Hmac
  succ Sha384Hmac = Sha384HmacGeneral
  succ Sha384HmacGeneral = Sha512
  succ Sha512 = Sha512Hmac
  succ Sha512Hmac = Sha512HmacGeneral
  succ Sha512HmacGeneral = CastKeyGen
  succ CastKeyGen = CastEcb
  succ CastEcb = CastCbc
  succ CastCbc = CastMac
  succ CastMac = CastMacGeneral
  succ CastMacGeneral = CastCbcPad
  succ CastCbcPad = Cast3KeyGen
  succ Cast3KeyGen = Cast3Ecb
  succ Cast3Ecb = Cast3Cbc
  succ Cast3Cbc = Cast3Mac
  succ Cast3Mac = Cast3MacGeneral
  succ Cast3MacGeneral = Cast3CbcPad
  succ Cast3CbcPad = Cast5KeyGen
  succ Cast5KeyGen = Cast5Ecb
  succ Cast128KeyGen = Cast5Ecb
  succ Cast5Ecb = Cast5Cbc
  succ Cast128Ecb = Cast5Cbc
  succ Cast5Cbc = Cast5Mac
  succ Cast128Cbc = Cast5Mac
  succ Cast5Mac = Cast5MacGeneral
  succ Cast128Mac = Cast5MacGeneral
  succ Cast5MacGeneral = Cast5CbcPad
  succ Cast128MacGeneral = Cast5CbcPad
  succ Cast5CbcPad = Rc5KeyGen
  succ Cast128CbcPad = Rc5KeyGen
  succ Rc5KeyGen = Rc5Ecb
  succ Rc5Ecb = Rc5Cbc
  succ Rc5Cbc = Rc5Mac
  succ Rc5Mac = Rc5MacGeneral
  succ Rc5MacGeneral = Rc5CbcPad
  succ Rc5CbcPad = IdeaKeyGen
  succ IdeaKeyGen = IdeaEcb
  succ IdeaEcb = IdeaCbc
  succ IdeaCbc = IdeaMac
  succ IdeaMac = IdeaMacGeneral
  succ IdeaMacGeneral = IdeaCbcPad
  succ IdeaCbcPad = GeneralSecretKeyGen
  succ GeneralSecretKeyGen = ConcatenateBaseAndKey
  succ ConcatenateBaseAndKey = ConcatenateBaseAndData
  succ ConcatenateBaseAndData = ConcatenateDataAndBase
  succ ConcatenateDataAndBase = XorBaseAndData
  succ XorBaseAndData = ExtractKeyFromKey
  succ ExtractKeyFromKey = Ssl3PreMasterKeyGen
  succ Ssl3PreMasterKeyGen = Ssl3MasterKeyDerive
  succ Ssl3MasterKeyDerive = Ssl3KeyAndMacDerive
  succ Ssl3KeyAndMacDerive = Sha224KeyDerivation
  succ Sha224KeyDerivation = PbeMd2DesCbc
  succ PbeMd2DesCbc = PbeMd5DesCbc
  succ PbeMd5DesCbc = PbeMd5CastCbc
  succ PbeMd5CastCbc = PbeMd5Cast3Cbc
  succ PbeMd5Cast3Cbc = PbeMd5Cast5Cbc
  succ PbeMd5Cast5Cbc = PbeSha1Cast5Cbc
  succ PbeMd5Cast128Cbc = PbeSha1Cast5Cbc
  succ PbeSha1Cast5Cbc = PbeSha1Rc4128
  succ PbeSha1Cast128Cbc = PbeSha1Rc4128
  succ PbeSha1Rc4128 = PbeSha1Rc440
  succ PbeSha1Rc440 = PbeSha1Des3EdeCbc
  succ PbeSha1Des3EdeCbc = PbeSha1Des2EdeCbc
  succ PbeSha1Des2EdeCbc = PbeSha1Rc2128Cbc
  succ PbeSha1Rc2128Cbc = PbeSha1Rc240Cbc
  succ PbeSha1Rc240Cbc = Pkcs5Pbkd2
  succ Pkcs5Pbkd2 = PbaSha1WithSha1Hmac
  succ PbaSha1WithSha1Hmac = EcdsaKeyPairGen
  succ EcdsaKeyPairGen = Ecdsa
  succ EcKeyPairGen = Ecdsa
  succ Ecdsa = EcdsaSha1
  succ EcdsaSha1 = Ecdh1Derive
  succ Ecdh1Derive = Ecdh1CofactorDerive
  succ Ecdh1CofactorDerive = DcmqvDerive
  succ DcmqvDerive = JuniperKeyGen
  succ JuniperKeyGen = JuniperEcb128
  succ JuniperEcb128 = JuniperCbc128
  succ JuniperCbc128 = JuniperCounter
  succ JuniperCounter = JuniperShuffle
  succ JuniperShuffle = JuniperWrap
  succ JuniperWrap = FastHash
  succ FastHash = AesKeyGen
  succ AesKeyGen = AesEcb
  succ AesEcb = AesCbc
  succ AesCbc = AesMac
  succ AesMac = AesMacGeneral
  succ AesMacGeneral = AesCbcPad
  succ AesCbcPad = AesCtr
  succ AesCtr = AesGcm
  succ AesGcm = AesCcm
  succ AesCcm = AesKeyWrap
  succ AesKeyWrap = AesKeyWrapPad
  succ BlowfishKeyGen = AesKeyWrapPad
  succ AesKeyWrapPad = TwoFishKeyGen
  succ BlowfishCbc = TwoFishKeyGen
  succ TwoFishKeyGen = TwoFishCbc
  succ TwoFishCbc = DesEcbEncryptData
  succ DesEcbEncryptData = DesCbcEncryptData
  succ DesCbcEncryptData = Des3EcbEncryptData
  succ Des3EcbEncryptData = Des3CbcEncryptData
  succ Des3CbcEncryptData = AesEcbEncryptData
  succ AesEcbEncryptData = AesCbcEncryptData
  succ AesCbcEncryptData = DsaParameterGen
  succ DsaParameterGen = DhPkcsParameterGen
  succ DhPkcsParameterGen = X9_42DhParameterGen
  succ X9_42DhParameterGen = VendorDefined
  succ VendorDefined = error "MechType.succ: VendorDefined has no successor"

  pred RsaPkcs = RsaPkcsKeyPairGen
  pred Rsa9796 = RsaPkcs
  pred RsaX509 = Rsa9796
  pred Md2RsaPkcs = RsaX509
  pred Md5RsaPkcs = Md2RsaPkcs
  pred Sha1RsaPkcs = Md5RsaPkcs
  pred RipeMd128RsaPkcs = Sha1RsaPkcs
  pred RipeMd160RsaPkcs = RipeMd128RsaPkcs
  pred RsaPkcsOaep = RipeMd160RsaPkcs
  pred RsaX931KeyPairGen = RsaPkcsOaep
  pred RsaX931 = RsaX931KeyPairGen
  pred Sha1RsaX931 = RsaX931
  pred RsaPkcsPss = Sha1RsaX931
  pred Sha1RsaPkcsPss = RsaPkcsPss
  pred DsaKeyPairGen = Sha1RsaPkcsPss
  pred Dsa = DsaKeyPairGen
  pred DsaSha1 = Dsa
  pred DhPkcsKeyPairGen = DsaSha1
  pred DhPkcsDerive = DhPkcsKeyPairGen
  pred X942DhKeyPairGen = DhPkcsDerive
  pred X942DhDerive = X942DhKeyPairGen
  pred X942DhHybridDerive = X942DhDerive
  pred X942MqvDerive = X942DhHybridDerive
  pred Sha256RsaPkcs = X942MqvDerive
  pred Sha384RsaPkcs = Sha256RsaPkcs
  pred Sha512RsaPkcs = Sha384RsaPkcs
  pred Sha256RsaPkcsPss = Sha512RsaPkcs
  pred Sha384RsaPkcsPss = Sha256RsaPkcsPss
  pred Sha512RsaPkcsPss = Sha384RsaPkcsPss
  pred Sha224RsaPkcs = Sha512RsaPkcsPss
  pred Sha224RsaPkcsPss = Sha224RsaPkcs
  pred Rc2KeyGen = Sha224RsaPkcsPss
  pred Rc2Ecb = Rc2KeyGen
  pred Rc2Cbc = Rc2Ecb
  pred Rc2Mac = Rc2Cbc
  pred Rc2MacGeneral = Rc2Mac
  pred Rc2CbcPad = Rc2MacGeneral
  pred Rc4KeyGen = Rc2CbcPad
  pred Rc4 = Rc4KeyGen
  pred DesKeyGen = Rc4
  pred DesEcb = DesKeyGen
  pred DesCbc = DesEcb
  pred DesMac = DesCbc
  pred DesMacGeneral = DesMac
  pred DesCbcPad = DesMacGeneral
  pred Des2KeyGen = DesCbcPad
  pred Des3KeyGen = Des2KeyGen
  pred Des3Ecb = Des3KeyGen
  pred Des3Cbc = Des3Ecb
  pred Des3Mac = Des3Cbc
  pred Des3MacGeneral = Des3Mac
  pred Des3CbcPad = Des3MacGeneral
  pred CdmfKeyGen = Des3CbcPad
  pred CdmfEcb = CdmfKeyGen
  pred CdmfCbc = CdmfEcb
  pred CdmfMac = CdmfCbc
  pred CdmfMacGeneral = CdmfMac
  pred CdmfCbcPad = CdmfMacGeneral
  pred DesOfb64 = CdmfCbcPad
  pred DesOfb8 = DesOfb64
  pred DesCfb64 = DesOfb8
  pred DesCfb8 = DesCfb64
  pred Md2 = DesCfb8
  pred Md2Hmac = Md2
  pred Md2HmacGeneral = Md2Hmac
  pred Md5 = Md2HmacGeneral
  pred Md5Hmac = Md5
  pred Md5HmacGeneral = Md5Hmac
  pred Sha1 = Md5HmacGeneral
  pred Sha1Hmac = Sha1
  pred Sha1HmacGeneral = Sha1Hmac
  pred RipeMd128 = Sha1HmacGeneral
  pred RipeMd128Hmac = RipeMd128
  pred RipeMd128HmacGeneral = RipeMd128Hmac
  pred Ripe160 = RipeMd128HmacGeneral
  pred Ripe160Hmac = Ripe160
  pred Ripe160HmacGeneral = Ripe160Hmac
  pred Sha256 = Ripe160HmacGeneral
  pred Sha256Hmac = Sha256
  pred Sha256HmacGeneral = Sha256Hmac
  pred Sha224 = Sha256HmacGeneral
  pred Sha224Hmac = Sha224
  pred Sha224HmacGeneral = Sha224Hmac
  pred Sha384 = Sha224HmacGeneral
  pred Sha384Hmac = Sha384
  pred Sha384HmacGeneral = Sha384Hmac
  pred Sha512 = Sha384HmacGeneral
  pred Sha512Hmac = Sha512
  pred Sha512HmacGeneral = Sha512Hmac
  pred CastKeyGen = Sha512HmacGeneral
  pred CastEcb = CastKeyGen
  pred CastCbc = CastEcb
  pred CastMac = CastCbc
  pred CastMacGeneral = CastMac
  pred CastCbcPad = CastMacGeneral
  pred Cast3KeyGen = CastCbcPad
  pred Cast3Ecb = Cast3KeyGen
  pred Cast3Cbc = Cast3Ecb
  pred Cast3Mac = Cast3Cbc
  pred Cast3MacGeneral = Cast3Mac
  pred Cast3CbcPad = Cast3MacGeneral
  pred Cast5KeyGen = Cast3CbcPad
  pred Cast128KeyGen = Cast3CbcPad
  pred Cast5Ecb = Cast5KeyGen
  pred Cast128Ecb = Cast5KeyGen
  pred Cast5Cbc = Cast5Ecb
  pred Cast128Cbc = Cast5Ecb
  pred Cast5Mac = Cast5Cbc
  pred Cast128Mac = Cast5Cbc
  pred Cast5MacGeneral = Cast5Mac
  pred Cast128MacGeneral = Cast5Mac
  pred Cast5CbcPad = Cast5MacGeneral
  pred Cast128CbcPad = Cast5MacGeneral
  pred Rc5KeyGen = Cast5CbcPad
  pred Rc5Ecb = Rc5KeyGen
  pred Rc5Cbc = Rc5Ecb
  pred Rc5Mac = Rc5Cbc
  pred Rc5MacGeneral = Rc5Mac
  pred Rc5CbcPad = Rc5MacGeneral
  pred IdeaKeyGen = Rc5CbcPad
  pred IdeaEcb = IdeaKeyGen
  pred IdeaCbc = IdeaEcb
  pred IdeaMac = IdeaCbc
  pred IdeaMacGeneral = IdeaMac
  pred IdeaCbcPad = IdeaMacGeneral
  pred GeneralSecretKeyGen = IdeaCbcPad
  pred ConcatenateBaseAndKey = GeneralSecretKeyGen
  pred ConcatenateBaseAndData = ConcatenateBaseAndKey
  pred ConcatenateDataAndBase = ConcatenateBaseAndData
  pred XorBaseAndData = ConcatenateDataAndBase
  pred ExtractKeyFromKey = XorBaseAndData
  pred Ssl3PreMasterKeyGen = ExtractKeyFromKey
  pred Ssl3MasterKeyDerive = Ssl3PreMasterKeyGen
  pred Ssl3KeyAndMacDerive = Ssl3MasterKeyDerive
  pred Sha224KeyDerivation = Ssl3KeyAndMacDerive
  pred PbeMd2DesCbc = Sha224KeyDerivation
  pred PbeMd5DesCbc = PbeMd2DesCbc
  pred PbeMd5CastCbc = PbeMd5DesCbc
  pred PbeMd5Cast3Cbc = PbeMd5CastCbc
  pred PbeMd5Cast5Cbc = PbeMd5Cast3Cbc
  pred PbeMd5Cast128Cbc = PbeMd5Cast3Cbc
  pred PbeSha1Cast5Cbc = PbeMd5Cast5Cbc
  pred PbeSha1Cast128Cbc = PbeMd5Cast5Cbc
  pred PbeSha1Rc4128 = PbeSha1Cast5Cbc
  pred PbeSha1Rc440 = PbeSha1Rc4128
  pred PbeSha1Des3EdeCbc = PbeSha1Rc440
  pred PbeSha1Des2EdeCbc = PbeSha1Des3EdeCbc
  pred PbeSha1Rc2128Cbc = PbeSha1Des2EdeCbc
  pred PbeSha1Rc240Cbc = PbeSha1Rc2128Cbc
  pred Pkcs5Pbkd2 = PbeSha1Rc240Cbc
  pred PbaSha1WithSha1Hmac = Pkcs5Pbkd2
  pred EcdsaKeyPairGen = PbaSha1WithSha1Hmac
  pred EcKeyPairGen = PbaSha1WithSha1Hmac
  pred Ecdsa = EcdsaKeyPairGen
  pred EcdsaSha1 = Ecdsa
  pred Ecdh1Derive = EcdsaSha1
  pred Ecdh1CofactorDerive = Ecdh1Derive
  pred DcmqvDerive = Ecdh1CofactorDerive
  pred JuniperKeyGen = DcmqvDerive
  pred JuniperEcb128 = JuniperKeyGen
  pred JuniperCbc128 = JuniperEcb128
  pred JuniperCounter = JuniperCbc128
  pred JuniperShuffle = JuniperCounter
  pred JuniperWrap = JuniperShuffle
  pred FastHash = JuniperWrap
  pred AesKeyGen = FastHash
  pred AesEcb = AesKeyGen
  pred AesCbc = AesEcb
  pred AesMac = AesCbc
  pred AesMacGeneral = AesMac
  pred AesCbcPad = AesMacGeneral
  pred AesCtr = AesCbcPad
  pred AesGcm = AesCtr
  pred AesCcm = AesGcm
  pred AesKeyWrap = AesCcm
  pred BlowfishKeyGen = AesCcm
  pred AesKeyWrapPad = AesKeyWrap
  pred BlowfishCbc = AesKeyWrap
  pred TwoFishKeyGen = AesKeyWrapPad
  pred TwoFishCbc = TwoFishKeyGen
  pred DesEcbEncryptData = TwoFishCbc
  pred DesCbcEncryptData = DesEcbEncryptData
  pred Des3EcbEncryptData = DesCbcEncryptData
  pred Des3CbcEncryptData = Des3EcbEncryptData
  pred AesEcbEncryptData = Des3CbcEncryptData
  pred AesCbcEncryptData = AesEcbEncryptData
  pred DsaParameterGen = AesCbcEncryptData
  pred DhPkcsParameterGen = DsaParameterGen
  pred X9_42DhParameterGen = DhPkcsParameterGen
  pred VendorDefined = X9_42DhParameterGen
  pred RsaPkcsKeyPairGen = error "MechType.pred: RsaPkcsKeyPairGen has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from VendorDefined

  fromEnum RsaPkcsKeyPairGen = 0
  fromEnum RsaPkcs = 1
  fromEnum Rsa9796 = 2
  fromEnum RsaX509 = 3
  fromEnum Md2RsaPkcs = 4
  fromEnum Md5RsaPkcs = 5
  fromEnum Sha1RsaPkcs = 6
  fromEnum RipeMd128RsaPkcs = 7
  fromEnum RipeMd160RsaPkcs = 8
  fromEnum RsaPkcsOaep = 9
  fromEnum RsaX931KeyPairGen = 10
  fromEnum RsaX931 = 11
  fromEnum Sha1RsaX931 = 12
  fromEnum RsaPkcsPss = 13
  fromEnum Sha1RsaPkcsPss = 14
  fromEnum DsaKeyPairGen = 16
  fromEnum Dsa = 17
  fromEnum DsaSha1 = 18
  fromEnum DhPkcsKeyPairGen = 32
  fromEnum DhPkcsDerive = 33
  fromEnum X942DhKeyPairGen = 48
  fromEnum X942DhDerive = 49
  fromEnum X942DhHybridDerive = 50
  fromEnum X942MqvDerive = 51
  fromEnum Sha256RsaPkcs = 64
  fromEnum Sha384RsaPkcs = 65
  fromEnum Sha512RsaPkcs = 66
  fromEnum Sha256RsaPkcsPss = 67
  fromEnum Sha384RsaPkcsPss = 68
  fromEnum Sha512RsaPkcsPss = 69
  fromEnum Sha224RsaPkcs = 70
  fromEnum Sha224RsaPkcsPss = 71
  fromEnum Rc2KeyGen = 256
  fromEnum Rc2Ecb = 257
  fromEnum Rc2Cbc = 258
  fromEnum Rc2Mac = 259
  fromEnum Rc2MacGeneral = 260
  fromEnum Rc2CbcPad = 261
  fromEnum Rc4KeyGen = 272
  fromEnum Rc4 = 273
  fromEnum DesKeyGen = 288
  fromEnum DesEcb = 289
  fromEnum DesCbc = 290
  fromEnum DesMac = 291
  fromEnum DesMacGeneral = 292
  fromEnum DesCbcPad = 293
  fromEnum Des2KeyGen = 304
  fromEnum Des3KeyGen = 305
  fromEnum Des3Ecb = 306
  fromEnum Des3Cbc = 307
  fromEnum Des3Mac = 308
  fromEnum Des3MacGeneral = 309
  fromEnum Des3CbcPad = 310
  fromEnum CdmfKeyGen = 320
  fromEnum CdmfEcb = 321
  fromEnum CdmfCbc = 322
  fromEnum CdmfMac = 323
  fromEnum CdmfMacGeneral = 324
  fromEnum CdmfCbcPad = 325
  fromEnum DesOfb64 = 336
  fromEnum DesOfb8 = 337
  fromEnum DesCfb64 = 338
  fromEnum DesCfb8 = 339
  fromEnum Md2 = 512
  fromEnum Md2Hmac = 513
  fromEnum Md2HmacGeneral = 514
  fromEnum Md5 = 528
  fromEnum Md5Hmac = 529
  fromEnum Md5HmacGeneral = 530
  fromEnum Sha1 = 544
  fromEnum Sha1Hmac = 545
  fromEnum Sha1HmacGeneral = 546
  fromEnum RipeMd128 = 560
  fromEnum RipeMd128Hmac = 561
  fromEnum RipeMd128HmacGeneral = 562
  fromEnum Ripe160 = 576
  fromEnum Ripe160Hmac = 577
  fromEnum Ripe160HmacGeneral = 578
  fromEnum Sha256 = 592
  fromEnum Sha256Hmac = 593
  fromEnum Sha256HmacGeneral = 594
  fromEnum Sha224 = 597
  fromEnum Sha224Hmac = 598
  fromEnum Sha224HmacGeneral = 599
  fromEnum Sha384 = 608
  fromEnum Sha384Hmac = 609
  fromEnum Sha384HmacGeneral = 610
  fromEnum Sha512 = 624
  fromEnum Sha512Hmac = 625
  fromEnum Sha512HmacGeneral = 626
  fromEnum CastKeyGen = 768
  fromEnum CastEcb = 769
  fromEnum CastCbc = 770
  fromEnum CastMac = 771
  fromEnum CastMacGeneral = 772
  fromEnum CastCbcPad = 773
  fromEnum Cast3KeyGen = 784
  fromEnum Cast3Ecb = 785
  fromEnum Cast3Cbc = 786
  fromEnum Cast3Mac = 787
  fromEnum Cast3MacGeneral = 788
  fromEnum Cast3CbcPad = 789
  fromEnum Cast5KeyGen = 800
  fromEnum Cast128KeyGen = 800
  fromEnum Cast5Ecb = 801
  fromEnum Cast128Ecb = 801
  fromEnum Cast5Cbc = 802
  fromEnum Cast128Cbc = 802
  fromEnum Cast5Mac = 803
  fromEnum Cast128Mac = 803
  fromEnum Cast5MacGeneral = 804
  fromEnum Cast128MacGeneral = 804
  fromEnum Cast5CbcPad = 805
  fromEnum Cast128CbcPad = 805
  fromEnum Rc5KeyGen = 816
  fromEnum Rc5Ecb = 817
  fromEnum Rc5Cbc = 818
  fromEnum Rc5Mac = 819
  fromEnum Rc5MacGeneral = 820
  fromEnum Rc5CbcPad = 821
  fromEnum IdeaKeyGen = 832
  fromEnum IdeaEcb = 833
  fromEnum IdeaCbc = 834
  fromEnum IdeaMac = 835
  fromEnum IdeaMacGeneral = 836
  fromEnum IdeaCbcPad = 837
  fromEnum GeneralSecretKeyGen = 848
  fromEnum ConcatenateBaseAndKey = 864
  fromEnum ConcatenateBaseAndData = 866
  fromEnum ConcatenateDataAndBase = 867
  fromEnum XorBaseAndData = 868
  fromEnum ExtractKeyFromKey = 869
  fromEnum Ssl3PreMasterKeyGen = 880
  fromEnum Ssl3MasterKeyDerive = 881
  fromEnum Ssl3KeyAndMacDerive = 882
  fromEnum Sha224KeyDerivation = 918
  fromEnum PbeMd2DesCbc = 928
  fromEnum PbeMd5DesCbc = 929
  fromEnum PbeMd5CastCbc = 930
  fromEnum PbeMd5Cast3Cbc = 931
  fromEnum PbeMd5Cast5Cbc = 932
  fromEnum PbeMd5Cast128Cbc = 932
  fromEnum PbeSha1Cast5Cbc = 933
  fromEnum PbeSha1Cast128Cbc = 933
  fromEnum PbeSha1Rc4128 = 934
  fromEnum PbeSha1Rc440 = 935
  fromEnum PbeSha1Des3EdeCbc = 936
  fromEnum PbeSha1Des2EdeCbc = 937
  fromEnum PbeSha1Rc2128Cbc = 938
  fromEnum PbeSha1Rc240Cbc = 939
  fromEnum Pkcs5Pbkd2 = 944
  fromEnum PbaSha1WithSha1Hmac = 960
  fromEnum EcdsaKeyPairGen = 4160
  fromEnum EcKeyPairGen = 4160
  fromEnum Ecdsa = 4161
  fromEnum EcdsaSha1 = 4162
  fromEnum Ecdh1Derive = 4176
  fromEnum Ecdh1CofactorDerive = 4177
  fromEnum DcmqvDerive = 4178
  fromEnum JuniperKeyGen = 4192
  fromEnum JuniperEcb128 = 4193
  fromEnum JuniperCbc128 = 4194
  fromEnum JuniperCounter = 4195
  fromEnum JuniperShuffle = 4196
  fromEnum JuniperWrap = 4197
  fromEnum FastHash = 4208
  fromEnum AesKeyGen = 4224
  fromEnum AesEcb = 4225
  fromEnum AesCbc = 4226
  fromEnum AesMac = 4227
  fromEnum AesMacGeneral = 4228
  fromEnum AesCbcPad = 4229
  fromEnum AesCtr = 4230
  fromEnum AesGcm = 4231
  fromEnum AesCcm = 4232
  fromEnum AesKeyWrap = 4240
  fromEnum BlowfishKeyGen = 4240
  fromEnum AesKeyWrapPad = 4241
  fromEnum BlowfishCbc = 4241
  fromEnum TwoFishKeyGen = 4242
  fromEnum TwoFishCbc = 4243
  fromEnum DesEcbEncryptData = 4352
  fromEnum DesCbcEncryptData = 4353
  fromEnum Des3EcbEncryptData = 4354
  fromEnum Des3CbcEncryptData = 4355
  fromEnum AesEcbEncryptData = 4356
  fromEnum AesCbcEncryptData = 4357
  fromEnum DsaParameterGen = 8192
  fromEnum DhPkcsParameterGen = 8193
  fromEnum X9_42DhParameterGen = 8194
  fromEnum VendorDefined = 2147483648

  toEnum 0 = RsaPkcsKeyPairGen
  toEnum 1 = RsaPkcs
  toEnum 2 = Rsa9796
  toEnum 3 = RsaX509
  toEnum 4 = Md2RsaPkcs
  toEnum 5 = Md5RsaPkcs
  toEnum 6 = Sha1RsaPkcs
  toEnum 7 = RipeMd128RsaPkcs
  toEnum 8 = RipeMd160RsaPkcs
  toEnum 9 = RsaPkcsOaep
  toEnum 10 = RsaX931KeyPairGen
  toEnum 11 = RsaX931
  toEnum 12 = Sha1RsaX931
  toEnum 13 = RsaPkcsPss
  toEnum 14 = Sha1RsaPkcsPss
  toEnum 16 = DsaKeyPairGen
  toEnum 17 = Dsa
  toEnum 18 = DsaSha1
  toEnum 32 = DhPkcsKeyPairGen
  toEnum 33 = DhPkcsDerive
  toEnum 48 = X942DhKeyPairGen
  toEnum 49 = X942DhDerive
  toEnum 50 = X942DhHybridDerive
  toEnum 51 = X942MqvDerive
  toEnum 64 = Sha256RsaPkcs
  toEnum 65 = Sha384RsaPkcs
  toEnum 66 = Sha512RsaPkcs
  toEnum 67 = Sha256RsaPkcsPss
  toEnum 68 = Sha384RsaPkcsPss
  toEnum 69 = Sha512RsaPkcsPss
  toEnum 70 = Sha224RsaPkcs
  toEnum 71 = Sha224RsaPkcsPss
  toEnum 256 = Rc2KeyGen
  toEnum 257 = Rc2Ecb
  toEnum 258 = Rc2Cbc
  toEnum 259 = Rc2Mac
  toEnum 260 = Rc2MacGeneral
  toEnum 261 = Rc2CbcPad
  toEnum 272 = Rc4KeyGen
  toEnum 273 = Rc4
  toEnum 288 = DesKeyGen
  toEnum 289 = DesEcb
  toEnum 290 = DesCbc
  toEnum 291 = DesMac
  toEnum 292 = DesMacGeneral
  toEnum 293 = DesCbcPad
  toEnum 304 = Des2KeyGen
  toEnum 305 = Des3KeyGen
  toEnum 306 = Des3Ecb
  toEnum 307 = Des3Cbc
  toEnum 308 = Des3Mac
  toEnum 309 = Des3MacGeneral
  toEnum 310 = Des3CbcPad
  toEnum 320 = CdmfKeyGen
  toEnum 321 = CdmfEcb
  toEnum 322 = CdmfCbc
  toEnum 323 = CdmfMac
  toEnum 324 = CdmfMacGeneral
  toEnum 325 = CdmfCbcPad
  toEnum 336 = DesOfb64
  toEnum 337 = DesOfb8
  toEnum 338 = DesCfb64
  toEnum 339 = DesCfb8
  toEnum 512 = Md2
  toEnum 513 = Md2Hmac
  toEnum 514 = Md2HmacGeneral
  toEnum 528 = Md5
  toEnum 529 = Md5Hmac
  toEnum 530 = Md5HmacGeneral
  toEnum 544 = Sha1
  toEnum 545 = Sha1Hmac
  toEnum 546 = Sha1HmacGeneral
  toEnum 560 = RipeMd128
  toEnum 561 = RipeMd128Hmac
  toEnum 562 = RipeMd128HmacGeneral
  toEnum 576 = Ripe160
  toEnum 577 = Ripe160Hmac
  toEnum 578 = Ripe160HmacGeneral
  toEnum 592 = Sha256
  toEnum 593 = Sha256Hmac
  toEnum 594 = Sha256HmacGeneral
  toEnum 597 = Sha224
  toEnum 598 = Sha224Hmac
  toEnum 599 = Sha224HmacGeneral
  toEnum 608 = Sha384
  toEnum 609 = Sha384Hmac
  toEnum 610 = Sha384HmacGeneral
  toEnum 624 = Sha512
  toEnum 625 = Sha512Hmac
  toEnum 626 = Sha512HmacGeneral
  toEnum 768 = CastKeyGen
  toEnum 769 = CastEcb
  toEnum 770 = CastCbc
  toEnum 771 = CastMac
  toEnum 772 = CastMacGeneral
  toEnum 773 = CastCbcPad
  toEnum 784 = Cast3KeyGen
  toEnum 785 = Cast3Ecb
  toEnum 786 = Cast3Cbc
  toEnum 787 = Cast3Mac
  toEnum 788 = Cast3MacGeneral
  toEnum 789 = Cast3CbcPad
  toEnum 800 = Cast5KeyGen
  toEnum 801 = Cast5Ecb
  toEnum 802 = Cast5Cbc
  toEnum 803 = Cast5Mac
  toEnum 804 = Cast5MacGeneral
  toEnum 805 = Cast5CbcPad
  toEnum 816 = Rc5KeyGen
  toEnum 817 = Rc5Ecb
  toEnum 818 = Rc5Cbc
  toEnum 819 = Rc5Mac
  toEnum 820 = Rc5MacGeneral
  toEnum 821 = Rc5CbcPad
  toEnum 832 = IdeaKeyGen
  toEnum 833 = IdeaEcb
  toEnum 834 = IdeaCbc
  toEnum 835 = IdeaMac
  toEnum 836 = IdeaMacGeneral
  toEnum 837 = IdeaCbcPad
  toEnum 848 = GeneralSecretKeyGen
  toEnum 864 = ConcatenateBaseAndKey
  toEnum 866 = ConcatenateBaseAndData
  toEnum 867 = ConcatenateDataAndBase
  toEnum 868 = XorBaseAndData
  toEnum 869 = ExtractKeyFromKey
  toEnum 880 = Ssl3PreMasterKeyGen
  toEnum 881 = Ssl3MasterKeyDerive
  toEnum 882 = Ssl3KeyAndMacDerive
  toEnum 918 = Sha224KeyDerivation
  toEnum 928 = PbeMd2DesCbc
  toEnum 929 = PbeMd5DesCbc
  toEnum 930 = PbeMd5CastCbc
  toEnum 931 = PbeMd5Cast3Cbc
  toEnum 932 = PbeMd5Cast5Cbc
  toEnum 933 = PbeSha1Cast5Cbc
  toEnum 934 = PbeSha1Rc4128
  toEnum 935 = PbeSha1Rc440
  toEnum 936 = PbeSha1Des3EdeCbc
  toEnum 937 = PbeSha1Des2EdeCbc
  toEnum 938 = PbeSha1Rc2128Cbc
  toEnum 939 = PbeSha1Rc240Cbc
  toEnum 944 = Pkcs5Pbkd2
  toEnum 960 = PbaSha1WithSha1Hmac
  toEnum 4160 = EcdsaKeyPairGen
  toEnum 4161 = Ecdsa
  toEnum 4162 = EcdsaSha1
  toEnum 4176 = Ecdh1Derive
  toEnum 4177 = Ecdh1CofactorDerive
  toEnum 4178 = DcmqvDerive
  toEnum 4192 = JuniperKeyGen
  toEnum 4193 = JuniperEcb128
  toEnum 4194 = JuniperCbc128
  toEnum 4195 = JuniperCounter
  toEnum 4196 = JuniperShuffle
  toEnum 4197 = JuniperWrap
  toEnum 4208 = FastHash
  toEnum 4224 = AesKeyGen
  toEnum 4225 = AesEcb
  toEnum 4226 = AesCbc
  toEnum 4227 = AesMac
  toEnum 4228 = AesMacGeneral
  toEnum 4229 = AesCbcPad
  toEnum 4230 = AesCtr
  toEnum 4231 = AesGcm
  toEnum 4232 = AesCcm
  toEnum 4240 = AesKeyWrap
  toEnum 4241 = AesKeyWrapPad
  toEnum 4242 = TwoFishKeyGen
  toEnum 4243 = TwoFishCbc
  toEnum 4352 = DesEcbEncryptData
  toEnum 4353 = DesCbcEncryptData
  toEnum 4354 = Des3EcbEncryptData
  toEnum 4355 = Des3CbcEncryptData
  toEnum 4356 = AesEcbEncryptData
  toEnum 4357 = AesCbcEncryptData
  toEnum 8192 = DsaParameterGen
  toEnum 8193 = DhPkcsParameterGen
  toEnum 8194 = X9_42DhParameterGen
  toEnum 2147483648 = VendorDefined
  toEnum unmatched = error ("MechType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 1289 "./System/Crypto/Pkcs11.chs" #-}



_decryptInit :: MechType -> Session -> ObjectHandle -> IO ()
_decryptInit mechType (Session sessionHandle functionListPtr) obj = do
    alloca $ \mechPtr -> do
        poke mechPtr (Mech {mechType = mechType, mechParamPtr = nullPtr, mechParamSize = 0})
        rv <- (\o x1 x2 x3 -> (\ptr -> do {C2HSImp.peekByteOff ptr 272 :: IO (C2HSImp.FunPtr (C2HSImp.CULong -> ((MechPtr) -> (C2HSImp.CULong -> (IO C2HSImp.CULong)))))}) o >>= \f -> cK_FUNCTION_LISTc_DecryptInit f x1 x2 x3) functionListPtr sessionHandle mechPtr obj
        if rv /= 0
            then fail $ "failed to initiate decryption: " ++ (rvToStr rv)
            else return ()


decrypt :: MechType -> Session -> ObjectHandle -> BS.ByteString -> IO BS.ByteString
decrypt mechType (Session sessionHandle functionListPtr) obj encData = do
    _decryptInit mechType (Session sessionHandle functionListPtr) obj
    unsafeUseAsCStringLen encData $ \(encDataPtr, encDataLen) -> do
        allocaBytes encDataLen $ \outDataPtr -> do
            alloca $ \outDataLenPtr -> do
                poke outDataLenPtr (fromIntegral encDataLen)
                rv <- (\o x1 x2 x3 x4 x5 -> (\ptr -> do {C2HSImp.peekByteOff ptr 280 :: IO (C2HSImp.FunPtr (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CUChar) -> (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CUChar) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CULong)))))))}) o >>= \f -> cK_FUNCTION_LISTc_Decrypt f x1 x2 x3 x4 x5) functionListPtr sessionHandle (castPtr encDataPtr) (fromIntegral encDataLen) outDataPtr outDataLenPtr
                if rv /= 0
                    then fail $ "failed to decrypt: " ++ (rvToStr rv)
                    else do
                        outDataLen <- peek outDataLenPtr
                        res <- BS.packCStringLen (castPtr outDataPtr, fromIntegral outDataLen)
                        return res


_encryptInit :: MechType -> Session -> ObjectHandle -> IO ()
_encryptInit mechType (Session sessionHandle functionListPtr) obj = do
    alloca $ \mechPtr -> do
        poke mechPtr (Mech {mechType = mechType, mechParamPtr = nullPtr, mechParamSize = 0})
        rv <- (\o x1 x2 x3 -> (\ptr -> do {C2HSImp.peekByteOff ptr 240 :: IO (C2HSImp.FunPtr (C2HSImp.CULong -> ((MechPtr) -> (C2HSImp.CULong -> (IO C2HSImp.CULong)))))}) o >>= \f -> cK_FUNCTION_LISTc_EncryptInit f x1 x2 x3) functionListPtr sessionHandle mechPtr obj
        if rv /= 0
            then fail $ "failed to initiate decryption: " ++ (rvToStr rv)
            else return ()


encrypt :: MechType -> Session -> ObjectHandle -> BS.ByteString -> IO BS.ByteString
encrypt mechType (Session sessionHandle functionListPtr) obj encData = do
    _encryptInit mechType (Session sessionHandle functionListPtr) obj
    let outLen = 1000
    unsafeUseAsCStringLen encData $ \(encDataPtr, encDataLen) -> do
        allocaBytes outLen $ \outDataPtr -> do
            alloca $ \outDataLenPtr -> do
                poke outDataLenPtr (fromIntegral outLen)
                rv <- (\o x1 x2 x3 x4 x5 -> (\ptr -> do {C2HSImp.peekByteOff ptr 248 :: IO (C2HSImp.FunPtr (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CUChar) -> (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CUChar) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CULong)))))))}) o >>= \f -> cK_FUNCTION_LISTc_Encrypt f x1 x2 x3 x4 x5) functionListPtr sessionHandle (castPtr encDataPtr) (fromIntegral encDataLen) outDataPtr outDataLenPtr
                if rv /= 0
                    then fail $ "failed to decrypt: " ++ (rvToStr rv)
                    else do
                        outDataLen <- peek outDataLenPtr
                        res <- BS.packCStringLen (castPtr outDataPtr, fromIntegral outDataLen)
                        return res


unwrapKey :: MechType -> Session -> ObjectHandle -> BS.ByteString -> [Attribute] -> IO ObjectHandle
unwrapKey mechType (Session sessionHandle functionListPtr) key wrappedKey template = do
    _withAttribs template $ \attribsPtr -> do
        alloca $ \mechPtr -> do
            poke mechPtr (Mech {mechType = mechType, mechParamPtr = nullPtr, mechParamSize = 0})
            unsafeUseAsCStringLen wrappedKey $ \(wrappedKeyPtr, wrappedKeyLen) -> do
                alloca $ \unwrappedKeyPtr -> do
                    rv <- (\o x1 x2 x3 x4 x5 x6 x7 x8 -> (\ptr -> do {C2HSImp.peekByteOff ptr 496 :: IO (C2HSImp.FunPtr (C2HSImp.CULong -> ((MechPtr) -> (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CUChar) -> (C2HSImp.CULong -> ((LlAttributePtr) -> (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CULong))))))))))}) o >>= \f -> cK_FUNCTION_LISTc_UnwrapKey f x1 x2 x3 x4 x5 x6 x7 x8) functionListPtr sessionHandle mechPtr key (castPtr wrappedKeyPtr) (fromIntegral wrappedKeyLen) attribsPtr (fromIntegral $ length template) unwrappedKeyPtr
                    if rv /= 0
                        then fail $ "failed to unwrap key: " ++ (rvToStr rv)
                        else do
                            unwrappedKey <- peek unwrappedKeyPtr
                            return unwrappedKey


-- | Obtains a list of mechanism types supported by a token
getMechanismList :: Library -> SlotId -> Int -> IO [Int]
getMechanismList (Library _ functionListPtr) slotId maxMechanisms = do
    (rv, types) <- _getMechanismList functionListPtr slotId maxMechanisms
    if rv /= 0
        then fail $ "failed to get list of mechanisms: " ++ (rvToStr rv)
        else return $ map (fromIntegral) types


-- | Obtains information about a particular mechanism possibly supported by a token
getMechanismInfo :: Library -> SlotId -> MechType -> IO MechInfo
getMechanismInfo (Library _ functionListPtr) slotId mechId = do
    (rv, types) <- _getMechanismInfo functionListPtr slotId (fromEnum mechId)
    if rv /= 0
        then fail $ "failed to get mechanism information: " ++ (rvToStr rv)
        else return types

foreign import ccall unsafe "dynamic"
  initialize'_ :: C2HSImp.FunPtr( ((C2HSImp.Ptr ()) -> (IO C2HSImp.CULong)) ) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CULong))

foreign import ccall unsafe "dynamic"
  getInfo''_ :: C2HSImp.FunPtr( ((InfoPtr) -> (IO C2HSImp.CULong)) ) -> ((InfoPtr) -> (IO C2HSImp.CULong))

foreign import ccall unsafe "dynamic"
  cK_FUNCTION_LISTc_GetSlotList :: C2HSImp.FunPtr( (C2HSImp.CUChar -> ((C2HSImp.Ptr C2HSImp.CULong) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CULong)))) ) -> (C2HSImp.CUChar -> ((C2HSImp.Ptr C2HSImp.CULong) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CULong))))

foreign import ccall unsafe "dynamic"
  getSlotInfo''_ :: C2HSImp.FunPtr( (C2HSImp.CULong -> ((SlotInfoPtr) -> (IO C2HSImp.CULong))) ) -> (C2HSImp.CULong -> ((SlotInfoPtr) -> (IO C2HSImp.CULong)))

foreign import ccall unsafe "dynamic"
  getTokenInfo''_ :: C2HSImp.FunPtr( (C2HSImp.CULong -> ((TokenInfoPtr) -> (IO C2HSImp.CULong))) ) -> (C2HSImp.CULong -> ((TokenInfoPtr) -> (IO C2HSImp.CULong)))

foreign import ccall unsafe "dynamic"
  cK_FUNCTION_LISTc_OpenSession :: C2HSImp.FunPtr( (C2HSImp.CULong -> (C2HSImp.CULong -> ((C2HSImp.Ptr ()) -> ((C2HSImp.FunPtr (C2HSImp.CULong -> (C2HSImp.CULong -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CULong))))) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CULong)))))) ) -> (C2HSImp.CULong -> (C2HSImp.CULong -> ((C2HSImp.Ptr ()) -> ((C2HSImp.FunPtr (C2HSImp.CULong -> (C2HSImp.CULong -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CULong))))) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CULong))))))

foreign import ccall unsafe "dynamic"
  closeSession''_ :: C2HSImp.FunPtr( (C2HSImp.CULong -> (IO C2HSImp.CULong)) ) -> (C2HSImp.CULong -> (IO C2HSImp.CULong))

foreign import ccall unsafe "dynamic"
  finalize'_ :: C2HSImp.FunPtr( ((C2HSImp.Ptr ()) -> (IO C2HSImp.CULong)) ) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CULong))

foreign import ccall unsafe "dynamic"
  cK_FUNCTION_LISTc_FindObjectsInit :: C2HSImp.FunPtr( (C2HSImp.CULong -> ((LlAttributePtr) -> (C2HSImp.CULong -> (IO C2HSImp.CULong)))) ) -> (C2HSImp.CULong -> ((LlAttributePtr) -> (C2HSImp.CULong -> (IO C2HSImp.CULong))))

foreign import ccall unsafe "dynamic"
  cK_FUNCTION_LISTc_FindObjects :: C2HSImp.FunPtr( (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CULong) -> (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CULong))))) ) -> (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CULong) -> (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CULong)))))

foreign import ccall unsafe "dynamic"
  findObjectsFinal''_ :: C2HSImp.FunPtr( (C2HSImp.CULong -> (IO C2HSImp.CULong)) ) -> (C2HSImp.CULong -> (IO C2HSImp.CULong))

foreign import ccall unsafe "dynamic"
  cK_FUNCTION_LISTc_Login :: C2HSImp.FunPtr( (C2HSImp.CULong -> (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CUChar) -> (C2HSImp.CULong -> (IO C2HSImp.CULong))))) ) -> (C2HSImp.CULong -> (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CUChar) -> (C2HSImp.CULong -> (IO C2HSImp.CULong)))))

foreign import ccall unsafe "dynamic"
  cK_FUNCTION_LISTc_GenerateKeyPair :: C2HSImp.FunPtr( (C2HSImp.CULong -> ((MechPtr) -> ((LlAttributePtr) -> (C2HSImp.CULong -> ((LlAttributePtr) -> (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CULong) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CULong))))))))) ) -> (C2HSImp.CULong -> ((MechPtr) -> ((LlAttributePtr) -> (C2HSImp.CULong -> ((LlAttributePtr) -> (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CULong) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CULong)))))))))

foreign import ccall unsafe "dynamic"
  cK_FUNCTION_LISTc_GetMechanismList :: C2HSImp.FunPtr( (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CULong) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CULong)))) ) -> (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CULong) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CULong))))

foreign import ccall unsafe "dynamic"
  _getMechanismInfo'_ :: C2HSImp.FunPtr( (C2HSImp.CULong -> (C2HSImp.CULong -> ((MechInfoPtr) -> (IO C2HSImp.CULong)))) ) -> (C2HSImp.CULong -> (C2HSImp.CULong -> ((MechInfoPtr) -> (IO C2HSImp.CULong))))

foreign import ccall unsafe "dynamic"
  cK_FUNCTION_LISTc_GetAttributeValue :: C2HSImp.FunPtr( (C2HSImp.CULong -> (C2HSImp.CULong -> ((LlAttributePtr) -> (C2HSImp.CULong -> (IO C2HSImp.CULong))))) ) -> (C2HSImp.CULong -> (C2HSImp.CULong -> ((LlAttributePtr) -> (C2HSImp.CULong -> (IO C2HSImp.CULong)))))

foreign import ccall unsafe "dynamic"
  cK_FUNCTION_LISTc_Logout :: C2HSImp.FunPtr( (C2HSImp.CULong -> (IO C2HSImp.CULong)) ) -> (C2HSImp.CULong -> (IO C2HSImp.CULong))

foreign import ccall unsafe "dynamic"
  cK_FUNCTION_LISTc_DecryptInit :: C2HSImp.FunPtr( (C2HSImp.CULong -> ((MechPtr) -> (C2HSImp.CULong -> (IO C2HSImp.CULong)))) ) -> (C2HSImp.CULong -> ((MechPtr) -> (C2HSImp.CULong -> (IO C2HSImp.CULong))))

foreign import ccall unsafe "dynamic"
  cK_FUNCTION_LISTc_Decrypt :: C2HSImp.FunPtr( (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CUChar) -> (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CUChar) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CULong)))))) ) -> (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CUChar) -> (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CUChar) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CULong))))))

foreign import ccall unsafe "dynamic"
  cK_FUNCTION_LISTc_EncryptInit :: C2HSImp.FunPtr( (C2HSImp.CULong -> ((MechPtr) -> (C2HSImp.CULong -> (IO C2HSImp.CULong)))) ) -> (C2HSImp.CULong -> ((MechPtr) -> (C2HSImp.CULong -> (IO C2HSImp.CULong))))

foreign import ccall unsafe "dynamic"
  cK_FUNCTION_LISTc_Encrypt :: C2HSImp.FunPtr( (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CUChar) -> (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CUChar) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CULong)))))) ) -> (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CUChar) -> (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CUChar) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CULong))))))

foreign import ccall unsafe "dynamic"
  cK_FUNCTION_LISTc_UnwrapKey :: C2HSImp.FunPtr( (C2HSImp.CULong -> ((MechPtr) -> (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CUChar) -> (C2HSImp.CULong -> ((LlAttributePtr) -> (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CULong))))))))) ) -> (C2HSImp.CULong -> ((MechPtr) -> (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CUChar) -> (C2HSImp.CULong -> ((LlAttributePtr) -> (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CULong)))))))))