one-time-password 2.0.0 → 3.0.0.0

raw patch · 16 files changed

+1731/−451 lines, 16 filesdep +base16dep +base32dep +chronosdep −memorydep −timedep ~basedep ~bytestringdep ~cerealsetup-changednew-component:exe:one-time-passwordnew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: base16, base32, chronos, cryptohash-sha1, network-uri, optparse-applicative, sel, tasty-quickcheck, text, text-display, torsor

Dependencies removed: memory, time

Dependency ranges changed: base, bytestring, cereal

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• LICENSE +1/−1
• README.md +15/−68
• Setup.hs +0/−2
• app/Main.hs +355/−0
• one-time-password.cabal +122/−47
• src/Data/OTP.hs +0/−260
• src/OTP/Commons.hs +195/−0
• src/OTP/HOTP.hs +199/−0
• src/OTP/TOTP.hs +250/−0
• test/Test.hs +20/−73
• test/Test/Comparison.hs +120/−0
• test/Test/HOTP.hs +148/−0
• test/Test/Properties.hs +183/−0
• test/Test/TOTP.hs +104/−0
• test/Test/Utils.hs +12/−0

@@ -1,5 +1,12 @@ # CHANGELOG +## 3.0.0.0 — 13-04-2024++* The library has been transferred to the Haskell Cryptography Group's stewardship;+* Switch to use `sel` for the cryptography provider;+* Support for GHC from 9.4 to 9.8;+* See the `OTP.TOTP` and the test suite for example usage.+ ## 2.0.0 ### Changed * Change versioning to semver

@@ -1,4 +1,4 @@-Copyright (c) 2012 Artem Leshchev+Copyright (c) 2023 The Haskell Cryptography Group  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal

@@ -1,72 +1,19 @@-# What--One time password implementation according to RFC4226 and RFC6238 in-Haskell.--# Generation passwords--If you need to generate HOTP password described in RFC4226, then use--```haskell->>> hotp SHA1 "1234" 100 6-317569-->>> hotp SHA512 "1234" 100 6-134131-```--Or--```haskell->>> totp SHA1 "1234" (read "2010-10-10 00:01:00 UTC") 30 8-43388892-```--to generate TOTP password described in RFC6238.--# Checking passwords--```haskell-hotpCheck :: (HashAlgorithm a)-          => a                  -- ^ Hashing algorithm-          -> ByteString         -- ^ Shared secret-          -> (Word64, Word64)   -- ^ how much counters to take lower and higher than ideal-          -> Word64             -- ^ ideal (expected) counter value-          -> Word               -- ^ Number of digits in password-          -> Word32             -- ^ Password entered by user-          -> Bool               -- ^ True if password acceptable-```--```haskell->>> hotpCheck SHA1 "1234" (0,0) 10 6 50897-True-->>> hotpCheck SHA1 "1234" (0,0) 9 6 50897-False-->>> hotpCheck SHA1 "1234" (0,1) 9 6 50897-True-```--Here almost the same aguments as for `hotp` function, but there is-also `(0, 0)` tuple. This tuple describes range of counters to check-in case of desynchronisation of counters between client and-server. I.e. if you specify `(1, 1)` and ideal counter will be `10`-then function will check passwords for `[9, 10, 11]` list of-counters.--There is also some protection, so if you specify `(minBound,-maxBound)` then function will check just 1000 counters around ideal.+<h1 align="center">+  one-time-password+</h1> -Here is the same for TOTP:+<p align="center">+<a href="https://github.com/haskell-cryptography/one-time-password/actions">+  <img src="https://img.shields.io/github/actions/workflow/status/haskell-cryptography/one-time-password/one-time-password.yml?style=flat-square" alt="CI badge" />+</a>+<a href="https://hackage.haskell.org/package/one-time-password">+  <img src="https://img.shields.io/hackage/v/one-time-password?style=flat-square" alt="Hackage" />+</a>+</p> -```haskell->>> totpCheck SHA1 "1234" (0, 0) (read "2010-10-10 00:00:00 UTC") 30 6 778374-True+A One-Time Password (OTP) is a dynamic password used once in conjunction with an account's usual password, a for the purpose of two-factor authentication.  ->>> totpCheck SHA1 "1234" (0, 0) (read "2010-10-10 00:00:30 UTC") 30 6 778374-False+It can be based on a counter (HOTP) or a timestamp (TOTP). This module provides both methods. ->>> totpCheck SHA1 "1234" (1, 0) (read "2010-10-10 00:00:30 UTC") 30 6 778374-True-```+Mobile authenticator applications will typically require a TOTP secret. They are most commonly provided as QR codes to scan.+This library can generate a URI that can be used by a QR Code generator.

@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain

@@ -0,0 +1,355 @@+module Main (main) where++import Chronos (Time (..), Timespan (..), datetimeToTime, decode_YmdHMS, now, second, w3c)+import Data.ByteString (StrictByteString)+import qualified Data.ByteString.Char8 as BSC8+import Data.Maybe (fromJust)+import Data.Text (Text)+import Data.Text.Display+import qualified Data.Text.Encoding as TE+import qualified Data.Text.IO as TIO+import Data.Version (showVersion)+import Data.Word+import Options.Applicative+import Paths_one_time_password (version)+import Sel (secureMain)+import qualified Sel.HMAC.SHA256 as SHA256+import qualified Sel.HMAC.SHA512 as SHA512+import System.Exit (exitFailure)+import Torsor (scale)++import OTP.Commons+import OTP.HOTP+import OTP.TOTP++main :: IO ()+main =+  secureMain $ do+    now' <- now+    let parserInfo = info (cmdP now' <**> helper <**> simpleVersioner (showVersion version)) (progDesc "One time passwords (OTP) utilities" <> briefDesc)+    customExecParser (prefs showHelpOnEmpty) parserInfo >>= runCmd++type RawSharedSecret = StrictByteString++data Command+  = -- | Compute HMAC-Based One-Time Password using secret key and counter value.+    -- ^ Shared secret+    -- ^ Counter value+    -- ^ Number of digits in a password+    HotpMk Algorithm RawSharedSecret Word64 Digits+  | -- | Check presented password against a valid range.+    -- ^ Shared secret+    -- ^ Valid counter range, before and after ideal+    -- ^ Ideal (expected) counter value+    -- ^ Number of digits in a password+    -- ^ Password entered by user+    HotpCheck Algorithm RawSharedSecret (Word64, Word64) Word64 Digits Text+  | -- | Compute a Time-Based One-Time Password using secret key and time.+    -- ^ Shared secret+    -- ^ Time of TOTP+    -- ^ Time range in seconds+    -- ^ Number of digits in a password+    TotpMk Algorithm RawSharedSecret Time Timespan Digits+  | -- | Check presented password against time periods.+    -- ^ Shared secret+    -- ^ Valid counter range, before and after ideal+    -- ^ Time of TOTP+    -- ^ Time range in seconds+    -- ^ Numer of digits in a password+    -- ^ Password given by user+    TotpCheck Algorithm RawSharedSecret (Word64, Word64) Time Timespan Digits Text+  | -- | Create a URI suitable for authenticators.+    -- ^ Shared secret key. Must be encoded in base32.+    -- ^ Name of the account (usually an email address)+    -- ^ Issuer+    -- ^ Amount of digits expected from the end-user+    -- ^ Amount of time before the generated code expires+    -- ^ Algorithm required+    TotpMkUri Text Text Text Digits Timespan Algorithm+  | -- | Create an new random key to be used with the SHA-1 functions+    KeyGen Algorithm++cmdP :: Time -> Parser Command+cmdP now' =+  hsubparser+    ( command "hotp" (info hotpCmdP (progDesc "HOTP commands"))+        <> command "totp" (info totpCmdP (progDesc "TOTP commands"))+        <> command "key-gen" (info keyGenCmdP (progDesc "Generate keys"))+    )+  where+    hotpCmdP =+      hsubparser $+        command+          "make"+          (info hotpMakeP (progDesc "Compute HMAC-Based One-Time Password using secret key and counter value"))+          <> command+            "check"+            (info hotpCheckP (progDesc "Check presented password against a valid range"))++    totpCmdP =+      hsubparser $+        command+          "make"+          (info totpMakeP (progDesc "Compute a Time-Based One-Time Password using secret key and time"))+          <> command+            "check"+            (info totpCheckP (progDesc "Check presented password against time periods"))+          <> command+            "uri"+            (info totpUriP (progDesc "Create a URI suitable for authenticators"))++    hotpMakeP :: Parser Command+    hotpMakeP =+      HotpMk+        <$> algorithmP+        <*> rawSharedSecretP+        <*> counterP+        <*> digitsP++    hotpCheckP :: Parser Command+    hotpCheckP =+      HotpCheck+        <$> algorithmP+        <*> rawSharedSecretP+        <*> timeRangeP+        <*> counterP+        <*> digitsP+        <*> passwordP++    totpMakeP :: Parser Command+    totpMakeP =+      TotpMk+        <$> algorithmP+        <*> rawSharedSecretP+        <*> timeP+        <*> timespanP+        <*> digitsP+    totpCheckP :: Parser Command+    totpCheckP =+      TotpCheck+        <$> algorithmP+        <*> rawSharedSecretP+        <*> timeRangeP+        <*> timeP+        <*> timespanP+        <*> digitsP+        <*> passwordP+    totpUriP :: Parser Command+    totpUriP =+      TotpMkUri+        <$> base32RawSharedSecretP+        <*> accountNameP+        <*> issuerP+        <*> digitsP+        <*> timespanP+        <*> algorithmP++    keyGenCmdP :: Parser Command+    keyGenCmdP =+      KeyGen+        <$> algorithmP++    algorithmP :: Parser Algorithm+    algorithmP =+      option (maybeReader mkAlgorithm) $+        long "algorithm"+          <> short 'a'+          <> metavar "ALGORITHM"+          <> help "Hash algorithm (sha1, sha256, sha512)"+          <> value HMAC_SHA1+          <> showDefault+          <> completeWith ["sha1", "sha256", "sha512"]++    mkAlgorithm :: String -> Maybe Algorithm+    mkAlgorithm =+      \case+        "sha1" -> Just HMAC_SHA1+        "sha256" -> Just HMAC_SHA256+        "sha512" -> Just HMAC_SHA512+        _ -> Nothing++    rawSharedSecretP :: Parser RawSharedSecret+    rawSharedSecretP =+      option (BSC8.pack <$> str) $+        long "secret"+          <> short 's'+          <> metavar "SECRET"+          <> help "Shared secret"++    digitsP :: Parser Digits+    digitsP =+      option (auto >>= mkReaderFromMaybe "Invalid number of digits" . mkDigits) $+        long "digits"+          <> short 'd'+          <> metavar "DIGITS"+          <> help "Number of digits in a password (at least 6)"+          <> value (fromJust $ mkDigits 6)+          <> showDefault++    timespanP :: Parser Timespan+    timespanP =+      option (fmap (flip scale second) auto) $+        long "timespan"+          <> short 'n'+          <> metavar "TIMESPAN"+          <> help "Time range in seconds"+          <> value (scale 30 second)+          <> showDefault++    timeP :: Parser Time+    timeP =+      option (auto >>= mkReaderFromMaybe "Invalid time" . mkTime) $+        long "time"+          <> short 't'+          <> metavar "TIME"+          <> help "Time of TOTP (iso or 'now')"+          <> value now'+          <> showDefault++    mkTime :: Text -> Maybe Time+    mkTime =+      \case+        "now" -> Just now'+        x -> datetimeToTime <$> decode_YmdHMS w3c x++    counterP :: Parser Word64+    counterP =+      option auto $+        long "counter"+          <> short 'c'+          <> metavar "COUNTER"+          <> help "Ideal counter value"+          <> value 0+          <> showDefault++    timeRangeP :: Parser (Word64, Word64)+    timeRangeP = (,) <$> counterRangeLowP <*> counterRangeHighP+      where+        counterRangeLowP =+          option auto $+            long "counter-range-low"+              <> metavar "COUNTER_RANGE_LOW"+              <> help "Valid counter range, before specified counter"+              <> value 0+              <> showDefault++        counterRangeHighP =+          option auto $+            long "counter-range-high"+              <> metavar "COUNTER_RANGE_HIGH"+              <> help "Valid counter range, after specified counter"+              <> value 0+              <> showDefault++    passwordP :: Parser Text+    passwordP =+      option auto $+        long "password"+          <> short 'p'+          <> metavar "PASSWORD"+          <> help "Password"++    base32RawSharedSecretP :: Parser Text+    base32RawSharedSecretP =+      option str $+        long "secret"+          <> short 's'+          <> metavar "SECRET"+          <> help "Shared secret"++    accountNameP :: Parser Text+    accountNameP =+      option str $+        long "account-name"+          <> short 'a'+          <> metavar "ACCOUNT-NAME"+          <> help "Name of the account (usually an email address)"++    issuerP :: Parser Text+    issuerP =+      option str $+        long "issuer"+          <> short 'i'+          <> metavar "ISSUER"+          <> help "Issuer"++    mkReaderFromMaybe :: String -> Maybe a -> ReadM a+    mkReaderFromMaybe err = maybe (readerError err) return++-- Define the main parser for Command++runCmd :: Command -> IO ()+runCmd =+  \case+    HotpMk algorithm rawSecret counter digits' ->+      case algorithm of+        HMAC_SHA1 -> do+          secret <- read256Secret rawSecret+          displayOtp $ hotpSHA1 secret counter digits'+        HMAC_SHA256 -> do+          secret <- read256Secret rawSecret+          displayOtp $ hotpSHA256 secret counter digits'+        HMAC_SHA512 -> do+          secret <- read512Secret rawSecret+          displayOtp $ hotpSHA512 secret counter digits'+    HotpCheck algorithm rawSecret range counter digits' pass ->+      case algorithm of+        HMAC_SHA1 -> do+          secret <- read256Secret rawSecret+          displayCheckedOtp $ hotpSHA1Check secret range counter digits' pass+        HMAC_SHA256 -> do+          secret <- read256Secret rawSecret+          displayCheckedOtp $ hotpSHA256Check secret range counter digits' pass+        HMAC_SHA512 -> do+          secret <- read512Secret rawSecret+          displayCheckedOtp $ hotpSHA512Check secret range counter digits' pass+    TotpMk algorithm rawSecret time period digits' ->+      case algorithm of+        HMAC_SHA1 -> do+          secret <- read256Secret rawSecret+          displayOtp $ totpSHA1 secret time period digits'+        HMAC_SHA256 -> do+          secret <- read256Secret rawSecret+          displayOtp $ totpSHA256 secret time period digits'+        HMAC_SHA512 -> do+          secret <- read512Secret rawSecret+          displayOtp $ totpSHA512 secret time period digits'+    TotpCheck algorithm rawSecret range time period digits' pass ->+      case algorithm of+        HMAC_SHA1 -> do+          secret <- read256Secret rawSecret+          displayCheckedOtp $ totpSHA1Check secret range time period digits' pass+        HMAC_SHA256 -> do+          secret <- read256Secret rawSecret+          displayCheckedOtp $ totpSHA256Check secret range time period digits' pass+        HMAC_SHA512 -> do+          secret <- read512Secret rawSecret+          displayCheckedOtp $ totpSHA512Check secret range time period digits' pass+    TotpMkUri secret account issuer digits' period algorithm ->+      TIO.putStrLn $ totpToURI secret account issuer digits' period algorithm+    KeyGen algorithm ->+      case algorithm of+        HMAC_SHA1 ->+          TIO.putStrLn . TE.decodeUtf8 . SHA256.unsafeAuthenticationKeyToHexByteString =<< newSHA1Key+        HMAC_SHA256 ->+          TIO.putStrLn . TE.decodeUtf8 . SHA256.unsafeAuthenticationKeyToHexByteString =<< newSHA256Key+        HMAC_SHA512 ->+          TIO.putStrLn . TE.decodeUtf8 . SHA512.unsafeAuthenticationKeyToHexByteString =<< newSHA512Key+  where+    displayOtp :: OTP -> IO ()+    displayOtp = TIO.putStrLn . display+    displayCheckedOtp :: Bool -> IO ()+    displayCheckedOtp p =+      if p+        then putStrLn "Match"+        else putStrLn "don't match" >> exitFailure+    read256Secret :: RawSharedSecret -> IO SHA256.AuthenticationKey+    read256Secret rawSecret =+      case SHA256.authenticationKeyFromHexByteString rawSecret of+        Right secret -> return secret+        Left err -> TIO.putStrLn ("Cannot read secret: " <> err) >> exitFailure+    read512Secret :: RawSharedSecret -> IO SHA512.AuthenticationKey+    read512Secret rawSecret =+      case SHA512.authenticationKeyFromHexByteString rawSecret of+        Right secret -> return secret+        Left err -> TIO.putStrLn ("Cannot read secret: " <> err) >> exitFailure

@@ -1,56 +1,131 @@-name:                one-time-password-version:             2.0.0-synopsis:            HMAC-Based and Time-Based One-Time Passwords--description: Implements HMAC-Based One-Time Password Algorithm as-             defined in RFC 4226 and Time-Based One-Time Password-             Algorithm as defined in RFC 6238.+cabal-version:      3.4+name:               one-time-password+version:            3.0.0.0+synopsis:           HMAC-Based and Time-Based One-Time Passwords+description:+  Implements HMAC-Based One-Time Password Algorithm as+  defined in RFC 4226 and Time-Based One-Time Password+  Algorithm as defined in RFC 6238. -license:        MIT-license-file:   LICENSE-copyright:      (c) 2012 Artem Leshchev, 2016 Aleksey Uimanov-author:         Artem Leshchev, Aleksey Uimanov-maintainer:     s9gf4ult@gmail.com <Aleksey Uimanov>-homepage:       https://github.com/s9gf4ult/one-time-password-bug-reports:    https://github.com/s9gf4ult/one-time-password/issues-category:       Cryptography-build-type:     Simple-cabal-version:  >=1.10+license:            MIT+license-file:       LICENSE+copyright:          (c) 2023 The Haskell Cryptography Group+author:             Hécate Moonlight+maintainer:         The Haskell Cryptography Group contributors+homepage:           https://github.com/haskell-cryptography/one-time-password+bug-reports:+  https://github.com/haskell-cryptography/one-time-password/issues -extra-source-files: CHANGELOG.md-                  , README.md+category:           Cryptography+build-type:         Simple+extra-source-files: README.md+extra-doc-files:    CHANGELOG.md+tested-with:        GHC ==9.4.8 || ==9.6.4 || ==9.8.2  source-repository head   type:     git-  location: git://github.com/s9gf4ult/one-time-password.git+  location: git://github.com/haskell-cryptography/one-time-password.git +common ghc-options+  ghc-options:+    -Wall -Wcompat -Widentities -Wincomplete-record-updates+    -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints+    -fhide-source-paths -Wno-unused-do-bind -fshow-hole-constraints+    -Wno-unticked-promoted-constructors -Werror=unused-imports+    -fdicts-strict -fmax-worker-args=16 -fspec-constr-recursive=16+    -Wunused-packages++  default-language: GHC2021+ library-  default-language:  Haskell2010-  hs-source-dirs:    src-  default-extensions: OverloadedStrings-                    , ScopedTypeVariables-  exposed-modules:   Data.OTP-  build-depends:     base >= 3 && < 5-                   , bytestring-                   , cereal-                   , cryptonite-                   , memory-                   , time >= 1.1-  ghc-options: -Wall+  import:          ghc-options+  hs-source-dirs:  src +  -- cabal-fmt: expand src/+  exposed-modules:+    OTP.Commons+    OTP.HOTP+    OTP.TOTP++  build-depends:+    , base             >=4.17   && <5+    , bytestring       ^>=0.11+    , cereal           ^>=0.5+    , chronos          ^>=1.1.6+    , cryptohash-sha1  ^>=0.11+    , network-uri      ^>=2.6+    , sel              ^>=0.0+    , text             ^>=2.1+    , text-display     ^>=0.0++  ghc-options:     -Wall+ test-suite tests-  default-language: Haskell2010-  type:            exitcode-stdio-1.0-  hs-source-dirs:  test-  ghc-options: -Wall-  default-extensions: ExistentialQuantification-                    , OverloadedStrings-                    , RankNTypes-  main-is:         Test.hs-  build-depends:   base >= 3 && < 5-                 , bytestring-                 , cryptonite-                 , one-time-password-                 , tasty-                 , tasty-hunit-                 , time >= 1.1+  import:             ghc-options+  type:               exitcode-stdio-1.0+  hs-source-dirs:     test+  default-extensions: OverloadedStrings+  main-is:            Test.hs+  other-modules:+    Test.Comparison+    Test.HOTP+    Test.Properties+    Test.TOTP+    Test.Utils++  build-depends:+    , base               >=4.17 && <5+    , base16+    , base32             ^>=0.4+    , bytestring+    , chronos+    , cryptonite+    , one-time-password+    , sel+    , tasty+    , tasty-hunit+    , tasty-quickcheck+    , text+    , text-display+    , torsor++executable one-time-password+  import:             ghc-options+  main-is:            Main.hs+  hs-source-dirs:     app+  default-extensions:+    DataKinds+    DefaultSignatures+    DeriveAnyClass+    DeriveGeneric+    DerivingStrategies+    DerivingVia+    DuplicateRecordFields+    FlexibleContexts+    GADTs+    GeneralizedNewtypeDeriving+    KindSignatures+    LambdaCase+    OverloadedRecordDot+    OverloadedStrings+    RankNTypes+    RecordWildCards+    ScopedTypeVariables+    TypeApplications+    TypeFamilies+    TypeOperators++  build-depends:+    , base                  >=4.17 && <5+    , bytestring+    , chronos+    , one-time-password+    , optparse-applicative  >=0.15 && <0.19+    , sel+    , text+    , text-display+    , torsor                ^>=0.1++  other-modules:      Paths_one_time_password+  autogen-modules:      Paths_one_time_password+  ghc-options:        -Wall

@@ -1,260 +0,0 @@--- |Implements HMAC-Based One-Time Password Algorithm as defined in RFC 4226 and--- Time-Based One-Time Password Algorithm as defined in RFC 6238.-module Data.OTP-       ( -- * HOTP-         hotp-       , hotpCheck-         -- * TOTP-       , totp-       , totpCheck-         -- * Auxiliary-       , totpCounter-       , counterRange-       , totpCounterRange-       ) where--import Crypto.Hash-import Crypto.MAC.HMAC-import Data.Bits-import Data.ByteArray (unpack, ByteArrayAccess)-import Data.Serialize.Get-import Data.Serialize.Put-import Data.Time-import Data.Time.Clock.POSIX-import Data.Word--import qualified Data.ByteString as BS--{- | Compute HMAC-Based One-Time Password using secret key and counter value.-->>> hotp SHA1 "1234" 100 6-317569-->>> hotp SHA512 "1234" 100 6-134131-->>> hotp SHA512 "1234" 100 8-55134131---}--hotp-  :: forall a key-   . (HashAlgorithm a, ByteArrayAccess key)-  => a                       -- ^ Hashing algorithm from module "Crypto.Hash.IO"-  -> key                     -- ^ Shared secret-  -> Word64                  -- ^ Counter value-  -> Word                    -- ^ Number of digits in a password-  -> Word32                  -- ^ HOTP-hotp _ key cnt digits =-  let msg = runPut $ putWord64be cnt-      h :: HMAC a-      h = hmac key msg-      w = trunc $ unpack h-  in w `mod` (10 ^ digits)-  where-    trunc :: [Word8] -> Word32-    trunc b =-      let offset = last b .&. 15 -- take low 4 bits of last byte-          rb = BS.pack $ take 4 $ drop (fromIntegral offset) b -- resulting 4 byte value-      in case runGet getWord32be rb of-      Left e    -> error e-      Right res -> res .&. (0x80000000 - 1) -- reset highest bit--{- | Check presented password against a valid range.-->>> hotp SHA1 "1234" 10 6-50897-->>> hotpCheck SHA1 "1234" (0,0) 10 6 50897-True-->>> hotpCheck SHA1 "1234" (0,0) 9 6 50897-False-->>> hotpCheck SHA1 "1234" (0,1) 9 6 50897-True-->>> hotpCheck SHA1 "1234" (1,0) 11 6 50897-True-->>> hotpCheck SHA1 "1234" (2,2) 8 6 50897-True-->>> hotpCheck SHA1 "1234" (2,2) 7 6 50897-False-->>> hotpCheck SHA1 "1234" (2,2) 12 6 50897-True-->>> hotpCheck SHA1 "1234" (2,2) 13 6 50897-False---}--hotpCheck-  :: (HashAlgorithm a, ByteArrayAccess key)-  => a                  -- ^ Hashing algorithm-  -> key                -- ^ Shared secret-  -> (Word64, Word64)   -- ^ Valid counter range, before and after ideal-  -> Word64             -- ^ Ideal (expected) counter value-  -> Word               -- ^ Number of digits in a password-  -> Word32             -- ^ Password entered by user-  -> Bool               -- ^ True if password is valid-hotpCheck alg secr rng cnt len pass =-    let counters = counterRange rng cnt-        passwds = map (\c -> hotp alg secr c len) counters-    in any (pass ==) passwds--{- | Compute a Time-Based One-Time Password using secret key and time.-->>> totp SHA1 "1234" (read "2010-10-10 00:01:00 UTC") 30 6-388892-->>> totp SHA1 "1234" (read "2010-10-10 00:01:00 UTC") 30 8-43388892-->>> totp SHA1 "1234" (read "2010-10-10 00:01:15 UTC") 30 8-43388892-->>> totp SHA1 "1234" (read "2010-10-10 00:01:31 UTC") 30 8-39110359---}--totp-  :: (HashAlgorithm a, ByteArrayAccess key)-  => a         -- ^ Hash algorithm to use-  -> key       -- ^ Shared secret-  -> UTCTime   -- ^ Time of TOTP-  -> Word64    -- ^ Time range in seconds-  -> Word      -- ^ Number of digits in a password-  -> Word32    -- ^ TOTP-totp alg secr time period len =-    hotp alg secr (totpCounter time period) len--{- | Check presented password against time periods.-->>> totp SHA1 "1234" (read "2010-10-10 00:00:00 UTC") 30 6-778374-->>> totpCheck SHA1 "1234" (0, 0) (read "2010-10-10 00:00:00 UTC") 30 6 778374-True-->>> totpCheck SHA1 "1234" (0, 0) (read "2010-10-10 00:00:30 UTC") 30 6 778374-False-->>> totpCheck SHA1 "1234" (1, 0) (read "2010-10-10 00:00:30 UTC") 30 6 778374-True-->>> totpCheck SHA1 "1234" (1, 0) (read "2010-10-10 00:01:00 UTC") 30 6 778374-False-->>> totpCheck SHA1 "1234" (2, 0) (read "2010-10-10 00:01:00 UTC") 30 6 778374-True--}--totpCheck-  :: (HashAlgorithm a, ByteArrayAccess key)-  => a                  -- ^ Hashing algorithm-  -> key                -- ^ Shared secret-  -> (Word64, Word64)   -- ^ Valid counter range, before and after ideal-  -> UTCTime            -- ^ Time of TOTP-  -> Word64             -- ^ Time range in seconds-  -> Word               -- ^ Numer of digits in a password-  -> Word32             -- ^ Password given by user-  -> Bool               -- ^ True if password is valid-totpCheck alg secr rng time period len pass =-    let counters = totpCounterRange rng time period-        passwds = map (\c -> hotp alg secr c len) counters-    in any (pass ==) passwds---{- | Calculate HOTP counter using time. Starting time (T0-according to RFC6238) is 0 (begining of UNIX epoch)-->>> totpCounter (read "2010-10-10 00:00:00 UTC") 30-42888960-->>> totpCounter (read "2010-10-10 00:00:30 UTC") 30-42888961-->>> totpCounter (read "2010-10-10 00:01:00 UTC") 30-42888962---}--totpCounter-  :: UTCTime     -- ^ Time of totp-  -> Word64      -- ^ Time range in seconds-  -> Word64      -- ^ Resulting counter-totpCounter time period =-    let timePOSIX = floor $ utcTimeToPOSIXSeconds time-    in timePOSIX `div` period--{- | Make a sequence of acceptable counters, protected from-arithmetic overflow. Maximum range is limited to 1000 due to huge-counter ranges being insecure.-->>> counterRange (0, 0) 9000-[9000]-->>> counterRange (1, 0) 9000-[8999,9000]-->>> length $ counterRange (5000, 0) 9000-501-->>> length $ counterRange (5000, 5000) 9000-1000-->>> counterRange (2, 2) maxBound-[18446744073709551613,18446744073709551614,18446744073709551615]-->>> counterRange (2, 2) minBound-[0,1,2]-->>> counterRange (2, 2) (maxBound `div` 2)-[9223372036854775805,9223372036854775806,9223372036854775807,9223372036854775808,9223372036854775809]-->>> counterRange (5, 5) 9000-[8995,8996,8997,8998,8999,9000,9001,9002,9003,9004,9005]--RFC recommends avoiding excessively large values for counter ranges.--}--counterRange-  :: (Word64, Word64) -- ^ Number of counters before and after ideal-  -> Word64           -- ^ Ideal counter value-  -> [Word64]-counterRange (tolow', tohigh') ideal =-    let tolow = min 500 tolow'-        tohigh = min 499 tohigh'-        l = trim 0 ideal (ideal - tolow)-        h = trim ideal maxBound (ideal + tohigh)-    in [l..h]-  where-    trim l h = max l . min h--{- | Make a sequence of acceptable periods.-->>> totpCounterRange (0, 0) (read "2010-10-10 00:01:00 UTC") 30-[42888962]-->>> totpCounterRange (2, 0) (read "2010-10-10 00:01:00 UTC") 30-[42888960,42888961,42888962]-->>> totpCounterRange (0, 2) (read "2010-10-10 00:01:00 UTC") 30-[42888962,42888963,42888964]-->>> totpCounterRange (2, 2) (read "2010-10-10 00:01:00 UTC") 30-[42888960,42888961,42888962,42888963,42888964]---}--totpCounterRange :: (Word64, Word64)-                 -> UTCTime-                 -> Word64-                 -> [Word64]-totpCounterRange rng time period =-    counterRange rng $ totpCounter time period

@@ -0,0 +1,195 @@+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE OverloadedStrings #-}++module OTP.Commons+  ( -- * Auxiliary+    OTP (..)+  , Digits+  , Algorithm (..)+  , mkDigits+  , digitsToWord32+  , totpCounter+  , counterRange+  , totpCounterRange+  ) where++import Chronos (Time (..), Timespan (..), asSeconds, sinceEpoch)+import Data.Int (Int64)+import Data.Text.Display+import Data.Text.Lazy.Builder (Builder)+import Data.Text.Lazy.Builder qualified as Text+import Data.Word+import Text.Printf (printf)++-- $setup+-- >>> import Chronos qualified+-- >>> import Chronos (DatetimeFormat(..))+-- >>> import Torsor qualified+-- >>> import Data.Maybe (fromJust)+-- >>> :set -XOverloadedStrings+-- >>> let format = DatetimeFormat (Just '-') (Just ' ') (Just ':')+-- >>> let decode txt = Chronos.datetimeToTime $ fromJust $ Chronos.decode_YmdHMS format txt++-- |+--+-- @since 3.0.0.0+data Algorithm+  = HMAC_SHA1+  | HMAC_SHA256+  | HMAC_SHA512+  deriving stock+    ( Eq+      -- ^ @since 3.0.0.0+    , Ord+      -- ^ @since 3.0.0.0+    , Show+      -- ^ @since 3.0.0.0+    )++-- |+--+-- @since 3.0.0.0+instance Display Algorithm where+  displayBuilder HMAC_SHA1 = "SHA1"+  displayBuilder HMAC_SHA256 = "SHA256"+  displayBuilder HMAC_SHA512 = "SHA512"++-- |+--+-- @since 3.0.0.0+data OTP = OTP+  { digits :: Word32+  , code :: Word32+  }+  deriving stock+    ( Eq+      -- ^ @since 3.0.0.0+    , Ord+      -- ^ @since 3.0.0.0+    , Show+      -- ^ @since 3.0.0.0+    )++-- |+--+-- @since 3.0.0.0+instance Display OTP where+  displayBuilder OTP{digits, code} = displayWord32AsOTP digits code++displayWord32AsOTP :: Word32 -> Word32 -> Builder+displayWord32AsOTP digits code = Text.fromString $ printf ("%0" <> show digits <> "u") code++-- |+--+-- @since 3.0.0.0+newtype Digits = Digits Word32+  deriving newtype (Eq, Show, Ord)+  deriving+    (Display)+    via ShowInstance Digits++digitsToWord32 :: Digits -> Word32+digitsToWord32 (Digits digits) = digits++-- |+--+-- RFC 4226 §5.3 says "Implementations MUST extract a 6-digit code at a minimum and possibly 7 and 8-digit code".+--+-- This function validates that the number of desired digits is equal or greater than 6.+mkDigits+  :: Word32+  -> Maybe Digits+mkDigits userDigits+  | userDigits >= 6 = Just (Digits userDigits)+  | otherwise = Nothing++-- | Calculate HOTP counter using time. Starting time (T0+-- according to RFC6238) is 0 (begining of UNIX epoch)+-- >>> let timestamp = decode "2010-10-10 00:00:30"+-- >>> let timespan = Torsor.scale 30 Chronos.second+-- >>> totpCounter timestamp timespan+-- 42888961+--+-- >>> let timestamp2 = decode "2010-10-10 00:00:45"+-- >>> totpCounter timestamp2 timespan+-- 42888961+--+-- >>> let timestamp3 = decode "2010-10-10 00:01:00"+-- >>> totpCounter timestamp3 timespan+-- 42888962+--+-- @since 3.0.0.0+totpCounter+  :: Time+  -- ^ Time of totp+  -> Timespan+  -- ^ Time range in seconds+  -> Word64+  -- ^ Resulting counter+totpCounter time period =+  ts2word (asSeconds (sinceEpoch time)) `quot` ts2word (asSeconds period)+  where+    ts2word :: Int64 -> Word64+    ts2word = fromIntegral++-- | Make a sequence of acceptable counters, protected from+-- arithmetic overflow. Maximum range is limited to 1000 due to huge+-- counter ranges being insecure.+--+-- >>> counterRange (0, 0) 9000+-- [9000]+--+-- >>> counterRange (1, 0) 9000+-- [8999,9000]+--+-- >>> length $ counterRange (5000, 0) 9000+-- 501+--+-- >>> length $ counterRange (5000, 5000) 9000+-- 1000+--+-- >>> counterRange (2, 2) maxBound+-- [18446744073709551613,18446744073709551614,18446744073709551615]+--+-- >>> counterRange (2, 2) minBound+-- [0,1,2]+--+-- >>> counterRange (2, 2) (maxBound `div` 2)+-- [9223372036854775805,9223372036854775806,9223372036854775807,9223372036854775808,9223372036854775809]+--+-- >>> counterRange (5, 5) 9000+-- [8995,8996,8997,8998,8999,9000,9001,9002,9003,9004,9005]+--+-- RFC recommends avoiding excessively large values for counter ranges.+--+-- @since 3.0.0.0+counterRange+  :: (Word64, Word64)+  -- ^ Number of counters before and after ideal+  -> Word64+  -- ^ Ideal counter value+  -> [Word64]+counterRange (tolow', tohigh') ideal =+  let tolow = min 500 tolow'+      tohigh = min 499 tohigh'+      l = trim 0 ideal (ideal - tolow)+      h = trim ideal maxBound (ideal + tohigh)+   in [l .. h]+  where+    trim l h = max l . min h++-- | Make a sequence of acceptable periods.+--+-- >>> let time = decode "2010-10-10 00:00:30"+-- >>> let timespan = Torsor.scale 30 Chronos.second+-- >>> totpCounterRange (1, 1) time timespan+-- [42888960,42888961,42888962]+--+-- @since 3.0.0.0+totpCounterRange+  :: (Word64, Word64)+  -> Time+  -> Timespan+  -> [Word64]+totpCounterRange range time period =+  counterRange range $ totpCounter time period

@@ -0,0 +1,199 @@+module OTP.HOTP+  ( OTP++    -- ** HMAC-SHA-1+  , newSHA1Key+  , hotpSHA1+  , hotpSHA1Check++    -- ** HMAC-SHA-256+  , newSHA256Key+  , hotpSHA256+  , hotpSHA256Check++    -- ** HMAC-SHA-512+  , newSHA512Key+  , hotpSHA512+  , hotpSHA512Check+  ) where++import Crypto.Hash.SHA1 qualified as SHA1+import Data.Bits+import Data.ByteString qualified as BS+import Data.List qualified as List+import Data.Serialize.Put+import Data.Text (Text)+import Data.Text.Display+import Data.Word+import Sel.HMAC.SHA256 qualified as SHA256+import Sel.HMAC.SHA512 qualified as SHA512+import System.IO.Unsafe (unsafePerformIO)++import OTP.Commons++-- ** HMAC-SHA-1++-- | Create an new random key to be used with the SHA-1 functions+--+-- @since 3.0.0.0+newSHA1Key :: IO SHA256.AuthenticationKey+newSHA1Key = SHA256.newAuthenticationKey++-- | Compute HMAC-Based One-Time Password using secret key and counter value.+--+-- @since 3.0.0.0+hotpSHA1+  :: SHA256.AuthenticationKey+  -- ^ Shared secret+  -> Word64+  -- ^ Counter value+  -> Digits+  -- ^ Number of digits in a password. MUST be 6 digits at a minimum, and possibly 7 and 8 digits.+  -> OTP+  -- ^ HOTP+hotpSHA1 authenticationKey counter digits' = unsafePerformIO $ do+  let digits = digitsToWord32 digits'+  let msg = runPut $ putWord64be counter+  let key = SHA256.unsafeAuthenticationKeyToBinary authenticationKey+  let hash = SHA1.hmac key msg+  let code = truncateHash $ BS.unpack hash+  let result = code `rem` (10 ^ digits)+  pure $ OTP digits result++-- | Check presented password against a valid range.+--+-- @since 3.0.0.0+hotpSHA1Check+  :: SHA256.AuthenticationKey+  -- ^ Shared secret+  -> (Word64, Word64)+  -- ^ Valid counter range, before and after ideal+  -> Word64+  -- ^ Ideal (expected) counter value+  -> Digits+  -- ^ Number of digits provided+  -> Text+  -- ^ Digits entered by user+  -> Bool+  -- ^ True if password is valid+hotpSHA1Check secret range counter digits pass =+  let counters = counterRange range counter+      passwords = fmap (\c -> display $ hotpSHA1 secret c digits) counters+   in elem pass passwords++-- ** HMAC-SHA-256++-- | Create an new random key to be used with the SHA256 functions+--+-- @since 3.0.0.0+newSHA256Key :: IO SHA256.AuthenticationKey+newSHA256Key = SHA256.newAuthenticationKey++-- | Compute HMAC-Based One-Time Password using secret key and counter value.+--+-- @since 3.0.0.0+hotpSHA256+  :: SHA256.AuthenticationKey+  -- ^ Shared secret+  -> Word64+  -- ^ Counter value+  -> Digits+  -- ^ Number of digits in a password. MUST be 6 digits at a minimum, and possibly 7 and 8 digits.+  -> OTP+  -- ^ HOTP+hotpSHA256 key counter digits' = unsafePerformIO $ do+  let digits = digitsToWord32 digits'+  let msg = runPut $ putWord64be counter+  hash <- SHA256.authenticationTagToBinary <$> SHA256.authenticate msg key+  let code = truncateHash $ BS.unpack hash+  let result = code `rem` (10 ^ digits)+  pure $ OTP digits result++-- | Check presented password against a valid range.+--+-- @since 3.0.0.0+hotpSHA256Check+  :: SHA256.AuthenticationKey+  -- ^ Shared secret+  -> (Word64, Word64)+  -- ^ Valid counter range, before and after ideal+  -> Word64+  -- ^ Ideal (expected) counter value+  -> Digits+  -- ^ Number of digits provided+  -> Text+  -- ^ Digits entered by user+  -> Bool+  -- ^ True if password is valid+hotpSHA256Check secret range counter digits pass =+  let counters = counterRange range counter+      passwords = fmap (\c -> display $ hotpSHA256 secret c digits) counters+   in elem pass passwords++-- ** HMAC-SHA-256++-- | Create an new random key to be used with the SHA512 functions+--+-- @since 3.0.0.0+newSHA512Key :: IO SHA512.AuthenticationKey+newSHA512Key = SHA512.newAuthenticationKey++-- | Compute HMAC-Based One-Time Password using secret key and counter value.+--+-- @since 3.0.0.0+hotpSHA512+  :: SHA512.AuthenticationKey+  -- ^ Shared secret+  -> Word64+  -- ^ Counter value+  -> Digits+  -- ^ Number of digits in a password+  -> OTP+  -- ^ HOTP+hotpSHA512 key counter digits' = unsafePerformIO $ do+  let digits = digitsToWord32 digits'+  let msg = runPut $ putWord64be counter+  hash <- SHA512.authenticationTagToBinary <$> SHA512.authenticate msg key+  let code = truncateHash $ BS.unpack hash+  let result = code `rem` (10 ^ digits)+  pure $ OTP digits result++-- |+--+-- @since 3.0.0.0+hotpSHA512Check+  :: SHA512.AuthenticationKey+  -- ^ Shared secret+  -> (Word64, Word64)+  -- ^ Valid counter range, before and after ideal+  -> Word64+  -- ^ Ideal (expected) counter value+  -> Digits+  -- ^ Number of digits in a password+  -> Text+  -- ^ Password entered by user+  -> Bool+  -- ^ True if password is valid+hotpSHA512Check secret range counter digits pass =+  let counters = counterRange range counter+      passwords = fmap (\c -> display $ hotpSHA512 secret c digits) counters+   in elem pass passwords++-- | Take a hash and truncate it to its low 4 bits of the last byte.+--+-- >>> truncateHash [32,34,234,40,232, 123, 253, 20, 4]+-- 1752956180+--+-- @since 3.0.0.0+truncateHash :: [Word8] -> Word32+truncateHash b =+  let to32 = fromIntegral @Word8 @Word32+      offset = List.last b .&. 0xF+      code = case List.take 4 $ List.drop (fromIntegral offset) b of -- resulting 4 byte value+        [b0, b1, b2, b3] ->+          ((to32 b0 .&. 0x7F) .<<. 24)+            .|. ((to32 b1 .&. 0xFF) .<<. 16)+            .|. ((to32 b2 .&. 0xFF) .<<. 8)+            .|. (to32 b3 .&. 0xFF)+        _ -> error "The impossible happened"+   in code .&. 0x7FFFFFFF -- clear the highest bit

@@ -0,0 +1,250 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Time-based One-Time Passwords (TOTP) with the HMAC-SHA-1, HMAC-SHA-256 and HMAC-SHA-512 algorithms.+--+-- They are single-use codes used for <https://en.wikipedia.org/wiki/Multi-factor_authentication 2-Factor Authentication>.+module OTP.TOTP+  ( -- ** Usage+    -- $usage+    OTP++    -- ** HMAC-SHA-1+  , newSHA1Key+  , totpSHA1+  , totpSHA1Check++    -- ** HMAC-SHA-256+  , newSHA256Key+  , totpSHA256+  , totpSHA256Check++    -- ** HMAC-SHA-512+  , newSHA512Key+  , totpSHA512+  , totpSHA512Check++    -- ** URI Generation+  , totpToURI+  ) where++import Chronos (Time (..), Timespan (..), asSeconds)+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Text.Display (display)+import Data.Word (Word64)+import Network.URI (escapeURIString, isUnescapedInURI)+import Sel.HMAC.SHA256 qualified as SHA256+import Sel.HMAC.SHA512 qualified as SHA512++import OTP.Commons+  ( Algorithm+  , Digits+  , OTP+  , totpCounter+  , totpCounterRange+  )+import OTP.HOTP+  ( hotpSHA1+  , hotpSHA256+  , hotpSHA512+  , newSHA1Key+  , newSHA256Key+  , newSHA512Key+  )++-- $usage+--+-- > import Chronos (Timespan, now, second)+-- > import Data.ByteString.Base32 qualified as Base32+-- > import Data.Maybe (fromJust)+-- > import Data.Text (Text)+-- > import OTP.Commons+-- > import OTP.TOTP+-- > import Sel.HMAC.SHA256 qualified as HMAC+-- > import Torsor (scale)+-- >+-- > period :: Timespan+-- > period = scale 30 second+-- >+-- > sixDigits :: Digits+-- > sixDigits = fromJust $ mkDigits 6+-- >+-- > uriFromKey :: Text -> Text -> HMAC.AuthenticationKey -> Text+-- > uriFromKey domain email key =+-- >  let+-- >    issuer = "your-domain"+-- >   in+-- >    totpToURI+-- >      (Base32.encodeBase32Unpadded $ HMAC.unsafeAuthenticationKeyToBinary key)+-- >      email+-- >      issuer+-- >      sixDigits+-- >      period+-- >      HMAC_SHA1+-- >+-- > validateTOTP :: HMAC.AuthenticationKey -> Text -> IO Bool+-- > validateTOTP key code = do+-- >  timestamp <- now+-- >  pure $+-- >    totpSHA1Check+-- >      key+-- >      (1, 1)+-- >      timestamp+-- >      period+-- >      sixDigits+-- >      code++-- | Compute a Time-based One-Time Password using secret key and time.+--+-- @since 3.0.0.0+totpSHA1+  :: SHA256.AuthenticationKey+  -- ^ Shared secret+  -> Time+  -- ^ Time of TOTP+  -> Timespan+  -- ^ Time range in seconds+  -> Digits+  -- ^ Number of digits in a password+  -> OTP+  -- ^ TOTP+totpSHA1 secret time period = hotpSHA1 secret (totpCounter time period)++-- | Compute a Time-based One-Time Password using secret key and time.+--+-- @since 3.0.0.0+totpSHA256+  :: SHA256.AuthenticationKey+  -- ^ Shared secret+  -> Time+  -- ^ Time of TOTP+  -> Timespan+  -- ^ Time range in seconds+  -> Digits+  -- ^ Number of digits in a password+  -> OTP+  -- ^ TOTP+totpSHA256 secret time period = hotpSHA256 secret (totpCounter time period)++-- | Compute a Time-based One-Time Password using secret key and time.+--+-- @since 3.0.0.0+totpSHA512+  :: SHA512.AuthenticationKey+  -- ^ Shared secret+  -> Time+  -- ^ Time of TOTP+  -> Timespan+  -- ^ Time range in seconds+  -> Digits+  -- ^ Number of digits in a password+  -> OTP+  -- ^ TOTP+totpSHA512 secret time period = hotpSHA512 secret (totpCounter time period)++-- | Check presented password against time periods.+--+-- @since 3.0.0.0+totpSHA1Check+  :: SHA256.AuthenticationKey+  -- ^ Shared secret+  -> (Word64, Word64)+  -- ^ Valid counter range, before and after ideal+  -> Time+  -- ^ Time of TOTP+  -> Timespan+  -- ^ Time range in seconds+  -> Digits+  -- ^ Numer of digits in a password+  -> Text+  -- ^ Password given by user+  -> Bool+  -- ^ True if password is valid+totpSHA1Check secret range time period digits pass =+  let counters = totpCounterRange range time period+      passwords = fmap (\c -> display $ hotpSHA1 secret c digits) counters+   in elem pass passwords++-- | Check presented password against time periods.+--+-- @since 3.0.0.0+totpSHA256Check+  :: SHA256.AuthenticationKey+  -- ^ Shared secret+  -> (Word64, Word64)+  -- ^ Valid counter range, before and after ideal+  -> Time+  -- ^ Time of TOTP+  -> Timespan+  -- ^ Time range in seconds+  -> Digits+  -- ^ Numer of digits in a password+  -> Text+  -- ^ Password given by user+  -> Bool+  -- ^ True if password is valid+totpSHA256Check secret range time period digits pass =+  let counters = totpCounterRange range time period+      passwords = fmap (\c -> display $ hotpSHA256 secret c digits) counters+   in elem pass passwords++-- | Check presented password against time periods.+--+-- @since 3.0.0.0+totpSHA512Check+  :: SHA512.AuthenticationKey+  -- ^ Shared secret+  -> (Word64, Word64)+  -- ^ Valid counter range, before and after ideal+  -> Time+  -- ^ Time of TOTP+  -> Timespan+  -- ^ Time range in seconds+  -> Digits+  -- ^ Numer of digits in a password+  -> Text+  -- ^ Password given by user+  -> Bool+  -- ^ True if password is valid+totpSHA512Check secret range time period digits pass =+  let counters = totpCounterRange range time period+      passwords = fmap (\c -> display $ hotpSHA512 secret c digits) counters+   in elem pass passwords++-- | Create a URI suitable for authenticators.+--+-- The result of this function is best given to a QR Code generator for end-users to scan.+--+-- @since 3.0.0.0+totpToURI+  :: Text+  -- ^ Shared secret key. Must be encoded in base32.+  -> Text+  -- ^ Name of the account (usually an email address)+  -> Text+  -- ^ Issuer+  -> Digits+  -- ^ Amount of digits expected from the end-user+  -> Timespan+  -- ^ Amount of time before the generated code expires+  -> Algorithm+  -- ^ Algorithm required+  -> Text+totpToURI secret account issuer digits period algorithm =+  Text.pack $+    escapeURIString isUnescapedInURI $+      Text.unpack $+        "otpauth://totp/"+          <> issuer+          <> ":"+          <> account+          <> "?secret="+          <> secret+          <> "&issuer="+          <> issuer+          <> "&digits="+          <> display digits+          <> "&algorithm="+          <> display algorithm+          <> "&period="+          <> display (asSeconds period)

@@ -1,79 +1,26 @@ module Main where -import Crypto.Hash-import Data.ByteString  (ByteString)-import Data.OTP-import Data.Time-import Data.Word+import Sel import Test.Tasty-import Test.Tasty.HUnit--import qualified Data.ByteString.Char8 as BC--hotpSecret :: ByteString-hotpSecret = "12345678901234567890"--testHotp :: Word64 -> Word32 -> TestTree-testHotp key result = testCase (show result) $ do-    let h = hotp SHA1 hotpSecret key 6-    result @=? h--hotpResults :: [Word32]-hotpResults =-    [ 755224, 287082, 359152-    , 969429, 338314, 254676-    , 287922, 162583, 399871-    , 520489-    ]---data SomeAlg = forall a. (HashAlgorithm a, Show a) => SomeAlg a--instance Show SomeAlg where-    show (SomeAlg a) = show a---testTotp :: (ByteString, UTCTime, SomeAlg, Word32) -> TestTree-testTotp (secr, key, alg', result) =-    testCase (show alg' ++ " => " ++ show result) $ case alg' of-        SomeAlg alg -> do-            let t = totp alg secr key 30 8-            result @=? t--sha1Secr :: ByteString-sha1Secr   = BC.pack $ take 20 $ cycle "12345678901234567890"--sha256Secr :: ByteString-sha256Secr = BC.pack $ take 32 $ cycle "12345678901234567890"--sha512Secr :: ByteString-sha512Secr = BC.pack $ take 64 $ cycle "12345678901234567890"--totpData :: [(ByteString, UTCTime, SomeAlg, Word32)]-totpData =-    [ (sha1Secr,   read "1970-01-01 00:00:59 UTC", SomeAlg SHA1,   94287082)-    , (sha256Secr, read "1970-01-01 00:00:59 UTC", SomeAlg SHA256, 46119246)-    , (sha512Secr, read "1970-01-01 00:00:59 UTC", SomeAlg SHA512, 90693936)-    , (sha1Secr,   read "2005-03-18 01:58:29 UTC", SomeAlg SHA1,   07081804)-    , (sha256Secr, read "2005-03-18 01:58:29 UTC", SomeAlg SHA256, 68084774)-    , (sha512Secr, read "2005-03-18 01:58:29 UTC", SomeAlg SHA512, 25091201)-    , (sha1Secr,   read "2005-03-18 01:58:31 UTC", SomeAlg SHA1,   14050471)-    , (sha256Secr, read "2005-03-18 01:58:31 UTC", SomeAlg SHA256, 67062674)-    , (sha512Secr, read "2005-03-18 01:58:31 UTC", SomeAlg SHA512, 99943326)-    , (sha1Secr,   read "2009-02-13 23:31:30 UTC", SomeAlg SHA1,   89005924)-    , (sha256Secr, read "2009-02-13 23:31:30 UTC", SomeAlg SHA256, 91819424)-    , (sha512Secr, read "2009-02-13 23:31:30 UTC", SomeAlg SHA512, 93441116)-    , (sha1Secr,   read "2033-05-18 03:33:20 UTC", SomeAlg SHA1,   69279037)-    , (sha256Secr, read "2033-05-18 03:33:20 UTC", SomeAlg SHA256, 90698825)-    , (sha512Secr, read "2033-05-18 03:33:20 UTC", SomeAlg SHA512, 38618901)-    , (sha1Secr,   read "2603-10-11 11:33:20 UTC", SomeAlg SHA1,   65353130)-    , (sha256Secr, read "2603-10-11 11:33:20 UTC", SomeAlg SHA256, 77737706)-    , (sha512Secr, read "2603-10-11 11:33:20 UTC", SomeAlg SHA512, 47863826)-    ]+import Test.Tasty.QuickCheck (QuickCheckTests) +import Test.Comparison qualified as Comparison+import Test.HOTP qualified as HOTP+import Test.Properties qualified as Properties+import Test.TOTP qualified as TOTP  main :: IO ()-main = defaultMain $ testGroup "test vectors"-    [ testGroup "hotp" $ map (uncurry testHotp) $ zip [0..] hotpResults-    , testGroup "totp" $ map testTotp totpData-    ]+main =+  secureMain $+    defaultMain $+      adjustOption moreTests $+        testGroup+          "one-time-password tests"+          [ HOTP.spec+          , TOTP.spec+          , Properties.spec+          , Comparison.spec+          ]++moreTests :: QuickCheckTests -> QuickCheckTests+moreTests = max 10_000

@@ -0,0 +1,120 @@+{-# LANGUAGE OverloadedRecordDot #-}++module Test.Comparison where++import Chronos qualified+import Data.Base16.Types qualified as Base+import Data.ByteString.Base16 qualified as Base+import Sel.HMAC.SHA256 qualified as SHA256+import Test.Tasty+import Test.Tasty.HUnit++import Chronos (Time (..))+import Crypto.Hash.Algorithms qualified as Crypton+import Crypto.OTP qualified as Crypton+import Data.ByteString (StrictByteString)+import Data.Int (Int64)+import Data.Text.Display+import Data.Word (Word64)+import OTP.Commons+import OTP.TOTP qualified as TOTP+import Sel.HMAC.SHA512 qualified as SHA512+import Test.Utils+import Torsor++spec :: TestTree+spec =+  testGroup+    "Comparing outputs of other implementations"+    [ testGroup+        "Crypton"+        [ testCase "HMAC-SHA1 TOTP" testCryptonSHA1TOTP+        , testCase "HMAC-SH256 TOTP" testCryptonSHA256TOTP+        , testCase "HMAC-SH512 TOTP" testCryptonSHA512TOTP+        ]+    ]++testCryptonSHA1TOTP :: Assertion+testCryptonSHA1TOTP = do+  let hexKey = "e90cbae2d7d187f614806347cfd75002bd0db847451109599da507e8da88bf43"+  key <- assertRight $ SHA256.authenticationKeyFromHexByteString hexKey+  let cryptoniteKey = Base.decodeBase16 $ Base.assertBase16 @StrictByteString hexKey+  timestamp@(Time ns) <- Chronos.now+  let seconds = ns `quot` (10 ^ (9 :: Int64))+  let timeStep = scale 30 Chronos.second+  digits <- assertJust $ mkDigits 6++  let cryptoniteTOTP =+        Crypton.totp+          Crypton.defaultTOTPParams+          cryptoniteKey+          (fromIntegral @Int64 @Word64 seconds)++  let ownTotp = TOTP.totpSHA1 key timestamp timeStep digits++  assertEqual+    "OTPs are the same"+    (display ownTotp.code)+    (display cryptoniteTOTP)++testCryptonSHA256TOTP :: Assertion+testCryptonSHA256TOTP = do+  let hexKey = "e90cbae2d7d187f614806347cfd75002bd0db847451109599da507e8da88bf43"+  key <- assertRight $ SHA256.authenticationKeyFromHexByteString hexKey+  let cryptonKey = Base.decodeBase16 $ Base.assertBase16 @StrictByteString hexKey+  timestamp@(Time ns) <- Chronos.now+  let seconds = ns `quot` (10 ^ (9 :: Int64))+  let timeStep = scale 30 Chronos.second+  digits <- assertJust $ mkDigits 6+  totpParams <-+    assertRight $+      Crypton.mkTOTPParams+        Crypton.SHA256+        0+        30+        Crypton.OTP6+        Crypton.TwoSteps++  let cryptoniteTOTP =+        Crypton.totp+          totpParams+          cryptonKey+          (fromIntegral @Int64 @Word64 seconds)++  let ownTotp = TOTP.totpSHA256 key timestamp timeStep digits++  assertEqual+    "OTPs are the same"+    (display ownTotp.code)+    (display cryptoniteTOTP)++testCryptonSHA512TOTP :: Assertion+testCryptonSHA512TOTP = do+  let hexKey = "e90cbae2d7d187f614806347cfd75002bd0db847451109599da507e8da88bf43"+  key <- assertRight $ SHA512.authenticationKeyFromHexByteString hexKey+  let cryptonKey = Base.decodeBase16 $ Base.assertBase16 @StrictByteString hexKey+  timestamp@(Time ns) <- Chronos.now+  let seconds = ns `quot` (10 ^ (9 :: Int64))+  let timeStep = scale 30 Chronos.second+  digits <- assertJust $ mkDigits 6+  totpParams <-+    assertRight $+      Crypton.mkTOTPParams+        Crypton.SHA512+        0+        30+        Crypton.OTP6+        Crypton.TwoSteps++  let cryptoniteTOTP =+        Crypton.totp+          totpParams+          cryptonKey+          (fromIntegral @Int64 @Word64 seconds)++  let ownTotp = TOTP.totpSHA512 key timestamp timeStep digits++  assertEqual+    "OTPs are the same"+    (display ownTotp.code)+    (display cryptoniteTOTP)

@@ -0,0 +1,148 @@+{-# LANGUAGE DataKinds #-}++module Test.HOTP where++import Data.Foldable (forM_)+import Data.Text.Display+import OTP.HOTP+import Sel.HMAC.SHA256 qualified as SHA256+import Sel.HMAC.SHA512 qualified as SHA512++import Data.Text qualified as Text+import OTP.Commons+import Test.Tasty+import Test.Tasty.HUnit+import Test.Utils++spec :: TestTree+spec =+  testGroup+    "HOTP"+    [ testGroup+        "HMAC-SHA-1"+        [ testCase "Expected codes" testExpectedHotpSHA1Codes+        , testCase "Validate code" testValidateHotpSHA1+        ]+    , testGroup+        "HMAC-SHA-256"+        [ testCase "Expected codes" testExpectedHotpSHA256Codes+        , testCase "Validate code" testValidateHotpSHA256+        ]+    , testGroup+        "HMAC-SHA-512"+        [ testCase "Expected codes" testExpectedHOTP512Codes+        , testCase "Validate code" testValidateHOTP512+        ]+    ]++testExpectedHotpSHA1Codes :: Assertion+testExpectedHotpSHA1Codes = do+  digits <- assertJust $ mkDigits 6+  key <- assertRight $ SHA256.authenticationKeyFromHexByteString "e90cbae2d7d187f614806347cfd75002bd0db847451109599da507e8da88bf43"+  let counters = [0 .. 10]+  let results = fmap (\counter -> display $ hotpSHA1 key counter digits) counters+  assertEqual+    "HMAC-SHA1 Codes are expected and stable"+    [ "023113"+    , "181354"+    , "151026"+    , "300498"+    , "479326"+    , "661773"+    , "464666"+    , "430540"+    , "941671"+    , "303579"+    , "027354"+    ]+    results++  forM_ results $ \code ->+    assertBool+      ("Code " <> show code <> " is not 6 characters long")+      (Text.length (display code) == 6)++testValidateHotpSHA1 :: Assertion+testValidateHotpSHA1 = do+  digits <- assertJust $ mkDigits 6+  key <- assertRight $ SHA256.authenticationKeyFromHexByteString "e90cbae2d7d187f614806347cfd75002bd0db847451109599da507e8da88bf43"+  let code = hotpSHA1 key 30 digits+  let result = hotpSHA1Check key (29, 31) 30 digits (display code)+  assertBool+    "Code is checked"+    result++testExpectedHotpSHA256Codes :: Assertion+testExpectedHotpSHA256Codes = do+  digits <- assertJust $ mkDigits 6+  key <- assertRight $ SHA256.authenticationKeyFromHexByteString "e90cbae2d7d187f614806347cfd75002bd0db847451109599da507e8da88bf43"+  let counters = [0 .. 10]+  let results = fmap (\counter -> display $ hotpSHA256 key counter digits) counters+  assertEqual+    "Codes are expected and stable"+    [ "545840"+    , "042194"+    , "783687"+    , "856777"+    , "199784"+    , "809856"+    , "270404"+    , "137308"+    , "219373"+    , "965280"+    , "635343"+    ]+    results++  forM_ results $ \code ->+    assertBool+      ("Code " <> show code <> " is not 6 characters long")+      (Text.length (display code) == 6)++testValidateHotpSHA256 :: Assertion+testValidateHotpSHA256 = do+  digits <- assertJust $ mkDigits 6+  key <- assertRight $ SHA256.authenticationKeyFromHexByteString "e90cbae2d7d187f614806347cfd75002bd0db847451109599da507e8da88bf43"+  let code = hotpSHA256 key 30 digits+  let result = hotpSHA256Check key (29, 31) 30 digits (display code)+  assertBool+    "Code is checked"+    result++testExpectedHOTP512Codes :: Assertion+testExpectedHOTP512Codes = do+  digits <- assertJust $ mkDigits 6+  key <- assertRight $ SHA512.authenticationKeyFromHexByteString "11f1bf4c4136f33194c95c80e29dfb091f488ca9ac12b07907e4ed145fd35269"+  let counters = [0 .. 10]+  let results = fmap (\counter -> display $ hotpSHA512 key counter digits) counters++  assertEqual+    "Codes are expected and stable"+    [ "789887"+    , "828664"+    , "852597"+    , "476319"+    , "098272"+    , "202574"+    , "057559"+    , "321460"+    , "156051"+    , "151927"+    , "131108"+    ]+    results++  forM_ results $ \code ->+    assertBool+      ("Code " <> show code <> " is not 6 characters long")+      (Text.length (display code) == 6)++testValidateHOTP512 :: Assertion+testValidateHOTP512 = do+  digits <- assertJust $ mkDigits 6+  key <- assertRight $ SHA512.authenticationKeyFromHexByteString "e90cbae2d7d187f614806347cfd75002bd0db847451109599da507e8da88bf43"+  let code = hotpSHA512 key 30 digits+  let result = hotpSHA512Check key (29, 31) 30 digits (display code)+  assertBool+    "Code is checked"+    result

@@ -0,0 +1,183 @@+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedRecordDot #-}+{-# OPTIONS_GHC -Wno-orphans #-}++module Test.Properties where++import Chronos+import Control.Monad (guard)+import Data.ByteString.Char8 qualified as SBSC+import Data.Function ((&))+import Data.Functor ((<&>))+import Data.Int (Int64)+import Data.Maybe (fromJust)+import Data.Text qualified as Text+import Data.Text.Display (Display (..), display)+import Data.Word (Word32)+import Sel.HMAC.SHA256 qualified as HMAC+import System.IO.Unsafe (unsafeDupablePerformIO)+import Test.Tasty+import Test.Tasty.QuickCheck+import Torsor qualified++import OTP.Commons+import OTP.HOTP qualified as HOTP+import OTP.TOTP qualified as TOTP++spec :: TestTree+spec =+  testGroup+    "Properties"+    [ digitNumberProperty+    , timePeriodProperty+    ]++-- Properties++digitNumberProperty :: TestTree+digitNumberProperty = testProperty "Digit parameter determines the length of the output" $+  property $ \(arbitraryDigits, key, timestamp) ->+    let period = Torsor.scale 30 second+        ArbitraryDigits digits = arbitraryDigits+        totp =+          TOTP.totpSHA1+            (getKey key)+            timestamp+            period+            digits+        expectedLength = digitsToWord32 digits+        actualLength = totp.digits+     in expectedLength === actualLength++timePeriodProperty :: TestTree+timePeriodProperty = testProperty "A code stays stable within a time frame with the same key & digit parameters" $+  property $ \(Key key, ArbitraryDigits digits, SeparationTime separationTime, ArbitraryTime signtime) ->+    let period = Torsor.scale separationTime second+        validUntil = Torsor.add period signtime+        (Timespan nanoseconds) = period+        checktime = Torsor.add (Timespan (negate $ nanoseconds `div` 2)) validUntil+        totp =+          TOTP.totpSHA1+            key+            signtime+            period+            digits+        signCounter = totpCounter signtime period+        checkCounters = totpCounterRange (1, 0) checktime period+        checkCodes = fmap (\c -> HOTP.hotpSHA1 key c digits) checkCounters+     in counterexample+          ( Text.unpack $+              mconcat+                [ "Time: "+                , display signtime+                , ", Separation time (tested period): "+                , display period+                , ", Valid until: "+                , display validUntil+                , ", Time tested: "+                , display checktime+                , ", Code tested: "+                , display totp+                , ", Codes checked against: "+                , display checkCodes+                , ", Counter at generation: "+                , display signCounter+                , ", Counters checked for: "+                , display checkCounters+                ]+          )+          ( TOTP.totpSHA1Check+              key+              (1, 0)+              checktime+              period+              digits+              (display totp)+          )++newtype ArbitraryDigits = ArbitraryDigits Digits+  deriving (Eq, Show) via Digits++instance Arbitrary ArbitraryDigits where+  arbitrary = ArbitraryDigits . fromJust . mkDigits . fromIntegral @Int @Word32 <$> chooseInt (6, 9)++deriving instance Arbitrary Time++newtype Key = Key {getKey :: HMAC.AuthenticationKey}+  deriving newtype (Eq, Ord)++-- This instance deliberately exposes the actual value of the key so that+-- failing tests will return more information. This is safe because the 'Key'+-- type is local to this testing module and is only used to generate random+-- test keys for property tests.+instance Show Key where+  show (Key key) = SBSC.unpack $ HMAC.unsafeAuthenticationKeyToHexByteString key++instance Arbitrary Key where+  arbitrary = pure $ Key $ unsafeDupablePerformIO HMAC.newAuthenticationKey++-- | A separation time is a period in which we test the validity of a code.+newtype SeparationTime = SeparationTime Int64+  deriving (Eq, Show, Ord, Num, Enum, Real, Integral) via Int64++instance Arbitrary SeparationTime where+  arbitrary =+    chooseInt (1, 30)+      <&> fromIntegral @Int @Int64+      <&> SeparationTime+  shrink (SeparationTime time) = do+    t' <- shrink time+    guard (t' >= 1)+    pure $ SeparationTime t'++instance Display Time where+  displayBuilder time =+    let format = DatetimeFormat (Just '-') (Just ' ') (Just ':')+     in time+          & timeToDatetime+          & builder_YmdHMS (SubsecondPrecisionFixed 0) format++instance Display Timespan where+  displayBuilder timespan = displayBuilder (asSeconds timespan) <> "s"++newtype ArbitraryTime = ArbitraryTime Time+  deriving (Eq, Show, Ord, Display) via Time++instance Arbitrary ArbitraryTime where+  arbitrary = do+    datetime <- arbitrary @Datetime+    pure $ ArbitraryTime (datetimeToTime datetime)++instance Arbitrary TimeOfDay where+  arbitrary =+    TimeOfDay+      <$> choose (0, 23)+      <*> choose (0, 59)+      -- never use leap seconds for property-based tests+      <*> ( do+              subsecPrecision <- chooseInt (0, 9)+              secs <- chooseInt (0, 59)+              case subsecPrecision of+                0 -> pure (fromIntegral @Int @Int64 secs * 1_000_000_000)+                _ -> do+                  subsecs <- chooseInt (0, ((10 :: Int) ^ subsecPrecision) - 1)+                  let subsecs' = subsecs * ((10 :: Int) ^ (9 - subsecPrecision))+                  if subsecs' < 0 || subsecs' >= 1_000_000_000+                    then error "Mistake in Arbitrary instance for TimeOfDay"+                    else+                      pure+                        ( (fromIntegral @Int @Int64 secs * 1_000_000_000)+                            + fromIntegral @Int @Int64 subsecs+                        )+          )++instance Arbitrary Date where+  arbitrary =+    Date+      <$> fmap Year (choose (1800, 2100))+      <*> fmap Month (choose (0, 11))+      <*> fmap DayOfMonth (choose (1, 28))++instance Arbitrary Datetime where+  arbitrary = Datetime <$> arbitrary <*> arbitrary

@@ -0,0 +1,104 @@+module Test.TOTP where++import Chronos+import Data.ByteString.Base32 qualified as Base32+import Data.Maybe (fromJust)+import Data.Text.Display (display)+import Sel.HMAC.SHA256 qualified as SHA256+import Sel.HMAC.SHA512 qualified as SHA512+import Test.Tasty+import Test.Tasty.HUnit+import Test.Utils+import Torsor (scale)++import OTP.Commons (Algorithm (..), mkDigits, totpCounter)+import OTP.TOTP (totpSHA1, totpSHA1Check, totpSHA256, totpSHA256Check, totpSHA512, totpSHA512Check, totpToURI)++spec :: TestTree+spec =+  testGroup+    "TOTP"+    [ testCase "TOTP counter from time" testTOTPCounterFromTime+    , testCase "HMAC-SHA-1 TOTP codes" testSHA1TOTPCodes+    , testCase "HMAC-SHA-256 TOTP codes" testSHA256TOTPCodes+    , testCase "HMAC-SHA-512 TOTP codes" testSHA512TOTPCodes+    , testCase "URI generation" testTOTPURIGeneration+    ]++testTOTPCounterFromTime :: Assertion+testTOTPCounterFromTime = do+  let dtf = DatetimeFormat (Just '-') (Just ' ') (Just ':')+  let decode txt = datetimeToTime $ fromJust $ Chronos.decode_YmdHMS dtf txt+  assertEqual+    "Correct counter from date 2010-10-10 00:00:00"+    (totpCounter (decode "2010-10-10 00:00:00") (scale 30 second))+    42888960++  assertEqual+    "Correct counter from date 2010-10-10 00:00:30"+    (totpCounter (decode "2010-10-10 00:00:30") (scale 30 second))+    42888961++  assertEqual+    "Correct counter from date 2010-10-10 00:01:00"+    (totpCounter (decode "2010-10-10 00:01:00") (scale 30 second))+    42888962++testSHA1TOTPCodes :: Assertion+testSHA1TOTPCodes = do+  timestamp <- now+  let timeStep = scale 30 second+  digits <- assertJust $ mkDigits 6+  key <- assertRight $ SHA256.authenticationKeyFromHexByteString "e90cbae2d7d187f614806347cfd75002bd0db847451109599da507e8da88bf43"+  let code = totpSHA1 key timestamp timeStep digits+  let result = totpSHA1Check key (0, 1) timestamp timeStep digits (display code)+  assertBool+    "Can check own code"+    result++testSHA256TOTPCodes :: Assertion+testSHA256TOTPCodes = do+  timestamp <- now+  let timeStep = scale 30 second+  digits <- assertJust $ mkDigits 6++  key <- assertRight $ SHA256.authenticationKeyFromHexByteString "e90cbae2d7d187f614806347cfd75002bd0db847451109599da507e8da88bf43"+  let code = totpSHA256 key timestamp timeStep digits+  let result = totpSHA256Check key (0, 1) timestamp timeStep digits (display code)+  assertBool+    "Can check own code"+    result++testSHA512TOTPCodes :: Assertion+testSHA512TOTPCodes = do+  timestamp <- now+  let timeStep = scale 30 second+  digits <- assertJust $ mkDigits 6+  key <- assertRight $ SHA512.authenticationKeyFromHexByteString "e90cbae2d7d187f614806347cfd75002bd0db847451109599da507e8da88bf43"+  let code = totpSHA512 key timestamp timeStep digits+  let result = totpSHA512Check key (0, 1) timestamp timeStep digits (display code)+  assertBool+    "Code is checked"+    result++testTOTPURIGeneration :: Assertion+testTOTPURIGeneration = do+  let period = scale 30 second+  digits <- assertJust $ mkDigits 6+  key <- assertRight $ SHA256.authenticationKeyFromHexByteString "e90cbae2d7d187f614806347cfd75002bd0db847451109599da507e8da88bf43"+  let issuer = "Localhost Inc"+  let account = "username@localhost.localdomain"++  let uri =+        totpToURI+          (Base32.encodeBase32 $ SHA256.unsafeAuthenticationKeyToBinary key)+          account+          issuer+          digits+          period+          HMAC_SHA1++  assertEqual+    "Expected URI"+    "otpauth://totp/Localhost%20Inc:username@localhost.localdomain?secret=5EGLVYWX2GD7MFEAMND47V2QAK6Q3OCHIUIQSWM5UUD6RWUIX5BQ====&issuer=Localhost%20Inc&digits=6&algorithm=SHA1&period=30"+    uri

@@ -0,0 +1,12 @@+module Test.Utils where++import GHC.Stack+import Test.Tasty.HUnit qualified as Test++assertRight :: HasCallStack => Either a b -> IO b+assertRight (Left _a) = Test.assertFailure "Test return Left instead of Right"+assertRight (Right b) = pure b++assertJust :: HasCallStack => Maybe a -> IO a+assertJust Nothing = Test.assertFailure "Test return Nothing instead of Just"+assertJust (Just a) = pure a