    -- Expirations.hs: OpenPGP (RFC4880) expiration checking
    -- Copyright © 2014-2015  Clint Adams
    -- This software is released under the terms of the Expat license.
    -- (See the LICENSE file).
    module Codec.Encryption.OpenPGP.Expirations
      ( isTKTimeValid
      , getKeyExpirationTimesFromSignature
      ) where

    import Control.Lens ((&), (^.), _1)
    import Data.Time.Clock (UTCTime)
    import Data.Time.Clock.POSIX (posixSecondsToUTCTime)

    import Codec.Encryption.OpenPGP.Ontology (isKET)
    import Codec.Encryption.OpenPGP.Types

    -- this assumes that all key expiration time subpackets are valid
    isTKTimeValid :: UTCTime -> TK -> Bool
    isTKTimeValid :: UTCTime -> TK -> Bool
    isTKTimeValid UTCTime
    ct TK
    key = UTCTime
    ct UTCTime -> UTCTime -> Bool
    forall a. Ord a => a -> a -> Bool
    >= UTCTime
    keyCreationTime Bool -> Bool -> Bool
    && UTCTime
    ct UTCTime -> UTCTime -> Bool
    forall a. Ord a => a -> a -> Bool
    < UTCTime
    keyExpirationTime
      where
        keyCreationTime :: UTCTime
    keyCreationTime =
          TK
    key TK
    -> Getting ThirtyTwoBitTimeStamp TK ThirtyTwoBitTimeStamp
    -> ThirtyTwoBitTimeStamp
    forall s a. s -> Getting a s a -> a
    ^. ((PKPayload, Maybe SKAddendum)
     -> Const ThirtyTwoBitTimeStamp (PKPayload, Maybe SKAddendum))
    -> TK -> Const ThirtyTwoBitTimeStamp TK
    Lens' TK (PKPayload, Maybe SKAddendum)
    tkKey (((PKPayload, Maybe SKAddendum)
      -> Const ThirtyTwoBitTimeStamp (PKPayload, Maybe SKAddendum))
     -> TK -> Const ThirtyTwoBitTimeStamp TK)
    -> ((ThirtyTwoBitTimeStamp
         -> Const ThirtyTwoBitTimeStamp ThirtyTwoBitTimeStamp)
        -> (PKPayload, Maybe SKAddendum)
        -> Const ThirtyTwoBitTimeStamp (PKPayload, Maybe SKAddendum))
    -> Getting ThirtyTwoBitTimeStamp TK ThirtyTwoBitTimeStamp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (PKPayload -> Const ThirtyTwoBitTimeStamp PKPayload)
    -> (PKPayload, Maybe SKAddendum)
    -> Const ThirtyTwoBitTimeStamp (PKPayload, Maybe SKAddendum)
    forall s t a b. Field1 s t a b => Lens s t a b
    Lens
      (PKPayload, Maybe SKAddendum)
      (PKPayload, Maybe SKAddendum)
      PKPayload
      PKPayload
    _1 ((PKPayload -> Const ThirtyTwoBitTimeStamp PKPayload)
     -> (PKPayload, Maybe SKAddendum)
     -> Const ThirtyTwoBitTimeStamp (PKPayload, Maybe SKAddendum))
    -> ((ThirtyTwoBitTimeStamp
         -> Const ThirtyTwoBitTimeStamp ThirtyTwoBitTimeStamp)
        -> PKPayload -> Const ThirtyTwoBitTimeStamp PKPayload)
    -> (ThirtyTwoBitTimeStamp
        -> Const ThirtyTwoBitTimeStamp ThirtyTwoBitTimeStamp)
    -> (PKPayload, Maybe SKAddendum)
    -> Const ThirtyTwoBitTimeStamp (PKPayload, Maybe SKAddendum)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ThirtyTwoBitTimeStamp
     -> Const ThirtyTwoBitTimeStamp ThirtyTwoBitTimeStamp)
    -> PKPayload -> Const ThirtyTwoBitTimeStamp PKPayload
    Lens' PKPayload ThirtyTwoBitTimeStamp
    timestamp ThirtyTwoBitTimeStamp
    -> (ThirtyTwoBitTimeStamp -> UTCTime) -> UTCTime
    forall a b. a -> (a -> b) -> b
    & POSIXTime -> UTCTime
    posixSecondsToUTCTime (POSIXTime -> UTCTime)
    -> (ThirtyTwoBitTimeStamp -> POSIXTime)
    -> ThirtyTwoBitTimeStamp
    -> UTCTime
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ThirtyTwoBitTimeStamp -> POSIXTime
    forall a b. (Real a, Fractional b) => a -> b
    realToFrac
        keyExpirationTime :: UTCTime
    keyExpirationTime =
          POSIXTime -> UTCTime
    posixSecondsToUTCTime (POSIXTime -> UTCTime)
    -> ([SignaturePayload] -> POSIXTime)
    -> [SignaturePayload]
    -> UTCTime
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word32 -> POSIXTime
    forall a b. (Real a, Fractional b) => a -> b
    realToFrac (Word32 -> POSIXTime)
    -> ([SignaturePayload] -> Word32)
    -> [SignaturePayload]
    -> POSIXTime
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
          ((TK
    key TK
    -> Getting ThirtyTwoBitTimeStamp TK ThirtyTwoBitTimeStamp
    -> ThirtyTwoBitTimeStamp
    forall s a. s -> Getting a s a -> a
    ^. ((PKPayload, Maybe SKAddendum)
     -> Const ThirtyTwoBitTimeStamp (PKPayload, Maybe SKAddendum))
    -> TK -> Const ThirtyTwoBitTimeStamp TK
    Lens' TK (PKPayload, Maybe SKAddendum)
    tkKey (((PKPayload, Maybe SKAddendum)
      -> Const ThirtyTwoBitTimeStamp (PKPayload, Maybe SKAddendum))
     -> TK -> Const ThirtyTwoBitTimeStamp TK)
    -> ((ThirtyTwoBitTimeStamp
         -> Const ThirtyTwoBitTimeStamp ThirtyTwoBitTimeStamp)
        -> (PKPayload, Maybe SKAddendum)
        -> Const ThirtyTwoBitTimeStamp (PKPayload, Maybe SKAddendum))
    -> Getting ThirtyTwoBitTimeStamp TK ThirtyTwoBitTimeStamp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (PKPayload -> Const ThirtyTwoBitTimeStamp PKPayload)
    -> (PKPayload, Maybe SKAddendum)
    -> Const ThirtyTwoBitTimeStamp (PKPayload, Maybe SKAddendum)
    forall s t a b. Field1 s t a b => Lens s t a b
    Lens
      (PKPayload, Maybe SKAddendum)
      (PKPayload, Maybe SKAddendum)
      PKPayload
      PKPayload
    _1 ((PKPayload -> Const ThirtyTwoBitTimeStamp PKPayload)
     -> (PKPayload, Maybe SKAddendum)
     -> Const ThirtyTwoBitTimeStamp (PKPayload, Maybe SKAddendum))
    -> ((ThirtyTwoBitTimeStamp
         -> Const ThirtyTwoBitTimeStamp ThirtyTwoBitTimeStamp)
        -> PKPayload -> Const ThirtyTwoBitTimeStamp PKPayload)
    -> (ThirtyTwoBitTimeStamp
        -> Const ThirtyTwoBitTimeStamp ThirtyTwoBitTimeStamp)
    -> (PKPayload, Maybe SKAddendum)
    -> Const ThirtyTwoBitTimeStamp (PKPayload, Maybe SKAddendum)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ThirtyTwoBitTimeStamp
     -> Const ThirtyTwoBitTimeStamp ThirtyTwoBitTimeStamp)
    -> PKPayload -> Const ThirtyTwoBitTimeStamp PKPayload
    Lens' PKPayload ThirtyTwoBitTimeStamp
    timestamp ThirtyTwoBitTimeStamp
    -> (ThirtyTwoBitTimeStamp -> Word32) -> Word32
    forall a b. a -> (a -> b) -> b
    & ThirtyTwoBitTimeStamp -> Word32
    unThirtyTwoBitTimeStamp) Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    +) (Word32 -> Word32)
    -> ([SignaturePayload] -> Word32) -> [SignaturePayload] -> Word32
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
          ThirtyTwoBitDuration -> Word32
    unThirtyTwoBitDuration (ThirtyTwoBitDuration -> Word32)
    -> ([SignaturePayload] -> ThirtyTwoBitDuration)
    -> [SignaturePayload]
    -> Word32
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
          [ThirtyTwoBitDuration] -> ThirtyTwoBitDuration
    forall {a}. (Bounded a, Ord a) => [a] -> a
    newest ([ThirtyTwoBitDuration] -> ThirtyTwoBitDuration)
    -> ([SignaturePayload] -> [ThirtyTwoBitDuration])
    -> [SignaturePayload]
    -> ThirtyTwoBitDuration
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
          (SignaturePayload -> [ThirtyTwoBitDuration])
    -> [SignaturePayload] -> [ThirtyTwoBitDuration]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap SignaturePayload -> [ThirtyTwoBitDuration]
    getKeyExpirationTimesFromSignature ([SignaturePayload] -> UTCTime) -> [SignaturePayload] -> UTCTime
    forall a b. (a -> b) -> a -> b
    $
          (((Text, [SignaturePayload]) -> [SignaturePayload])
    -> [(Text, [SignaturePayload])] -> [SignaturePayload]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (Text, [SignaturePayload]) -> [SignaturePayload]
    forall a b. (a, b) -> b
    snd (TK
    key TK
    -> Getting
         [(Text, [SignaturePayload])] TK [(Text, [SignaturePayload])]
    -> [(Text, [SignaturePayload])]
    forall s a. s -> Getting a s a -> a
    ^. Getting
      [(Text, [SignaturePayload])] TK [(Text, [SignaturePayload])]
    Lens' TK [(Text, [SignaturePayload])]
    tkUIDs) [SignaturePayload] -> [SignaturePayload] -> [SignaturePayload]
    forall a. [a] -> [a] -> [a]
    ++ (([UserAttrSubPacket], [SignaturePayload]) -> [SignaturePayload])
    -> [([UserAttrSubPacket], [SignaturePayload])]
    -> [SignaturePayload]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ([UserAttrSubPacket], [SignaturePayload]) -> [SignaturePayload]
    forall a b. (a, b) -> b
    snd (TK
    key TK
    -> Getting
         [([UserAttrSubPacket], [SignaturePayload])]
         TK
         [([UserAttrSubPacket], [SignaturePayload])]
    -> [([UserAttrSubPacket], [SignaturePayload])]
    forall s a. s -> Getting a s a -> a
    ^. Getting
      [([UserAttrSubPacket], [SignaturePayload])]
      TK
      [([UserAttrSubPacket], [SignaturePayload])]
    Lens' TK [([UserAttrSubPacket], [SignaturePayload])]
    tkUAts))
        newest :: [a] -> a
    newest [] = a
    forall a. Bounded a => a
    maxBound
        newest [a]
    xs = [a] -> a
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum [a]
    xs

    getKeyExpirationTimesFromSignature :: SignaturePayload -> [ThirtyTwoBitDuration]
    getKeyExpirationTimesFromSignature :: SignaturePayload -> [ThirtyTwoBitDuration]
    getKeyExpirationTimesFromSignature (SigV4 SigType
    _ PubKeyAlgorithm
    _ HashAlgorithm
    _ [SigSubPacket]
    xs [SigSubPacket]
    _ Word16
    _ NonEmpty MPI
    _) =
      (SigSubPacket -> ThirtyTwoBitDuration)
    -> [SigSubPacket] -> [ThirtyTwoBitDuration]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(SigSubPacket Bool
    _ (KeyExpirationTime ThirtyTwoBitDuration
    x)) -> ThirtyTwoBitDuration
    x) ([SigSubPacket] -> [ThirtyTwoBitDuration])
    -> [SigSubPacket] -> [ThirtyTwoBitDuration]
    forall a b. (a -> b) -> a -> b
    $ (SigSubPacket -> Bool) -> [SigSubPacket] -> [SigSubPacket]
    forall a. (a -> Bool) -> [a] -> [a]
    filter SigSubPacket -> Bool
    isKET [SigSubPacket]
    xs