{-# Language OverloadedStrings #-}
{-|
Module      : Client.Authentication.Ecdsa
Description : Binding to ecdsatool
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

Implementation of ECDSA-NIST256P-CHALLENGE SASL authentication mode
as implemented at <https://github.com/kaniini/ecdsatool>.

Using this mode requires that the @ecdsa@ utility program is available
in your search path.

-}
module Client.Authentication.Ecdsa
  ( authenticationMode
  , encodeAuthentication
  , computeResponse
  ) where

import Control.Exception (displayException, try)
import Data.ByteString.Lazy qualified as L
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text
import Irc.Commands (AuthenticatePayload(..))
import System.Process.Typed (readProcessStdout_, proc)


-- | Identifier for SASL ECDSA challenge response authentication
-- using curve NIST256P.
--
-- @ECDSA-NIST256P-CHALLENGE@
authenticationMode :: Text
authenticationMode :: Text
authenticationMode = Text
"ECDSA-NIST256P-CHALLENGE"


-- | Encode a username as specified in this authentication mode.
encodeAuthentication ::
  Maybe Text {- ^ authorization identity  -} ->
  Text {- ^ authentication identity -} ->
  AuthenticatePayload
encodeAuthentication :: Maybe Text -> Text -> AuthenticatePayload
encodeAuthentication Maybe Text
Nothing Text
authc =
  ByteString -> AuthenticatePayload
AuthenticatePayload (Text -> ByteString
Text.encodeUtf8 Text
authc)
encodeAuthentication (Just Text
authz) Text
authc =
  ByteString -> AuthenticatePayload
AuthenticatePayload (Text -> ByteString
Text.encodeUtf8 (Text
authc forall a. Semigroup a => a -> a -> a
<> Text
"\0" forall a. Semigroup a => a -> a -> a
<> Text
authz))


-- | Compute the response for a given challenge using the @ecdsatool@
-- executable which must be available in @PATH@.
computeResponse ::
  FilePath                {- ^ private key file                 -} ->
  Text                    {- ^ challenge string                 -} ->
  IO (Either String Text) {- ^ error message or response string -}
computeResponse :: String -> Text -> IO (Either String Text)
computeResponse String
privateKeyFile Text
challenge =
  do Either IOError ByteString
res <- forall e a. Exception e => IO a -> IO (Either e a)
try (forall (m :: * -> *) stdin stdoutIgnored stderr.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderr -> m ByteString
readProcessStdout_ (String -> [String] -> ProcessConfig () () ()
proc String
"ecdsatool" [String
"sign", String
privateKeyFile, Text -> String
Text.unpack Text
challenge]))
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! case Either IOError ByteString
res of
                 Left IOError
e -> forall a b. a -> Either a b
Left (forall e. Exception e => e -> String
displayException (IOError
e :: IOError))
                 Right ByteString
resp ->
                     case Text -> [Text]
Text.words forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either UnicodeException Text
Text.decodeUtf8' (ByteString -> ByteString
L.toStrict ByteString
resp) of
                         Left UnicodeException
e      -> forall a b. a -> Either a b
Left (forall e. Exception e => e -> String
displayException UnicodeException
e)
                         Right [Text
str] -> forall a b. b -> Either a b
Right Text
str
                         Right [Text]
_     -> forall a b. a -> Either a b
Left String
"bad sasl ecdsa response message"