-- {-# LANGUAGE FlexibleInstances #-}

-- |
-- Module      : Crypto.Saltine.Class
-- Copyright   : (c) Joseph Abrahamson 2013
-- License     : MIT
--
-- Maintainer  : me@jspha.com
-- Stability   : experimental
-- Portability : non-portable
--
-- Saltine type classes
module Crypto.Saltine.Class (
  IsEncoding (..),
  IsNonce (..)
  ) where

import Data.Profunctor
import Data.ByteString (ByteString)

-- | Class for all keys and nonces in Saltine which have a
-- representation as ByteString. 'encoded' is a 'Prism' of
-- type @Prism' ByteString a@ compatible with "Control.Lens" and
-- is automatically deduced.
class IsEncoding a where
  encode  :: a -> ByteString
  decode  :: ByteString -> Maybe a
  encoded :: (Choice p, Applicative f)
             => p a (f a) -> p ByteString (f ByteString)
  encoded = (a -> ByteString)
-> (ByteString -> Maybe a)
-> p a (f a)
-> p ByteString (f ByteString)
forall (f :: * -> *) (p :: * -> * -> *) a1 a a2.
(Applicative f, Choice p) =>
(a1 -> a) -> (a -> Maybe a2) -> p a2 (f a1) -> p a (f a)
prism' a -> ByteString
forall a. IsEncoding a => a -> ByteString
encode ByteString -> Maybe a
forall a. IsEncoding a => ByteString -> Maybe a
decode
  {-# INLINE encoded #-}

-- | A generic class for interacting with nonces.
class IsNonce n where
  zero  :: n
  -- ^ Some privileged nonce value.
  nudge :: n -> n
  -- ^ Some perturbation on nonces such that @n /= nudge n@ with high
  -- probability. Since nonces are finite, repeats may happen in
  -- particularly small cases, but no nonces in Saltine are so
  -- small. This is not guaranteed to be difficult to predict---if a
  -- nonce had an `Enum` instance `succ` would be a good
  -- implementation excepting that `succ` is partial.

-- Copied over from Control.Lens

prism' :: (Applicative f, Choice p) =>
          (a1 -> a) -> (a -> Maybe a2) -> p a2 (f a1) -> p a (f a)
prism' :: (a1 -> a) -> (a -> Maybe a2) -> p a2 (f a1) -> p a (f a)
prism' a1 -> a
bs a -> Maybe a2
sma = (a1 -> a) -> (a -> Either a a2) -> p a2 (f a1) -> p a (f a)
forall (f :: * -> *) (p :: * -> * -> *) a2 a1 a a3.
(Applicative f, Choice p) =>
(a2 -> a1) -> (a -> Either a1 a3) -> p a3 (f a2) -> p a (f a1)
prism a1 -> a
bs (\a
s -> Either a a2 -> (a2 -> Either a a2) -> Maybe a2 -> Either a a2
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (a -> Either a a2
forall a b. a -> Either a b
Left a
s) a2 -> Either a a2
forall a b. b -> Either a b
Right (a -> Maybe a2
sma a
s))
{-# INLINE prism' #-}

prism :: (Applicative f, Choice p) =>
         (a2 -> a1) -> (a -> Either a1 a3) -> p a3 (f a2) -> p a (f a1)
prism :: (a2 -> a1) -> (a -> Either a1 a3) -> p a3 (f a2) -> p a (f a1)
prism a2 -> a1
bt a -> Either a1 a3
seta = (a -> Either a1 a3)
-> (Either a1 (f a2) -> f a1)
-> p (Either a1 a3) (Either a1 (f a2))
-> p a (f a1)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap a -> Either a1 a3
seta ((a1 -> f a1) -> (f a2 -> f a1) -> Either a1 (f a2) -> f a1
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a1 -> f a1
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a2 -> a1) -> f a2 -> f a1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a2 -> a1
bt)) (p (Either a1 a3) (Either a1 (f a2)) -> p a (f a1))
-> (p a3 (f a2) -> p (Either a1 a3) (Either a1 (f a2)))
-> p a3 (f a2)
-> p a (f a1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a3 (f a2) -> p (Either a1 a3) (Either a1 (f a2))
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
right'
{-# INLINE prism #-}