{-# Language OverloadedStrings #-}
{-|
Module      : Irc.Commands
Description : Smart constructors for "RawIrcMsg"
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

This module provides smart constructors for IRC commands.
-}
module Irc.Commands
  ( ircAdmin
  , ircAway
  , ircCapEnd
  , ircCapLs
  , ircCapReq
  , ircChantrace
  , ircCnotice
  , ircCprivmsg
  , ircEtrace
  , ircInfo
  , ircInvite
  , ircIson
  , ircJoin
  , ircKick
  , ircKill
  , ircKline
  , ircKnock
  , ircLinks
  , ircList
  , ircLusers
  , ircMap
  , ircMasktrace
  , ircMode
  , ircMonitor
  , ircMotd
  , ircNick
  , ircNotice
  , ircOper
  , ircPart
  , ircPass
  , ircPing
  , ircPong
  , ircPrivmsg
  , ircQuit
  , ircRemove
  , ircRules
  , ircStats
  , ircTestline
  , ircTestmask
  , ircTime
  , ircTopic
  , ircTrace
  , ircUnkline
  , ircUser
  , ircUserhost
  , ircUserip
  , ircUsers
  , ircVersion
  , ircWallops
  , ircWho
  , ircWhois
  , ircWhowas

  -- * ZNC support
  , ircZnc

  -- * SASL support
  , AuthenticatePayload(..)
  , ircAuthenticate
  , ircAuthenticates
  , encodePlainAuthentication
  , encodeExternalAuthentication
  ) where

import           Irc.RawIrcMsg
import           Irc.Identifier
import           Data.ByteString (ByteString)
import           Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.ByteString as B
import qualified Data.ByteString.Base64 as Enc

nonempty :: Text -> [Text]
nonempty :: Text -> [Text]
nonempty Text
txt = [Text
txt | Bool -> Bool
not (Text -> Bool
Text.null Text
txt)]

-- | PRIVMSG command
ircPrivmsg ::
  Text {- ^ target  -} ->
  Text {- ^ message -} ->
  RawIrcMsg
ircPrivmsg :: Text -> Text -> RawIrcMsg
ircPrivmsg Text
who Text
msg = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"PRIVMSG" [Text
who, Text
msg]

-- | CPRIVMSG command
--
-- > CPRIVMSG <nickname> <channel> :<message>
ircCprivmsg ::
  Text {- ^ nickname -} ->
  Text {- ^ channel  -} ->
  Text {- ^ message  -} ->
  RawIrcMsg
ircCprivmsg :: Text -> Text -> Text -> RawIrcMsg
ircCprivmsg Text
nick Text
chan Text
msg = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"CPRIVMSG" [Text
nick, Text
chan, Text
msg]

-- | CNOTICE command
--
-- > CNOTICE <nickname> <channel> :<message>
ircCnotice ::
  Text {- ^ nickname -} ->
  Text {- ^ channel  -} ->
  Text {- ^ message  -} ->
  RawIrcMsg
ircCnotice :: Text -> Text -> Text -> RawIrcMsg
ircCnotice Text
nick Text
chan Text
msg = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"CNOTICE" [Text
nick, Text
chan, Text
msg]

-- | KNOCK command
--
-- > KNOCK <channel> [<message>]
ircKnock ::
  Text {- ^ channel  -} ->
  Text {- ^ message  -} ->
  RawIrcMsg
ircKnock :: Text -> Text -> RawIrcMsg
ircKnock Text
chan Text
msg = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"KNOCK" (Text
chan Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text -> [Text]
nonempty Text
msg)

-- | NOTICE command
ircNotice ::
  Text {- ^ target  -} ->
  Text {- ^ message -} ->
  RawIrcMsg
ircNotice :: Text -> Text -> RawIrcMsg
ircNotice Text
who Text
msg = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"NOTICE" [Text
who, Text
msg]

-- | MODE command
ircMode ::
  Identifier {- ^ target     -} ->
  [Text]     {- ^ parameters -} ->
  RawIrcMsg
ircMode :: Identifier -> [Text] -> RawIrcMsg
ircMode Identifier
tgt [Text]
params = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"MODE" (Identifier -> Text
idText Identifier
tgt Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
params)

ircMonitor ::
  [Text] {- ^ parameters -} ->
  RawIrcMsg
ircMonitor :: [Text] -> RawIrcMsg
ircMonitor [Text]
params = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"MONITOR" [Text]
params

-- | WHOIS command
ircWhois ::
  [Text] {- ^ parameters -} ->
  RawIrcMsg
ircWhois :: [Text] -> RawIrcMsg
ircWhois = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"WHOIS"

-- | WHO command
ircWho ::
  [Text] {- ^ parameters -} ->
  RawIrcMsg
ircWho :: [Text] -> RawIrcMsg
ircWho = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"WHO"

-- | WHOWAS command
ircWhowas ::
  [Text] {- ^ parameters -} ->
  RawIrcMsg
ircWhowas :: [Text] -> RawIrcMsg
ircWhowas = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"WHOWAS"

-- | WALLOPS command
ircWallops ::
  Text {- ^ message -} ->
  RawIrcMsg
ircWallops :: Text -> RawIrcMsg
ircWallops Text
msg = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"WALLOPS" [Text
msg]

-- | NICK command
ircNick ::
  Text {- ^ nickname -} ->
  RawIrcMsg
ircNick :: Text -> RawIrcMsg
ircNick Text
nick = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"NICK" [Text
nick]

-- | PART command
ircPart ::
  Identifier {- ^ channel -} ->
  Text       {- ^ message -} ->
  RawIrcMsg
ircPart :: Identifier -> Text -> RawIrcMsg
ircPart Identifier
chan Text
msg = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"PART" (Identifier -> Text
idText Identifier
chan Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text -> [Text]
nonempty Text
msg)

-- | JOIN command
ircJoin ::
  Text       {- ^ channel -} ->
  Maybe Text {- ^ key     -} ->
  RawIrcMsg
ircJoin :: Text -> Maybe Text -> RawIrcMsg
ircJoin Text
chan (Just Text
key) = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"JOIN" [Text
chan, Text
key]
ircJoin Text
chan Maybe Text
Nothing    = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"JOIN" [Text
chan]

-- | INVITE command
ircInvite ::
  Text       {- ^ nickname -} ->
  Identifier {- ^ channel  -} ->
  RawIrcMsg
ircInvite :: Text -> Identifier -> RawIrcMsg
ircInvite Text
nick Identifier
channel = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"INVITE" [Text
nick, Identifier -> Text
idText Identifier
channel]

-- | TOPIC command
ircTopic ::
  Identifier {- ^ channel -} ->
  Text       {- ^ topic   -} ->
  RawIrcMsg
ircTopic :: Identifier -> Text -> RawIrcMsg
ircTopic Identifier
chan Text
msg = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"TOPIC" (Identifier -> Text
idText Identifier
chan Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text -> [Text]
nonempty Text
msg)

-- | KICK command
ircKick ::
  Identifier {- ^ channel  -} ->
  Text       {- ^ nickname -} ->
  Text       {- ^ message  -} ->
  RawIrcMsg
ircKick :: Identifier -> Text -> Text -> RawIrcMsg
ircKick Identifier
chan Text
who Text
msg = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"KICK" (Identifier -> Text
idText Identifier
chan Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
who Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text -> [Text]
nonempty Text
msg)

-- | KILL command
ircKill ::
  Text {- ^ client  -} ->
  Text {- ^ message -} ->
  RawIrcMsg
ircKill :: Text -> Text -> RawIrcMsg
ircKill Text
who Text
msg = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"KILL" (Text
who Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text -> [Text]
nonempty Text
msg)

-- | KLINE command
ircKline ::
  Text {- ^ minutes -} ->
  Text {- ^ mask    -} ->
  Text {- ^ reason  -} ->
  RawIrcMsg
ircKline :: Text -> Text -> Text -> RawIrcMsg
ircKline Text
minutes Text
mask Text
reason = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"KLINE" [Text
minutes, Text
mask, Text
reason]

-- | UNKLINE command
ircUnkline ::
  Text {- ^ mask -} ->
  RawIrcMsg
ircUnkline :: Text -> RawIrcMsg
ircUnkline Text
mask = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"UNKLINE" [Text
mask]

-- | TESTLINE command
ircTestline ::
  Text {- ^ mask -} ->
  RawIrcMsg
ircTestline :: Text -> RawIrcMsg
ircTestline Text
mask = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"TESTLINE" [Text
mask]

-- | TESTMASK command
ircTestmask ::
  Text {- ^ mask  -} ->
  Text {- ^ gecos -} ->
  RawIrcMsg
ircTestmask :: Text -> Text -> RawIrcMsg
ircTestmask Text
mask Text
gecos = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"TESTMASK" (Text
mask Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text -> [Text]
nonempty Text
gecos)

-- | MASKTRACE command
ircMasktrace ::
  Text {- ^ mask  -} ->
  Text {- ^ gecos -} ->
  RawIrcMsg
ircMasktrace :: Text -> Text -> RawIrcMsg
ircMasktrace Text
mask Text
gecos = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"MASKTRACE" [Text
mask, Text
gecos]

-- | CHANTRACE command
ircChantrace ::
  Text {- ^ channel -} ->
  RawIrcMsg
ircChantrace :: Text -> RawIrcMsg
ircChantrace Text
channel = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"CHANTRACE" [Text
channel]

-- | ETRACE command
ircEtrace ::
  Text {- ^ argument -} ->
  RawIrcMsg
ircEtrace :: Text -> RawIrcMsg
ircEtrace Text
arg = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"ETRACE" (Text -> [Text]
nonempty Text
arg)

-- | REMOVE command
ircRemove ::
  Identifier {- ^ channel  -} ->
  Text       {- ^ nickname -} ->
  Text       {- ^ message  -} ->
  RawIrcMsg
ircRemove :: Identifier -> Text -> Text -> RawIrcMsg
ircRemove Identifier
chan Text
who Text
msg = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"REMOVE" (Identifier -> Text
idText Identifier
chan Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
who Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text -> [Text]
nonempty Text
msg)

-- | QUIT command
ircQuit :: Text {- ^ quit message -} -> RawIrcMsg
ircQuit :: Text -> RawIrcMsg
ircQuit Text
msg = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"QUIT" [Text
msg]

-- | PASS command
ircPass :: Text {- ^ password -} -> RawIrcMsg
ircPass :: Text -> RawIrcMsg
ircPass Text
pass = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"PASS" [Text
pass]

-- | LIST command
ircList ::
  [Text] {- ^ parameters -} ->
  RawIrcMsg
ircList :: [Text] -> RawIrcMsg
ircList = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"LIST"

-- | PING command
ircPing ::
  [Text] {- ^ parameters -} ->
  RawIrcMsg
ircPing :: [Text] -> RawIrcMsg
ircPing = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"PING"

-- | PONG command
ircPong ::
  [Text] {- ^ parameters -} ->
  RawIrcMsg
ircPong :: [Text] -> RawIrcMsg
ircPong = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"PONG"

-- | ISON command
ircIson ::
  [Text] {- ^ nicknames -} ->
  RawIrcMsg
ircIson :: [Text] -> RawIrcMsg
ircIson [Text]
nicks = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"ISON" [[Text] -> Text
Text.unwords [Text]
nicks]

-- | TIME command
ircTime ::
  Text {- ^ optional servername -} ->
  RawIrcMsg
ircTime :: Text -> RawIrcMsg
ircTime = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"TIME" ([Text] -> RawIrcMsg) -> (Text -> [Text]) -> Text -> RawIrcMsg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
nonempty

-- | USERHOST command
ircUserhost ::
  [Text] {- ^ parameters -} ->
  RawIrcMsg
ircUserhost :: [Text] -> RawIrcMsg
ircUserhost = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"USERHOST"

-- | USERIP command
ircUserip ::
  [Text] {- ^ parameters -} ->
  RawIrcMsg
ircUserip :: [Text] -> RawIrcMsg
ircUserip = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"USERIP"

-- | USERS command
ircUsers ::
  Text {- ^ optional servername -} ->
  RawIrcMsg
ircUsers :: Text -> RawIrcMsg
ircUsers = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"USERS" ([Text] -> RawIrcMsg) -> (Text -> [Text]) -> Text -> RawIrcMsg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
nonempty

-- | STATS command
ircStats ::
  [Text] {- ^ parameters -} ->
  RawIrcMsg
ircStats :: [Text] -> RawIrcMsg
ircStats = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"STATS"

-- | OPER command
ircOper ::
  Text {- ^ username -} ->
  Text {- ^ password -} ->
  RawIrcMsg
ircOper :: Text -> Text -> RawIrcMsg
ircOper Text
u Text
p = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"OPER" [Text
u,Text
p]

-- | LINKS command
ircLinks ::
  [Text] {- ^ parameters -} ->
  RawIrcMsg
ircLinks :: [Text] -> RawIrcMsg
ircLinks = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"LINKS"

-- | AWAY command
ircAway ::
  Text {- ^ message -} ->
  RawIrcMsg
ircAway :: Text -> RawIrcMsg
ircAway = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"AWAY" ([Text] -> RawIrcMsg) -> (Text -> [Text]) -> Text -> RawIrcMsg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
nonempty

-- | MAP command
ircMap :: RawIrcMsg
ircMap :: RawIrcMsg
ircMap = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"MAP" []

-- | INFO command
ircInfo :: RawIrcMsg
ircInfo :: RawIrcMsg
ircInfo = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"INFO" []

-- | RULES command
ircRules ::
  Text {- ^ servername -} ->
  RawIrcMsg
ircRules :: Text -> RawIrcMsg
ircRules = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"RULES" ([Text] -> RawIrcMsg) -> (Text -> [Text]) -> Text -> RawIrcMsg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
nonempty

-- | VERSION command
ircVersion ::
  Text {- ^ server -} ->
  RawIrcMsg
ircVersion :: Text -> RawIrcMsg
ircVersion = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"VERSION" ([Text] -> RawIrcMsg) -> (Text -> [Text]) -> Text -> RawIrcMsg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
nonempty

-- | LUSERS command
--
-- > LUSERS [<mask> [<server>]]
ircLusers ::
  [Text] {- ^ params -} ->
  RawIrcMsg
ircLusers :: [Text] -> RawIrcMsg
ircLusers = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"LUSERS"

-- | MOTD command
--
-- > MOTD [<server>]
ircMotd ::
  Text {- ^ server -} ->
  RawIrcMsg
ircMotd :: Text -> RawIrcMsg
ircMotd = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"MOTD" ([Text] -> RawIrcMsg) -> (Text -> [Text]) -> Text -> RawIrcMsg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
nonempty

-- | ADMIN command
--
-- > ADMIN [<target>]
ircAdmin ::
  Text {- ^ target -} ->
  RawIrcMsg
ircAdmin :: Text -> RawIrcMsg
ircAdmin = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"ADMIN" ([Text] -> RawIrcMsg) -> (Text -> [Text]) -> Text -> RawIrcMsg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
nonempty

-- | TRACE command
--
-- > TRACE [<target>]
ircTrace ::
  [Text] {- ^ params -} ->
  RawIrcMsg
ircTrace :: [Text] -> RawIrcMsg
ircTrace = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"TRACE"

-- | USER command
ircUser ::
  Text {- ^ username -} ->
  Text {- ^ realname -} -> RawIrcMsg
ircUser :: Text -> Text -> RawIrcMsg
ircUser Text
user Text
real = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"USER" [Text
user, Text
"0", Text
"*", Text
real]

-- | CAP REQ command
ircCapReq ::
  [Text] {- ^ capabilities -} ->
  RawIrcMsg
ircCapReq :: [Text] -> RawIrcMsg
ircCapReq [Text]
caps = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"CAP" [Text
"REQ", [Text] -> Text
Text.unwords [Text]
caps]

-- | CAP END command
ircCapEnd :: RawIrcMsg
ircCapEnd :: RawIrcMsg
ircCapEnd = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"CAP" [Text
"END"]

-- | CAP LS command - support CAP version 3.2
ircCapLs :: RawIrcMsg
ircCapLs :: RawIrcMsg
ircCapLs = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"CAP" [Text
"LS", Text
"302"]

-- | ZNC command
--
-- /specific to ZNC/
ircZnc ::
  [Text] {- ^ parameters -} ->
  RawIrcMsg
ircZnc :: [Text] -> RawIrcMsg
ircZnc = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"ZNC"

-- | Payload for 'ircAuthenticates'
newtype AuthenticatePayload = AuthenticatePayload ByteString
  deriving Int -> AuthenticatePayload -> ShowS
[AuthenticatePayload] -> ShowS
AuthenticatePayload -> String
(Int -> AuthenticatePayload -> ShowS)
-> (AuthenticatePayload -> String)
-> ([AuthenticatePayload] -> ShowS)
-> Show AuthenticatePayload
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthenticatePayload] -> ShowS
$cshowList :: [AuthenticatePayload] -> ShowS
show :: AuthenticatePayload -> String
$cshow :: AuthenticatePayload -> String
showsPrec :: Int -> AuthenticatePayload -> ShowS
$cshowsPrec :: Int -> AuthenticatePayload -> ShowS
Show

ircAuthenticate ::
  Text {- ^ authentication mechanism -} ->
  RawIrcMsg
ircAuthenticate :: Text -> RawIrcMsg
ircAuthenticate Text
msg = Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
"AUTHENTICATE" [Text
msg]

-- | AUTHENTICATE command generator. Returns a list
-- because AUTHENTICATE has a chunking behavior.
ircAuthenticates ::
  AuthenticatePayload {- ^ authentication payload -} ->
  [RawIrcMsg]
ircAuthenticates :: AuthenticatePayload -> [RawIrcMsg]
ircAuthenticates (AuthenticatePayload ByteString
bytes) =
  (ByteString -> RawIrcMsg) -> [ByteString] -> [RawIrcMsg]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> RawIrcMsg
ircAuthenticate (Text -> RawIrcMsg)
-> (ByteString -> Text) -> ByteString -> RawIrcMsg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeUtf8) (ByteString -> [ByteString]
chunks (ByteString -> ByteString
Enc.encode ByteString
bytes))
  where
    chunks :: ByteString -> [ByteString]
    chunks :: ByteString -> [ByteString]
chunks ByteString
b
      | ByteString -> Bool
B.null ByteString
b          = [ByteString
"+"]
      | ByteString -> Int
B.length ByteString
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
400 = Int -> ByteString -> ByteString
B.take Int
400 ByteString
b ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> [ByteString]
chunks (Int -> ByteString -> ByteString
B.drop Int
400 ByteString
b)
      | Bool
otherwise         = [ByteString
b]

-- | Encoding of username and password in PLAIN authentication
encodePlainAuthentication ::
  Text {- ^ authorization identity -} ->
  Text {- ^ authentication identity -} ->
  Text {- ^ password -} ->
  AuthenticatePayload
encodePlainAuthentication :: Text -> Text -> Text -> AuthenticatePayload
encodePlainAuthentication Text
authz Text
authc Text
pass
  = ByteString -> AuthenticatePayload
AuthenticatePayload
  (ByteString -> AuthenticatePayload)
-> ByteString -> AuthenticatePayload
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
Text.encodeUtf8
  (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
Text.intercalate Text
"\0" [Text
authz,Text
authc,Text
pass]

-- | Encoding of username in EXTERNAL authentication
encodeExternalAuthentication ::
  Text {- ^ authorization identity -} ->
  AuthenticatePayload
encodeExternalAuthentication :: Text -> AuthenticatePayload
encodeExternalAuthentication Text
authz = ByteString -> AuthenticatePayload
AuthenticatePayload (Text -> ByteString
Text.encodeUtf8 Text
authz)