solitare.gleam - solitare - A gleam implementation of Solitare encryption scheme

solitare.gleam (12181B)
      1 import gleam/string
      2 import gleam/list
      3 import gleam/result
      4 import gleam/option.{type Option,Some,None}
      5 import gleam/io
      6 import gleam/int
      7 import argv
      8 
      9 pub type NewCardError {
     10   InvalidCard
     11 }
     12 pub type Suit {
     13   Clubs
     14   Diamonds
     15   Hearts
     16   Spades
     17   JokerA
     18   JokerB
     19 }
     20 pub type Card {
     21   Card(suit: Suit, value: Option(Int))
     22 }
     23 
     24 pub fn new_card(suit: Suit, value: Option(Int)) -> Result(Card, NewCardError) {
     25   case suit {
     26     Clubs | Diamonds | Hearts | Spades -> case value {
     27       Some(value) -> case value {
     28         x if x < 1 || x > 13 -> Error(InvalidCard)
     29         y -> Ok(Card(suit, Some(y)))
     30       }
     31       None -> Error(InvalidCard)
     32     }
     33     JokerA | JokerB -> case value {
     34       Some(_a) -> Error(InvalidCard)
     35       None -> Ok(Card(suit, None))
     36     }
     37   }
     38 }
     39 
     40 pub fn unkeyed_deck() -> List(Card) {
     41   let makesuit = fn (s: Suit) -> List(Result(Card,NewCardError)) {
     42     list.reverse(int.range(1, 14, [], fn (lst, value) {
     43       [new_card(s, Some(value)), ..lst]
     44     }))
     45   }
     46   let assert Ok(ud) = result.all(list.flatten([
     47     makesuit(Clubs), 
     48     makesuit(Diamonds), 
     49     makesuit(Hearts), 
     50     makesuit(Spades),
     51     [new_card(JokerA, None), new_card(JokerB, None)]
     52   ]))
     53   ud
     54 }
     55 
     56 pub fn count_cut(deck: List(Card)) -> Result(List(Card),DeckError) {
     57   let len = list.length(deck)
     58   case len {
     59     0 -> Error(MalformedDeck)
     60     _ -> {
     61       let #(rest, b) = list.split(deck, len-1)
     62       let assert Ok(bottom_card) = list.first(b)
     63       let count = count_cut_value(bottom_card)
     64       let #(top, bottom) = list.split(rest, count)
     65       let res = list.append(bottom, top)
     66       |> list.append([bottom_card]) 
     67       Ok(res)
     68     }
     69   }
     70 }
     71 
     72 // (Use the bridge order of suits: clubs, diamonds, hearts, and spades. 
     73 // If the card is a club, it is the value shown. If the card is a diamond, 
     74 // it is the value plus 13. If it is a heart, it is the value plus 26. 
     75 // If it is a spade, it is the value plus 39. Either joker is a 53.) 
     76 pub fn count_cut_value(card: Card) -> Int {
     77   case card.suit {
     78     Clubs | Diamonds | Hearts | Spades -> {
     79       let assert Some(value) = card.value
     80       case card.suit {
     81         Clubs -> value
     82         Diamonds -> 13 + value
     83         Hearts -> 26 + value
     84         Spades -> 39 + value
     85         JokerA | JokerB -> panic
     86       }
     87     }
     88     JokerA | JokerB -> 53
     89   }
     90 }
     91 
     92 pub type DeckError{
     93   MalformedDeck
     94 }
     95 
     96 pub fn triple_cut(deck: List(Card)) -> Result(List(Card), DeckError) {
     97   let jokers = list.index_map(deck, fn (card, ix) {
     98     case is_joker(card) {
     99       True -> [ix]
    100       False -> []
    101     }
    102   }) |> list.flatten
    103   case list.length(jokers) {
    104     2 -> {
    105       let assert Ok(j1) = list.first(jokers)
    106       let assert Ok(j2) = list.last(jokers)
    107       let #(top, rest) = list.split(deck, j1)
    108       let #(mid, bottom) = list.split(rest, j2-j1+1)
    109       Ok(list.append(list.append(bottom, mid), top))
    110     }
    111     _ -> Error(MalformedDeck)
    112   }
    113 }
    114 
    115 fn is_joker(card: Card) -> Bool {
    116   card.suit == JokerA || card.suit == JokerB
    117 }
    118 
    119 pub fn move_jokers(deck: List(Card)) -> Result(List(Card),DeckError) {
    120   move_joker_a(deck)
    121   |> result.map(fn (d) {move_joker_b(d)})
    122   |> result.flatten()
    123 }
    124 
    125 // joker A moves back one
    126 pub fn move_joker_a(deck: List(Card)) -> Result(List(Card),DeckError) {
    127   let #(pre, suffix) = list.split_while(deck, fn (card) { card.suit != JokerA })
    128   let #(jokera, post) = list.split(suffix, 1)
    129   case list.length(jokera) {
    130     1 -> case list.length(post) {
    131       0 -> {
    132         let #(a, b) = list.split(pre, 1)
    133         let res = list.append(a, [Card(JokerA, None)])
    134         |> list.append(b)
    135         Ok(res)
    136       }
    137       _ -> {
    138         let #(a, b) = list.split(post, 1)
    139         let res = list.append(pre, a) 
    140         |> list.append([Card(JokerA, None)])
    141         |> list.append(b)
    142         Ok(res)
    143       }
    144     }
    145     _ -> Error(MalformedDeck)
    146   }
    147 }
    148 
    149 // joker B moves back two
    150 pub fn move_joker_b(deck: List(Card)) -> Result(List(Card),DeckError) {
    151   let #(pre, suffix) = list.split_while(deck, fn (card) { card.suit != JokerB})
    152   let #(jokerb, post) = list.split(suffix, 1)
    153   case list.length(jokerb) {
    154     1 -> case list.length(post) {
    155       0 -> {
    156         let #(a, b) = list.split(pre, 2)
    157         let res = list.append(list.append(a, [Card(JokerB, None)]), b)
    158         Ok(res)
    159       }
    160       1 -> {
    161         let #(a, b) = list.split(pre, 1)
    162         let res = list.append(a, [Card(JokerB, None)])
    163         |> list.append(b)
    164         |> list.append(post)
    165         Ok(res)
    166       }
    167       _ -> {
    168         let #(a, b) = list.split(post, 2)
    169         let res = list.append(pre, a)
    170         |> list.append([Card(JokerB, None)])
    171         |> list.append(b)
    172         Ok(res)
    173       }
    174     }
    175     _ -> Error(MalformedDeck)
    176   }
    177 }
    178 
    179 // it might return None if the output is a joker card, in which case
    180 // this output must be skipped
    181 pub fn read_output(deck: List(Card)) -> Result(Option(Int), DeckError) {
    182   case list.first(deck) {
    183     Ok(first) -> {
    184       let val = count_cut_value(first)
    185       case at(deck, val) {
    186         Some(out_card) -> Ok(output_value(out_card))
    187         None -> Error(MalformedDeck)
    188       }
    189     }
    190     Error(_) -> Error(MalformedDeck)
    191   }
    192 }
    193 
    194 fn output_value(card: Card) -> Option(Int) {
    195   option.map(card.value, fn (value) {
    196     case card.suit {
    197       Clubs | Hearts -> value
    198       Diamonds | Spades -> 13 + value
    199       _ -> panic // unreachable, other suits have no value
    200     }
    201   })
    202 }
    203 
    204 
    205 pub fn generate_keystream(deck: List(Card), length: Int) -> Result(#(List(Card), List(Int)),DeckError) {
    206   case generate_keystream_internal(deck, length, []) {
    207     Ok(#(updated_deck, keystream)) -> Ok(#(updated_deck, list.reverse(keystream)))
    208     Error(e) -> Error(e)
    209   }
    210 }
    211 
    212 // Keystream is returned _reversed_ because prepending is cheaper right now
    213 fn generate_keystream_internal(deck: List(Card), length: Int, ks: List(Int)) -> Result(#(List(Card), List(Int)), DeckError) {
    214   case length {
    215     0 -> Ok(#(deck, ks))
    216     _ -> {
    217       let updated_deck = move_jokers(deck)
    218        |> flat_map(triple_cut)
    219        |> flat_map(count_cut)
    220        case updated_deck {
    221         Ok(ud) -> {
    222           case read_output(ud) {
    223             Ok(out) -> case out {
    224               Some(value) -> generate_keystream_internal(ud, length-1, [value, ..ks])
    225               None -> generate_keystream_internal(ud, length, ks)
    226             }
    227             Error(e) -> Error(e)
    228           }
    229         }
    230         Error(e) -> Error(e)
    231        }
    232     }
    233   }
    234 
    235 }
    236 
    237 // TODO use a better data structure than List (which is a singly-linked list)
    238 fn at(l: List(a), i: Int) -> Option(a) {
    239   list.index_fold(l, None, fn (acc, e, ix) {
    240     case acc {
    241       Some(g) -> Some(g)
    242       None -> case ix == i {
    243         True -> Some(e)
    244         False -> None
    245       }
    246     }
    247   })
    248 }
    249 
    250 
    251 fn flat_map(r: Result(a, b), f: fn (a) -> Result(c, b)) -> Result(c, b) {
    252   case r {
    253     Ok(x) -> case f(x) {
    254       Ok(y) -> Ok(y)
    255       Error(z) -> Error(z)
    256     }
    257     Error(z) -> Error(z)
    258   }
    259 }
    260 
    261 
    262 pub type ToNumberError {
    263   InvalidString
    264 }
    265 
    266 fn encode(s: String) -> Result(Int, ToNumberError) {
    267   case string.uppercase(s) {
    268     "A" -> Ok(1)
    269     "B" -> Ok(2)
    270     "C" -> Ok(3)
    271     "D" -> Ok(4)
    272     "E" -> Ok(5)
    273     "F" -> Ok(6)
    274     "G" -> Ok(7)
    275     "H" -> Ok(8)
    276     "I" -> Ok(9)
    277     "J" -> Ok(10)
    278     "K" -> Ok(11)
    279     "L" -> Ok(12)
    280     "M" -> Ok(13)
    281     "N" -> Ok(14)
    282     "O" -> Ok(15)
    283     "P" -> Ok(16)
    284     "Q" -> Ok(17)
    285     "R" -> Ok(18)
    286     "S" -> Ok(19)
    287     "T" -> Ok(20)
    288     "U" -> Ok(21)
    289     "V" -> Ok(22)
    290     "W" -> Ok(23)
    291     "X" -> Ok(24)
    292     "Y" -> Ok(25)
    293     "Z" -> Ok(26)
    294     _ -> Error(InvalidString)
    295   }
    296 }
    297 fn decode(i: Int) -> Result(String,ToNumberError) {
    298   case i {
    299     1  -> Ok("A")
    300     2  -> Ok("B")
    301     3  -> Ok("C")
    302     4  -> Ok("D")
    303     5  -> Ok("E")
    304     6  -> Ok("F")
    305     7  -> Ok("G")
    306     8  -> Ok("H")
    307     9  -> Ok("I")
    308     10 -> Ok("J")
    309     11 -> Ok("K")
    310     12 -> Ok("L")
    311     13 -> Ok("M")
    312     14 -> Ok("N")
    313     15 -> Ok("O")
    314     16 -> Ok("P")
    315     17 -> Ok("Q")
    316     18 -> Ok("R")
    317     19 -> Ok("S")
    318     20 -> Ok("T")
    319     21 -> Ok("U")
    320     22 -> Ok("V")
    321     23 -> Ok("W")
    322     24 -> Ok("X")
    323     25 -> Ok("Y")
    324     26 -> Ok("Z")
    325     _ -> Error(InvalidString)
    326   }
    327 }
    328 
    329 pub type EncryptError {
    330   EEMalformedDeck
    331   EEInvalidString
    332   EEKeystreamError
    333 }
    334 fn map_de(de: DeckError) -> EncryptError {
    335   case de {
    336     MalformedDeck -> EEMalformedDeck
    337   }
    338 }
    339 fn map_ne(ne: ToNumberError) -> EncryptError {
    340   case ne { 
    341     InvalidString -> EEInvalidString
    342   }
    343 }
    344 
    345 // Encrypt with a pre-keyed deck
    346 pub fn encrypt(deck: List(Card), plaintext: String) -> Result(String, EncryptError) {
    347   crypt(deck, plaintext, enc)
    348 }
    349 
    350 // Decrypt with a pre-keyed deck
    351 pub fn decrypt(deck: List(Card), ciphertext: String) -> Result(String,EncryptError) {
    352   crypt(deck, ciphertext, dec)
    353 }
    354 
    355 fn crypt(deck: List(Card), text: String, f: fn (Int, Int) -> Int) -> Result(String,EncryptError) {
    356   case string.to_graphemes(text)
    357   |> pad("X", 5)
    358   |> list.map(encode)
    359   |> result.all() {
    360     Ok(encoded) -> {
    361       case generate_keystream(deck, list.length(encoded)) {
    362         Ok(#(_updated_deck, keystream)) -> {
    363           case list.strict_zip(encoded, keystream) {
    364             Ok(zipped) -> {
    365               case list.map(zipped, fn (zz) {
    366                 let #(e, k) = zz
    367                 f(e, k)
    368               })
    369               |> list.map(decode)
    370               |> result.all() {
    371                 Ok(decode_l) -> Ok(string.join(decode_l, ""))
    372                 Error(e) -> Error(map_ne(e))
    373               }
    374             }
    375             Error(_) -> Error(EEKeystreamError)
    376           }
    377         }
    378         Error(e) -> Error(map_de(e))
    379       }
    380     }
    381     Error(e) -> Error(map_ne(e))
    382   }
    383 }
    384 
    385 fn pad(lst: List(String), p: String, x: Int) -> List(String) {
    386   let len = list.length(lst)
    387   case {len % x} {
    388     0 -> lst
    389     x -> list.append(lst, list.repeat(p, 5 - x))
    390   }
    391 }
    392 
    393 fn enc(text: Int, key: Int) -> Int {
    394   case text + key {
    395     x if x > 26 -> x - 26
    396     x -> x
    397   }
    398 }
    399 fn dec(text: Int, key: Int) -> Int {
    400   case text - key {
    401     x if x < 1 -> x + 26
    402     x -> x
    403   }
    404 }
    405 
    406 pub fn passphrase_key(passphrase: String) -> Result(List(Card), EncryptError) {
    407   string.to_graphemes(passphrase)
    408   |> passphrase_key_internal(unkeyed_deck())
    409 }
    410 
    411 fn passphrase_key_internal(passphrase_l: List(String), deck: List(Card)) -> Result(List(Card), EncryptError) {
    412   case list.length(passphrase_l) {
    413     0 -> Ok(deck)
    414     _ -> {
    415       case list.first(passphrase_l) {
    416         Ok(ch) -> {
    417           case encode(ch) {
    418             Ok(enc) -> {
    419               case move_jokers(deck)
    420                |> flat_map(triple_cut)
    421                |> flat_map(count_cut)
    422                |> flat_map(fn (d) {count_cut_x(d, enc)}) {
    423                 Ok(updated_deck) -> {
    424                   let #(_, rest) = list.split(passphrase_l, 1)
    425                   passphrase_key_internal(rest, updated_deck)
    426                 }
    427                 Error(e) -> Error(map_de(e))
    428                }
    429             }
    430             Error(e) -> Error(map_ne(e))
    431           }
    432         }
    433         Error(_) -> panic
    434       }
    435     }
    436   }
    437 }
    438 
    439 fn count_cut_x(deck: List(Card), x: Int) -> Result(List(Card),DeckError) {
    440   let len = list.length(deck)
    441   case len {
    442     0 -> Error(MalformedDeck)
    443     _ -> {
    444       let #(rest, b) = list.split(deck, len-1)
    445       let assert Ok(bottom_card) = list.first(b)
    446       let #(top, bottom) = list.split(rest, x)
    447       let res = list.append(bottom, top)
    448       |> list.append([bottom_card]) 
    449       Ok(res)
    450     }
    451   }
    452 }
    453 
    454 pub fn encrypt_key(key: String, plaintext: String) -> Result(String,EncryptError) {
    455   passphrase_key(key)
    456   |> flat_map(fn (deck){ encrypt(deck, plaintext) })
    457 }
    458 
    459 pub fn decrypt_key(key: String, ciphertext: String) -> Result(String,EncryptError) {
    460   passphrase_key(key)
    461   |> flat_map(fn (deck){ decrypt(deck, ciphertext) })
    462 }
    463 
    464 pub fn main() -> Nil {
    465   case argv.load().arguments {
    466     ["encrypt", key, plaintext] -> {
    467       case encrypt_key(key, plaintext) {
    468         Ok(ciphertext) -> io.println(ciphertext)
    469         Error(e) -> io.println_error("error encrypting: " <> string.inspect(e))
    470       }
    471     }
    472     ["decrypt", key, ciphertext] -> {
    473       case decrypt_key(key, ciphertext) {
    474         Ok(plaintext) -> io.println(plaintext)
    475         Error(e) -> io.println_error("error decrypting: " <> string.inspect(e))
    476       }
    477     }
    478     _ -> io.println("usage: solitare (encrypt|decrypt) key (cipher|plain)text")
    479 
    480   }
    481   Nil
    482 }
	solitare A gleam implementation of Solitare encryption scheme
	Log \| Files \| Refs \| README