-- 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 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 28 "./System/Crypto/Pkcs11.chs" #-}

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

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

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

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

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

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

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

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


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

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

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

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

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

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

type MechPtr = C2HSImp.Ptr (Mech)
{-# LINE 44 "./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 58 "./System/Crypto/Pkcs11.chs" #-}

  alignment _ = 1
{-# LINE 59 "./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 {
    infoCryptokiVersion :: Version,
    infoManufacturerId :: String,
    infoFlags :: CK_FLAGS,
    infoLibraryDescription :: String,
    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
                 }


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


data SlotInfo = SlotInfo {
    slotInfoDescription :: String,
    slotInfoManufacturerId :: String,
    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
                     }


data TokenInfo = TokenInfo {
    tokenInfoLabel :: String,
    tokenInfoManufacturerId :: String,
    tokenInfoModel :: String,
    tokenInfoSerialNumber :: String,
    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
                          }


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

instance Storable MechInfo where
  sizeOf _ = 24
{-# LINE 161 "./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 :: Int,
    mechParamPtr :: Ptr (),
    mechParamSize :: Int
}

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

    alignment _ = 1
    poke p x = do
        poke (p `plusPtr` 0) (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 191 "./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 195 "./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 212 "./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 219 "./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 231 "./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 236 "./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 265 "./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 268 "./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 -> Int -> [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, [CULong])
_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, 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 309 "./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 381 "./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 390 "./System/Crypto/Pkcs11.chs" #-}


data AttributeType = ClassType
                   | TokenType
                   | LabelType
                   | KeyTypeType
                   | DecryptType
                   | ModulusType
                   | ModulusBitsType
                   | PublicExponentType
                   | PrivateExponentType
                   | Prime1Type
                   | Prime2Type
                   | Exponent1Type
                   | Exponent2Type
                   | CoefficientType
  deriving (Show,Eq)
instance Enum AttributeType where
  succ ClassType = TokenType
  succ TokenType = LabelType
  succ LabelType = KeyTypeType
  succ KeyTypeType = DecryptType
  succ DecryptType = 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 = error "AttributeType.succ: CoefficientType has no successor"

  pred TokenType = ClassType
  pred LabelType = TokenType
  pred KeyTypeType = LabelType
  pred DecryptType = KeyTypeType
  pred ModulusType = DecryptType
  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 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 CoefficientType

  fromEnum ClassType = 0
  fromEnum TokenType = 1
  fromEnum LabelType = 3
  fromEnum KeyTypeType = 256
  fromEnum DecryptType = 261
  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

  toEnum 0 = ClassType
  toEnum 1 = TokenType
  toEnum 3 = LabelType
  toEnum 256 = KeyTypeType
  toEnum 261 = DecryptType
  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 unmatched = error ("AttributeType.toEnum: Cannot match " ++ show unmatched)

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


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

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

}

instance Storable LlAttribute where
    sizeOf _ = 8 + 8 + 8
{-# LINE 426 "./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 433 "./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 448 "./System/Crypto/Pkcs11.chs" #-}

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

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

_valueSize (Token _) = 1
{-# LINE 452 "./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)


-- High level API starts here


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


data Session = Session SessionHandle FunctionListPtr


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


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


getSlotList :: Library -> Bool -> Int -> IO [CULong]
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 slots


getSlotInfo :: Library -> Int -> 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


getTokenInfo :: Library -> Int -> 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 -> Int -> 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 -> Int -> Int -> (Session -> IO a) -> IO a
withSession lib slotId flags f = do
    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 -> Int -> [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)


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


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 ()


data MechType = RsaPkcsKeyPairGen
              | RsaPkcs
              | AesEcb
              | AesCbc
              | AesMac
              | AesMacGeneral
              | AesCbcPad
              | AesCtr
  deriving (Eq)
instance Enum MechType where
  succ RsaPkcsKeyPairGen = RsaPkcs
  succ RsaPkcs = AesEcb
  succ AesEcb = AesCbc
  succ AesCbc = AesMac
  succ AesMac = AesMacGeneral
  succ AesMacGeneral = AesCbcPad
  succ AesCbcPad = AesCtr
  succ AesCtr = error "MechType.succ: AesCtr has no successor"

  pred RsaPkcs = RsaPkcsKeyPairGen
  pred AesEcb = RsaPkcs
  pred AesCbc = AesEcb
  pred AesMac = AesCbc
  pred AesMacGeneral = AesMac
  pred AesCbcPad = AesMacGeneral
  pred AesCtr = AesCbcPad
  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 AesCtr

  fromEnum RsaPkcsKeyPairGen = 0
  fromEnum RsaPkcs = 1
  fromEnum AesEcb = 4225
  fromEnum AesCbc = 4226
  fromEnum AesMac = 4227
  fromEnum AesMacGeneral = 4228
  fromEnum AesCbcPad = 4229
  fromEnum AesCtr = 4230

  toEnum 0 = RsaPkcsKeyPairGen
  toEnum 1 = RsaPkcs
  toEnum 4225 = AesEcb
  toEnum 4226 = AesCbc
  toEnum 4227 = AesMac
  toEnum 4228 = AesMacGeneral
  toEnum 4229 = AesCbcPad
  toEnum 4230 = AesCtr
  toEnum unmatched = error ("MechType.toEnum: Cannot match " ++ show unmatched)

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



_decryptInit :: MechType -> Session -> ObjectHandle -> IO ()
_decryptInit mechType (Session sessionHandle functionListPtr) obj = do
    alloca $ \mechPtr -> do
        poke mechPtr (Mech {mechType = fromEnum 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
        putStrLn $ "in data len " ++ (show encDataLen)
        putStrLn $ show encData
        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 = fromEnum 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 = fromEnum 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


getMechanismList :: Library -> Int -> Int -> IO [CULong]
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 types


getMechanismInfo :: Library -> Int -> Int -> IO MechInfo
getMechanismInfo (Library _ functionListPtr) slotId mechId = do
    (rv, types) <- _getMechanismInfo functionListPtr slotId 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_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)))))))))