module Gamgee.Operation
  ( addToken
  , deleteToken
  , listTokens
  , getOTP
  , getInfo
  , changePassword
  ) where


import           Data.Aeson            ((.=))
import qualified Data.Aeson            as Aeson
import qualified Data.Time.Clock.POSIX as Clock
import qualified Data.Version          as Version
import qualified Gamgee.Effects        as Eff
import qualified Gamgee.Token          as Token
import           Paths_gamgee          (version)
import           Polysemy              (Members, Sem)
import qualified Polysemy.Error        as P
import qualified Polysemy.Input        as P
import qualified Polysemy.Output       as P
import qualified Polysemy.State        as P
import           Relude
import qualified Relude.Extra.Map      as Map


addToken :: Members [ P.State Token.Tokens
                    , Eff.Crypto
                    , Eff.SecretInput Text
                    , P.Error Eff.EffError ] r
         => Token.TokenSpec
         -> Sem r ()
addToken :: TokenSpec -> Sem r ()
addToken TokenSpec
spec = do
  let ident :: TokenIdentifier
ident = TokenSpec -> TokenIdentifier
Token.getIdentifier TokenSpec
spec
  Tokens
tokens <- forall (r :: [Effect]).
MemberWithError (State Tokens) r =>
Sem r Tokens
forall s (r :: [Effect]). MemberWithError (State s) r => Sem r s
P.get @Token.Tokens
  if Key Tokens
TokenIdentifier
ident Key Tokens -> Tokens -> Bool
forall t. StaticMap t => Key t -> t -> Bool
`Map.member` Tokens
tokens
  then EffError -> Sem r ()
forall e (r :: [Effect]) a.
MemberWithError (Error e) r =>
e -> Sem r a
P.throw (EffError -> Sem r ()) -> EffError -> Sem r ()
forall a b. (a -> b) -> a -> b
$ TokenIdentifier -> EffError
Eff.AlreadyExists TokenIdentifier
ident
  else do
    TokenSpec
spec' <- TokenSpec -> Sem r TokenSpec
forall (r :: [Effect]).
Members '[SecretInput Text, Crypto] r =>
TokenSpec -> Sem r TokenSpec
Eff.encryptSecret TokenSpec
spec
    Tokens -> Sem r ()
forall s (r :: [Effect]).
MemberWithError (State s) r =>
s -> Sem r ()
P.put (Tokens -> Sem r ()) -> Tokens -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Key Tokens -> Val Tokens -> Tokens -> Tokens
forall t. DynamicMap t => Key t -> Val t -> t -> t
Map.insert Key Tokens
TokenIdentifier
ident Val Tokens
TokenSpec
spec' Tokens
tokens

deleteToken :: Members [ P.State Token.Tokens
                       , P.Error Eff.EffError ] r
            => Token.TokenIdentifier
            -> Sem r ()
deleteToken :: TokenIdentifier -> Sem r ()
deleteToken TokenIdentifier
ident = do
  Tokens
tokens <- forall (r :: [Effect]).
MemberWithError (State Tokens) r =>
Sem r Tokens
forall s (r :: [Effect]). MemberWithError (State s) r => Sem r s
P.get @Token.Tokens
  case Key Tokens -> Tokens -> Maybe (Val Tokens)
forall t. StaticMap t => Key t -> t -> Maybe (Val t)
Map.lookup Key Tokens
TokenIdentifier
ident Tokens
tokens of
    Maybe (Val Tokens)
Nothing -> EffError -> Sem r ()
forall e (r :: [Effect]) a.
MemberWithError (Error e) r =>
e -> Sem r a
P.throw (EffError -> Sem r ()) -> EffError -> Sem r ()
forall a b. (a -> b) -> a -> b
$ TokenIdentifier -> EffError
Eff.NoSuchToken TokenIdentifier
ident
    Just Val Tokens
_  -> Tokens -> Sem r ()
forall s (r :: [Effect]).
MemberWithError (State s) r =>
s -> Sem r ()
P.put (Tokens -> Sem r ()) -> Tokens -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Key Tokens -> Tokens -> Tokens
forall t. DynamicMap t => Key t -> t -> t
Map.delete Key Tokens
TokenIdentifier
ident Tokens
tokens

listTokens :: Members [ P.State Token.Tokens
                      , P.Output Text ] r
           => Sem r ()
listTokens :: Sem r ()
listTokens = do
  Tokens
tokens <- forall (r :: [Effect]).
MemberWithError (State Tokens) r =>
Sem r Tokens
forall s (r :: [Effect]). MemberWithError (State s) r => Sem r s
P.get @Token.Tokens
  (TokenSpec -> Sem r ()) -> Tokens -> Sem r ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Text -> Sem r ()
forall o (r :: [Effect]).
MemberWithError (Output o) r =>
o -> Sem r ()
P.output (Text -> Sem r ()) -> (TokenSpec -> Text) -> TokenSpec -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenIdentifier -> Text
Token.unTokenIdentifier (TokenIdentifier -> Text)
-> (TokenSpec -> TokenIdentifier) -> TokenSpec -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenSpec -> TokenIdentifier
Token.getIdentifier) Tokens
tokens

getOTP :: Members [ P.State Token.Tokens
                  , P.Error Eff.EffError
                  , P.Output Text
                  , Eff.TOTP ] r
       => Token.TokenIdentifier
       -> Clock.POSIXTime
       -> Sem r ()
getOTP :: TokenIdentifier -> POSIXTime -> Sem r ()
getOTP TokenIdentifier
ident POSIXTime
time = do
  Tokens
tokens <- forall (r :: [Effect]).
MemberWithError (State Tokens) r =>
Sem r Tokens
forall s (r :: [Effect]). MemberWithError (State s) r => Sem r s
P.get @Token.Tokens
  case Key Tokens -> Tokens -> Maybe (Val Tokens)
forall t. StaticMap t => Key t -> t -> Maybe (Val t)
Map.lookup Key Tokens
TokenIdentifier
ident Tokens
tokens of
    Maybe (Val Tokens)
Nothing   -> EffError -> Sem r ()
forall e (r :: [Effect]) a.
MemberWithError (Error e) r =>
e -> Sem r a
P.throw (EffError -> Sem r ()) -> EffError -> Sem r ()
forall a b. (a -> b) -> a -> b
$ TokenIdentifier -> EffError
Eff.NoSuchToken TokenIdentifier
ident
    Just Val Tokens
spec -> TokenSpec -> POSIXTime -> Sem r Text
forall (r :: [Effect]).
MemberWithError TOTP r =>
TokenSpec -> POSIXTime -> Sem r Text
Eff.getTOTP Val Tokens
TokenSpec
spec POSIXTime
time Sem r Text -> (Text -> Sem r ()) -> Sem r ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Sem r ()
forall o (r :: [Effect]).
MemberWithError (Output o) r =>
o -> Sem r ()
P.output

getInfo :: Members [ P.Input FilePath
                   , P.Output Aeson.Value ] r
        => Sem r (Maybe Token.Config)
        -> Sem r ()
getInfo :: Sem r (Maybe Config) -> Sem r ()
getInfo Sem r (Maybe Config)
cfg = do
  FilePath
path <- forall (r :: [Effect]).
MemberWithError (Input FilePath) r =>
Sem r FilePath
forall i (r :: [Effect]). MemberWithError (Input i) r => Sem r i
P.input @FilePath

  -- Info command should work even if the config file can't be read. So we handle the
  -- potential "missing" config here with a `Maybe Config`.
  Value
cfgVersion <- Value -> (Config -> Value) -> Maybe Config -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
Aeson.Null (Word32 -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON (Word32 -> Value) -> (Config -> Word32) -> Config -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Word32
Token.configVersion) (Maybe Config -> Value) -> Sem r (Maybe Config) -> Sem r Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem r (Maybe Config)
cfg

  let info :: Value
info = [Pair] -> Value
Aeson.object [ Text
"version" Text -> FilePath -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Version -> FilePath
Version.showVersion Version
version
                          , Text
"config"  Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
Aeson.object [ Text
"filepath" Text -> FilePath -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= FilePath
path
                                                      , Text
"version"  Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Value
cfgVersion ]
                          ]
  Value -> Sem r ()
forall o (r :: [Effect]).
MemberWithError (Output o) r =>
o -> Sem r ()
P.output Value
info

changePassword :: Members [ P.State Token.Tokens
                          , Eff.SecretInput Text
                          , Eff.Crypto
                          , Eff.TOTP
                          , P.Error Eff.EffError ] r
               => Token.TokenIdentifier
               -> Sem r ()
changePassword :: TokenIdentifier -> Sem r ()
changePassword TokenIdentifier
ident = do
  Tokens
tokens <- forall (r :: [Effect]).
MemberWithError (State Tokens) r =>
Sem r Tokens
forall s (r :: [Effect]). MemberWithError (State s) r => Sem r s
P.get @Token.Tokens
  case Key Tokens -> Tokens -> Maybe (Val Tokens)
forall t. StaticMap t => Key t -> t -> Maybe (Val t)
Map.lookup Key Tokens
TokenIdentifier
ident Tokens
tokens of
    Maybe (Val Tokens)
Nothing   -> EffError -> Sem r ()
forall e (r :: [Effect]) a.
MemberWithError (Error e) r =>
e -> Sem r a
P.throw (EffError -> Sem r ()) -> EffError -> Sem r ()
forall a b. (a -> b) -> a -> b
$ TokenIdentifier -> EffError
Eff.NoSuchToken TokenIdentifier
ident
    Just Val Tokens
spec -> do
      Text
secret <- TokenSpec -> Sem r Text
forall (r :: [Effect]).
MemberWithError TOTP r =>
TokenSpec -> Sem r Text
Eff.getSecret Val Tokens
TokenSpec
spec
      TokenSpec
spec' <- TokenSpec -> Sem r TokenSpec
forall (r :: [Effect]).
Members '[SecretInput Text, Crypto] r =>
TokenSpec -> Sem r TokenSpec
Eff.encryptSecret Val Tokens
TokenSpec
spec { tokenSecret :: TokenSecret
Token.tokenSecret = Text -> TokenSecret
Token.TokenSecretPlainText Text
secret }
      Tokens -> Sem r ()
forall s (r :: [Effect]).
MemberWithError (State s) r =>
s -> Sem r ()
P.put (Tokens -> Sem r ()) -> Tokens -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Key Tokens -> Val Tokens -> Tokens -> Tokens
forall t. DynamicMap t => Key t -> Val t -> t -> t
Map.insert Key Tokens
TokenIdentifier
ident Val Tokens
TokenSpec
spec' Tokens
tokens