diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Capital Match (c) 2018 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/docusign-client.cabal b/docusign-client.cabal new file mode 100644 --- /dev/null +++ b/docusign-client.cabal @@ -0,0 +1,45 @@ +name: docusign-client +version: 0.0.1 +synopsis: Client bindings for the DocuSign API +description: DocuSign is an electronic signature technology and digital transaction + management. This is the client API. +category: Business +author: Jonathan Knowles +maintainer: dev@capital-match.com +license-file: LICENSE +license: BSD3 +build-type: Simple +cabal-version: >= 1.10 + +source-repository head + type: git + location: https://github.com/capital-match/docusign-client + +library + exposed-modules: + DocuSign.Client + DocuSign.Client.Configuration + DocuSign.Client.Types + DocuSign.Client.Types.Conversion + DocuSign.Client.Types.Parsing + other-modules: + DocuSign.Client.Authentication + Paths_docusign_client + hs-source-dirs: + src + build-depends: + aeson + -- base upper version bound is nonsense + , base < 1000 + , base64-bytestring + , bytestring + , data-default + , docusign-base >= 0.0.1 + , exceptions + , http-client + , http-client-tls + , http-types + , servant-client + , text + , uuid + default-language: Haskell2010 diff --git a/src/DocuSign/Client.hs b/src/DocuSign/Client.hs new file mode 100644 --- /dev/null +++ b/src/DocuSign/Client.hs @@ -0,0 +1,143 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +-- | A simple client for communicating with a DocuSign server instance. + +module DocuSign.Client + ( DocuSignClient (..) + , docuSignClient + , runClient + ) where + +import DocuSign.Base.ContentTypes +import DocuSign.Client.Authentication +import DocuSign.Client.Types +import DocuSign.Client.Types.Conversion +import DocuSign.Client.Types.Parsing + +import Control.Monad.IO.Class ( liftIO ) +import Data.Aeson ( encode ) +import Data.ByteString ( ByteString ) +import Data.Default ( def ) +import Data.List ( nub ) +import Data.Text.Encoding ( decodeUtf8 ) +import Network.HTTP.Client ( Request + , managerModifyRequest + , newManager + , requestHeaders ) +import Network.HTTP.Client.TLS ( tlsManagerSettings ) +import Network.HTTP.Types.Header ( HeaderName ) +import Servant.Client ( BaseUrl (..) + , mkClientEnv + , ClientM + , Scheme (..) + , ServantError + , runClientM ) + +import qualified Data.ByteString.Base64 as Base64 +import qualified Data.ByteString.Lazy as BL +import qualified Data.Text as T +import qualified DocuSign.Base as D +import qualified DocuSign.Base.Types as D +import qualified DocuSign.Client.Configuration as C + +data DocuSignClient m = DocuSignClient { + + -- | List all accounts associated with the current set of credentials. + listAccounts :: m [AccountInfo] + + -- | Post a set of documents to a single recipient for signing via email. + , postDocumentsForEmailBasedSigning + :: AccountId -> [Document] -> Envelope -> Recipient + -> m EnvelopeId + + -- | Post a set of documents to a single recipient for signing via browser + -- redirection. + , postDocumentsForRedirectionBasedSigning + :: AccountId -> [Document] -> Envelope -> Recipient + -> (EnvelopeId -> PostSigningUri) + -> m (EnvelopeId, SigningUri) + + -- | Fetch a document in its current state, regardless of whether it has + -- or has not been signed. + , fetchDocument :: AccountId -> EnvelopeId -> DocumentId -> m PDF + } + +docuSignClient :: DocuSignClient ClientM +docuSignClient = DocuSignClient + + { listAccounts = + parseM =<< loginInformationGetLoginInformation + Nothing Nothing Nothing Nothing + + , postDocumentsForEmailBasedSigning = postDocuments EmailBasedSigning + + , postDocumentsForRedirectionBasedSigning = \aid ds e r p -> do + eid <- postDocuments RedirectionBasedSigning aid ds e r + url <- generateSigningLink aid eid (recipientClientUserId r) r (RedirectionOptions $ p eid) + pure (eid, url) + + , fetchDocument = \aid eid did -> + documentsGetDocument (convert aid) (convert eid) (convert did) + Nothing Nothing Nothing Nothing Nothing Nothing Nothing + } + where + D.DocuSignClient {..} = D.docuSignClient + + postDocuments sm aid ds Envelope {..} Recipient {..} = + parseM =<< envelopesPostEnvelopes (convert aid) Nothing Nothing Nothing def + { D.envelopeDefinitionEmailSubject = Just envelopeSubject + , D.envelopeDefinitionEmailBlurb = Just envelopeMessage + , D.envelopeDefinitionStatus = Just "sent" + , D.envelopeDefinitionDocuments = Just $ flip fmap ds $ \Document {..} -> + def { D.documentDocumentBase64 = Just $ decodeUtf8 $ Base64.encode + $ toBytes documentContent + , D.documentDocumentId = Just $ convert documentId + , D.documentName = Just documentName } + , D.envelopeDefinitionRecipients = Just def + { D.envelopeRecipientsSigners = Just + [ def { D.signerClientUserId = case sm of + EmailBasedSigning -> Nothing + RedirectionBasedSigning -> + Just $ unUserId recipientClientUserId + , D.signerEmail = Just $ unEmailAddress recipientEmailAddress + , D.signerName = Just recipientName + , D.signerRecipientId = Just "1" + , D.signerRoutingOrder = Just "1" + , D.signerTabs = flip fmap recipientSignatureAnchorText $ \a -> + def { D.envelopeRecipientTabsSignHereTabs = Just [ + def { D.signHereAnchorString = Just a } ] } } ] } } + + generateSigningLink aid eid uid Recipient {..} RedirectionOptions {..} = + parseM =<< viewsPostEnvelopeRecipientView (convert aid) (convert eid) def + { D.recipientViewRequestAuthenticationMethod = Just "email" + , D.recipientViewRequestClientUserId = Just $ unUserId uid + , D.recipientViewRequestEmail = Just $ unEmailAddress recipientEmailAddress + , D.recipientViewRequestRecipientId = Just "1" + , D.recipientViewRequestReturnUrl = Just $ unUri postSigningRedirectionUri + , D.recipientViewRequestUserName = Just recipientName } + +runClient :: C.Config -> ClientM a -> IO (Either ServantError a) +runClient config client = do + m <- liftIO $ newManager (tlsManagerSettings {managerModifyRequest = addHeaders}) + runClientM client $ mkClientEnv m (baseUrlFromConfig config) + + where + + addHeaders :: Request -> IO Request + addHeaders r = pure $ r { requestHeaders = nub (authenticationHeader : requestHeaders r)} + + authenticationHeader :: (HeaderName, ByteString) + authenticationHeader = + ( authenticationHeaderKey + , BL.toStrict $ encode $ authenticationHeaderFromConfig config) + + authenticationHeaderFromConfig :: C.Config -> AuthenticationHeader + authenticationHeaderFromConfig (C.Config (C.AccountConfig _ k u p) _) = + AuthenticationHeader k u p + + baseUrlFromConfig :: C.Config -> BaseUrl + baseUrlFromConfig (C.Config _ s) = + BaseUrl Https (T.unpack $ C.serverHost s) (C.serverPort s) "/restapi" + diff --git a/src/DocuSign/Client/Authentication.hs b/src/DocuSign/Client/Authentication.hs new file mode 100644 --- /dev/null +++ b/src/DocuSign/Client/Authentication.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} + +module DocuSign.Client.Authentication + ( AuthenticationHeader (..) + , authenticationHeaderKey + ) where + +import Data.Aeson ( FromJSON + , ToJSON + , defaultOptions + , genericParseJSON + , genericToJSON + , parseJSON + , toJSON ) +import Data.UUID ( UUID ) +import Data.Text ( Text ) +import DocuSign.Base.Fields ( modifyFieldLabel ) +import GHC.Generics ( Generic ) +import Network.HTTP.Types.Header ( HeaderName ) + +data AuthenticationHeader = AuthenticationHeader + { authenticationHeaderIntegratorKey :: UUID + , authenticationHeaderUsername :: Text + , authenticationHeaderPassword :: Text + } deriving (Show, Eq, Generic) + +-- In the JSON serialization of an AuthenticationHeader, field names must start +-- with a capital letter, which is against the normal convention. Hence we must +-- define custom implementations of FromJSON and ToJSON: + +instance FromJSON AuthenticationHeader where + parseJSON = genericParseJSON + $ modifyFieldLabel (dropLength "authenticationHeader") + $ defaultOptions + +instance ToJSON AuthenticationHeader where + toJSON = genericToJSON + $ modifyFieldLabel (dropLength "authenticationHeader") + $ defaultOptions + +authenticationHeaderKey :: HeaderName +authenticationHeaderKey = "X-DocuSign-Authentication" + +dropLength :: String -> String -> String +dropLength = drop . length + diff --git a/src/DocuSign/Client/Configuration.hs b/src/DocuSign/Client/Configuration.hs new file mode 100644 --- /dev/null +++ b/src/DocuSign/Client/Configuration.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE DeriveGeneric #-} + +module DocuSign.Client.Configuration + ( Config (..) + , AccountConfig (..) + , ServerConfig (..) + ) where + +import Data.Text ( Text ) +import Data.UUID ( UUID ) +import GHC.Generics ( Generic ) + +import DocuSign.Client.Types +import DocuSign.Base.Fields + +import qualified Data.Aeson as J + +data Config = Config + { configAccount :: AccountConfig + , configServer :: ServerConfig + } deriving (Generic, Read, Show) + +instance J.FromJSON Config where + parseJSON = J.genericParseJSON (removeFieldLabelPrefix "config") +instance J.ToJSON Config where + toJSON = J.genericToJSON (removeFieldLabelPrefix "config") + +data AccountConfig = AccountConfig + { accountId :: AccountId + , accountKey :: UUID + , accountUsername :: Text + , accountPassword :: Text + } deriving (Generic, Read, Show) + +instance J.FromJSON AccountConfig where + parseJSON = J.genericParseJSON (removeFieldLabelPrefix "account") +instance J.ToJSON AccountConfig where + toJSON = J.genericToJSON (removeFieldLabelPrefix "account") + +data ServerConfig = ServerConfig + { serverHost :: Text + , serverPort :: Int + } deriving (Generic, Read, Show) + +instance J.FromJSON ServerConfig where + parseJSON = J.genericParseJSON (removeFieldLabelPrefix "server") +instance J.ToJSON ServerConfig where + toJSON = J.genericToJSON (removeFieldLabelPrefix "server") + diff --git a/src/DocuSign/Client/Types.hs b/src/DocuSign/Client/Types.hs new file mode 100644 --- /dev/null +++ b/src/DocuSign/Client/Types.hs @@ -0,0 +1,163 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module DocuSign.Client.Types + ( AccountId + , AccountName + , DocumentId + , EmailAddress + , EnvelopeId + , PostSigningUri + , RecipientId + , SigningUri + , Uri + , UserId + , UserName + + , mkAccountId + , mkAccountName + , mkDocumentId + , mkEmailAddress + , mkEnvelopeId + , mkRecipientId + , mkUri + , mkUserId + , mkUserName + + , unAccountId + , unAccountName + , unDocumentId + , unEmailAddress + , unEnvelopeId + , unRecipientId + , unUri + , unUserId + , unUserName + + , AccountInfo (..) + , Document (..) + , Envelope (..) + , Recipient (..) + , RedirectionOptions (..) + , SigningEvent (..) + , SigningMethod (..) + ) where + +import Control.Exception ( assert ) +import Data.Aeson ( FromJSON + , ToJSON ) +import Data.Data ( Data ) +import Data.Text ( Text ) +import Data.Typeable ( Typeable ) +import Data.UUID ( UUID ) +import DocuSign.Base.ContentTypes ( PDF ) + +-- Type aliases. + +-- | Represents a single-use signing link. +type SigningUri = Uri + +-- | Represents a post-signing redirection target. +type PostSigningUri = Uri + +-- Simple boxed value types. + +newtype AccountId = AccountId { unAccountId :: Integer } + deriving (Enum, Eq, FromJSON, Integral, Num, Ord, Read, Real, Show, ToJSON, Typeable) + +mkAccountId :: Integer -> AccountId +mkAccountId i = assert (i > 0) $ AccountId i + +newtype AccountName = AccountName { unAccountName :: Text } + deriving (Eq, FromJSON, Read, Show, ToJSON, Typeable) + +mkAccountName :: Text -> AccountName +mkAccountName = AccountName + +newtype DocumentId = DocumentId { unDocumentId :: Integer } + deriving (Data, Enum, Eq, FromJSON, Integral, Num, Ord, Read, Real, Show, ToJSON, Typeable) + +mkDocumentId :: Integer -> DocumentId +mkDocumentId i = assert (i > 0) $ DocumentId i + +newtype EmailAddress = EmailAddress { unEmailAddress :: Text } + deriving (Eq, FromJSON, Read, Show, ToJSON, Typeable) + +mkEmailAddress :: Text -> EmailAddress +mkEmailAddress = EmailAddress + +newtype EnvelopeId = EnvelopeId { unEnvelopeId :: UUID } + deriving (Data, Eq, FromJSON, Read, Show, ToJSON, Typeable) + +mkEnvelopeId :: UUID -> EnvelopeId +mkEnvelopeId = EnvelopeId + +newtype RecipientId = RecipientId { unRecipientId :: Text } + deriving (Eq, FromJSON, Read, Show, ToJSON, Typeable) + +mkRecipientId :: Text -> RecipientId +mkRecipientId = RecipientId + +newtype Uri = Uri { unUri :: Text } + deriving (Eq, FromJSON, Read, Show, ToJSON, Typeable) + +mkUri :: Text -> Uri +mkUri = Uri + +newtype UserId = UserId { unUserId :: Text } + deriving (Eq, FromJSON, Read, Show, ToJSON, Typeable) + +mkUserId :: Text -> UserId +mkUserId = UserId + +newtype UserName = UserName { unUserName :: Text } + deriving (Eq, FromJSON, Read, Show, ToJSON, Typeable) + +mkUserName :: Text -> UserName +mkUserName = UserName + +-- Sum types. + +data SigningEvent + = SigningCancelled + | SigningCompleted + | SigningDeclined + | SigningException + | SigningFaxPending + | SigningIdCheckFailed + | SigningSessionExpired + | SigningTokenExpired + | SigningViewingCompleted + deriving (Eq, Show, Typeable) + +data SigningMethod + = EmailBasedSigning + | RedirectionBasedSigning + +-- Record types. + +data AccountInfo = AccountInfo + { accountId :: AccountId + , accountIsDefault :: Bool + , accountName :: AccountName + , accountUserId :: UserId + , accountUserName :: UserName } + +data Document = Document + { documentContent :: PDF + , documentId :: DocumentId + , documentName :: Text } + +data Envelope = Envelope + { envelopeSubject :: Text + , envelopeMessage :: Text } + +data Recipient = Recipient + { recipientClientUserId :: UserId + , recipientEmailAddress :: EmailAddress + , recipientName :: Text + , recipientSignatureAnchorText :: Maybe Text } + +newtype RedirectionOptions = RedirectionOptions + { postSigningRedirectionUri :: Uri } + diff --git a/src/DocuSign/Client/Types/Conversion.hs b/src/DocuSign/Client/Types/Conversion.hs new file mode 100644 --- /dev/null +++ b/src/DocuSign/Client/Types/Conversion.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +{-| This module contains conversion operations that are guaranteed not to fail. + + Such conversions are typically used when preparing messages to be sent to a + DocuSign server instance, and convert from types exposed by the user-facing + high-level client API to types consumed by the lower-level REST API. +-} + +module DocuSign.Client.Types.Conversion where + +import DocuSign.Client.Types + +import Data.Text ( Text ) + +import qualified Data.Text as T +import qualified Data.UUID as U + +-- | A class for conversions that are guaranteed not to fail. +class Convert a b where + convert :: a -> b + +instance Convert AccountId Text where + convert = T.pack . show . unAccountId + +instance Convert DocumentId Text where + convert = T.pack . show . unDocumentId + +instance Convert EnvelopeId Text where + convert = U.toText . unEnvelopeId + diff --git a/src/DocuSign/Client/Types/Parsing.hs b/src/DocuSign/Client/Types/Parsing.hs new file mode 100644 --- /dev/null +++ b/src/DocuSign/Client/Types/Parsing.hs @@ -0,0 +1,113 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} + +{-| This module contains conversion operations that have the potential to fail. + + Such conversions are typically used when processing messages received from + a DocuSign server instance, which may return values that are incomplete. + + Such messages typically include record instances for which only a subset of + values are present. The precise subset of values included often depends on + which particular operation was invoked, or on the current server state. + + The knowledge of when to expect that values will be present (and when to + expect that they will be missing) is encapsulated in this module. +-} + +module DocuSign.Client.Types.Parsing where + +import DocuSign.Client.Types + +import Control.Exception ( Exception ) +import Control.Monad ( join ) +import Control.Monad.Catch ( MonadThrow + , throwM ) +import Type.Reflection ( TypeRep + , typeRep ) +import Data.Text ( Text ) +import Data.Text.Read ( decimal ) +import Data.Typeable ( Typeable ) +import Data.UUID ( UUID ) + +import qualified Data.Text as T +import qualified Data.UUID as U +import qualified DocuSign.Base.Types as D + +-- | A class for conversions that have the potential to fail. +class Parse a b where + parse :: a -> Maybe b + +-- | Parse a value monadically. +parseM :: forall a b m . + MonadThrow m => + Parse a b => + Show a => + Typeable a => + Typeable b => a -> m b +parseM a = maybe (throwM (parseFailure a :: ParseFailure a b)) pure $ parse a + +-- | Thrown when the base API fails to return a value that was expected. +data ParseFailure a b = ParseFailure + { sourceValue :: a + , sourceType :: TypeRep a + , targetType :: TypeRep b } + deriving Show + +parseFailure :: Typeable a => Typeable b => a -> ParseFailure a b +parseFailure a = ParseFailure a typeRep typeRep + +instance (Show a, Typeable a, Typeable b) => Exception (ParseFailure a b) + +instance Parse D.Authentication [AccountInfo] where + parse D.Authentication {..} = + join $ fmap (traverse parse) authenticationLoginAccounts + +instance Parse Text AccountId where + parse = either (const Nothing) (Just . fst) . decimal + +instance Parse D.LoginAccount AccountInfo where + parse D.LoginAccount {..} = + AccountInfo + <$> (parse =<< loginAccountAccountId) + <*> (parse =<< loginAccountIsDefault) + <*> (mkAccountName <$> loginAccountName ) + <*> (mkUserId <$> loginAccountUserId ) + <*> (mkUserName <$> loginAccountUserName ) + +instance Parse Text UUID where + parse = U.fromText + +instance Parse Text EnvelopeId where + parse = fmap mkEnvelopeId . parse + +instance Parse D.EnvelopeSummary EnvelopeId where + parse D.EnvelopeSummary {..} = + parse =<< envelopeSummaryEnvelopeId + +instance Parse D.EnvelopeViews Uri where + parse D.EnvelopeViews {..} = + mkUri <$> envelopeViewsUrl + +instance Parse Text Bool where + parse t = case T.unpack $ T.toLower t of + 't' : _ -> Just True + 'f' : _ -> Just False + _ -> Nothing + +instance Parse Text SigningEvent where + parse = \case + "cancel" -> Just SigningCancelled + "decline" -> Just SigningDeclined + "exception" -> Just SigningException + "fax_pending" -> Just SigningFaxPending + "id_check_failed" -> Just SigningIdCheckFailed + "session_timeout" -> Just SigningSessionExpired + "signing_complete" -> Just SigningCompleted + "ttl_expired" -> Just SigningTokenExpired + "viewing_complete" -> Just SigningViewingCompleted + _ -> Nothing +