diff --git a/Test.hs b/Test.hs --- a/Test.hs +++ b/Test.hs @@ -23,7 +23,9 @@ lib <- loadLibrary "/usr/local/Cellar/softhsm/2.3.0/lib/softhsm/libsofthsm2.so" info <- getInfo lib putStrLn(show info) - slots <- getSlotList lib True 10 + allSlotsNum <- getSlotNum lib False + putStrLn("total number of slots: " ++ show allSlotsNum) + slots <- getSlotList lib True 2 putStrLn("slots: " ++ show slots) let slotId = head slots @@ -71,8 +73,7 @@ encData <- PL.encrypt sess (BSL.pack [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]) putStrLn $ show encData putStrLn "decryption" - decryptInit (simpleMech AesEcb) sess aesKeyHandle - decData <- decrypt sess (BSL.toStrict encData) 1000 + decData <- decrypt (simpleMech AesEcb) sess aesKeyHandle (BSL.toStrict encData) 1000 putStrLn $ show decData putStrLn "generating key pair" (pubKeyHandle, privKeyHandle) <- generateKeyPair sess (simpleMech RsaPkcsKeyPairGen) [ModulusBits 2048, Token True, Label "key"] [Token True, Label "key"] @@ -82,19 +83,15 @@ putStrLn $ show wrappedAesKey putStrLn "unwrap key" unwrappedAesKey <- unwrapKey (simpleMech RsaPkcs) sess privKeyHandle wrappedAesKey [Class SecretKey, KeyType AES] - putStrLn "signInit" - signInit (simpleMech RsaPkcs) sess privKeyHandle putStrLn "sign" let signedData = BS.pack [0,0,0,0] - signature <- sign sess signedData 1000 + signature <- sign (simpleMech RsaPkcs) sess privKeyHandle signedData 1000 putStrLn $ show signature - putStrLn "verifyInit" - verifyInit sess (simpleMech RsaPkcs) pubKeyHandle --putStrLn "get operation state" --operState <- getOperationState sess 1000 --putStrLn $ show operState putStrLn "verify" - verRes <- verify sess signedData signature + verRes <- verify (simpleMech RsaPkcs) sess pubKeyHandle signedData signature putStrLn $ "verify result " ++ (show verRes) --putStrLn "signRecoverInit" --signRecoverInit (simpleMech Rsa9796) sess privKeyHandle @@ -113,10 +110,8 @@ putStrLn $ show copiedObjHandle putStrLn "deleting object" destroyObject sess aesKeyHandle - putStrLn "digestInit" - digestInit (simpleMech Sha256) sess putStrLn "digest" - digestedData <- digest sess signedData 1000 + digestedData <- digest (simpleMech Sha256) sess (BS.replicate 16 0) 1000 putStrLn $ show digestedData putStrLn "create object" createdAesKey <- createObject sess [Class SecretKey, @@ -175,13 +170,11 @@ encryptedMessage = AESmod.encryptECB aesKey "hello00000000000" -- test decryption using RSA key - decryptInit (simpleMech RsaPkcs) sess objId - dec <- decrypt sess (BSL.toStrict encKey) 1000 + dec <- decrypt (simpleMech RsaPkcs) sess objId (BSL.toStrict encKey) 1000 putStrLn $ show dec -- test decryption using AES key - decryptInit (simpleMech AesEcb) sess unwrappedKeyHandle - decAes <- decrypt sess encryptedMessage 1000 + decAes <- decrypt (simpleMech AesEcb) sess unwrappedKeyHandle encryptedMessage 1000 putStrLn $ show decAes logout sess diff --git a/hspkcs11.cabal b/hspkcs11.cabal --- a/hspkcs11.cabal +++ b/hspkcs11.cabal @@ -1,5 +1,5 @@ name: hspkcs11 -version: 0.4 +version: 0.5 synopsis: Wrapper for PKCS #11 interface description: This package allows to call PKCS#11 provider libraries. PKCS#11 is a C interface specification for cryptography providers, such as crypto tokens and HSMs homepage: https://github.com/denisenkom/hspkcs11 diff --git a/src/System/Crypto/Pkcs11.chs b/src/System/Crypto/Pkcs11.chs --- a/src/System/Crypto/Pkcs11.chs +++ b/src/System/Crypto/Pkcs11.chs @@ -6,21 +6,25 @@ releaseLibrary, -- ** Reading library information - Info, getInfo, + LibraryInfo, infoCryptokiVersion, infoManufacturerId, infoFlags, infoLibraryDescription, infoLibraryVersion, + Version, + versionMajor, + versionMinor, -- * Slots SlotId, + getSlotNum, getSlotList, -- ** Reading slot information - SlotInfo, getSlotInfo, + SlotInfo, slotInfoDescription, slotInfoManufacturerId, slotInfoFlags, @@ -40,31 +44,38 @@ setPin, -- * Mechanisms + getMechanismList, + getMechanismInfo, MechType(RsaPkcsKeyPairGen,RsaPkcs,Rsa9796,AesEcb,AesCbc,AesMac,AesMacGeneral,AesCbcPad,AesCtr,AesKeyGen,Sha256, DhPkcsKeyPairGen,DhPkcsParameterGen,DhPkcsDerive), MechInfo, - getMechanismList, - getMechanismInfo, mechInfoMinKeySize, mechInfoMaxKeySize, mechInfoFlags, + Mech, simpleMech, -- * Session management Session, - UserType(User,SecurityOfficer,ContextSpecific), withSession, + login, + UserType(User,SecurityOfficer,ContextSpecific), + logout, closeAllSessions, getSessionInfo, + SessionInfo, + sessionInfoSlotId, + sessionInfoState, + sessionInfoFlags, + sessionInfoDeviceError, + SessionState(ROPublicSession,ROUserFunctions,RWPublicSession,RWUserFunctions,RWSOFunctions), getOperationState, - login, - logout, -- * Object attributes ObjectHandle, Attribute(Class,Label,KeyType,Modulus,ModulusBits,PrimeBits,PublicExponent,Prime,Base,Token,Decrypt,ValueLen, Extractable,Value), - ClassType(PrivateKey,SecretKey), + ClassType(Data,Certificate,PublicKey,PrivateKey,SecretKey,HWFeature,DomainParameters,Mechanism), KeyTypeValue(RSA,DSA,DH,ECDSA,EC,AES), destroyObject, createObject, @@ -98,33 +109,29 @@ unwrapKey, -- * Encryption/decryption - decryptInit, decrypt, - encryptInit, encrypt, + -- ** Multipart operations + decryptInit, + encryptInit, encryptUpdate, encryptFinal, -- * Digest - digestInit, digest, + digestInit, -- * Signing - signInit, sign, - signRecoverInit, + verify, signRecover, + signInit, verifyInit, - verify, + signRecoverInit, -- * Random seedRandom, generateRandom, - - -- * Misc - Version, - versionMajor, - versionMinor, ) where import Foreign import Foreign.Marshal.Utils @@ -152,10 +159,12 @@ rsaPkcsKeyPairGen = {#const CKM_RSA_PKCS_KEY_PAIR_GEN#} :: Int +-- | Used to reference an object type ObjectHandle = {#type CK_OBJECT_HANDLE#} {#typedef CK_OBJECT_HANDLE ObjectHandle#} {#default in `ObjectHandle' [CK_OBJECT_HANDLE] fromIntegral#} {#default out `ObjectHandle' [CK_OBJECT_HANDLE] fromIntegral#} + type SlotId = {#type CK_SLOT_ID#} {#typedef CK_SLOT_ID SlotId#} {#default in `SlotId' [CK_SLOT_ID] fromIntegral#} @@ -167,7 +176,6 @@ type CK_BYTE = {#type CK_BYTE#} type CK_FLAGS = {#type CK_FLAGS#} type GetFunctionListFunPtr = {#type CK_C_GetFunctionList#} -type GetSlotListFunPtr = {#type CK_C_GetSlotList#} type NotifyFunPtr = {#type CK_NOTIFY#} type SessionHandle = {#type CK_SESSION_HANDLE#} {#typedef CK_SESSION_HANDLE SessionHandle#} @@ -175,7 +183,7 @@ {#default out `SessionHandle' [CK_SESSION_HANDLE] fromIntegral#} {#pointer *CK_FUNCTION_LIST as FunctionListPtr#} -{#pointer *CK_INFO as InfoPtr -> Info#} +{#pointer *CK_INFO as LibraryInfoPtr -> LibraryInfo#} {#pointer *CK_SLOT_INFO as SlotInfoPtr -> SlotInfo#} {#pointer *CK_TOKEN_INFO as TokenInfoPtr -> TokenInfo#} {#pointer *CK_SESSION_INFO as SessionInfoPtr -> SessionInfo#} @@ -204,7 +212,8 @@ {#set CK_VERSION->major#} p (fromIntegral $ versionMajor x) {#set CK_VERSION->minor#} p (fromIntegral $ versionMinor x) -data Info = Info { +-- | Represents general library information. Returned by 'getInfo' function. +data LibraryInfo = LibraryInfo { -- | Cryptoki interface version number, for compatibility with future revisions of this interface infoCryptokiVersion :: Version, -- | ID of the Cryptoki library manufacturer @@ -216,7 +225,7 @@ infoLibraryVersion :: Version } deriving (Show) -instance Storable Info where +instance Storable LibraryInfo where sizeOf _ = (2+32+4+32+10+2) alignment _ = 1 peek p = do @@ -227,7 +236,7 @@ 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, + return LibraryInfo {infoCryptokiVersion=ver, infoManufacturerId=manufacturerId, infoFlags=fromIntegral flags, infoLibraryDescription=libraryDescription, @@ -237,10 +246,6 @@ error "not implemented" -peekInfo :: Ptr Info -> IO Info -peekInfo ptr = peek ptr - - data SlotInfo = SlotInfo { slotInfoDescription :: String, slotInfoManufacturerId :: String, @@ -304,9 +309,13 @@ error "not implemented" +-- | Represent information about a mechanism. Returned by 'getMechanismInfo' function. data MechInfo = MechInfo { + -- | Minimum size of a key in bits or bytes depending on the mechanism. mechInfoMinKeySize :: Int, + -- | Maximum size of a key in bits or bytes depending on the mechanism. mechInfoMaxKeySize :: Int, + -- | Mechanism's flags as described in https://www.cryptsoft.com/pkcs11doc/v220/pkcs11__all_8h.html#aCK_MECHANISM_INFO mechInfoFlags :: Int } deriving (Show) @@ -323,12 +332,15 @@ {#set CK_MECHANISM_INFO->flags#} p (fromIntegral $ mechInfoFlags x) +-- | Represents mechanism with parameters to be used in cryptographic operation. Parameterless mechanism can be +-- created with 'simpleMech' function. Few example operations using this data structure are 'encrypt', 'generateKey'. data Mech = Mech { mechType :: MechType, mechParamPtr :: Ptr (), mechParamSize :: Int } +-- | Return parameterless mechanism which can be used in cryptographic operation. simpleMech :: MechType -> Mech simpleMech mechType = Mech mechType nullPtr 0 @@ -343,21 +355,28 @@ poke (p `plusPtr` ({#sizeof CK_MECHANISM_TYPE#} + {#sizeof CK_VOID_PTR#})) (mechParamSize x) +-- | Represent session information. Returned by 'getSessionInfo' function. data SessionInfo = SessionInfo { - slotId :: SlotId, - state :: CULong, - flags :: CULong, - deviceError :: CULong + -- | Slot for which session is open + sessionInfoSlotId :: SlotId, + -- | State of the session, e.g. 'ROPublicSession', 'RWUserFunctions'. + sessionInfoState :: SessionState, + -- | Session flags as described in https://www.cryptsoft.com/pkcs11doc/v220/pkcs11__all_8h.html#aCK_SESSION_INFO. + sessionInfoFlags :: CULong, + -- | Device specific error code. + sessionInfoDeviceError :: CULong } deriving (Show) + instance Storable SessionInfo where sizeOf _ = {#sizeof CK_SESSION_INFO#} alignment _ = 1 peek p = SessionInfo <$> liftM fromIntegral ({#get CK_SESSION_INFO->slotID#} p) - <*> {#get CK_SESSION_INFO->state#} p + <*> liftM culong2sessState ({#get CK_SESSION_INFO->state#} p) <*> {#get CK_SESSION_INFO->flags#} p <*> {#get CK_SESSION_INFO->ulDeviceError#} p + where culong2sessState val = toEnum $ fromIntegral val poke p x = do error "not implemented" @@ -368,17 +387,40 @@ {#fun unsafe CK_FUNCTION_LIST.C_GetInfo as getInfo' {`FunctionListPtr', - alloca- `Info' peekInfo* } -> `Rv' fromIntegral#} + alloca- `LibraryInfo' peek* } -> `Rv' fromIntegral#} +{#fun unsafe CK_FUNCTION_LIST.C_GetSlotList as getSlotList' + {`FunctionListPtr', + `Bool', + castPtr `Ptr SlotId', + `CULong' peek*} -> `Rv' +#} -getSlotList' functionListPtr active num = do - alloca $ \arrayLenPtr -> do - poke arrayLenPtr (fromIntegral num) +-- | Return number of slots in the system. +getSlotNum :: Library -- ^ Library to be used for operation. + -> Bool -- ^ If True will return only slots with tokens in them. + -> IO (CULong) -- ^ Number of slots. +getSlotNum (Library _ functionListPtr) active = do + (rv, outNum) <- getSlotList' functionListPtr active nullPtr 0 + if rv /= 0 + then fail $ "failed to get number of slots " ++ (rvToStr rv) + else return outNum + +-- | Get a list of slot IDs in the system. Can filter for slots with attached tokens. +-- +-- > 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 -- ^ Library to be used for operation. + -> Bool -- ^ If True will return only slots with tokens in them. + -> Int -- ^ Maximum number of slot IDs to be returned. + -> IO [SlotId] +getSlotList (Library _ functionListPtr) active num = do allocaArray num $ \array -> do - res <- {#call unsafe CK_FUNCTION_LIST.C_GetSlotList#} functionListPtr (fromBool active) array arrayLenPtr - arrayLen <- peek arrayLenPtr - slots <- peekArray (fromIntegral arrayLen) array - return (fromIntegral res, slots) + (rv, outNum) <- getSlotList' functionListPtr active array (fromIntegral num) + if rv /= 0 + then fail $ "failed to get list of slots " ++ (rvToStr rv) + else peekArray (fromIntegral outNum) array initToken' :: FunctionListPtr -> SlotId -> BU8.ByteString -> String -> IO (Rv) @@ -493,7 +535,16 @@ {#enum define UserType {CKU_USER as User, CKU_SO as SecurityOfficer, CKU_CONTEXT_SPECIFIC as ContextSpecific} deriving (Eq) #} +{#enum define SessionState { + CKS_RO_PUBLIC_SESSION as ROPublicSession, + CKS_RO_USER_FUNCTIONS as ROUserFunctions, + CKS_RW_PUBLIC_SESSION as RWPublicSession, + CKS_RW_USER_FUNCTIONS as RWUserFunctions, + CKS_RW_SO_FUNCTIONS as RWSOFunctions + } deriving (Eq,Show) +#} + {#fun unsafe CK_FUNCTION_LIST.C_GetOperationState as getOperationState' {`FunctionListPtr', `SessionHandle', @@ -520,6 +571,7 @@ `SessionHandle', `ObjectHandle'} -> `Rv'#} +-- | Deletes an object from token or session. destroyObject (Session sessHandle funcListPtr) objectHandle = do rv <- destroyObject' funcListPtr sessHandle objectHandle if rv /= 0 @@ -544,6 +596,17 @@ -- alloca- `ObjectHandle'} -> `Rv' fromIntegral#} +-- | Generates a symmetric key using provided mechanism and applies provided attributes to resulting key object. +-- +-- Examples: +-- +-- Generate 128-bit AES key: +-- +-- > keyHandle <- generateKey sess (simpleMech AesKeyGen) [ValueLen 16] +-- +-- Generate 1024-bit Diffie-Hellman domain parameters using PKCS#3 mechanism: +-- +-- > dhParamsHandle <- generateKey sess (simpleMech DhPkcsParameterGen) [PrimeBits 1028] generateKey :: Session -> Mech -> [Attribute] -> IO ObjectHandle generateKey (Session sessHandle funcListPtr) mech attribs = do (rv, keyHandle) <- generateKey' funcListPtr sessHandle mech attribs @@ -552,7 +615,12 @@ else return keyHandle -_generateKeyPair :: FunctionListPtr -> SessionHandle -> Mech -> [Attribute] -> [Attribute] -> IO (Rv, ObjectHandle, ObjectHandle) +_generateKeyPair :: FunctionListPtr + -> SessionHandle + -> Mech + -> [Attribute] + -> [Attribute] + -> IO (Rv, ObjectHandle, ObjectHandle) _generateKeyPair functionListPtr session mech pubAttrs privAttrs = do alloca $ \pubKeyHandlePtr -> do alloca $ \privKeyHandlePtr -> do @@ -649,11 +717,11 @@ {#enum define ClassType { CKO_DATA as Data, CKO_CERTIFICATE as Certificate, - CKO_PUBLIC_KEY as PublicKey, - CKO_PRIVATE_KEY as PrivateKey, - CKO_SECRET_KEY as SecretKey, + CKO_PUBLIC_KEY as PublicKey, -- ^ asymmetric public key, e.g. RSA public key + CKO_PRIVATE_KEY as PrivateKey, -- ^ asymmetric private key, e.g. RSA private key + CKO_SECRET_KEY as SecretKey, -- ^ symmetric key, e.g. AES key CKO_HW_FEATURE as HWFeature, - CKO_DOMAIN_PARAMETERS as DomainParameters, + CKO_DOMAIN_PARAMETERS as DomainParameters, -- ^ e.g. parameters for Diffie-Hellman CKO_MECHANISM as Mechanism } deriving (Show, Eq) #} @@ -791,21 +859,22 @@ CKA_VENDOR_DEFINED as VendorDefinedType } deriving (Show, Eq) #} -data Attribute = Class ClassType - | KeyType KeyTypeValue - | Label String - | ModulusBits Int - | PrimeBits Int - | Token Bool - | Decrypt Bool - | Sign Bool - | Modulus Integer - | PublicExponent Integer - | Prime Integer - | Base Integer - | ValueLen Integer - | Value BS.ByteString - | Extractable Bool +-- | Represents an attribute of an object +data Attribute = Class ClassType -- ^ class of an object, e.g. 'PrivateKey', 'SecretKey' + | KeyType KeyTypeValue -- ^ e.g. 'RSA' or 'AES' + | Label String -- ^ object's label + | Token Bool -- ^ whether object is stored on the token or is a temporary session object + | Decrypt Bool -- ^ allow/deny encryption function for an object + | Sign Bool -- ^ allow/deny signing function for an object + | ModulusBits Int -- ^ number of bits used by modulus, for example in RSA public key + | Modulus Integer -- ^ modulus value, used by RSA keys + | PublicExponent Integer -- ^ value of public exponent, used by RSA public keys + | PrimeBits Int -- ^ number of bits used by prime in classic Diffie-Hellman + | Prime Integer -- ^ value of prime modulus, used in classic Diffie-Hellman + | Base Integer -- ^ value of generator, used in classic Diffie-Hellman + | ValueLen Int -- ^ length in bytes of the corresponding 'Value' attribute + | Value BS.ByteString -- ^ object's value attribute, for example it is a DER encoded certificate for certificate objects + | Extractable Bool -- ^ allows or denys extraction of certain attributes of private keys deriving (Show) data LlAttribute = LlAttribute { @@ -945,17 +1014,18 @@ -- High level API starts here - +-- | Represents a PKCS#11 library. data Library = Library { libraryHandle :: DL, functionListPtr :: FunctionListPtr } +-- | Represent session. Created by 'withSession' function. data Session = Session SessionHandle FunctionListPtr --- | Load PKCS#11 dynamically linked library +-- | Load PKCS#11 dynamically linked library from given path -- -- > lib <- loadLibrary "/path/to/dll.so" loadLibrary :: String -> IO Library @@ -972,13 +1042,14 @@ else return Library { libraryHandle = lib, functionListPtr = functionListPtr } +-- | Releases resources used by loaded library releaseLibrary lib = do rv <- finalize $ functionListPtr lib dlclose $ libraryHandle lib --- | Returns general information about Cryptoki -getInfo :: Library -> IO Info +-- | Get general information about Cryptoki library +getInfo :: Library -> IO LibraryInfo getInfo (Library _ functionListPtr) = do (rv, info) <- getInfo' functionListPtr if rv /= 0 @@ -986,20 +1057,12 @@ 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 - - -initToken :: Library -> SlotId -> BU8.ByteString -> String -> IO () +-- | Initialize a token in a given slot. All objects created by user on the token are destroyed. +initToken :: Library -- ^ PKCS#11 library + -> SlotId -- ^ slot id in which to initialize token + -> BU8.ByteString -- ^ token's security officer password + -> String -- ^ new label for the token + -> IO () initToken (Library _ funcListPtr) slotId pin label = do rv <- initToken' funcListPtr slotId pin label if rv /= 0 @@ -1045,7 +1108,12 @@ else return () -withSession :: Library -> SlotId -> Bool -> (Session -> IO a) -> IO a +-- | Opens a read-only or read-write session with a token in a given slot and then closes it after callback function is finished. +withSession :: Library -- ^ Library to use. + -> SlotId -- ^ Slot ID for which to open session. + -> Bool -- ^ If True will open writable session, otherwise will open read-only session. + -> (Session -> IO a) -- ^ Callback function which is executed while session is open. + -> IO a -- ^ Returns a result of callback function. withSession lib slotId writable f = do let flags = if writable then _rwSession else 0 bracket @@ -1079,13 +1147,25 @@ else return () +-- | Searches current session for objects matching provided attributes list, returns a list of matching object handles findObjects :: Session -> [Attribute] -> IO [ObjectHandle] findObjects session attribs = do _findObjectsInitEx session attribs finally (_findObjectsEx session) (_findObjectsFinalEx session) -generateKeyPair :: Session -> Mech -> [Attribute] -> [Attribute] -> IO (ObjectHandle, ObjectHandle) +-- | Generates an asymmetric key pair using provided mechanism. +-- +-- Examples: +-- +-- Generate an 2048-bit RSA key: +-- +-- > (pubKey, privKey) <- generateKeyPair sess (simpleMech RsaPkcsKeyPairGen) [ModulusBits 2048] [] +generateKeyPair :: Session -- ^ session in which to generate key + -> Mech -- ^ a mechanism to use for key generation, for example 'simpleMech RsaPkcs' + -> [Attribute] -- ^ attributes applied to generated public key object + -> [Attribute] -- ^ attributes applied to generated private key object + -> IO (ObjectHandle, ObjectHandle) -- ^ created objects references, first is public key, second is private key generateKeyPair (Session sessionHandle functionListPtr) mech pubKeyAttrs privKeyAttrs = do (rv, pubKeyHandle, privKeyHandle) <- _generateKeyPair functionListPtr sessionHandle mech pubKeyAttrs privKeyAttrs if rv /= 0 @@ -1103,6 +1183,8 @@ alloca- `ObjectHandle' peek*} -> `Rv' #} +-- | Derives a key from a base key using provided mechanism and applies provided attributes to a resulting key. +-- Can be used to derive symmetric key using Diffie-Hellman key exchange. deriveKey (Session sessHandle funcListPtr) mech baseKeyHandle attribs = do _withAttribs attribs $ \attribsPtr -> do (rv, createdHandle) <- deriveKey' funcListPtr sessHandle mech baseKeyHandle attribsPtr (fromIntegral $ length attribs) @@ -1119,6 +1201,7 @@ alloca- `ObjectHandle' peek*} -> `Rv' #} +-- | Creates an object from given list of attributes and returns a reference to created object. createObject (Session sessHandle funcListPtr) attribs = do _withAttribs attribs $ \attribsPtr -> do (rv, createdHandle) <- createObject' funcListPtr sessHandle attribsPtr (fromIntegral $ length attribs) @@ -1136,6 +1219,7 @@ alloca- `ObjectHandle' peek*} -> `Rv' #} +-- | Makes a copy of an object and changes attributes of copied object, returns a reference to new object. copyObject (Session sessHandle funcListPtr) objHandle attribs = do _withAttribs attribs $ \attribsPtr -> do (rv, createdHandle) <- copyObject' funcListPtr sessHandle objHandle attribsPtr (fromIntegral $ length attribs) @@ -1151,6 +1235,7 @@ alloca- `CULong' peek*} -> `Rv' #} +-- | Returns an approximate amount of space occupied by an object in bytes. getObjectSize (Session sessHandle funcListPtr) objHandle = do (rv, objSize) <- getObjectSize' funcListPtr sessHandle objHandle if rv /= 0 @@ -1228,6 +1313,7 @@ `CULong'} -> `Rv' #} +-- | Modifies attributes of an object. setAttributes (Session sessHandle funcListPtr) objHandle attribs = do _withAttribs attribs $ \attribsPtr -> do rv <- setAttributeValue' funcListPtr sessHandle objHandle attribsPtr (fromIntegral $ length attribs) @@ -1236,6 +1322,8 @@ else return () +-- | Initializes normal user's PIN. Session should be logged in by SO user in other words it should be in +-- 'RWSOFunctions' state. initPin :: Session -> BU8.ByteString -> IO () initPin (Session sessHandle funcListPtr) pin = do rv <- initPin' funcListPtr sessHandle pin @@ -1244,7 +1332,11 @@ else return () -setPin :: Session -> BU8.ByteString -> BU8.ByteString -> IO () +-- | Changes PIN of a currently logged in user. +setPin :: Session -- ^ session to act on + -> BU8.ByteString -- ^ old PIN + -> BU8.ByteString -- ^ new PIN + -> IO () setPin (Session sessHandle funcListPtr) oldPin newPin = do rv <- setPin' funcListPtr sessHandle oldPin newPin if rv /= 0 @@ -1252,7 +1344,11 @@ else return () -login :: Session -> UserType -> BU8.ByteString -> IO () +-- | Logs a user into a token. +login :: Session -- ^ session to act on + -> UserType -- ^ type of user to login + -> BU8.ByteString -- ^ user's PIN + -> IO () login (Session sessionHandle functionListPtr) userType pin = do rv <- _login functionListPtr sessionHandle userType pin if rv /= 0 @@ -1260,6 +1356,7 @@ else return () +-- | Logs a user out from a token. logout :: Session -> IO () logout (Session sessionHandle functionListPtr) = do rv <- {#call unsafe CK_FUNCTION_LIST.C_Logout#} functionListPtr sessionHandle @@ -1625,6 +1722,7 @@ } deriving (Eq,Show) #} +-- | Initialize a multi-part decryption operation using provided mechanism and key. decryptInit :: Mech -> Session -> ObjectHandle -> IO () decryptInit mech (Session sessionHandle functionListPtr) obj = do with mech $ \mechPtr -> do @@ -1634,8 +1732,19 @@ else return () -decrypt :: Session -> BS.ByteString -> CULong -> IO BS.ByteString -decrypt (Session sessionHandle functionListPtr) encData outLen = do +-- | Decrypt data using provided mechanism and key handle. +-- +-- Example AES ECB decryption. +-- +-- > decData <- decrypt (simpleMech AesEcb) sess aesKeyHandle encData 1000 +decrypt :: Mech -- ^ Mechanism used for decryption. + -> Session -- ^ Session on which key resides. + -> ObjectHandle -- ^ Key handle used for decryption. + -> BS.ByteString -- ^ Encrypted data to be decrypted. + -> CULong -- ^ Maximum number of bytes to be returned. + -> IO BS.ByteString -- ^ Decrypted data +decrypt mech (Session sessionHandle functionListPtr) keyHandle encData outLen = do + decryptInit mech (Session sessionHandle functionListPtr) keyHandle unsafeUseAsCStringLen encData $ \(encDataPtr, encDataLen) -> do allocaBytes (fromIntegral outLen) $ \outDataPtr -> do with outLen $ \outDataLenPtr -> do @@ -1647,7 +1756,11 @@ BS.packCStringLen (castPtr outDataPtr, fromIntegral outDataLen) -encryptInit :: Mech -> Session -> ObjectHandle -> IO () +-- | Initialize multi-part encryption operation. +encryptInit :: Mech -- ^ Mechanism to use for encryption. + -> Session -- ^ Session in which to perform operation. + -> ObjectHandle -- ^ Key handle. + -> IO () encryptInit mech (Session sessionHandle functionListPtr) obj = do with mech $ \mechPtr -> do rv <- {#call unsafe CK_FUNCTION_LIST.C_EncryptInit#} functionListPtr sessionHandle mechPtr obj @@ -1656,8 +1769,15 @@ else return () -encrypt :: Session -> BS.ByteString -> CULong -> IO BS.ByteString -encrypt (Session sessionHandle functionListPtr) encData outLen = do +-- | Encrypt data using provided mechanism and key handle. +encrypt :: Mech -- ^ Mechanism to use for encryption. + -> Session -- ^ Session in which to perform operation. + -> ObjectHandle -- ^ Key handle. + -> BS.ByteString -- ^ Data to be encrypted. + -> CULong -- ^ Maximum number of bytes to be returned. + -> IO BS.ByteString -- ^ Encrypted data. +encrypt mech (Session sessionHandle functionListPtr) keyHandle encData outLen = do + encryptInit mech (Session sessionHandle functionListPtr) keyHandle unsafeUseAsCStringLen encData $ \(encDataPtr, encDataLen) -> do allocaBytes (fromIntegral outLen) $ \outDataPtr -> do with outLen $ \outDataLenPtr -> do @@ -1723,8 +1843,19 @@ with* `CULong' peek*} -> `Rv' #} -digest :: Session -> BS.ByteString -> CULong -> IO (BS.ByteString) -digest (Session sessHandle funcListPtr) digestData outLen = do +-- | Calculates digest aka hash of a data using provided mechanism. +-- +-- Example calculating SHA256 hash: +-- +-- >>> digest (simpleMech Sha256) sess (replicate 16 0) 1000 +-- "7G\b\255\247q\157\213\151\158\200u\213l\210(om<\247\236\&1z;%c*\171(\236\&7\187" +digest :: Mech -- ^ Digest mechanism. + -> Session -- ^ Session to be used for digesting. + -> BS.ByteString -- ^ Data to be digested. + -> CULong -- ^ Maximum number of bytes to be returned. + -> IO (BS.ByteString) -- ^ Resulting digest. +digest mech (Session sessHandle funcListPtr) digestData outLen = do + digestInit mech (Session sessHandle funcListPtr) allocaBytes (fromIntegral outLen) $ \outPtr -> do (rv, outResLen) <- digest' funcListPtr sessHandle digestData (fromIntegral $ BS.length digestData) outPtr outLen if rv /= 0 @@ -1763,9 +1894,19 @@ then fail $ "failed to initialize signing operation: " ++ (rvToStr rv) else return () - -sign :: Session -> BS.ByteString -> CULong -> IO (BS.ByteString) -sign (Session sessHandle funcListPtr) signData outLen = do +-- | Signs data using provided mechanism and key. +-- +-- Example signing with RSA PKCS#1 +-- +-- > signature <- sign (simpleMech RsaPkcs) sess privKeyHandle signedData 1000 +sign :: Mech -- ^ Mechanism to use for signing. + -> Session -- ^ Session to work in. + -> ObjectHandle -- ^ Key handle. + -> BS.ByteString -- ^ Data to be signed. + -> CULong -- ^ Maximum number of bytes to be returned. + -> IO (BS.ByteString) -- ^ Signature. +sign mech (Session sessHandle funcListPtr) key signData outLen = do + signInit mech (Session sessHandle funcListPtr) key with outLen $ \outLenPtr -> do allocaBytes (fromIntegral outLen) $ \outPtr -> do (rv, outResLen) <- sign' funcListPtr sessHandle signData (fromIntegral $ BS.length signData) outPtr outLen @@ -1830,8 +1971,20 @@ then fail $ "failed to initialize verify operation: " ++ (rvToStr rv) else return () -verify :: Session -> BS.ByteString -> BS.ByteString -> IO (Bool) -verify (Session sessHandle funcListPtr) signData signatureData = do +-- | Verifies signature using provided mechanism and key. +-- +-- Example signature verification using RSA public key: +-- +-- >>> verify (simpleMech RsaPkcs) sess pubKeyHandle signedData signature +-- True +verify :: Mech -- ^ Mechanism to be used for signature validation. + -> Session -- ^ Session to be used. + -> ObjectHandle -- ^ Key handle. + -> BS.ByteString -- ^ Signed data. + -> BS.ByteString -- ^ Signature. + -> IO (Bool) -- ^ True is signature is valid, False otherwise. +verify mech (Session sessHandle funcListPtr) keyHandle signData signatureData = do + verifyInit (Session sessHandle funcListPtr) mech keyHandle rv <- verify' funcListPtr sessHandle signData (fromIntegral $ BS.length signData) signatureData (fromIntegral $ BS.length signatureData) case rv of 0 -> return True {#const CKR_SIGNATURE_INVALID#} -> return False @@ -1848,6 +2001,18 @@ with* `CULong' peek*} -> `Rv' #} +-- | Wrap a key using provided wrapping key and return opaque byte array representing wrapped key. This byte array +-- can be stored in user application and can be used later to recreate wrapped key using 'unwrapKey' function. +-- +-- Example wrapping AES key using RSA public key: +-- +-- > wrappedAesKey <- wrapKey (simpleMech RsaPkcs) sess pubRsaKeyHandle aesKeyHandle 300 +wrapKey :: Mech -- ^ Mechanism used to wrap key (to encrypt) + -> Session -- ^ Session in which both keys reside. + -> ObjectHandle -- ^ Key which will be used to wrap (encrypt) another key + -> ObjectHandle -- ^ Key to be wrapped + -> CULong -- ^ Maximum size in bytes of a resulting byte array + -> IO BS.ByteString -- ^ Resulting opaque wrapped key wrapKey mech (Session sessHandle funcListPtr) wrappingKey key dataLen = do allocaBytes (fromIntegral dataLen) $ \dataPtr -> do (rv, outDataLen) <- wrapKey' funcListPtr sessHandle mech wrappingKey key dataPtr dataLen @@ -1856,11 +2021,20 @@ else BS.packCStringLen (castPtr dataPtr, fromIntegral outDataLen) -unwrapKey :: Mech -> Session -> ObjectHandle -> BS.ByteString -> [Attribute] -> IO ObjectHandle +-- | Unwrap a key from opaque byte string and apply attributes to a resulting key object. +-- +-- Example unwrapping AES key using RSA private key: +-- +-- > unwrappedAesKey <- unwrapKey (simpleMech RsaPkcs) sess privRsaKeyHandle wrappedAesKey [Class SecretKey, KeyType AES] +unwrapKey :: Mech -- ^ Mechanism to use for unwrapping (decryption). + -> Session -- ^ Session in which to perform operation. + -> ObjectHandle -- ^ Handle to a key which will be used to unwrap (decrypt) key. + -> BS.ByteString -- ^ Key to be unwrapped. + -> [Attribute] -- ^ Attributes applied to unwrapped key object. + -> IO ObjectHandle -- ^ Unwrapped key handle. unwrapKey mech (Session sessionHandle functionListPtr) key wrappedKey template = do _withAttribs template $ \attribsPtr -> do - alloca $ \mechPtr -> do - poke mechPtr mech + with mech $ \mechPtr -> do unsafeUseAsCStringLen wrappedKey $ \(wrappedKeyPtr, wrappedKeyLen) -> do alloca $ \unwrappedKeyPtr -> do rv <- {#call unsafe CK_FUNCTION_LIST.C_UnwrapKey#} functionListPtr sessionHandle mechPtr key (castPtr wrappedKeyPtr) (fromIntegral wrappedKeyLen) attribsPtr (fromIntegral $ length template) unwrappedKeyPtr @@ -1878,6 +2052,7 @@ `CULong'} -> `Rv' #} +-- | Mixes provided seed data with token's seed seedRandom (Session sessHandle funcListPtr) seedData = do rv <- seedRandom' funcListPtr sessHandle seedData (fromIntegral $ BS.length seedData) if rv /= 0 @@ -1892,6 +2067,10 @@ `CULong'} -> `Rv' #} +-- | Generates random data using token's RNG. +generateRandom :: Session -- ^ Session to work on. + -> CULong -- ^ Number of bytes to generate. + -> IO BS.ByteString -- ^ Generated random bytes. generateRandom (Session sessHandle funcListPtr) randLen = do allocaBytes (fromIntegral randLen) $ \randPtr -> do rv <- generateRandom' funcListPtr sessHandle randPtr randLen