smtpbz (empty) → 1.0.0
raw patch · 7 files changed
+332/−0 lines, 7 filesdep +aesondep +basedep +bytestring
Dependencies added: aeson, base, bytestring, http-conduit, http-types, text
Files
- CHANGELOG.markdown +4/−0
- LICENSE +26/−0
- README.markdown +6/−0
- smtpbz.cabal +41/−0
- src/Smtpbz.hs +7/−0
- src/Smtpbz/Internal/Api.hs +215/−0
- src/Smtpbz/Internal/Has.hs +33/−0
+ CHANGELOG.markdown view
@@ -0,0 +1,4 @@+1.0.0+=====++ * Initial release.
+ LICENSE view
@@ -0,0 +1,26 @@+Copyright Matvey Aksenov (c) 2022++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.++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..
+ README.markdown view
@@ -0,0 +1,6 @@+smtpbz+===++A small library wrapping the [API][0] provided by https://smtp.bz/++ [0]: https://docs.smtp.bz/#/api
+ smtpbz.cabal view
@@ -0,0 +1,41 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.7.+--+-- see: https://github.com/sol/hpack++name: smtpbz+version: 1.0.0+synopsis: This is smtpbz+description: See README.markdown+category: Web+author: Matvey Aksenov+maintainer: matvey.aksenov@gmail.com+copyright: 2022 Matvey Aksenov+license: BSD2+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.markdown+ CHANGELOG.markdown++library+ exposed-modules:+ Smtpbz+ Smtpbz.Internal.Api+ Smtpbz.Internal.Has+ other-modules:+ Paths_smtpbz+ hs-source-dirs:+ src+ default-extensions:+ OverloadedStrings+ ghc-options: -funbox-strict-fields -Wall+ build-depends:+ aeson+ , base >=4.7 && <5+ , bytestring+ , http-conduit+ , http-types+ , text+ default-language: Haskell2010
+ src/Smtpbz.hs view
@@ -0,0 +1,7 @@+module Smtpbz+ ( module Smtpbz.Internal.Has+ , module Smtpbz.Internal.Api+ ) where++import Smtpbz.Internal.Has (Has(..), Lens, Lens')+import Smtpbz.Internal.Api
+ src/Smtpbz/Internal/Api.hs view
@@ -0,0 +1,215 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE RecordWildCards #-}+-- | Reference: https://docs.smtp.bz/#/api+--+-- The response bodies are really un(der)specified, so this library doesn't+-- try to do to much with them. You are on your own.+--+-- Functions' names map (trivially) to API routes. So, for some of them,+-- it's not obvious what they do from their name. This is by design.+module Smtpbz.Internal.Api+ ( user+ , userStats+ , userDomains+ , userDomain+ , userIPs+ , userIP+ , LogMessages(..)+ , logMessages+ , logMessage+ , Unsubscribe(..)+ , unsubscribe+ , unsubscribeAdd+ , unsubscribeRemove+ , unsubscribeRemoveAll+ , SmtpSend(..)+ , sendSmtp+ , checkEmail++ , successfulCall+ , debugPrintResponse+ ) where++import Data.Bool (bool)+import Data.ByteString (ByteString)+import qualified Data.ByteString.Lazy as Lazy (ByteString)+import qualified Data.ByteString.Lazy.Char8 as ByteString.Lazy+import Data.Maybe (mapMaybe)+import Data.String (fromString)+import qualified Network.HTTP.Conduit as Http+import qualified Network.HTTP.Types as Http+import Text.Printf (printf)++import Smtpbz.Internal.Has (Has(..), view)+++-- | User data.+user :: Has smtpbz => smtpbz -> IO (Http.Response Lazy.ByteString)+user smtpbz =+ simpleApiCall smtpbz "user"++-- | User's mail distribution statistics.+userStats :: Has smtpbz => smtpbz -> IO (Http.Response Lazy.ByteString)+userStats smtpbz =+ simpleApiCall smtpbz "user/stats"++-- | User's domains data.+userDomains :: Has smtpbz => smtpbz -> IO (Http.Response Lazy.ByteString)+userDomains smtpbz =+ simpleApiCall smtpbz "user/domain"++-- | User's specific domain data.+userDomain :: Has smtpbz => smtpbz -> String -> IO (Http.Response Lazy.ByteString)+userDomain smtpbz domain =+ simpleApiCall smtpbz (printf "user/domain/%s" domain)++-- | User's IPs data.+userIPs :: Has smtpbz => smtpbz -> IO (Http.Response Lazy.ByteString)+userIPs smtpbz =+ simpleApiCall smtpbz "user/ip"++-- | User's specific IP data.+userIP :: Has smtpbz => smtpbz -> String -> IO (Http.Response Lazy.ByteString)+userIP smtpbz ip = do+ simpleApiCall smtpbz (printf "user/ip/%s" ip)++data LogMessages = LogMessages+ { limit :: Maybe Int+ , offset :: Maybe Int+ , from :: Maybe ByteString+ , to :: Maybe ByteString+ , isOpen :: Maybe Bool+ , tag :: Maybe ByteString+ } deriving (Show, Eq)++-- | Message log search.+logMessages :: Has smtpbz => smtpbz -> LogMessages -> IO (Http.Response Lazy.ByteString)+logMessages smtpbz LogMessages {..} = do+ req <- prepareApiCall smtpbz "log/message"+ callApi smtpbz (Http.setQueryString params req)+ where+ params =+ [ ("limit", fmap (fromString . show) limit)+ , ("offset", fmap (fromString . show) offset)+ , ("from", from)+ , ("to", to)+ -- documentation says it's a normal person's bool,+ -- but in reality it's a C-programmer's bool+ , ("is_open", fmap (bool "0" "1") isOpen)+ , ("tag", tag)+ ]++-- | Look up a specific message.+logMessage :: Has smtpbz => smtpbz -> String -> IO (Http.Response Lazy.ByteString)+logMessage smtpbz messageID = do+ simpleApiCall smtpbz (printf "log/message/%s" messageID)++data Unsubscribe = Unsubscribe+ { limit :: Maybe Int+ , offset :: Maybe Int+ , address :: Maybe ByteString+ , reason :: Maybe ByteString+ } deriving (Show, Eq)++-- | List of e-mail addresses mail is not delivired to.+unsubscribe :: Has smtpbz => smtpbz -> Unsubscribe -> IO (Http.Response Lazy.ByteString)+unsubscribe smtpbz Unsubscribe {..} = do+ req <- prepareApiCall smtpbz "unsubscribe"+ callApi smtpbz (Http.setQueryString params req)+ where+ params =+ [ ("limit", fmap (fromString . show) limit)+ , ("offset", fmap (fromString . show) offset)+ , ("address", address)+ , ("reason", reason)+ ]++-- | Ignore an address.+unsubscribeAdd :: Has smtpbz => smtpbz -> ByteString -> IO (Http.Response Lazy.ByteString)+unsubscribeAdd smtpbz address = do+ req <- prepareApiCall smtpbz "unsubscribe/add"+ callApi smtpbz (Http.urlEncodedBody params req)+ where+ params =+ [ ("address", address)+ ]++-- | Stop ignoring an address.+unsubscribeRemove :: Has smtpbz => smtpbz -> ByteString -> IO (Http.Response Lazy.ByteString)+unsubscribeRemove smtpbz address = do+ req <- prepareApiCall smtpbz "unsubscribe/remove"+ callApi smtpbz (Http.urlEncodedBody params req)+ where+ params =+ [ ("address", address)+ ]++-- | Stop ignoring all previously ignored addresses.+unsubscribeRemoveAll :: Has smtpbz => smtpbz -> IO (Http.Response Lazy.ByteString)+unsubscribeRemoveAll smtpbz = do+ req <- prepareApiCall smtpbz "unsubscribe/removeall"+ callApi smtpbz (Http.urlEncodedBody [] req)++data SmtpSend = SmtpSend+ { from :: ByteString+ , name :: Maybe ByteString+ , subject :: ByteString+ , to :: ByteString+ , replyTo :: Maybe ByteString+ , html :: ByteString+ , text :: Maybe ByteString+ -- , headers :: ByteString ???+ } deriving (Show, Eq)++--- | Send an email.+sendSmtp :: Has smtpbz => smtpbz -> SmtpSend -> IO (Http.Response Lazy.ByteString)+sendSmtp smtpbz SmtpSend {..} = do+ req <- prepareApiCall smtpbz "smtp/send"+ callApi smtpbz (Http.urlEncodedBody (collapse params) req)+ where+ params =+ [ ("from", pure from)+ , ("name", name)+ , ("subject", pure subject)+ , ("to", pure to)+ , ("reply", replyTo)+ , ("html", pure html)+ , ("text", text)+ ]++--- | Check email address validity.+checkEmail :: Has smtpbz => smtpbz -> String -> IO (Http.Response Lazy.ByteString)+checkEmail smtpbz email =+ simpleApiCall smtpbz (printf "check/email/%s" email)++simpleApiCall :: Has smtpbz => smtpbz -> String -> IO (Http.Response Lazy.ByteString)+simpleApiCall smtpbz path = do+ req <- prepareApiCall smtpbz path+ callApi smtpbz req++prepareApiCall :: Has smtpbz => smtpbz -> String -> IO Http.Request+prepareApiCall smtpbz path = do+ req <- Http.parseRequest (printf "%s/%s" (view baseUrl smtpbz) path)+ pure req+ { Http.requestHeaders = ("Authorization", view apiKey smtpbz) : Http.requestHeaders req+ }++callApi :: Has smtpbz => smtpbz -> Http.Request -> IO (Http.Response Lazy.ByteString)+callApi smtpbz req =+ Http.httpLbs req (view httpMan smtpbz)++-- | Check if response status code is in [200, 300).+successfulCall :: Http.Response Lazy.ByteString -> Bool+successfulCall res =+ case Http.responseStatus res of+ st ->+ Http.status200 <= st && st < Http.status300++-- | Print response body to stdout.+debugPrintResponse :: Http.Response Lazy.ByteString -> IO ()+debugPrintResponse =+ ByteString.Lazy.putStrLn . Http.responseBody++collapse :: [(a, Maybe b)] -> [(a, b)]+collapse =+ mapMaybe sequence
+ src/Smtpbz/Internal/Has.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE RankNTypes #-}+module Smtpbz.Internal.Has+ ( Has(..)+ , Lens+ , Lens'+ , view+ ) where++import Data.ByteString (ByteString)+import Data.Functor.Const (Const(..))+import Data.Text (Text)+import qualified Network.HTTP.Conduit as Http+++-- | smtp.bz configuration that is used by the library+-- and the user may want to override.+class Has t where+ -- | API key; get one at https://smtp.bz/panel/user+ apiKey :: Lens' t ByteString+ -- | API base URL; Most likely, https://api.smtp.bz/v1+ baseUrl :: Lens' t Text+ -- | The 'Http.Manager' under which all requests will be made.+ httpMan :: Lens' t Http.Manager++-- | Type changing stabby lenses.+type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t++-- | Stabby lenses that can't change the type.+type Lens' s a = Lens s s a a++view :: Lens s t a b -> s -> a+view l x = getConst (l Const x)+{-# INLINE view #-}