{-# LINE 1 "System\\Win32\\SimpleMAPI.hsc" #-}{-# LINE 2 "System\\Win32\\SimpleMAPI.hsc" #-}{-# LANGUAGE Safe #-}{-# LINE 6 "System\\Win32\\SimpleMAPI.hsc" #-}-----------------------------------------------------------------------------
-- |
-- Module : System.Win32.SimpleMAPI
-- Copyright : (c) Esa Ilari Vuokko, 2006
-- License : BSD-style (see the file LICENSE)
--
-- Maintainer : Esa Ilari Vuokko <ei@vuokko.info>
-- Stability : provisional
-- Portability : portable
--
-- FFI-bindings to interact with SimpleMAPI
--
-----------------------------------------------------------------------------
moduleSystem.Win32.SimpleMAPIwhere-- I am not sure why exactly, but with mingw64 mapi.h does not define
-- some of the values we use, e.g. MAPI_LOGOFF_SHARED.
-- mapix.h does define MAPI_LOGOFF_SHARED, but the various flags
-- clash with each other.
importControl.Exception(bracket,handle,finally,onException,IOException)importControl.Monad(liftM5)importForeign(FunPtr,newForeignPtr,pokeByteOff,maybeWith,Ptr,castPtr,castPtrToFunPtr,nullPtr,touchForeignPtr,alloca,peek,allocaBytes,minusPtr,plusPtr,copyBytes,ForeignPtr)importForeign.C(withCAString,withCAStringLen)-- Apparently, simple MAPI does not support unicode and probably never will,
-- so this module will just mangle any Unicode in your strings
importGraphics.Win32.GDI.Types(HWND)importSystem.Win32.DLL(loadLibrary,freeLibrary,getProcAddress)importSystem.Win32.Types(DWORD,LPSTR,HMODULE,failIfNull)
#include "windows_cconv.h"
typeULONG=DWORDtypeLHANDLE=ULONGnewtypeMapiRecipDesc=MapiRecipDesc()typeMapiFlag=ULONGmAPI_LOGON_UI::MapiFlagmAPI_LOGON_UI=1mAPI_NEW_SESSION::MapiFlagmAPI_NEW_SESSION=2mAPI_FORCE_DOWNLOAD::MapiFlagmAPI_FORCE_DOWNLOAD=4096mAPI_DIALOG::MapiFlagmAPI_DIALOG=8mAPI_UNREAD_ONLY::MapiFlagmAPI_UNREAD_ONLY=32mAPI_LONG_MSGID::MapiFlagmAPI_LONG_MSGID=16384mAPI_GUARANTEE_FIFO::MapiFlagmAPI_GUARANTEE_FIFO=256mAPI_ENVELOPE_ONLY::MapiFlagmAPI_ENVELOPE_ONLY=64mAPI_PEEK::MapiFlagmAPI_PEEK=128mAPI_BODY_AS_FILE::MapiFlagmAPI_BODY_AS_FILE=512mAPI_SUPPRESS_ATTACH::MapiFlagmAPI_SUPPRESS_ATTACH=2048mAPI_AB_NOMODIFY::MapiFlagmAPI_AB_NOMODIFY=1024mAPI_OLE::MapiFlagmAPI_OLE=1mAPI_OLE_STATIC::MapiFlagmAPI_OLE_STATIC=2mAPI_UNREAD::MapiFlagmAPI_UNREAD=1mAPI_RECEIPT_REQUESTED::MapiFlagmAPI_RECEIPT_REQUESTED=2mAPI_SENT::MapiFlagmAPI_SENT=4{-# LINE 70 "System\\Win32\\SimpleMAPI.hsc" #-}-- Have to define enum values outside previous declaration due to
-- hsc2hs bug in --cross-compile mode:
-- https://ghc.haskell.org/trac/ghc/ticket/13620
{-# LINE 78 "System\\Win32\\SimpleMAPI.hsc" #-}{-# LINE 83 "System\\Win32\\SimpleMAPI.hsc" #-}mapiErrors::[(ULONG,String)]mapiErrors=[((0),"Success"){-# LINE 87 "System\\Win32\\SimpleMAPI.hsc" #-},((2),"Generic error or multiple errors"){-# LINE 88 "System\\Win32\\SimpleMAPI.hsc" #-},((1),"User aborted"){-# LINE 89 "System\\Win32\\SimpleMAPI.hsc" #-},((3),"Logoff failed"){-# LINE 90 "System\\Win32\\SimpleMAPI.hsc" #-},((3),"Logon failed"){-# LINE 91 "System\\Win32\\SimpleMAPI.hsc" #-},((4),"Disk full"){-# LINE 92 "System\\Win32\\SimpleMAPI.hsc" #-},((5),"Not enough memory"){-# LINE 93 "System\\Win32\\SimpleMAPI.hsc" #-},((6),"Access denied"){-# LINE 94 "System\\Win32\\SimpleMAPI.hsc" #-}{-# LINE 97 "System\\Win32\\SimpleMAPI.hsc" #-},((8),"Too many open sessions"){-# LINE 98 "System\\Win32\\SimpleMAPI.hsc" #-},((9),"Too many open files"){-# LINE 99 "System\\Win32\\SimpleMAPI.hsc" #-},((10),"Too many recipients"){-# LINE 100 "System\\Win32\\SimpleMAPI.hsc" #-},((11),"Attachment not found"){-# LINE 101 "System\\Win32\\SimpleMAPI.hsc" #-},((12),"Couldn't open attachment"){-# LINE 102 "System\\Win32\\SimpleMAPI.hsc" #-},((13),"Couldn't write attachment"){-# LINE 103 "System\\Win32\\SimpleMAPI.hsc" #-},((14),"Unknown recipient"){-# LINE 104 "System\\Win32\\SimpleMAPI.hsc" #-},((15),"Bad recipient type"){-# LINE 105 "System\\Win32\\SimpleMAPI.hsc" #-},((16),"No messages"){-# LINE 106 "System\\Win32\\SimpleMAPI.hsc" #-},((17),"Invalid message"){-# LINE 107 "System\\Win32\\SimpleMAPI.hsc" #-},((18),"Text too large"){-# LINE 108 "System\\Win32\\SimpleMAPI.hsc" #-},((19),"Invalid session"){-# LINE 109 "System\\Win32\\SimpleMAPI.hsc" #-},((20),"Type not supported"){-# LINE 110 "System\\Win32\\SimpleMAPI.hsc" #-},((21),"Ambiguous recipient"){-# LINE 111 "System\\Win32\\SimpleMAPI.hsc" #-}{-# LINE 114 "System\\Win32\\SimpleMAPI.hsc" #-},((22),"Message in use"){-# LINE 115 "System\\Win32\\SimpleMAPI.hsc" #-},((23),"Network failure"){-# LINE 116 "System\\Win32\\SimpleMAPI.hsc" #-},((24),"Invalid editfields"){-# LINE 117 "System\\Win32\\SimpleMAPI.hsc" #-},((25),"Invalid recipient(s)"){-# LINE 118 "System\\Win32\\SimpleMAPI.hsc" #-},((26),"Not supported"){-# LINE 119 "System\\Win32\\SimpleMAPI.hsc" #-}]mapiErrorString::ULONG->StringmapiErrorStringc=caselookupcmapiErrorsofNothing->"Unkown error ("++showc++")"Justx->xmapiFail::String->IOULONG->IOULONGmapiFailnameact=act>>=\err->iferr==(0){-# LINE 128 "System\\Win32\\SimpleMAPI.hsc" #-}thenreturnerrelsefail$name++": "++mapiErrorStringerrmapiFail_::String->IOULONG->IO()mapiFail_na=mapiFailna>>return()typeMapiLogonType=ULONG->LPSTR->LPSTR->MapiFlag->ULONG->PtrLHANDLE->IOULONGforeignimportWINDOWS_CCONV"dynamic"mkMapiLogon::FunPtrMapiLogonType->MapiLogonTypetypeMapiLogoffType=LHANDLE->ULONG->MapiFlag->ULONG->IOULONGforeignimportWINDOWS_CCONV"dynamic"mkMapiLogoff::FunPtrMapiLogoffType->MapiLogoffTypetypeMapiResolveNameType=LHANDLE->ULONG->LPSTR->MapiFlag->ULONG->Ptr(PtrMapiRecipDesc)->IOULONGforeignimportWINDOWS_CCONV"dynamic"mkMapiResolveName::FunPtrMapiResolveNameType->MapiResolveNameTypetypeMapiFreeBufferType=Ptr()->IOULONGforeignimportWINDOWS_CCONV"dynamic"mkMapiFreeBuffer::FunPtrMapiFreeBufferType->MapiFreeBufferTypetypeMapiSendMailType=LHANDLE->ULONG->PtrMessage->MapiFlag->ULONG->IOULONGforeignimportWINDOWS_CCONV"dynamic"mkMapiSendMail::FunPtrMapiSendMailType->MapiSendMailTypedataMapiFuncs=MapiFuncs{mapifLogon::MapiLogonType,mapifLogoff::MapiLogoffType,mapifResolveName::MapiResolveNameType,mapifFreeBuffer::MapiFreeBufferType,mapifSendMail::MapiSendMailType}typeMapiLoaded=(MapiFuncs,ForeignPtr())-- |
loadMapiFuncs::String->HMODULE->IOMapiFuncsloadMapiFuncsdllnamedll=liftM5MapiFuncs(loadProc"MAPILogon"dllmkMapiLogon)(loadProc"MAPILogoff"dllmkMapiLogoff)(loadProc"MAPIResolveName"dllmkMapiResolveName)(loadProc"MAPIFreeBuffer"dllmkMapiFreeBuffer)(loadProc"MAPISendMail"dllmkMapiSendMail)whereloadProc::String->HMODULE->(FunPtra->a)->IOaloadProcnamedll'conv=doproc<-failIfNull("loadMapiDll: "++dllname++": "++name)$getProcAddressdll'namereturn$conv$castPtrToFunPtrproc-- |
loadMapiDll::String->IO(MapiFuncs,HMODULE)loadMapiDlldllname=dodll<-loadLibrarydllnamedofuncs<-loadMapiFuncsdllnamedllreturn(funcs,dll)`onException`freeLibrarydll-- |
withMapiFuncs::[String]->(MapiFuncs->IOa)->IOawithMapiFuncsdllsact=bracketloadfree(act.fst)whereloadOnel=caselof[]->fail$"withMapiFuncs: Failed to load DLLs: "++showdllsx:y->handleIOException(const$loadOney)(loadMapiDllx)load=loadOnedllsfree=freeLibrary.snd-- |
loadMapi::[String]->IOMapiLoadedloadMapidlls=do(f,m)<-loadOnedllsm'<-newForeignPtrc_FreeLibraryFinalisermreturn(f,m')whereloadOnel=caselof[]->fail$"loadMapi: Failed to load any of DLLs: "++showdllsx:y->handleIOException(const$loadOney)(loadMapiDllx){-# CFILES cbits/HsWin32.c #-}foreignimportccall"HsWin32.h &FreeLibraryFinaliser"c_FreeLibraryFinaliser::FunPtr(HMODULE->IO())-- |
withMapiLoaded::MapiLoaded->(MapiFuncs->IOa)->IOawithMapiLoaded(f,m)act=finally(actf)(touchForeignPtrm)maybeHWND::MaybeHWND->ULONGmaybeHWND=maybe0(fromIntegral.flipminusPtrnullPtr)-- | Create Simple MAPI-session by logon
mapiLogon::MapiFuncs-- ^ Functions loaded from MAPI DLL
->MaybeHWND-- ^ Parent window, used for modal logon dialog
->MaybeString-- ^ Session
->MaybeString-- ^ Password
->MapiFlag-- ^ None, one or many flags: FORCE_DOWNLOAD, NEW_SESSION, LOGON_UI, PASSWORD_UI
->IOLHANDLEmapiLogonfhwndsespwflags=maybeWithwithCAStringses$\c_ses->maybeWithwithCAStringpw$\c_pw->alloca$\out->domapiFail_"MAPILogon: "$mapifLogonf(maybeHWNDhwnd)c_sesc_pwflags0outpeekout-- | End Simple MAPI-session
mapiLogoff::MapiFuncs->LHANDLE->MaybeHWND->IO()mapiLogofffseshwnd=mapiFail_"MAPILogoff"$mapifLogofffses(maybeHWNDhwnd)00dataRecipientClass=RcOriginal|RcTo|RcCc|RcBccderiving(Show,Eq,Ord,Enum)rcToULONG::RecipientClass->ULONGrcToULONG=fromIntegral.fromEnumuLONGToRc::ULONG->RecipientClassuLONGToRc=toEnum.fromIntegraldataRecipient=RecipResolve(MaybeHWND)MapiFlagString(MaybeRecipient)|RecipStringStringderiving(Show)typeRecipients=[(RecipientClass,Recipient)]simpleRecip::String->RecipientsimpleRecips=RecipResolveNothing0s$Just$RecipsswithRecipient::MapiFuncs->LHANDLE->RecipientClass->Recipient->(PtrMapiRecipDesc->IOa)->IOawithRecipientfsesrclsrecact=resolve""recwhereabuf=do((\hsc_ptr->pokeByteOffhsc_ptr4))buf(rcToULONGrcls){-# LINE 276 "System\\Win32\\SimpleMAPI.hsc" #-}actbufresolveerrrc=casercofRecipnameaddr->withCAStringname$\c_name->withCAStringaddr$\c_addr->allocaBytes((40))$\buf->do{-# LINE 282 "System\\Win32\\SimpleMAPI.hsc" #-}((\hsc_ptr->pokeByteOffhsc_ptr0))buf(0::ULONG){-# LINE 283 "System\\Win32\\SimpleMAPI.hsc" #-}((\hsc_ptr->pokeByteOffhsc_ptr8))bufc_name{-# LINE 284 "System\\Win32\\SimpleMAPI.hsc" #-}((\hsc_ptr->pokeByteOffhsc_ptr16))bufc_addr{-# LINE 285 "System\\Win32\\SimpleMAPI.hsc" #-}((\hsc_ptr->pokeByteOffhsc_ptr24))buf(0::ULONG){-# LINE 286 "System\\Win32\\SimpleMAPI.hsc" #-}((\hsc_ptr->pokeByteOffhsc_ptr32))bufnullPtr{-# LINE 287 "System\\Win32\\SimpleMAPI.hsc" #-}abufRecipResolvehwndflagnamefallback->dores<-alloca$\res->withCAStringname$\name'->doerrn<-mapifResolveNamefses(maybeHWNDhwnd)name'flag0resiferrn==(0){-# LINE 294 "System\\Win32\\SimpleMAPI.hsc" #-}thendobuf<-peekresv<-abuf_<-mapifFreeBufferf$castPtrbufreturn$Rightvelsereturn$Left$err++", "++name++":"++mapiErrorStringerrncaseresofLefte->casefallbackofNothing->fail$"Failed to resolve any of the recipients: "++eJustx->resolveexRightx->returnxwithRecipients::MapiFuncs->LHANDLE->Recipients->(Int->PtrMapiRecipDesc->IOa)->IOawithRecipientsfsesrecact=w[]recwherewres[]=allocaBytes(lengthres*rs)$\buf->domapM_(writebuf)$zip[0..]$reverseresact(lengthres)bufwres((c,r):y)=withRecipientfsescr$\x->w(x:res)yrs=((40)){-# LINE 321 "System\\Win32\\SimpleMAPI.hsc" #-}writebuf(off,src)=doletbuf'=plusPtrbuf(off*rs)copyBytesbuf'srcrsdataFileTag=FileTag{ftTag::MaybeString-- ^ mime
,ftEncoding::MaybeString}deriving(Show)defFileTag::FileTagdefFileTag=FileTagNothingNothingwithFileTag::FileTag->(PtrFileTag->IOa)->IOawithFileTagftact=allocaBytes((32))$\buf->{-# LINE 336 "System\\Win32\\SimpleMAPI.hsc" #-}w(ftTagft)$\(tbuf,tsiz)->w(ftEncodingft)$\(ebuf,esiz)->do((\hsc_ptr->pokeByteOffhsc_ptr0))buf(0::ULONG){-# LINE 339 "System\\Win32\\SimpleMAPI.hsc" #-}((\hsc_ptr->pokeByteOffhsc_ptr4))buftsiz{-# LINE 340 "System\\Win32\\SimpleMAPI.hsc" #-}((\hsc_ptr->pokeByteOffhsc_ptr8))buftbuf{-# LINE 341 "System\\Win32\\SimpleMAPI.hsc" #-}((\hsc_ptr->pokeByteOffhsc_ptr16))bufesiz{-# LINE 342 "System\\Win32\\SimpleMAPI.hsc" #-}((\hsc_ptr->pokeByteOffhsc_ptr24))bufebuf{-# LINE 343 "System\\Win32\\SimpleMAPI.hsc" #-}actbufwherewva=casevofNothing->a(nullPtr,0)Justx->withCAStringLenxadataAttachment=Attachment{attFlag::MapiFlag,attPosition::MaybeULONG,attPath::String,attName::MaybeString,attTag::MaybeFileTag}deriving(Show)defAttachment::AttachmentdefAttachment=Attachment0Nothing""NothingNothingtypeAttachments=[Attachment]withAttachments::Attachments->(Int->PtrAttachment->IOa)->IOawithAttachmentsattact=allocaBytes(len*as)$\buf->write(actlenbuf)bufattwhereas=((40)){-# LINE 364 "System\\Win32\\SimpleMAPI.hsc" #-}len=lengthattwriteact'_[]=act'writeact'buf(att':y)=withCAString(attPathatt')$\path->maybeWithwithFileTag(attTagatt')$\tag->withCAString(maybe(attPathatt')id(attNameatt'))$\name->do((\hsc_ptr->pokeByteOffhsc_ptr0))buf(0::ULONG){-# LINE 371 "System\\Win32\\SimpleMAPI.hsc" #-}((\hsc_ptr->pokeByteOffhsc_ptr4))buf(attFlagatt'){-# LINE 372 "System\\Win32\\SimpleMAPI.hsc" #-}((\hsc_ptr->pokeByteOffhsc_ptr8))buf(maybe0xffffffffid$attPositionatt'){-# LINE 373 "System\\Win32\\SimpleMAPI.hsc" #-}((\hsc_ptr->pokeByteOffhsc_ptr16))bufpath{-# LINE 374 "System\\Win32\\SimpleMAPI.hsc" #-}((\hsc_ptr->pokeByteOffhsc_ptr24))bufname{-# LINE 375 "System\\Win32\\SimpleMAPI.hsc" #-}((\hsc_ptr->pokeByteOffhsc_ptr32))buftag{-# LINE 376 "System\\Win32\\SimpleMAPI.hsc" #-}writeact'(plusPtrbufas)ydataMessage=Message{msgSubject::String,msgBody::String,msgType::MaybeString,msgDate::MaybeString,msgConversationId::MaybeString,msgFlags::MapiFlag,msgFrom::MaybeRecipient,msgRecips::Recipients,msgAttachments::Attachments}deriving(Show)defMessage::MessagedefMessage=Message""""NothingNothingNothing0Nothing[][]withMessage::MapiFuncs->LHANDLE->Message->(PtrMessage->IOa)->IOawithMessagefsesmact=withCAString(msgSubjectm)$\subject->withCAString(msgBodym)$\body->maybeWithwithCAString(msgTypem)$\message_type->maybeWithwithCAString(msgDatem)$\date->maybeWithwithCAString(msgConversationIdm)$\conv_id->withRecipientsfses(msgRecipsm)$\rlenrbuf->withAttachments(msgAttachmentsm)$\alenabuf->maybeWith(withRecipientfsesRcOriginal)(msgFromm)$\from->allocaBytes((96))$\buf->do{-# LINE 409 "System\\Win32\\SimpleMAPI.hsc" #-}((\hsc_ptr->pokeByteOffhsc_ptr0))buf(0::ULONG){-# LINE 410 "System\\Win32\\SimpleMAPI.hsc" #-}((\hsc_ptr->pokeByteOffhsc_ptr8))bufsubject{-# LINE 411 "System\\Win32\\SimpleMAPI.hsc" #-}((\hsc_ptr->pokeByteOffhsc_ptr16))bufbody{-# LINE 412 "System\\Win32\\SimpleMAPI.hsc" #-}((\hsc_ptr->pokeByteOffhsc_ptr24))bufmessage_type{-# LINE 413 "System\\Win32\\SimpleMAPI.hsc" #-}((\hsc_ptr->pokeByteOffhsc_ptr32))bufdate{-# LINE 414 "System\\Win32\\SimpleMAPI.hsc" #-}((\hsc_ptr->pokeByteOffhsc_ptr40))bufconv_id{-# LINE 415 "System\\Win32\\SimpleMAPI.hsc" #-}((\hsc_ptr->pokeByteOffhsc_ptr48))buf(msgFlagsm){-# LINE 416 "System\\Win32\\SimpleMAPI.hsc" #-}((\hsc_ptr->pokeByteOffhsc_ptr56))buffrom{-# LINE 417 "System\\Win32\\SimpleMAPI.hsc" #-}((\hsc_ptr->pokeByteOffhsc_ptr64))buf(fromIntegralrlen::ULONG){-# LINE 418 "System\\Win32\\SimpleMAPI.hsc" #-}((\hsc_ptr->pokeByteOffhsc_ptr72))bufrbuf{-# LINE 419 "System\\Win32\\SimpleMAPI.hsc" #-}((\hsc_ptr->pokeByteOffhsc_ptr80))bufalen{-# LINE 420 "System\\Win32\\SimpleMAPI.hsc" #-}((\hsc_ptr->pokeByteOffhsc_ptr88))bufabuf{-# LINE 421 "System\\Win32\\SimpleMAPI.hsc" #-}actbufmapiSendMail::MapiFuncs->LHANDLE->MaybeHWND->Message->MapiFlag->IO()mapiSendMailfseshwndmsgflag=withMessagefsesmsg$\c_msg->mapiFail_"MAPISendMail"$mapifSendMailfses(maybeHWNDhwnd)c_msgflag0handleIOException::(IOException->IOa)->IOa->IOahandleIOException=handle