{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Query haveibeenpwned database to check basic password strength in a secure way.
--
--   By checking new user passwords against a database of leaked passwords you
--   get some means for rejecting very weak or just leaked passwords.
module HaveIBeenPwned where

import "cryptonite" Crypto.Hash
import Control.Exception
import Control.Monad.Logger
import Control.Monad.Reader
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as LBS
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Encoding
import Network.HTTP.Client
import Network.HTTP.Types.Status (Status(..))
import Safe (readMay)

data HaveIBeenPwnedConfig = HaveIBeenPwnedConfig
  { HaveIBeenPwnedConfig -> Manager
_haveIBeenPwnedConfig_manager :: Manager
  , HaveIBeenPwnedConfig -> Text
_haveIBeenPwnedConfig_apihost :: Text
  }

-- | Result of a password check.
--
--   It is either considered secure, insecure or we can't say because of an
--   error.
data HaveIBeenPwnedResult =
    HaveIBeenPwnedResult_Secure
    -- ^ We could not find the password in any database, thus it is considered
    -- "secure" as far as this library is concerned.
  | HaveIBeenPwnedResult_Pwned Int
    -- ^ How many times the password was found in public places. Usually this
    -- will be a value greater than 0, but in any case if you hit this
    -- constructor you must assume tha password has been leaked.
  | HaveIBeenPwnedResult_Error
    -- ^ The check failed for some reason. We can't say anything about the
    -- password quality.
  deriving (HaveIBeenPwnedResult -> HaveIBeenPwnedResult -> Bool
(HaveIBeenPwnedResult -> HaveIBeenPwnedResult -> Bool)
-> (HaveIBeenPwnedResult -> HaveIBeenPwnedResult -> Bool)
-> Eq HaveIBeenPwnedResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HaveIBeenPwnedResult -> HaveIBeenPwnedResult -> Bool
== :: HaveIBeenPwnedResult -> HaveIBeenPwnedResult -> Bool
$c/= :: HaveIBeenPwnedResult -> HaveIBeenPwnedResult -> Bool
/= :: HaveIBeenPwnedResult -> HaveIBeenPwnedResult -> Bool
Eq, Eq HaveIBeenPwnedResult
Eq HaveIBeenPwnedResult =>
(HaveIBeenPwnedResult -> HaveIBeenPwnedResult -> Ordering)
-> (HaveIBeenPwnedResult -> HaveIBeenPwnedResult -> Bool)
-> (HaveIBeenPwnedResult -> HaveIBeenPwnedResult -> Bool)
-> (HaveIBeenPwnedResult -> HaveIBeenPwnedResult -> Bool)
-> (HaveIBeenPwnedResult -> HaveIBeenPwnedResult -> Bool)
-> (HaveIBeenPwnedResult
    -> HaveIBeenPwnedResult -> HaveIBeenPwnedResult)
-> (HaveIBeenPwnedResult
    -> HaveIBeenPwnedResult -> HaveIBeenPwnedResult)
-> Ord HaveIBeenPwnedResult
HaveIBeenPwnedResult -> HaveIBeenPwnedResult -> Bool
HaveIBeenPwnedResult -> HaveIBeenPwnedResult -> Ordering
HaveIBeenPwnedResult
-> HaveIBeenPwnedResult -> HaveIBeenPwnedResult
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: HaveIBeenPwnedResult -> HaveIBeenPwnedResult -> Ordering
compare :: HaveIBeenPwnedResult -> HaveIBeenPwnedResult -> Ordering
$c< :: HaveIBeenPwnedResult -> HaveIBeenPwnedResult -> Bool
< :: HaveIBeenPwnedResult -> HaveIBeenPwnedResult -> Bool
$c<= :: HaveIBeenPwnedResult -> HaveIBeenPwnedResult -> Bool
<= :: HaveIBeenPwnedResult -> HaveIBeenPwnedResult -> Bool
$c> :: HaveIBeenPwnedResult -> HaveIBeenPwnedResult -> Bool
> :: HaveIBeenPwnedResult -> HaveIBeenPwnedResult -> Bool
$c>= :: HaveIBeenPwnedResult -> HaveIBeenPwnedResult -> Bool
>= :: HaveIBeenPwnedResult -> HaveIBeenPwnedResult -> Bool
$cmax :: HaveIBeenPwnedResult
-> HaveIBeenPwnedResult -> HaveIBeenPwnedResult
max :: HaveIBeenPwnedResult
-> HaveIBeenPwnedResult -> HaveIBeenPwnedResult
$cmin :: HaveIBeenPwnedResult
-> HaveIBeenPwnedResult -> HaveIBeenPwnedResult
min :: HaveIBeenPwnedResult
-> HaveIBeenPwnedResult -> HaveIBeenPwnedResult
Ord, Int -> HaveIBeenPwnedResult -> ShowS
[HaveIBeenPwnedResult] -> ShowS
HaveIBeenPwnedResult -> String
(Int -> HaveIBeenPwnedResult -> ShowS)
-> (HaveIBeenPwnedResult -> String)
-> ([HaveIBeenPwnedResult] -> ShowS)
-> Show HaveIBeenPwnedResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HaveIBeenPwnedResult -> ShowS
showsPrec :: Int -> HaveIBeenPwnedResult -> ShowS
$cshow :: HaveIBeenPwnedResult -> String
show :: HaveIBeenPwnedResult -> String
$cshowList :: [HaveIBeenPwnedResult] -> ShowS
showList :: [HaveIBeenPwnedResult] -> ShowS
Show)

class Monad m => MonadPwned m where
  -- | Returns the number of disclosures the supplied password has been seen in.
  --
  -- If this is not zero, do not use the supplied password, it is known to hackers.
  -- If it *is* zero, it might still not be safe, only that if it is
  -- compromised, that is not yet known.
  --
  -- https://haveibeenpwned.com/API/v2#SearchingPwnedPasswordsByRange
  haveIBeenPwned :: Text -> m HaveIBeenPwnedResult

newtype PwnedT m a = PwnedT { forall (m :: * -> *) a.
PwnedT m a -> ReaderT HaveIBeenPwnedConfig m a
unPwnedT :: ReaderT HaveIBeenPwnedConfig m a }
  deriving ((forall a b. (a -> b) -> PwnedT m a -> PwnedT m b)
-> (forall a b. a -> PwnedT m b -> PwnedT m a)
-> Functor (PwnedT m)
forall a b. a -> PwnedT m b -> PwnedT m a
forall a b. (a -> b) -> PwnedT m a -> PwnedT m b
forall (m :: * -> *) a b.
Functor m =>
a -> PwnedT m b -> PwnedT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> PwnedT m a -> PwnedT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> PwnedT m a -> PwnedT m b
fmap :: forall a b. (a -> b) -> PwnedT m a -> PwnedT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> PwnedT m b -> PwnedT m a
<$ :: forall a b. a -> PwnedT m b -> PwnedT m a
Functor, Functor (PwnedT m)
Functor (PwnedT m) =>
(forall a. a -> PwnedT m a)
-> (forall a b. PwnedT m (a -> b) -> PwnedT m a -> PwnedT m b)
-> (forall a b c.
    (a -> b -> c) -> PwnedT m a -> PwnedT m b -> PwnedT m c)
-> (forall a b. PwnedT m a -> PwnedT m b -> PwnedT m b)
-> (forall a b. PwnedT m a -> PwnedT m b -> PwnedT m a)
-> Applicative (PwnedT m)
forall a. a -> PwnedT m a
forall a b. PwnedT m a -> PwnedT m b -> PwnedT m a
forall a b. PwnedT m a -> PwnedT m b -> PwnedT m b
forall a b. PwnedT m (a -> b) -> PwnedT m a -> PwnedT m b
forall a b c.
(a -> b -> c) -> PwnedT m a -> PwnedT m b -> PwnedT m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (PwnedT m)
forall (m :: * -> *) a. Applicative m => a -> PwnedT m a
forall (m :: * -> *) a b.
Applicative m =>
PwnedT m a -> PwnedT m b -> PwnedT m a
forall (m :: * -> *) a b.
Applicative m =>
PwnedT m a -> PwnedT m b -> PwnedT m b
forall (m :: * -> *) a b.
Applicative m =>
PwnedT m (a -> b) -> PwnedT m a -> PwnedT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> PwnedT m a -> PwnedT m b -> PwnedT m c
$cpure :: forall (m :: * -> *) a. Applicative m => a -> PwnedT m a
pure :: forall a. a -> PwnedT m a
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
PwnedT m (a -> b) -> PwnedT m a -> PwnedT m b
<*> :: forall a b. PwnedT m (a -> b) -> PwnedT m a -> PwnedT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> PwnedT m a -> PwnedT m b -> PwnedT m c
liftA2 :: forall a b c.
(a -> b -> c) -> PwnedT m a -> PwnedT m b -> PwnedT m c
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
PwnedT m a -> PwnedT m b -> PwnedT m b
*> :: forall a b. PwnedT m a -> PwnedT m b -> PwnedT m b
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
PwnedT m a -> PwnedT m b -> PwnedT m a
<* :: forall a b. PwnedT m a -> PwnedT m b -> PwnedT m a
Applicative, Applicative (PwnedT m)
Applicative (PwnedT m) =>
(forall a b. PwnedT m a -> (a -> PwnedT m b) -> PwnedT m b)
-> (forall a b. PwnedT m a -> PwnedT m b -> PwnedT m b)
-> (forall a. a -> PwnedT m a)
-> Monad (PwnedT m)
forall a. a -> PwnedT m a
forall a b. PwnedT m a -> PwnedT m b -> PwnedT m b
forall a b. PwnedT m a -> (a -> PwnedT m b) -> PwnedT m b
forall (m :: * -> *). Monad m => Applicative (PwnedT m)
forall (m :: * -> *) a. Monad m => a -> PwnedT m a
forall (m :: * -> *) a b.
Monad m =>
PwnedT m a -> PwnedT m b -> PwnedT m b
forall (m :: * -> *) a b.
Monad m =>
PwnedT m a -> (a -> PwnedT m b) -> PwnedT m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
PwnedT m a -> (a -> PwnedT m b) -> PwnedT m b
>>= :: forall a b. PwnedT m a -> (a -> PwnedT m b) -> PwnedT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
PwnedT m a -> PwnedT m b -> PwnedT m b
>> :: forall a b. PwnedT m a -> PwnedT m b -> PwnedT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> PwnedT m a
return :: forall a. a -> PwnedT m a
Monad , Monad (PwnedT m)
Monad (PwnedT m) =>
(forall a. IO a -> PwnedT m a) -> MonadIO (PwnedT m)
forall a. IO a -> PwnedT m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (PwnedT m)
forall (m :: * -> *) a. MonadIO m => IO a -> PwnedT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> PwnedT m a
liftIO :: forall a. IO a -> PwnedT m a
MonadIO, Monad (PwnedT m)
Monad (PwnedT m) =>
(forall msg.
 ToLogStr msg =>
 Loc -> Text -> LogLevel -> msg -> PwnedT m ())
-> MonadLogger (PwnedT m)
forall msg.
ToLogStr msg =>
Loc -> Text -> LogLevel -> msg -> PwnedT m ()
forall (m :: * -> *).
Monad m =>
(forall msg.
 ToLogStr msg =>
 Loc -> Text -> LogLevel -> msg -> m ())
-> MonadLogger m
forall (m :: * -> *). MonadLogger m => Monad (PwnedT m)
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> PwnedT m ()
$cmonadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> PwnedT m ()
monadLoggerLog :: forall msg.
ToLogStr msg =>
Loc -> Text -> LogLevel -> msg -> PwnedT m ()
MonadLogger
    , (forall (m :: * -> *). Monad m => Monad (PwnedT m)) =>
(forall (m :: * -> *) a. Monad m => m a -> PwnedT m a)
-> MonadTrans PwnedT
forall (m :: * -> *). Monad m => Monad (PwnedT m)
forall (m :: * -> *) a. Monad m => m a -> PwnedT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *). Monad m => Monad (t m)) =>
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
$clift :: forall (m :: * -> *) a. Monad m => m a -> PwnedT m a
lift :: forall (m :: * -> *) a. Monad m => m a -> PwnedT m a
MonadTrans
    )

runPwnedT :: PwnedT m a -> HaveIBeenPwnedConfig -> m a
runPwnedT :: forall (m :: * -> *) a. PwnedT m a -> HaveIBeenPwnedConfig -> m a
runPwnedT (PwnedT (ReaderT HaveIBeenPwnedConfig -> m a
f)) = HaveIBeenPwnedConfig -> m a
f

mapPwnedT :: (m a -> n b) -> PwnedT m a -> PwnedT n b
mapPwnedT :: forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> PwnedT m a -> PwnedT n b
mapPwnedT m a -> n b
f = ReaderT HaveIBeenPwnedConfig n b -> PwnedT n b
forall (m :: * -> *) a.
ReaderT HaveIBeenPwnedConfig m a -> PwnedT m a
PwnedT (ReaderT HaveIBeenPwnedConfig n b -> PwnedT n b)
-> (PwnedT m a -> ReaderT HaveIBeenPwnedConfig n b)
-> PwnedT m a
-> PwnedT n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m a -> n b)
-> ReaderT HaveIBeenPwnedConfig m a
-> ReaderT HaveIBeenPwnedConfig n b
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT m a -> n b
f (ReaderT HaveIBeenPwnedConfig m a
 -> ReaderT HaveIBeenPwnedConfig n b)
-> (PwnedT m a -> ReaderT HaveIBeenPwnedConfig m a)
-> PwnedT m a
-> ReaderT HaveIBeenPwnedConfig n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PwnedT m a -> ReaderT HaveIBeenPwnedConfig m a
forall (m :: * -> *) a.
PwnedT m a -> ReaderT HaveIBeenPwnedConfig m a
unPwnedT

instance MonadReader r m => MonadReader r (PwnedT m) where
  ask :: PwnedT m r
ask = m r -> PwnedT m r
forall (m :: * -> *) a. Monad m => m a -> PwnedT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
  local :: forall a. (r -> r) -> PwnedT m a -> PwnedT m a
local = (m a -> m a) -> PwnedT m a -> PwnedT m a
forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> PwnedT m a -> PwnedT n b
mapPwnedT ((m a -> m a) -> PwnedT m a -> PwnedT m a)
-> ((r -> r) -> m a -> m a) -> (r -> r) -> PwnedT m a -> PwnedT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> r) -> m a -> m a
forall a. (r -> r) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local
  reader :: forall a. (r -> a) -> PwnedT m a
reader = m a -> PwnedT m a
forall (m :: * -> *) a. Monad m => m a -> PwnedT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> PwnedT m a) -> ((r -> a) -> m a) -> (r -> a) -> PwnedT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> a) -> m a
forall a. (r -> a) -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
reader

instance (MonadLogger m, MonadIO m) => MonadPwned (PwnedT m) where
 haveIBeenPwned :: Text -> PwnedT m HaveIBeenPwnedResult
haveIBeenPwned Text
password = do
  let (Text
pfx, Text
rest) = Text -> (Text, Text)
passwdDigest Text
password
  cfg <- ReaderT HaveIBeenPwnedConfig m HaveIBeenPwnedConfig
-> PwnedT m HaveIBeenPwnedConfig
forall (m :: * -> *) a.
ReaderT HaveIBeenPwnedConfig m a -> PwnedT m a
PwnedT ReaderT HaveIBeenPwnedConfig m HaveIBeenPwnedConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
  let request = String -> Request
parseRequest_ (String -> Request) -> String -> Request
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [HaveIBeenPwnedConfig -> Text
_haveIBeenPwnedConfig_apihost HaveIBeenPwnedConfig
cfg, Text
"/", Text
pfx]
  result' <- liftIO $ try $ httpLbs request (_haveIBeenPwnedConfig_manager cfg)
  case result' of
    Left HttpException
err -> do
      $(logError) (Text -> PwnedT m ()) -> Text -> PwnedT m ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show @HttpException (HttpException -> String) -> HttpException -> String
forall a b. (a -> b) -> a -> b
$ HttpException
err
      HaveIBeenPwnedResult -> PwnedT m HaveIBeenPwnedResult
forall a. a -> PwnedT m a
forall (m :: * -> *) a. Monad m => a -> m a
return HaveIBeenPwnedResult
HaveIBeenPwnedResult_Error
    Right Response ByteString
result -> case Response ByteString -> Status
forall body. Response body -> Status
responseStatus Response ByteString
result of
      Status Int
200 ByteString
_ -> do
        let r :: HaveIBeenPwnedResult
r = ByteString -> Text -> HaveIBeenPwnedResult
parseHIBPResponse (Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
result) Text
rest
        case HaveIBeenPwnedResult
r of
          HaveIBeenPwnedResult
HaveIBeenPwnedResult_Error ->
            $(logError) (Text -> PwnedT m ()) -> Text -> PwnedT m ()
forall a b. (a -> b) -> a -> b
$ Text
"Parsing number of occurrences failed. (Not an Int)."
          HaveIBeenPwnedResult
_ -> () -> PwnedT m ()
forall a. a -> PwnedT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        HaveIBeenPwnedResult -> PwnedT m HaveIBeenPwnedResult
forall a. a -> PwnedT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HaveIBeenPwnedResult
r
      Status Int
code ByteString
phrase -> do
        $(logError) (Text -> PwnedT m ()) -> Text -> PwnedT m ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Status -> String
forall a. Show a => a -> String
show (Status -> String) -> Status -> String
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> Status
Status Int
code ByteString
phrase
        HaveIBeenPwnedResult -> PwnedT m HaveIBeenPwnedResult
forall a. a -> PwnedT m a
forall (m :: * -> *) a. Monad m => a -> m a
return HaveIBeenPwnedResult
HaveIBeenPwnedResult_Error


-- | Get the sha1 digest for the supplied password, split into two parts, to agree with the
--   hibp api.
passwdDigest :: Text -> (Text, Text)
passwdDigest :: Text -> (Text, Text)
passwdDigest Text
passwd = (Int -> Text -> Text
T.take Int
5 Text
digest, Int -> Text -> Text
T.drop Int
5 Text
digest)
  where digest :: Text
digest = Text -> Text
T.toUpper (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Digest SHA1 -> String
forall a. Show a => a -> String
show (Digest SHA1 -> String) -> Digest SHA1 -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> Digest SHA1
sha1 (ByteString -> Digest SHA1) -> ByteString -> Digest SHA1
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
passwd
        sha1 :: ByteString -> Digest SHA1
        sha1 :: ByteString -> Digest SHA1
sha1 = ByteString -> Digest SHA1
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash

-- | The hibp response is a line separated list of colon separated hash
-- *suffixes* and a number indicating the number of times that password(hash)
-- has been seen in known publicly disclosed leaks
parseHIBPResponse :: LBS.ByteString -> Text -> HaveIBeenPwnedResult
parseHIBPResponse :: ByteString -> Text -> HaveIBeenPwnedResult
parseHIBPResponse ByteString
response Text
suffix =
  let
    digests :: [(LT.Text, Maybe Int)]
    digests :: [(Text, Maybe Int)]
digests = (Text -> (Text, Maybe Int)) -> [Text] -> [(Text, Maybe Int)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> Maybe Int) -> (Text, Text) -> (Text, Maybe Int)
forall a b. (a -> b) -> (Text, a) -> (Text, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMay (String -> Maybe Int) -> (Text -> String) -> Text -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
LT.unpack (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Text -> Text
LT.drop Int64
1) ((Text, Text) -> (Text, Maybe Int))
-> (Text -> (Text, Text)) -> Text -> (Text, Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
LT.breakOn Text
":") ([Text] -> [(Text, Maybe Int)]) -> [Text] -> [(Text, Maybe Int)]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
LT.lines (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
Data.Text.Lazy.Encoding.decodeUtf8 ByteString
response
  in case ((Text, Maybe Int) -> Bool)
-> [(Text, Maybe Int)] -> [(Text, Maybe Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> Text
LT.fromStrict Text
suffix Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==) (Text -> Bool)
-> ((Text, Maybe Int) -> Text) -> (Text, Maybe Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Maybe Int) -> Text
forall a b. (a, b) -> a
fst) [(Text, Maybe Int)]
digests of
    ((Text
_,Maybe Int
n):[(Text, Maybe Int)]
_) -> HaveIBeenPwnedResult
-> (Int -> HaveIBeenPwnedResult)
-> Maybe Int
-> HaveIBeenPwnedResult
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HaveIBeenPwnedResult
HaveIBeenPwnedResult_Error Int -> HaveIBeenPwnedResult
HaveIBeenPwnedResult_Pwned Maybe Int
n
    [] -> HaveIBeenPwnedResult
HaveIBeenPwnedResult_Secure