mondo 0.1.0.0 → 0.2.0.0
raw patch · 5 files changed
+339/−42 lines, 5 filesdep +containersdep +text
Dependencies added: containers, text
Files
- mondo.cabal +6/−3
- src/Mondo.hs +0/−7
- src/Mondo/API.hs +146/−28
- src/Mondo/Types.hs +180/−3
- test/Example.hs +7/−1
mondo.cabal view
@@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.1.0.0 +version: 0.2.0.0 -- A short (one-line) description of the package. synopsis: Haskell bindings for the Mondo API @@ -71,7 +71,9 @@ http-client-tls >= 0.2, authenticate-oauth >=1.5, bytestring >=0.10, - mtl + mtl, + text >= 1.2, + containers -- Directories containing source files. hs-source-dirs: src @@ -87,4 +89,5 @@ FlexibleInstances, FlexibleContexts, UndecidableInstances, - TypeFamilies + TypeFamilies, + RecordWildCards
src/Mondo.hs view
@@ -10,14 +10,7 @@ -------------------------------------------------------------------------------- -import Control.Monad.IO.Class - -import qualified Data.ByteString.Internal as BS - import Web.Authenticate.OAuth - -import Servant.API.BasicAuth -import Servant.Client (ServantError) import Mondo.Types import Mondo.API
src/Mondo/API.hs view
@@ -5,15 +5,31 @@ {-# LANGUAGE FunctionalDependencies #-} -module Mondo.API where +module Mondo.API ( + Mondo, + withMondo, + getAccounts, + getBalance, + getTransaction, + listTransactions, + annotateTransaction, + createFeedItem, + registerWebhook, + listWebhooks, + deleteWebhook, + uploadAttachment, + registerAttachment, + removeAttachment +) where + -------------------------------------------------------------------------------- import GHC.TypeLits import qualified Data.ByteString.Internal as BS import Data.Proxy -import Data.Monoid +import Data.Monoid ((<>)) import Control.Monad.Trans import Control.Monad.Trans.Except @@ -43,23 +59,42 @@ -------------------------------------------------------------------------------- -data MondoAccount +type TransactionsAPI = + Capture "transaction_id" TransactionID :> + QueryParam "expand[]" String :> + Get '[JSON] TransactionResponse + :<|> QueryParam "account_id" AccountID :> + Get '[JSON] Transactions + :<|> Capture "transaction_id" TransactionID :> + ReqBody '[FormUrlEncoded] Metadata :> + Patch '[JSON] TransactionResponse -instance HasClient api => HasClient (MondoAccount :> api) where - type Client (MondoAccount :> api) = AccountID -> Client api +-- | A type representing Mondo's feed API. +type FeedAPI = + ReqBody '[FormUrlEncoded] FeedItem :> Post '[JSON] Empty - clientWithRoute Proxy req url mgr val = - clientWithRoute (Proxy :: Proxy api) (addHeader "account_id" val req) url mgr +-- | A type representing Mondo's webhooks API. +type WebhooksAPI = + ReqBody '[FormUrlEncoded] Webhook :> Post '[JSON] Webhook + :<|> QueryParam "account_id" AccountID :> Get '[JSON] Webhooks + :<|> Capture "webhook_id" WebhookID :> Delete '[JSON] Empty --------------------------------------------------------------------------------- +-- | A type representing Mondo's attachments API. +type AttachmentsAPI = + "upload" :> ReqBody '[FormUrlEncoded] FileUploadReq :> Post '[JSON] FileUploadRes + :<|> "register" :> ReqBody '[FormUrlEncoded] Attachment :> Post '[JSON] Attachment + :<|> "deregister" :> ReqBody '[FormUrlEncoded] AttachmentID :> Post '[JSON] Empty --- | A type representing the Mondo API. -type MondoAPI = - MondoAuth :> "accounts" :> Get '[JSON] AccountsResponse - :<|> MondoAuth :> "balance" :> QueryParam "account_id" AccountID :> Get '[JSON] Balance - :<|> MondoAuth :> "transactions" :> Capture "transaction_id" String :> Get '[JSON] TransactionResponse - :<|> MondoAuth :> "transactions" :> QueryParam "account_id" AccountID :> Get '[JSON] Transactions +type AuthAPI = + "accounts" :> Get '[JSON] AccountsResponse + :<|> "balance" :> QueryParam "account_id" AccountID :> Get '[JSON] Balance + :<|> "transactions" :> TransactionsAPI + :<|> "feed" :> FeedAPI + :<|> "webhooks" :> WebhooksAPI + :<|> "attachment" :> AttachmentsAPI +-- | A type representing the Mondo API. +type MondoAPI = MondoAuth :> AuthAPI mondoAPI :: Proxy MondoAPI mondoAPI = Proxy @@ -85,40 +120,115 @@ -------------------------------------------------------------------------------- -api = client mondoAPI mondoURL +fullApi = client mondoAPI mondoURL +transactionsApi :: Manager -> String -> + (TransactionID -> Maybe String -> ExceptT ServantError IO TransactionResponse) + :<|> ((Maybe AccountID -> ExceptT ServantError IO Transactions) + :<|> (TransactionID -> Metadata -> ExceptT ServantError IO TransactionResponse)) +transactionsApi mgr tkn = getNth (Proxy :: Proxy 2) $ fullApi mgr tkn + +feedApi mgr tkn = getNth (Proxy :: Proxy 3) $ fullApi mgr tkn +webhooksApi mgr tkn = getNth (Proxy :: Proxy 4) $ fullApi mgr tkn + getAccounts :: Mondo AccountsResponse getAccounts = do mgr <- manager tkn <- credential let - fn = getNth (Proxy :: Proxy 0) $ api mgr - lift $ lift $ fn tkn + fn = getNth (Proxy :: Proxy 0) $ fullApi mgr tkn + lift $ lift fn -getBalance :: String -> Mondo Balance +getBalance :: AccountID -> Mondo Balance getBalance acc = do mgr <- manager tkn <- credential let - fn = getNth (Proxy :: Proxy 1) $ api mgr - lift $ lift $ fn tkn (Just acc) + fn = getNth (Proxy :: Proxy 1) $ fullApi mgr tkn + lift $ lift $ fn (Just acc) -getTransaction :: String -> Mondo Transaction -getTransaction tr = do +getTransaction :: TransactionID -> Bool -> Mondo Transaction +getTransaction tr expandMerchant = do mgr <- manager tkn <- credential let - fn = getNth (Proxy :: Proxy 2) $ api mgr - lift $ lift (transaction <$> fn tkn tr) + fn = getNth (Proxy :: Proxy 0) $ transactionsApi mgr tkn + ex = if expandMerchant then Just "merchant" else Nothing + lift $ lift (transaction <$> fn tr ex) -getTransactions :: AccountID -> Mondo Transactions -getTransactions acc = do +listTransactions :: AccountID -> Mondo Transactions +listTransactions acc = do mgr <- manager tkn <- credential let - fn = getNth (Proxy :: Proxy 3) $ api mgr - lift $ lift $ fn tkn (Just acc) + fn = getNth (Proxy :: Proxy 1) $ transactionsApi mgr tkn + lift $ lift $ fn (Just acc) +annotateTransaction :: TransactionID -> Metadata -> Mondo Transaction +annotateTransaction tr meta = do + mgr <- manager + tkn <- credential + let + fn = getNth (Proxy :: Proxy 2) $ transactionsApi mgr tkn + lift $ lift (transaction <$> fn tr meta) + +-- | `createFeedItem item' creates a new feed item. +createFeedItem :: FeedItem -> Mondo () +createFeedItem item = do + mgr <- manager + tkn <- credential + let + fn = getNth (Proxy :: Proxy 0) $ feedApi mgr tkn + lift $ lift $ toUnit <$> fn item + +registerWebhook :: Webhook -> Mondo Webhook +registerWebhook hook = do + mgr <- manager + tkn <- credential + let + fn = getNth (Proxy :: Proxy 0) $ webhooksApi mgr tkn + lift $ lift $ fn hook + +listWebhooks :: AccountID -> Mondo Webhooks +listWebhooks acc = do + mgr <- manager + tkn <- credential + let + fn = getNth (Proxy :: Proxy 1) $ webhooksApi mgr tkn + lift $ lift $ fn (Just acc) + +deleteWebhook :: WebhookID -> Mondo () +deleteWebhook hookID = do + mgr <- manager + tkn <- credential + let + fn = getNth (Proxy :: Proxy 2) $ webhooksApi mgr tkn + lift $ lift $ toUnit <$> fn hookID + +uploadAttachment :: FileUploadReq -> Mondo FileUploadRes +uploadAttachment req = do + mgr <- manager + tkn <- credential + let + fn = getNth (Proxy :: Proxy 5) $ fullApi mgr tkn + lift $ lift $ fn req + +registerAttachment :: Attachment -> Mondo Attachment +registerAttachment att = do + mgr <- manager + tkn <- credential + let + fn = getNth (Proxy :: Proxy 6) $ fullApi mgr tkn + lift $ lift $ fn att + +removeAttachment :: AttachmentID -> Mondo () +removeAttachment attID = do + mgr <- manager + tkn <- credential + let + fn = getNth (Proxy :: Proxy 7) $ fullApi mgr tkn + lift $ lift $ toUnit <$> fn attID + -------------------------------------------------------------------------------- class GetNth (n :: Nat) a b | n a -> b where @@ -135,5 +245,13 @@ (GetNth (n-1) x y) => GetNth n (a :<|> x) y where getNth _ (_ :<|> x) = getNth (Proxy :: Proxy (n-1)) x +class GetLast a b | a -> b where + getLast :: a -> b + +instance {-# OVERLAPPING #-} (GetLast b c) => GetLast (a :<|> b) c where + getLast (_ :<|> b) = getLast b + +instance a ~ b => GetLast a b where + getLast a = a --------------------------------------------------------------------------------
src/Mondo/Types.hs view
@@ -12,11 +12,45 @@ import Control.Monad (mzero) import Data.Aeson +import Data.Aeson.Types (emptyObject) +import qualified Data.Text as T +import qualified Data.Map as M +import Data.Monoid ((<>)) +import Servant.API + -------------------------------------------------------------------------------- -type AccountID = String +data Empty = Empty +instance FromJSON Empty where + parseJSON val + | val == emptyObject = pure Empty + | otherwise = mzero + +toUnit :: Empty -> () +toUnit _ = () + +-- | The type of account IDs. +type AccountID = String + +-- | The type of transaction IDs. +type TransactionID = String + +-- | The type of webhook IDs. +type WebhookID = String + +-- | The type of attachment IDs. +newtype AttachmentID = AttID T.Text + deriving Show + +instance FromJSON AttachmentID where + parseJSON (String v) = pure $ AttID v + parseJSON _ = mzero + +instance ToFormUrlEncoded AttachmentID where + toFormUrlEncoded (AttID v) = [("id", v)] + -------------------------------------------------------------------------------- data AccountsResponse = AccountsResponse { @@ -44,6 +78,8 @@ instance FromJSON Balance +-------------------------------------------------------------------------------- + -- | Enumerates reasons which cause transactions to be declined. data DeclineReason = InsufficientFunds @@ -78,6 +114,7 @@ <*> v .: "longitude" <*> v .: "postcode" <*> v .: "region" + parseJSON _ = mzero data Merchant = Merchant { merchantAddress :: Maybe Address, @@ -100,6 +137,7 @@ <*> v .: "emoji" <*> v .: "name" <*> v .: "category" + parseJSON _ = mzero data Transactions = Transactions { transactions :: [Transaction] @@ -121,12 +159,13 @@ transactionCreated :: String, transactionCurrency :: String, transactionDescription :: String, - transactionID :: String, + transactionID :: TransactionID, transactionDeclineReason :: Maybe DeclineReason, transactionIsLoad :: Bool, transactionSettled :: Bool, transactionCategory :: Maybe String, - transactionMerchant :: Merchant + transactionMerchant :: Merchant, + transactionMetadata :: M.Map String String } deriving Show instance FromJSON Transaction where @@ -142,5 +181,143 @@ <*> v .: "settled" <*> v .: "category" <*> v .: "merchant" + <*> v .: "metadata" + parseJSON _ = mzero + +data Metadata = Metadata { metadata :: M.Map String String } + +instance ToFormUrlEncoded Metadata where + toFormUrlEncoded (Metadata d) = + [("metadata[" <> T.pack k <> "]", T.pack v) | (k,v) <- M.toList d] + +-------------------------------------------------------------------------------- + +data FeedItemType + = BasicItem + +instance Show FeedItemType where + show BasicItem = "basic" + +instance ToJSON FeedItemType where + toJSON BasicItem = String "basic" + +data FeedItemParams + = BasicFeedItem { + itemTitle :: String, + itemImageURL :: String, + itemBody :: Maybe String, + itemBackgroundColour :: Maybe String, + itemTitleColour :: Maybe String, + itemBodyColour :: Maybe String + } + +newBasicFeedItem :: String -> String -> FeedItemParams +newBasicFeedItem title url = BasicFeedItem { + itemTitle = title, + itemImageURL = url, + itemBody = Nothing, + itemBackgroundColour = Nothing, + itemTitleColour = Nothing, + itemBodyColour = Nothing +} + +instance ToFormUrlEncoded FeedItemParams where + toFormUrlEncoded (BasicFeedItem {..}) = + [ ( "params[title]" , T.pack itemTitle ) + , ( "params[image_url]", T.pack itemImageURL ) + ] + +data FeedItem = FeedItem { + itemAccountID :: AccountID, + itemType :: FeedItemType, + itemParams :: FeedItemParams, + itemURL :: Maybe String +} + +instance ToFormUrlEncoded FeedItem where + toFormUrlEncoded item = + [ ( "account_id", T.pack $ itemAccountID item ) + , ( "type" , T.pack $ show $ itemType item ) + ] ++ toFormUrlEncoded (itemParams item) + +-------------------------------------------------------------------------------- + +data Webhooks = Webhooks { + webhooks :: [Webhook] +} deriving (Show, Generic) + +instance FromJSON Webhooks + +data Webhook = Webhook { + webhookAccountID :: AccountID, + webhookURL :: String, + webhookID :: Maybe WebhookID +} deriving Show + +instance FromJSON Webhook where + parseJSON (Object v) = + Webhook <$> v .: "account_id" + <*> v .: "url" + <*> v .: "id" + parseJSON _ = mzero + +instance ToFormUrlEncoded Webhook where + toFormUrlEncoded hook = + [ ( "account_id", T.pack $ webhookAccountID hook ) + , ( "url" , T.pack $ webhookURL hook ) + ] + +-------------------------------------------------------------------------------- + +data FileUploadReq = FileUploadReq { + uploadFileName :: String, + uploadFileType :: String +} + +instance ToFormUrlEncoded FileUploadReq where + toFormUrlEncoded req = + [ ( "file_name", T.pack $ uploadFileName req ) + , ( "file_type", T.pack $ uploadFileType req ) + ] + +data FileUploadRes = FileUploadRes { + uploadURL :: String, + uploadPostURL :: String +} + +instance FromJSON FileUploadRes where + parseJSON (Object v) = + FileUploadRes <$> v .: "file_url" + <*> v .: "file_type" + parseJSON _ = mzero + +-------------------------------------------------------------------------------- + +-- | Transaction attachments. +data Attachment = Attachment { + attachmentTransaction :: TransactionID, + attachmentFileType :: String, + attachmentURL :: String, + attachmentID :: Maybe AttachmentID, + attachmentUserID :: Maybe String, + attachmentCreated :: Maybe String +} deriving Show + +instance FromJSON Attachment where + parseJSON (Object v) = + Attachment <$> v .: "external_id" + <*> v .: "file_type" + <*> v .: "file_url" + <*> v .: "id" + <*> v .: "user_id" + <*> v .: "created" + parseJSON _ = mzero + +instance ToFormUrlEncoded Attachment where + toFormUrlEncoded att = + [ ( "external_id", T.pack $ attachmentTransaction att ) + , ( "file_url", T.pack $ attachmentURL att ) + , ( "file_type", T.pack $ attachmentFileType att ) + ] --------------------------------------------------------------------------------
test/Example.hs view
@@ -28,7 +28,13 @@ r2 <- getBalance (accountID acc) liftIO $ print r2 - r3 <- getTransactions (accountID acc) + r3 <- listTransactions (accountID acc) liftIO $ print r3 + + createFeedItem $ FeedItem + (accountID acc) + BasicItem + (newBasicFeedItem "Haskell test" "https://www.haskell.org/static/img/logo.png?etag=rJR84DMh") + Nothing --------------------------------------------------------------------------------